home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / snobol4 / vsnobol4.arc / DIFF.SNO < prev    next >
Text File  |  1987-12-04  |  4KB  |  140 lines
  1. *    Symbolic differentiation.  Simple transformations for the
  2. *    binary operators +, -, *, /, and ^.
  3. *
  4. *    Provides an interesting example of the usage of OPSYN
  5. *    as well as expression parsing.
  6. *
  7. *    From STRING AND LIST PROCESSING IN SNOBOL4 by Ralph E. Griswold,
  8. *             by permission of the author.
  9. *    ----------------------------------------------------------------
  10. *
  11. *    (c) Copyright 1985, 1987 - Catspaw, Incorporated
  12. *
  13.  
  14. *  PAREN
  15. *    Function to convert an infix expression to fully parenthesized form:
  16. *
  17.     DEFINE("PAREN(PAREN)L,R,OP,M")
  18.     STRIP    =    POS(0) "(" BAL . PAREN ")" RPOS(0)
  19.     ASSIGN    =    *GT(M,0) TAB(*(M - 1)) . L LEN(1) . OP REM . R
  20.     MATPM    =    (POS(0) BAL ANY("+-") @M FAIL) | ASSIGN
  21.     MATMD    =    (POS(0) BAL ANY("*/") @M FAIL) | ASSIGN
  22.     MATE    =    POS(0) BAL . L "^" . OP REM . R        :(PAREN_END)
  23.  
  24. PAREN    PAREN    STRIP                        :S(PAREN)
  25.     PAREN    MATPM                        :S(FORM)
  26.     PAREN    MATMD                        :S(FORM)
  27.     PAREN    MATE                        :F(RETURN)
  28. FORM    PAREN    =    "(" PAREN(L) OP PAREN(R) ")"        :S(RETURN)
  29. PAREN_END
  30.  
  31. *  RULES
  32. *
  33. *    Functions to perform the actual transformations used by D.
  34. *
  35.     DEFINE("ADD(U,V)")
  36.     DEFINE("SUB(U,V)")
  37.     DEFINE("MUL(U,V)")
  38.     DEFINE("DIV(U,V)")
  39.     DEFINE("EXP(U,V)")
  40.     OPSYN("&","+",2)
  41.     OPSYN("#","-",2)
  42.     OPSYN("%","/",2)
  43.     OPSYN("?","*",2)
  44.     OPSYN("@","**",2)
  45.     OPSYN("+","ADD",2)
  46.     OPSYN("-","SUB",2)
  47.     OPSYN("/","DIV",2)
  48.     OPSYN("*","MUL",2)
  49.     OPSYN("**","EXP",2)                    :(RULES_END)
  50.  
  51. *    Some simple reduction rules.
  52. ADD    INTEGER(U)                        :F(ADDV)
  53.     ADD    =    INTEGER(V) U & V            :S(RETURN)
  54.     ADD    =    EQ(U,0) V                :S(RETURN)
  55. ADDT    ADD    =    "(" U "+" V ")"                :(RETURN)
  56. ADDV    INTEGER(V)                        :F(ADDT)
  57.     ADD    =    EQ(V,0) U                :S(RETURN)F(ADDT)
  58.  
  59. SUB    INTEGER(U)                        :F(SUBV)
  60.     SUB    =    INTEGER(V) U # V            :S(RETURN)
  61.     SUB    =    EQ(U,0) V                :S(RETURN)
  62. SUBT    SUB    =    "(" U "-" V ")"                :(RETURN)
  63. SUBV    INTEGER(V)                        :F(SUBT)
  64.     SUB    =    EQ(V,0) U                :S(RETURN)F(SUBT)
  65.  
  66. MUL    INTEGER(U)                        :F(MULV)
  67.     MUL    =    INTEGER(V) U ? V            :S(RETURN)
  68.     MUL    =    EQ(U,0) 0                :S(RETURN)
  69.     MUL    =    EQ(U,1) V                :S(RETURN)
  70. MULT    MUL    =    "(" U "*" V ")"                :(RETURN)
  71. MULV    INTEGER(V)                        :F(MULT)
  72.     MUL    =    EQ(V,0) 0                :S(RETURN)
  73.     MUL    =    EQ(V,1) U                :S(RETURN)F(MULT)
  74.  
  75. DIV    INTEGER(V)                        :F(DIVU)
  76.     EQ(V,0)                            :S(DIVT)
  77.     INTEGER(U)                        :F(DIVT)
  78.     EQ(REMDR(U,V),0)                    :F(DIVT)
  79.     DIV    =    U % V                    :(RETURN)
  80. DIVT    DIV    =    "(" U "/" V ")"                :(RETURN)
  81. DIVU    INTEGER(U)                        :F(DIVT)
  82.     DIV    =    EQ(U,0) 0                :S(RETURN)F(DIVT)
  83.  
  84. EXP    INTEGER(V)                        :F(EXPU)
  85.     EXP    =    EQ(V,0) 1                :S(RETURN)
  86.     EXP    =    EQ(V,1) U                :S(RETURN)
  87.     EXP    =    INTEGER(U) U @ V            :S(RETURN)
  88. EXPT    EXP    =    "(" U "^" V ")"                :(RETURN)
  89. EXPU    INTEGER(U)                        :F(EXPT)
  90.     EXP    =    EQ(U,0) 0                :S(RETURN)
  91.     EXP    =    EQ(U,1) 1                :S(RETURN)F(EXPT)
  92. RULES_END
  93.  
  94. *  D
  95. *    Function to differentiate a parenthesized expression E with
  96. *    respect to string X.  This solution redefines the arithmetic
  97. *    operators to allow writing the transformation rules in a
  98. *    natural, elegant form.  Binary operators only.
  99. *
  100.     DEFINE("D(E,X)U,V,OP")
  101.     BINARY    =    POS(0) "(" BAL . U ANY("+-*/^") . OP BAL . V ")"
  102. +            RPOS(0)                    :(D_END)
  103.  
  104. D    E    BINARY                        :S($("D" OP))
  105.     D    =    IDENT(E,X) 1                :S(RETURN)
  106.     D    =    0                    :(RETURN)
  107. D+    D    =    D(U,X) + D(V,X)                :(RETURN)
  108. D-    D    =    D(U,X) - D(V,X)                :(RETURN)
  109. D*    D    =    U * D(V,X) + V * D(U,X)            :(RETURN)
  110. D/    D    =    (V * D(U,X) - U * D(V,X)) / V ** 2    :(RETURN)
  111. D^    D    =    V * U ** (V - 1) * D(U,X)        :(RETURN)
  112. D_END
  113.  
  114.  
  115. *    Program to test the differentiation routines:
  116. *
  117.  
  118.     &TRIM    =    1
  119.     REMOVE    =    POS(0) "(" BAL . EXP ")" RPOS(0)
  120.     IMAGE    =    BREAK(";") . EXP LEN(1) REM . VAR
  121.  
  122. DTEST    OUTPUT    =    'Type Expression;Variable or null line to '
  123. +            'use previous result and same variable.'
  124.     EXP    =    '3*X^2+6*X-2'
  125.     VAR    =    'X'
  126.     OUTPUT    =    'For example:  ' EXP ';' VAR
  127.  
  128. READ    LINE    =    INPUT                    :F(END)
  129.     IDENT(LINE)                        :S(READ1)
  130.     LINE    IMAGE                        :F(ERROR)
  131. READ1    OUTPUT    =    "The derivative of " EXP " with respect to " VAR
  132. +            " is "
  133.     EXP    =    D(PAREN(EXP),VAR)
  134. READ2    EXP    REMOVE                        :S(READ2)
  135.     OUTPUT    =    EXP
  136.     OUTPUT    =                        :(READ)
  137. ERROR    OUTPUT    =    'Bad input, re-enter'            :(READ)
  138.  
  139. END
  140.