home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / prolog / algebra.arc / SIMPSV.PRO < prev   
Text File  |  1987-04-11  |  11KB  |  384 lines
  1. /* -------------------------------------------------------------------
  2.  
  3.                                SIMPSV.PRO
  4.  
  5.                               (version 1.0)
  6.  
  7.                           Copyright 1987 S.Vaghi
  8.  
  9.  
  10.                 Program for the symbolic simplification of
  11.                             algebraic functions.
  12.  
  13.                 ..........................................
  14.  
  15.  
  16.     Example of how to use the program:
  17.  
  18.         to simplify the expression
  19.                                              (2*1)*(x^(2-1))
  20.             one can
  21.  
  22.                 a) simply enter
  23.                                              s( (2*1)*(x^(2-1)), Z).
  24.                    after the Prolog prompt,
  25.             or
  26.                 b) enter
  27.                                               Y = (2*1)*(x^(2-1)),
  28.                                               s( Y, Z).
  29.                    after the prompt.
  30.  
  31.             In both cases a two pass simplification is performed.
  32.  
  33.  
  34. -------------------------------------------------------------------- */
  35.  
  36.  
  37.  
  38.                  /*  definition of operators */
  39.  
  40. ?-op(11, yfx,  '^').                 /*  exponentiation     */
  41. ?-op( 9,  fx,  '~').                 /*  minus sign         */
  42. ?-op(11,  fx, 'ln').                 /*  natural logarithm  */
  43.  
  44.  
  45.  
  46.              /*  two pass simplification clause  */
  47.  
  48.  
  49.              s(X,Y) :- simplify(X,Z), simplify(Z,Y).
  50.  
  51.  
  52.  
  53.       /*  list processing of the expression to be simplified  */
  54.  
  55.  
  56. simplify(X,X) :- atomic(X), ! .
  57.  
  58. simplify(X,Y) :- X =..[Op,Z], simplify(Z,Z1), u(Op,Z1,Y), ! .
  59.  
  60. simplify(X,Y) :- X =..[Op,Z,W], simplify(Z,Z1),
  61.                  simplify(W,W1),
  62.                  r(Op,Z1,W1,Y), ! .
  63.  
  64.  
  65.  
  66.       /*  simplification clauses for addition  */
  67.  
  68.  
  69. r('+',~X,~X,Z) :- b('*',2,X,W), u('~',W,Z) , ! .
  70. r('+', X, X,Z) :- b('*',2,X,Z), ! .
  71.  
  72. r('+', X,~Y,Z) :- b('-',X,Y,Z), ! .
  73. r('+',~X, Y,Z) :- b('-',Y,X,Z), ! .
  74. r('+',~X,~Y,Z) :- b('+',X,Y,W), u('~',W,Z), ! .
  75.  
  76. r('+',   X, Y/Z, W) :- integer(X), integer(Y), integer(Z),
  77.                        T is Z*X+Y,
  78.                        b('/',T,Z,W), ! .
  79. r('+', X/Z,   Y, W) :- integer(X), integer(Y), integer(Z),
  80.                        T is X+Y*Z,
  81.                        b('/',T,Z,W), ! .
  82.  
  83. r('+',   X, Y+Z, W) :- b('+',Y,Z,T), b('+',X,T,W), ! .
  84. r('+', X+Y,   Z, W) :- b('+',X,Y,T), b('+',T,Z,W), ! .
  85.  
  86. r('+', X*Y,Z*Y,W) :- b('+',X,Z,T), b('*',Y,T,W), ! .
  87. r('+', X*Y,Y*Z,W) :- b('+',X,Z,T), b('*',Y,T,W), ! .
  88. r('+', Y*X,Z*Y,W) :- b('+',X,Z,T), b('*',Y,T,W), ! .
  89. r('+', Y*X,Y*Z,W) :- b('+',X,Z,T), b('*',Y,T,W), ! .
  90.  
  91. r('+',X,Y,Z) :- integer(Y), b('+',Y,X,Z), ! .
  92.  
  93.  
  94.  
  95.       /*  simplification clauses for subtraction  */
  96.  
  97.  
  98. r('-', X,~X,Z) :- b('*',2,X,Z), ! .
  99. r('-',~X, X,Z) :- b('*',2,X,W), u('~',W,Z), ! .
  100.  
  101. r('-', X,~Y,Z) :- b('+',X,Y,Z), ! .
  102. r('-',~X, Y,Z) :- b('+',X,Y,W), u('~',W,Z), ! .
  103. r('-',~X,~Y,Z) :- b('-',Y,X,Z), ! .
  104.  
  105. r('-',   X, Y/Z, W) :- integer(X), integer(Y), integer(Z),
  106.                        T is X*Z-Y,
  107.                        b('/',T,Z,W), ! .
  108. r('-', X/Z,   Y, W) :- integer(X), integer(Y), integer(Z),
  109.                        T is X-Y*Z,
  110.                        b('/',T,Z,W), ! .
  111.  
  112. r('-',   X, Y-Z, W) :- b('-',Y,Z,T), b('-',X,T,W), ! .
  113. r('-', X-Y,   Z, W) :- b('-',X,Y,T), b('-',T,Z,W), ! .
  114.  
  115. r('-', X*Y, Z*Y, W) :- b('-',X,Z,T), b('*',Y,T,W), ! .
  116. r('-', X*Y, Y*Z, W) :- b('-',X,Z,T), b('*',Y,T,W), ! .
  117. r('-', Y*X, Z*Y, W) :- b('-',X,Z,T), b('*',Y,T,W), ! .
  118. r('-', Y*X, Y*Z, W) :- b('-',X,Z,T), b('*',Y,T,W), ! .
  119.  
  120.  
  121.  
  122.       /*  simplification clauses for multiplication  */
  123.  
  124.  
  125. r('*', X, X,Z) :- b('^',X,2,Z), ! .
  126. r('*',~X,~X,Z) :- b('^',X,2,Z), ! .
  127. r('*',~X, X,Z) :- b('^',X,2,W), u('~',W,Z), ! .
  128. r('*', X,~X,Z) :- b('^',X,2,W), u('~',W,Z), ! .
  129.  
  130. r('*',      X, X^(~1), Z) :- b('/',X,X,Z), ! .
  131. r('*', X^(~1),      X, Z) :- b('/',X,X,Z), ! .
  132.  
  133. r('*',   X, 1/X, Z) :- b('/',X,X,Z), ! .
  134. r('*', 1/X,   X, Z) :- b('/',X,X,Z), ! .
  135. r('*',   X, 1/Y, Z) :- b('/',X,Y,Z), ! .
  136. r('*', 1/X,   Y, Z) :- b('/',Y,X,Z), ! .
  137. r('*',   M, N/X, Z) :- atomic(M), atomic(N),
  138.                        b('*',M,N,S), b('/',S,X,Z), ! .
  139. r('*', M/X,   N, Z) :- atomic(M), atomic(N),
  140.                        b('*',M,N,S), b('/',S,X,Z), ! .
  141.  
  142.  
  143. r('*',  X, N/Y, Z) :- atomic(N), b('/',X,Y,S), b('*',N,S,Z), ! .
  144. r('*',N/Y,   X, Z) :- atomic(N), b('/',X,Y,S), b('*',N,S,Z), ! .
  145.  
  146. r('*',     X,Y^(~1),Z) :- b('/',X,Y,Z), ! .
  147. r('*',     X,  X^~Y,Z) :- b('-',Y,1,S), b('^',X,S,T), b('/',1,T,Z), ! .
  148. r('*',X^(~1),     Y,Z) :- b('/',Y,X,Z), ! .
  149. r('*',  X^~Y,     X,Z) :- b('-',Y,1,S), b('^',X,S,T), b('/',1,T,Z), ! .
  150.  
  151. r('*',  X,X^Y,Z) :- b('+',1,Y,S), b('^',X,S,Z), ! .
  152. r('*',X^Y,  X,Z) :- b('+',Y,1,S), b('^',X,S,Z), ! .
  153.  
  154. r('*',~X,~Y,Z) :- b('*',X,Y,Z), ! .
  155. r('*', X,~Y,Z) :- b('*',X,Y,W), u('~',W,Z), ! .
  156. r('*',~X, Y,Z) :- b('*',X,Y,W), u('~',W,Z), ! .
  157.  
  158. r('*',Z^~X,Z^~Y,W) :- b('+',X,Y,S), b('^',Z,S,T), b('/',1,T,W), ! .
  159. r('*',Z^~X, Z^Y,W) :- b('-',Y,X,S), b('^',Z,S,W), ! .
  160. r('*', Z^X,Z^~Y,W) :- b('-',X,Y,S), b('^',Z,S,W), ! .
  161. r('*', Z^X, Z^Y,W) :- b('+',X,Y,T), b('^',Z,T,W), ! .
  162. r('*',X^~Z,Y^~Z,W) :- b('*',X,Y,S), b('^',S,Z,T), b('/',1,T,W), ! .
  163. r('*', X^Z,Y^~Z,W) :- b('/',X,Y,S), b('^',S,Z,W), ! .
  164. r('*',X^~Z, Y^Z,W) :- b('/',Y,X,S), b('^',S,Z,W), ! .
  165. r('*', X^Z, Y^Z,W) :- b('*',X,Y,T), b('^',T,Z,W), ! .
  166.  
  167. r('*', X*Y,   Y, Z) :- b('^',Y,2,S), b('*',X,S,Z), ! .
  168. r('*', Y*X,   Y, Z) :- b('^',Y,2,S), b('*',X,S,Z), ! .
  169. r('*',   Y, X*Y, Z) :- b('^',Y,2,S), b('*',X,S,Z), ! .
  170. r('*',   Y, Y*X, Z) :- b('^',Y,2,S), b('*',X,S,Z), ! .
  171.  
  172. r('*', X*Y, X*Z, W) :- b('*',Y,Z,S), b('^',X,2,T), b('*',T,S,W), ! .
  173. r('*', Y*X, X*Z, W) :- b('*',Y,Z,S), b('^',X,2,T), b('*',T,S,W), ! .
  174. r('*', X*Y, Z*X, W) :- b('*',Y,Z,S), b('^',X,2,T), b('*',T,S,W), ! .
  175. r('*', Y*X, Z*X, W) :- b('*',Y,Z,S), b('^',X,2,T), b('*',T,S,W), ! .
  176.  
  177. r('*',  M, N*X, W) :- atomic(M), atomic(N),
  178.                       b('*',M,N,P), b('*',P,X,W), ! .
  179. r('*',M*X,   N, W) :- atomic(M), atomic(N),
  180.                       b('*',M,N,P), b('*',P,X,W), ! .
  181.  
  182. r('*',   X, Y*Z, W) :- b('*',Y,Z,T), b('*',X,T,W), ! .
  183. r('*', X*Y,   Z, W) :- b('*',X,Y,T), b('*',T,Z,W), ! .
  184.  
  185. r('*',X,Y,Z) :- integer(Y), b('*',Y,X,Z), ! .
  186.  
  187.  
  188.  
  189.       /*    simplification clauses for division
  190.            (division is never actually performed)  */
  191.  
  192.  
  193. r('/', 1, X/Y, Z) :- b('/',Y,X,Z), ! .
  194. r('/',~1, X/Y, Z) :- b('/',Y,X,W), u('~',W,Z), ! .
  195.  
  196. r('/',~X,~Y,Z) :- b('/',X,Y,Z), ! .
  197. r('/', X,~Y,Z) :- b('/',X,Y,W), u('~',W,Z), ! .
  198. r('/',~X, Y,Z) :- b('/',X,Y,W), u('~',W,Z), ! .
  199.  
  200. r('/',      X, Y^(~1), Z) :- b('*',X,Y,Z), ! .
  201. r('/', X^(~1),      Y, Z) :- b('*',X,Y,W), b('/',1,W,Z), ! .
  202.  
  203. r('/',   X, Y/Z, W) :- b('*',X,Z,T), b('/',T,Y,W), ! .
  204. r('/', X/Y,   Z, W) :- b('*',Y,Z,T), b('/',X,T,W), ! .
  205.  
  206. r('/',     X,Y^(~Z),W) :- b('^',Y,Z,T), b('*',X,T,W), ! .
  207. r('/',X^(~Z),     Y,W) :- b('^',X,Z,S), b('*',S,Y,T), b('/',1,T,W), ! .
  208.  
  209. r('/',X,X^(~Y),Z) :- b('+',1,Y,S), b('^',X,S,Z), ! .
  210. r('/',X,   X^Y,Z) :- b('-',Y,1,S), b('^',X,S,T), b('/',1,T,Z), ! .
  211. r('/',X^(~Y),X,Z) :- b('+',Y,1,S), b('^',X,S,T), b('/',1,T,Z), ! .
  212.  
  213. r('/',   X^Y,     X,Z) :- b('-',Y,1,S), b('^',X,S,Z), ! .
  214. r('/',   X^N,X^(~M),Z) :- b('+',N,M,S), b('^',X,S,Z), ! .
  215. r('/',X^(~N),   X^M,Z) :- b('+',N,M,S), b('^',X,S,T), b('/',1,T,Z), ! .
  216. r('/',X^(~N),X^(~M),Z) :- b('-',M,N,S), b('^',X,S,Z), ! .
  217. r('/',   X^N,   X^M,Z) :- b('-',N,M,W), b('^',X,W,Z), ! .
  218.  
  219. r('/',X^(~Z),   Y^Z,W) :- b('*',X,Y,S), b('^',S,Z,T), b('/',1,T,W), ! .
  220. r('/',   X^Z,Y^(~Z),W) :- b('*',X,Y,S), b('^',S,Z,W), ! .
  221. r('/',X^(~Z),Y^(~Z),W) :- b('/',Y,X,S), b('^',S,Z,W), ! .
  222. r('/',   X^Z,   Y^Z,W) :- b('/',X,Y,T), b('^',T,Z,W), ! .
  223.  
  224.  
  225.  
  226.       /*  simplification clauses for exponentiation  */
  227.  
  228.  
  229. r('^',X,~1,Y) :- b('/',1,X,Y), ! .
  230.  
  231. r('^',X,~Y,Z) :- b('^',X,Y,W), b('/',1,W,Z), ! .
  232.  
  233. r('^',X^Y,Z,W) :- b('*',Y,Z,T), b('^',X,T,W), ! .
  234.  
  235.  
  236.  
  237.       /*  catch all clause to cover cases not covered
  238.           by the previous clauses                      */
  239.  
  240.  
  241. r(X,Y,Z,W) :- b(X,Y,Z,W).
  242.  
  243.  
  244.  
  245.       /*  basic rules for the unary operator '~'  */
  246.  
  247.  
  248. u('~', 0, 0) :- ! .
  249. u('~',~X, X) :- ! .
  250. u('~', X,~X) :- ! .
  251. u('~',X^Y,~(X^Y) ) :- ! .
  252.  
  253.  
  254.  
  255.       /*  basic rules of addition  */
  256.  
  257.  
  258. b('+', X, 0, X) :- ! .
  259. b('+',~X, 0,~X) :- ! .
  260. b('+', 0, X, X) :- ! .
  261. b('+', 0,~X,~X) :- ! .
  262. b('+', X,~X, 0) :- ! .
  263. b('+',~X, X, 0) :- ! .
  264.  
  265. b('+',X,Y,Z) :- integer(X), integer(Y),
  266.                 Z is X+Y, ! .
  267.  
  268. b('+',X,Y,X+Y).
  269.  
  270.  
  271.       /*  basic rules of subtraction  */
  272.  
  273.  
  274. b('-', X, 0, X) :- ! .
  275. b('-',~X, 0,~X) :- ! .
  276. b('-', 0, X,~X) :- ! .
  277. b('-', 0,~X, X) :- ! .
  278. b('-',~X,~X, 0) :- ! .
  279. b('-', X, X, 0) :- ! .
  280.  
  281. b('-',X,Y,Z) :- integer(X), integer(Y),
  282.                 Z is X-Y, ! .
  283.  
  284. b('-',X,Y,X-Y).
  285.  
  286.  
  287.  
  288.       /*  basic rules of multiplication  */
  289.  
  290.  
  291. b('*', 0, X,0) :- ! .
  292. b('*', 0,~X,0) :- ! .
  293. b('*', X, 0,0) :- ! .
  294. b('*',~X, 0,0) :- ! .
  295.  
  296. b('*', 1, X, X) :- ! .
  297. b('*', 1,~X,~X) :- ! .
  298. b('*',~1, X,~X) :- ! .
  299. b('*',~1,~X, X) :- ! .
  300. b('*', X, 1, X) :- ! .
  301. b('*',~X, 1,~X) :- ! .
  302. b('*', X,~1,~X) :- ! .
  303. b('*',~X,~1, X) :- ! .
  304.  
  305. b('*', X/Y,   Y, X) :- ! .
  306. b('*',   Y, X/Y, X) :- ! .
  307.  
  308. b('*',X,Y,Z) :- integer(X), integer(Y),
  309.                 Z is X*Y, ! .
  310.  
  311. b('*',X,Y,X*Y).
  312.  
  313.  
  314.  
  315.       /*  basic rules of division  */
  316.  
  317.  
  318. b('/',0,0,'ERROR - indefinite form 0/0') :- ! .   /* indefinite form */
  319. b('/',X,0,'ERROR - division by 0      ') :- ! .   /* division by 0   */
  320.  
  321. b('/',0, X,0) :- ! .
  322. b('/',0,~X,0) :- ! .
  323.  
  324. b('/', X,1, X) :- ! .
  325. b('/',~X,1,~X) :- ! .
  326.  
  327. b('/', 1,X,    1/X) :- ! .
  328. b('/',~1,X, ~(1/X)) :- ! .
  329.  
  330. b('/', X,~1,~X) :- ! .
  331. b('/',~X,~1, X) :- ! .
  332.  
  333. b('/', 1,  ~X,~(1/X)) :- ! .
  334. b('/',~1,  ~X,   1/X) :- ! .
  335. b('/', 1, 1/X,     X) :- ! .
  336. b('/',~1, 1/X,    ~X) :- ! .
  337.  
  338. b('/', X,~X,~1) :- ! .
  339. b('/',~X, X,~1) :- ! .
  340. b('/',~X,~X, 1) :- ! .
  341. b('/', X, X, 1) :- ! .
  342.  
  343. b('/',X,Y,X/Y).
  344.  
  345.  
  346.  
  347.       /*  basic rules of exponentiation  */
  348.  
  349.  
  350. b('^',1,X,1) :- ! .
  351.  
  352.                                                   /* indefinite forms */
  353.  
  354. b('^',0, 0,'ERROR - indefinite form 0^0       ') :- ! .
  355. b('^',0,~1,'ERROR - indefinite form 0^~1 = 1/0') :- ! .
  356. b('^',0,~K,'ERROR - indefinite form 0^~K = 1/0') :- atomic(K), ! .
  357.  
  358.  
  359. b('^',~X,1,~X) :- ! .
  360. b('^', X,1, X) :- ! .
  361. b('^', X,0, 1) :- ! .
  362.  
  363.  
  364.                                         /* recursive clauses to
  365.                                            calculate the n-th power
  366.                                            of positive and negative
  367.                                            integers                 */
  368.  
  369. b('^', X,N,Y) :- integer(X), integer(N),
  370.                  M is N-1, b('^',X,M,Z),
  371.                  Y is Z*X, ! .
  372. b('^',~X,N,Y) :- integer(X), integer(N),
  373.                  R is (N mod 2), R \= 0,
  374.                  b('^',X,N,Z), Y = ~Z, ! .
  375. b('^',~X,N,Y) :- integer(X), integer(Y),
  376.                  R is (N mod 2), R = 0,
  377.                  b('^',X,N,Z), Y =  Z, ! .
  378.  
  379. b('^',~X,Y, ~(X^Y)) :- ! .
  380.  
  381. b('^',X,Y,X^Y).
  382.  
  383.  
  384.