Metropoli BBS
VIEWER: laplace.src MODE: TEXT (ASCII)
%%HP: T(3)A(D)F(.);
@ LAPLACE by John Meissner
DIR
  L2EQ
    \<< DUP ROT ROT PF SWAP \->QUAD 0 0 0 0 0 1
      \-> numer denom count a b r1 r2 dups
      \<< denom SIZE 1
        FOR count
          IF count denom SIZE <
          THEN
            IF denom count GETI ROT ROT GET ==
            THEN dups 1 + 'dups' STO
            ELSE 1 'dups' STO
            END
          END denom count GET
          IF DUP TYPE 5 ==
          THEN LIST\-> DROP
            IF OVER
            THEN 2 \->LIST { 1 0 0 } PADD RT DROP C\->R 'r2' STO
              NEG 'r1' STO numer count GET 1 r1 2 \->LIST PDIV
              LIST\-> DROP 'b' STO LIST\-> DROP 'a' STO
              'a*EXP(-r1*T)*COS(r2*T)*u(T)+b/r2*EXP(-r1*T)*SIN(r2*T)*u(T)'
              EVAL
            ELSE \v/ 'r2' STO 'r1' STO numer count GET LIST\-> DROP
            'b' STO 'a' STO
              IF dups 1 >
              THEN
                'a*T*COS(r2*T)*u(T)+b/(2*r2)*T*SIN(r2*T)*u(T)' EVAL
              ELSE
                'a*COS(r2*T)*u(T)+b/r2*SIN(r2*T)*u(T)' EVAL
              END
            END
          ELSE 'r1' STO numer count GET 'a' STO
            IF r1
            THEN
              IF dups 1 >
              THEN
                'a/(dups-1)!*T^(dups-1)*EXP(-r1*T)*u(T)' EVAL
              ELSE
                'a*EXP(-r1*T)*u(T)' EVAL
              END
            ELSE
              IF dups 1 >
              THEN
                'a/(dups-1)!*T^(dups-1)*u(T)' EVAL
              ELSE
                'a*u(T)' EVAL
              END
            END
          END
          IF count denom SIZE <
          THEN +
          END -1
        STEP
      \>>
    \>>
  \->QUAD
    \<< DUP SIZE 0 0 0 0
      \<<
        IF DUP IM NOT
        THEN RE
        END
      \>> \-> numer denom count a b r1 r2 reduce
      \<<
        WHILE count 1 >
        REPEAT denom count 1 - GETI 'r1' STO GET 'r2' STO
          IF r1 IM 0 \=/ r1 CONJ r2 == AND
          THEN numer count 1 - GETI 'a' STO GET 'b' STO
            denom count 1 - r1 r2 + NEG reduce EVAL r1 r2 * reduce EVAL
            2 \->LIST PUT LIST\-> DUP count - 2 + ROLL DROP 1 - \->LIST
            'denom' STO numer count 1 - a b + reduce EVAL a r2 * b r1 *
            + NEG reduce EVAL 2 \->LIST PUT LIST\-> DUP count - 2 + ROLL
            DROP 1 - \->LIST 'numer' STO count 2 - 'count' STO
          ELSE denom count DUP2 GET NEG PUT 'denom' STO numer count DUP2
            GET reduce EVAL PUT 'numer' STO count 1 - 'count' STO
          END
        END numer denom
        IF count
        THEN SWAP 1 DUP2 GET reduce EVAL PUT SWAP 1 DUP2 GET NEG PUT
        END
      \>>
    \>>
  \->L
    \<<
      { '&k*(T-&a)^&n*u(T-&a)' '&k*&n!/S^(&n+1)*EXP(-&a*S)' } \|vMATCH DROP
      { '&k*u(T-&a)' '&k*u(T)*EXP(-&a*S)' } \|vMATCH DROP
      { '&k*r(T-&a)' '&k*r(T)*EXP(-&a*S)' } \|vMATCH DROP
      { '&k*d(T-&a)' '&k*d(T)*EXP(-&a*S)' } \|vMATCH DROP
      { '&k*d(T)' &k } \|vMATCH DROP
      { '&k*r(T)' '&k/S^2' } \|vMATCH DROP
      { '&k*T^&n*u(T)' '&k*&n!/S^(&n+1)' } \|vMATCH DROP
      { '&k*T^&n*EXP(&a*T)*u(T)' '&k*&n!/(S-&a)^(&n+1)' } \|vMATCH DROP
      { '&k*EXP(&a*T)*COS(&\Gw*T)*u(T)' '&k*(S-&a)/((S-&a)^2+&\Gw^2)' }
        \|vMATCH DROP
      { '&k*EXP(&a*T)*SIN(&\Gw*T)*u(T)' '&k*&\Gw/((S-&a)^2+&\Gw^2)' }
        \|vMATCH DROP
      { '&k*T*COS(&\Gw*T)*u(T)' '&k*(S^2-&\Gw^2)/(S^2+&\Gw^2)^2' }
        \|vMATCH DROP
      { '&k*T*SIN(&\Gw*T)*u(T)' '&k/(2*&\Gw)*S/(S^2+&\Gw)^2' } \|vMATCH DROP
      { '&k*COS(&\Gw*T+&\Gh)*u(T)'
        '&k*(S*COS(&\Gh)-&\Gw*SIN(&\Gh))/(S^2+&\Gw^2)' } \|vMATCH DROP
      { '&k*SIN(&\Gw*T+&\Gh)*u(T)'
        '&k*(S*SIN(&\Gh)+&\Gw*COS(&\Gh))/(S^2+&\Gw^2)' } \|vMATCH DROP
      { '&k*COS(&\Gw*T)*u(T)' '&k*S/(S^2+&\Gw^2)' } \|vMATCH DROP
      { '&k*SIN(&\Gw*T)*u(T)' '&k*&\Gw/(S^2+&\Gw^2)' } \|vMATCH DROP
      { '&k*(EXP(&\Ga*T)-EXP(&\Gg*T))*u(T)' '&k/((S-&\Ga)*(S-&\Gg))' }
        \|vMATCH DROP
      { '&k*EXP(&a*T)*u(T)' '&k/(S-&a)'} \|vMATCH DROP
      { '&k*u(T)' '&k/S' } \|vMATCH DROP
    \>>
  L\->
    \<<
      { '&k/S' '&k*u(T)' } \|vMATCH DROP
      { '&k/(S+&a)' '&k*EXP(-&a*T)*u(T)' } \|vMATCH DROP
      { '&k/S^2' '&k*r(T)' } \|vMATCH DROP
      { '&k/S^&n' '&k/(&n-1)!*T^(&n-1)*u(T)' } \|vMATCH DROP
      { '&k/(S+&a)^&n' '&k/(&n-1)!*T^(&n-1)*EXP(-&a*T)*u(T)' } \|vMATCH DROP
      { '&k/S^&n*EXP(&a*S)' '&k/(&n-1)!*(T-&a)^(&n-1)*u(T-&a)' } \|vMATCH DROP
      { '&k*(S+&a)/((S+&a)^2+&\Gw)' '&k*EXP(-&a*T)*COS(\v/&\Gw*T)*u(T)' }
        \|vMATCH DROP
      { '&k/((S+&a)^2+&\Gw)' '&k/\v/&\Gw*EXP(-&a*T)*SIN(\v/&\Gw*T)*u(T)' }
        \|vMATCH DROP
      { '&k*(S^2-&\Gw)/(S^2+&\Gw)^2' '&k*T*COS(\v/&\Gw*T)*u(T)' }
        \|vMATCH DROP
      { '&k*S/(S^2+&\Gw)^2' '&k/(2*\v/&\Gw)*T*SIN(\v/&\Gw*T)*u(T)' }
        \|vMATCH DROP
      { '&k*(S*COS(&\Gh)-&\Gw*SIN(&\Gh))/(S^2+&\Gr)'
        '&k*COS(&\Gw*T+&\Gh)*u(T)' } \|vMATCH DROP
      { '&k*(S*SIN(&\Gh)+&\Gw*COS(&\Gh))/(S^2+&\Gr)'
        '&k*SIN(&\Gw*T+&\Gh)*u(T)' } \|vMATCH DROP
      { '&k*S/(S^2+&\Gw)' '&k*COS(\v/&\Gw*T)*u(T)' } \|vMATCH DROP
      { '&k/(S^2+&\Gw)' '&k/\v/&\Gw*SIN(\v/&\Gw*T)*u(T)' } \|vMATCH DROP
      { '&k/((S+&\Ga)*(S+&\Gg))'
        '&k/(&\Gg-&\Ga)*(EXP(-&\Ga*T)-EXP(-&\Gg*T))*u(T)' } \|vMATCH DROP
      { '&k*&f(T)*EXP(&a*S)' '&k*&f(T+&a)' } \|vMATCH DROP
      { '&k*EXP(&a*S)' '&k*d(T+&a)' } \|vMATCH DROP
    \>>
END
[ RETURN TO DIRECTORY ]