home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol166 / deriv.rec < prev    next >
Encoding:
Text File  |  1984-04-29  |  7.8 KB  |  289 lines
  1.  
  2. [DERIV.REC]
  3. [Calculate symbolic derivatives]
  4. [Harold V. McIntosh, 26 July 1983]
  5.  
  6. [[]]
  7.  
  8. {
  9.                    {
  10.     [find/make FCB]        (Jj'TTY:'EQZD;(':'UQD':'ED\64-%;0%;)
  11.                  ('.'U<(8a;@b;)Q|D>;Z'.DAT'IJj:)
  12.                   '.'FJDZ(3a;@b;)Q|JZDI
  13.                  32(dpGm$r0=npGpGd0&$Sm@znpGQ&$rrS0;
  14.                  r12wQmwnEn;n:)D;) f
  15.     [blank fill by count]    (Zz(d' 'I:;)JZ;) b
  16.     [zero fill]            (cmpw0%(f:;)w;) 0
  17.     [zero FCB & buffer]        ($m33@0130@0nn&0||pLnS;) z
  18.     [set default input file]    (0,30$S'5C'H12wA' 'Ew4@0n0|0|pL31$S
  19.                  'TTY:'31$rrS; B9aQD(3a'   'E
  20.                  'DAT';Q;)|mw31@zn31$rrS31@r;) i
  21.     [open for read]        (@hr15K(255='NO FILE'I;L;)L;) r
  22.     [open for write]        (@hpGpG4+1&SrpG19k22k^^r128&S;) w
  23.     [set DMA address]        ($rpG^^r^^26k;) h
  24.     [open]            (m@f0=n@@;nLL;) O
  25.     [read]            (''(AL@f(0=pG@r;'TTY:'(='T');))
  26.                  ('T'='';L31pG$rr12w'TTY:'Ew;w)
  27.                  L@&'> 'TL(@#I;:);
  28.                  $r(pG^^rpGmr(0=(npGpGm128&S^^26kpGr
  29.                  20K0=L;LL1npGpGm129+26%&SS;)npGmr;;)
  30.                  pG130&-n+&dm(u13%=;10%(=)pGI(26%=;
  31.                  L);ndm:)L^^rn&S;LpG^^r0&S:);) R
  32.     [write]            (Jj'='U<(A@f'TTY:'(=)(0=pG@w;;))>'='ED
  33.                  ZqtD; >'='EDZ<@g;) W
  34.     [write to disk]        ($r(pG^^rpGpGmrpGm- 130+n&maQD>Z<nSn^^
  35.                  26kpGr21kpG^^r128&S:JZQD>nSnSL;);) g
  36.     [close all files]        (31pGm($r0=;pG4+r(0=L;LJj26%I<npGm@gpG
  37.                  ^^rpGr127(N^^26kpGr21k;L;)r16k;)ndpGm:)
  38.                  nL;;) c
  39.     [PVR]            (pG@&#'= '|TL$r(0='undef';yG;)TL;) _
  40.     [cr, lf]            (2573TL;)&
  41.     [insert cr, lf]        (2573I;)|
  42.     [read console]        (R13%='';08%(=)(T@#|;08%T' 'TLTLL@#;);)#
  43.     [type comment]        (@TD;)C
  44.     [display at logon]        ('
  45. Symbolic differentiation is a symbol manipulation process, in
  46. which the known rules for derivatives, such as: the derivative
  47. of a sum is a sum of derivatives, the derivative of a product
  48. is a sum in which one factor is differentiated at a time, or
  49. the chain rule for the derivative of a function of a function,
  50. are applied recursively until finally the derivative of a constant
  51. is zero or the derivative of the variable iself is one.
  52.  
  53. Enter an algebraic expression - only sums, differences, products,
  54. and quotients are considered, and only integer constants. Terms
  55. may be enclosed in parentheses.  Terminate your expression with a
  56. carriage return. The expression will be parsed and differentiated,
  57. finally the result shown; the result may be surprising because very
  58. little simplification and no rearrangement is made. Exit with a
  59. single carriage return. The message "other" indicates an error.
  60. 'TL@&;)D
  61.     [write workspace]        (@&JZqt;)T
  62.                 (@@;) }%
  63.     [integer arithmetic]    {(+;)+ (-;)- (*;)* (/&L;)/
  64.                 (pGm/L1=nL1;0=n;n&:)|
  65.                  ((pGmJj(U);QD(O)I;npGmEDZQD(O)IjnpGmI;
  66.                  n@@#I)nLJZ;;) } #
  67.     [save & init variables]    (pGpGm$rm0&$S;) (
  68.     [reinitialize variable]    (pG$r0=L;LnL0&$S;) :
  69.     [undefine variable]        ($r0=;LnL;) )
  70.     [compare/define variable]    (pG$r0=ZQzml&$S;&LyGEz;
  71.     ) ]
  72.     [body of variable search]    (pG$r(0=)yG(E;&L)z&L@=L;pG$r(0=;LL)
  73.                   Z<((&pGm&n(F;''mZz<)jJQmpGl&$S
  74.                   zZ<@=>;J>);nLA:0&$SL>)>LL;) >
  75.     [body of variable search]    (pG$r(0=)yGEz@=L;pG$r(0=;LL)
  76.                   Z<((jJQmpGl&$S
  77.                   zZ<@=>;J>);nLA:0&$S>)>L;) <
  78.     [insert variable]        ($ryGI;) [
  79.                 
  80. [individual cases]
  81. {(0@( 1@( {(0@: 1@: ;); (
  82.         @;(J2573TL'intermediate 'TLZqtj()JZD;);
  83.   [sum]        @;(J [and] Z<( ([itr] Z<'+'Ez>; J>@j:) [itr]  
  84.     jJ>< {[vbl] ('+'Ez(A);) =
  85.     ('+'0@>;)}[vbl] (A);>)>
  86.      [and] 1@]JZDz<z<0@[@xZ>
  87.     ','Iz<1@[@xZ>
  88.     @sZ>;);
  89.   [difference]    @;(J [and] Z<(([ITR] Z<@l'-'Ez>:J>;)[ITR]  
  90.     jJ>< {[vbl] ('-'Ez(A);) =
  91.     ('-'0@>;)}[vbl] (A);>)>
  92.      [and] 1@]JZDz<z<0@[@xZ>
  93.     ','Iz<1@[@xZ>
  94.     @mZ>;);
  95.   [product]    @;(J [and] Z<( ([itr] Z<'*'Ez>; J>@j:) [itr]  
  96.     jJ>< {[vbl] ('*'Ez(A);) =
  97.     ('*'0@>;)}[vbl] (A);>)>
  98.      [and] 1@]JZDz<z<0@[','Iz<1@[@xZ>
  99.     @pZ>','Iz<z<0@[@xZ>
  100.     ','I1@[@pZ>@sZ>;);
  101.   [quotient]    @;(J [and] Z<( ([itr] Z<'/'Ez>; J>@j:) [itr]  
  102.     jJ>< {[vbl] ('/'Ez(A);) =
  103.     ('/'0@>;)}[vbl] (A);>)>
  104.      [and] 1@]JZDz<'('Iz<z<z<z<0@[@xZ>
  105.     ','I1@[@pZ>','Iz<0@[','Iz<1@[@xZ>
  106.     @pZ>@mZ>@uZ>'),'Iz<1@[','I1@[@pZ>@qZ>;);
  107.   [paren]    @;(J [and] Z<(@i(A) 
  108.     jJ><'('Ez {[vbl] (')'Ez(A);) =
  109.     (0@<;)}[vbl] (A);>)>
  110.      [and] JZD0@[;):
  111.   [unary -]    @;(J'-'Ez0@]JZDz<z<0@[@xZ>
  112.     @nZ>;);
  113.   [variable]    @;(J'x'Ez(A)JZD'1'I;);
  114.   [constant]    @;(J@j(A)JZD'0'I;);
  115.   [other]    @;(J0@]JZDz<'other: 'I0@['C'@%Z>;);
  116.   ;)} 0@) 1@)   nn$S nn$S;)} x
  117.  
  118. [simplify difference]
  119. {(0@( 1@( {(0@: 1@: ;); (
  120.         @;(J {[vbl] (','Ez0@];) =
  121.     (0@<;)}[vbl] JZD'0'I;);
  122.         @;(J {[vbl] (',0'Ez(A);) =
  123.     (0@<;)}[vbl] JZD0@[;);
  124.         @;(J'0,'Ez0@]JZDz<0@[@nZ>;);
  125.         @;(J [and] Z<(@U','Ez@U(A) 
  126.     jJ>< {[vbl] (','Ez1@];) =
  127.     (0@<;)}[vbl] (A);>)>
  128.      [and] JZDz<0@['-'I1@['-'@#Z>;);
  129.         @;(J {[vbl] (','Ez1@];) =
  130.     (0@<;)}[vbl] JZD0@['-'I1@[;);
  131.   ;)} 0@) 1@)   nn$S nn$S;)} m
  132.  
  133. [simplify negative]
  134. {(0@( {(0@: ;); (
  135.         @;(J'0'Ez(A)JZD'0'I;);
  136.         @;(J'('Ez [and] Z<( [or] Z<('-'Ez;
  137.      J;>)>
  138.      [or] @k 
  139.     jJ><0@](A);>)>
  140.      [and] ')'Ez(A)JZD0@[;):
  141.         @;(J'-'Ez [and] Z<(@k(A) 
  142.     jJ><0@](A);>)>
  143.      [and] JZD0@[;);
  144.         @;(J [and] Z<(@k(A) 
  145.     jJ><0@](A);>)>
  146.      [and] JZD'-'I0@[;);
  147.         @;(J0@]JZD'-('I0@[')'I;);
  148.   ;)} 0@)   nn$S;)} n
  149.  
  150. [parenthesize composite]
  151. {(0@( {(0@: ;); (
  152.         @;(J [and] Z<(@k(A) 
  153.     jJ><0@](A);>)>
  154.      [and] JZD0@[;);
  155.         @;(J0@]JZD'('I0@[')'I;);
  156.   ;)} 0@)   nn$S;)} o
  157.  
  158. [simplify product]
  159. {(0@( 1@( {(0@: 1@: ;); (
  160.         @;(J'0,'Ez((Z<>;J>);A:)JZD'0'I;);
  161.         @;(J((Z<',0'Ez(A)>;J>);A:)JZD'0'I;);
  162.         @;(J'1,'Ez0@]JZD0@[;);
  163.         @;(J {[vbl] (',1'Ez(A);) =
  164.     (0@<;)}[vbl] JZD0@[;);
  165.         @;(J [and] Z<(@U','Ez@U(A) 
  166.     jJ>< {[vbl] (','Ez1@];) =
  167.     (0@<;)}[vbl] (A);>)>
  168.      [and] JZDz<0@['*'I1@['*'@#Z>;) ;
  169.         @;(J {[vbl] (','Ez1@];) =
  170.     (0@<;)}[vbl] JZDz<0@[@oZ>'*'Iz<1@[@oZ>;);
  171.   ;)} 0@) 1@)   nn$S nn$S;)} p
  172.  
  173. [simplify quotient]
  174. {(0@( 1@( {(0@: 1@: ;); (
  175.         @;(J'0,'Ez((Z<>;J>);A:)JZD'0'I;);
  176.         @;(J'('Ez [and] Z<(@k 
  177.     jJ><0@](A);>)>
  178.      [and] '),'Ez1@]JZD0@[','I1@[;):
  179.         @;(J'(-'Ez [and] Z<(@k 
  180.     jJ><0@](A);>)>
  181.      [and] '),'Ez1@]JZD'-'I0@[','I1@[;):
  182.         @;(J {[vbl] (',1'Ez(A);) =
  183.     (0@<;)}[vbl] JZD0@[;);
  184.         @;(J {[vbl] (','Ez1@];) =
  185.     (0@<;)}[vbl] JZDz<0@[@oZ>'/'Iz<1@[@oZ>;);
  186.   ;)} 0@) 1@)   nn$S nn$S;)} q
  187.  
  188. [simplify sum]
  189. {(0@( 1@( {(0@: 1@: ;); (
  190.         @;(J'0,'Ez0@]JZD0@[;);
  191.         @;(J {[vbl] (',0'Ez(A);) =
  192.     (0@<;)}[vbl] JZD0@[;);
  193.         @;(J [and] Z<(@U','Ez@U(A) 
  194.     jJ>< {[vbl] (','Ez1@];) =
  195.     (0@<;)}[vbl] (A);>)>
  196.      [and] JZDz<0@['+'I1@['+'@#Z>;);
  197.         @;(J {[vbl] (','Ez0@];) =
  198.     (0@<;)}[vbl] JZD'2*'I0@[;);
  199.         @;(J {[vbl] (','Ez1@];) =
  200.     (0@<;)}[vbl] JZD0@['+'I1@[;);
  201.   ;)} 0@) 1@)   nn$S nn$S;)} s
  202.  
  203. [negate expression]
  204. {(0@( 1@( {(0@: 1@: ;); (
  205.     @;(J [and] Z<(@l 
  206.     jJ><0@](A);>)>
  207.      [and] '+'Ez1@]JZD0@['-'Iz<1@[@tZ>;);
  208.     @;(J [and] Z<(@l 
  209.     jJ><0@](A);>)>
  210.      [and] '-'Ez1@]JZD0@['+'Iz<1@[@tZ>;);
  211.   ;)} 0@) 1@)   nn$S nn$S;)} t
  212.  
  213. [common level for sum or difference]
  214. {(0@( 1@( {(0@: 1@: ;); (
  215.     @;(J [and] Z<(@i 
  216.     jJ><'('Ez {[vbl] (')'Ez;
  217.     ) =
  218.     (0@<;)}[vbl] (A);>)>
  219.      [and] '+'Ez [and] Z<(@i 
  220.     jJ><'('Ez {[vbl] (')'Ez;
  221.     ) =
  222.     (1@<;)}[vbl] (A);>)>
  223.      [and] JZD0@['+'I1@[;);
  224.     @;(J [and] Z<(@i 
  225.     jJ><'('Ez {[vbl] (')'Ez;
  226.     ) =
  227.     (0@<;)}[vbl] (A);>)>
  228.      [and] '-'Ez [and] Z<(@i 
  229.     jJ><'('Ez {[vbl] (')'Ez;
  230.     ) =
  231.     (1@<;)}[vbl] (A);>)>
  232.      [and] JZD0@['-'Iz<1@[@tZ>;);
  233.   ;)} 0@) 1@)   nn$S nn$S;)} u
  234.  
  235. [collect]
  236. {(0@( 1@( 2@( {(0@: 1@: 2@: ;); (
  237.   ;)} 0@) 1@) 2@)   nn$S nn$S nn$S;)} v
  238.  
  239. [main program]
  240. {
  241.   [alfanum]  ( [and] Z<(1(a;L)z 
  242.     jJ><' ''~'Mz(A);>)>
  243.      [and] ;) a
  244.   [numeric]  ( [and] Z<(1(a;L)z 
  245.     jJ><'0''9'Mz(A);>)>
  246.      [and] ;) b
  247.   [uconst]   (@b([ITR] Z<@b>:J>;)[ITR] ;) U
  248.   [number]   ( [or] Z<('-'Ez;
  249.      J;>)>
  250.      [or] @U;) c
  251.   [pelem]    ( [and] Z<(1(a;L)z 
  252.     jJ><[not] (Z<  [or] Z<('('Ez;
  253.      J')'Ez;
  254.     >)>
  255.      [or] J>)J>[not] Zz(A);>)>
  256.      [and] ;) e
  257.   [telem]    ( [and] Z<(1(a;L)z 
  258.     jJ><[not] (Z<  [or] Z<('('Ez;
  259.      J')'Ez;
  260.      J'+'Ez;
  261.      J'-'Ez;
  262.      J'*'Ez;
  263.      J'/'Ez;
  264.     >)>
  265.      [or] J>)J>[not] Zz(A);>)>
  266.      [and] ;) f
  267.   [token]    (@f([ITR] Z<@f>:J>;)[ITR] ;) g
  268.   [paren]    ('('Ez([ITR] Z<@j>:J>;)[ITR] ')'Ez;
  269.     ) i
  270.   [term]     ( [or] Z<(@i; J@e;>)>
  271.      [or] ;) j
  272.   [t or p]   ( [or] Z<(@g; J@i;>)>
  273.      [or] ;) k
  274.   [prqu]     (@k([ITR] Z< [or] Z<('*'Ez;
  275.      J'/'Ez;
  276.     >)>
  277.      [or] @k>:J>;)[ITR] ;) l
  278.  
  279.   (0@( {(0@: ;); (
  280.     @;(J [or] Z<(';'Ez;
  281.      J(A);>)>
  282.      [or] JZD'goodbye'I;);
  283.     @;(J0@]JZDz<z<0@[@xZ>
  284.     'C'@%Z>z<'R'@%Z>;):
  285.   ;)} 0@)   nn$S;)} ~
  286. ('i'@%'D'@%'R'@%@~JZqt'c'@%;)  }
  287.  
  288. [end]
  289.