1:- module(tidy). % SEPIA header 2 3:- lib(struct). 4:- import copy_ground/3, subst/3 from struct. 5 6eval(X) :- call(X). 7add(A,B,C) :- +(A,B,C). 8multiply(A,B,C) :- *(A,B,C). 9power(A,B,C) :- ^(A,B,C). 10 11:- dynamic simplify_axiom/2. 12 13simple(X) :- var(X), !. 14simple(X) :- atomic(X). 15 16 17/* File : TIDY.PL 18 Author : R.A.O'Keefe 19 Updated: 2 June 1984 20 Purpose: Limited algebraic expression simplifier. 21 22 This is a new implementation of tidy, written in an attempt to remedy 23 some of the deficiencies of the old one. Unfortunately, it has a few 24 of its own. The only completely satisfactory approach seems to be to 25 keep all expressions in bag form all the time. 26 27 Tidy has now been split into two parts: tidy_stmt and tidy_expr. 28 <stmt> ::= <stmt> # <stmt> % disjunction 29 | <stmt> & <stmt> % conjunction 30 | <expr> R <expr> % equation/inequality 31 where R is one of = < > \= >= =< 32 An <expr> is an ordinary algebraic expression. Statements are scanned 33 top-down, and no great effort is expended on them beyond a limited bit 34 of evaluation. Expressions are scanned bottom-up, and are worked hard. 35 36 Tidy_stmt works from top down. It doesn't bother putting statements in 37 bag form, although since & (and) and # (or) are both commutative and 38 associative it could well do so. It does however do some flattening of 39 statements: (E1 & E2) & E3 -> E1 & (E2 & E3). This can do no harm. As 40 an experiment, tidy_stmt tries to put constants on the right-hand-sides 41 of equations. E.g. "x+y-3 = 0" -> "x+y = 3". Just how useful this may 42 be remains to be seen. The code for combine_and and combine_or comes 43 almost directly from the original tidy. 44 45 The intermediate form makes use of a different representation of bags. 46 A plus (times) bag is stored as +(Tree, Hole, Num) {*(Tree, Hole, Num)}. 47 For example, a+b+c+3 would be stored as 48 +( + , X, 3) 49 / \ 50 + c 51 / \ 52 + b 53 / \ 54 X a 55 56 <expr> ::= <expr> + <expr> | <expr> - <expr> | - <expr> 57 | <expr> * <expr> | <expr> / <expr> 58 | <expr> ^ <expr> | sqrt(<expr>) 59 | <special function>(<expr>,...) 60 | <atom> -- algebraic variable 61 | <variable> -- treated like an atom 62 | <number> -- including rational numbers 63 64 <tidy expr> ::= {like <expr>, but only the first column. Also, 65 numeric fragments are combined where possible, and sums 66 and products are flattened.} 67 68 <baggy expr> ::= +(Tree, Hole, Num) 69 | *(Tree, Hole, Num) 70 | <tidy expr> ^ <baggy expr> 71 | <tidy expr> 72 73 BUG: if the exponent of a term eventually simplifies to 1, the base 74 emerges as a <tidy expr>, rather than a <baggy expr>. Hence some 75 simplifications will be missed. E.g. "(1+x)^(-1)^(-1) + -1" will end 76 up as "(1+x) + -1" rather than as "x". There appears to be no easy 77 way around this problem, though keeping the base as a <baggy expr> 78 may yet prove to be feasible. In any case, the new tidy only has this 79 problem with exponents, which are generally fairly simple. 80 81 Tidy requires simple/1 and copy_ground/3 from STRUCT.PL. 82 83 [2 June 1984] Bug fix: the user has always been able to add its 84 own rewrite rules in the form simplify_axiom(Lhs, Rhs), e.g. 85 simplify_axiom(X^log(X,Y), Y). The result of this rewrite was 86 assumed to be tidy, which was not always true. The result is 87 now retidied. This could lead to looping, where the user's rules 88 undo something that tidy does. Look at your intended use of this 89 hook, and decided whether to do retidying or not. A related bug 90 was that simplify_axiom was not called for powers. 91*/ 92 93 :- export 94 tidy/2, % general interface 95 tidy_withvars/2, % same as tidy_expr 96 tidy_expr/2, % tidy an expression 97 tidy_stmt/2. % tidy a statement. 98 99 100 :- mode 101 bag_to_tidy(+,-), % F(T,H,N) -> T' 102 bag_to_tidy(+,+,+), 103 combine_and(+,+,-), % X,Y -> X&Y 104 combine_bags(+,-), % apply op to baggy arguments 105 combine_or(+,+,-), % X,Y -> X#Y 106 combine_power(+,+,-), % X,Y -> X^Y 107 combine_plus(+,+,-), % X,Y -> X+Y 108 combine_rel(+,+,-,-), % X(R)Y -> X'(R)Y' 109 combine_times(+,+,-), % X,Y -> X*Y 110 expr_to_bag(+,-), % <expr> -> <baggy expr> 111 expr_to_bag(+,+,+,+,-), % map down args of <expr> 112 multiply_exp(+,+,-), % X,N -> N*X 113 multiply_out(+,+,-), % N,X -> N*X 114 multiply_out(+,-,+,-), % +(T,H),N -> +(T*N,H) 115 number_check(+,+,-), % maintain number-p accum 116 power_out(+,+,-), 117 power_out(+,-,+,-), % *(T,H),N -> *(T^N,H) 118 relop_tidy(-,+,+,+), % R,X,Y -> X(R)Y or true/false 119 tidy_expr(+,-), % tidy expression 120 tidy_stmt(+,-), % tidy statement 121 user_tidy(+,-). % invoke user's simplify_axioms. 122 123% Operator declarations from util.ops 124 125:- op(950,xfy,#). % Used for disjunction 126:- op(920,xfy,&). 127:- op(700,xfx,\=). 128 129 130tidy(Old, New) :- 131 tidy_stmt(Old, Mid), !, New = Mid. % which now tries tidy_expr 132tidy(Old, Old) :- 133 write('** failed: '), write(tidy(Old, '_')), nl. 134 135 136tidy_withvars(Old, New) :- 137 copy_ground(Old, Ground, Subst), 138 tidy(Ground, Tidier), 139 subst(Subst, Tidier, Mid), !, 140 New = Mid. 141 142 143tidy_stmt(Var, _) :- % don't do anything with variables 144 var(Var), !, fail. 145tidy_stmt(OldOne # OldTwo, New) :- !, 146 tidy_stmt(OldOne, MidOne), 147 tidy_stmt(OldTwo, MidTwo), !, 148 combine_or(MidOne, MidTwo, New). 149tidy_stmt(OldOne & OldTwo, New) :- !, 150 tidy_stmt(OldOne, MidOne), 151 tidy_stmt(OldTwo, MidTwo), !, 152 combine_and(MidOne, MidTwo, New). 153tidy_stmt(Equation, New) :- 154 tidy_relop(Equation, Relation, OldLhs, OldRhs), 155 !, 156 expr_to_bag(OldLhs, MidLhs), 157 expr_to_bag(OldRhs, MidRhs), 158 combine_rel(MidLhs, MidRhs, NewLhs, NewRhs), !, 159 relop_tidy(New, Relation, NewLhs, NewRhs). 160tidy_stmt(Old, New) :- 161 tidy_expr(Old, New). 162 163 164combine_or(true, _, true) :- !. % zero element 165combine_or(false, Y, Y) :- !. % unit element 166combine_or(_, true, true) :- !. % zero element 167combine_or(X, false, X) :- !. % unit element 168combine_or(X, X, X) :- !. % merging identical elements 169combine_or(W#X, Y, W#(X#Y)) :- !. % change association 170combine_or(X, Y, X # Y). % general case 171 172combine_and(false, _, false) :- !. % zero element 173combine_and(true, Y, Y) :- !. % unit element 174combine_and(_, false, false) :- !. % zero element 175combine_and(X, true, X) :- !. % unit element 176combine_and(X, X, X) :- !. % merging identical elements 177combine_and(W&X, Y, W&(X&Y)) :- !. % change association 178combine_and(X, Y, X & Y). % general case 179 180 181tidy_relop(X = Y, =, X, Y). 182tidy_relop(X < Y, <, X, Y). 183tidy_relop(X > Y, >, X, Y). 184tidy_relop(X =< Y, =<, X, Y). 185tidy_relop(X >= Y, >=, X, Y). 186tidy_relop(X \= Y, \=, X, Y). 187 188 189relop_tidy(Value, Relation, Lhs, Rhs) :- 190 number(Lhs), number(Rhs), 191 tidy_relop(Goal, Relation, Lhs, Rhs), !, 192 eval(Goal, Value). 193relop_tidy(Goal, Relation, Lhs, Rhs) :- 194 tidy_relop(Goal, Relation, Lhs, Rhs). 195 196 197combine_rel(+(T1, H1, N1), +(T2, H2, N2), Lhs, Rhs) :- !, 198 bag_to_tidy(+(T1, H1, 0), Lhs), 199 eval(N2-N1, N3), 200 bag_to_tidy(+(T2, H2, N3), Rhs). 201combine_rel(+(T1, H1, N1), N2, Lhs, N3) :- 202 number(N2), !, 203 eval(N2-N1, N3), 204 bag_to_tidy(+(T1, H1, 0), Lhs). 205combine_rel(*(T1, H1, N1), *(T2, H2, N2), Lhs, Rhs) :- 206 eval(N1 > 0), !, 207 bag_to_tidy(*(T1, H1, 1), Lhs), 208 eval(N2/N1, N3), 209 bag_to_tidy(*(T2, H2, N3), Rhs). 210combine_rel(*(T1, H1, N1), N2, Lhs, N3) :- 211 number(N2), 212 eval(N1 > 0), !, 213 eval(N2/N1, N3), 214 bag_to_tidy(*(T1, H1, 1), Lhs). 215combine_rel(E1, E2, Lhs, Rhs) :- 216 bag_to_tidy(E1, Lhs), 217 bag_to_tidy(E2, Rhs). 218 219 220 221tidy_expr(Old, New) :- 222 expr_to_bag(Old, Mid), !, 223 bag_to_tidy(Mid, New). 224 225expr_to_bag(Var, _) :- % do nothing with variables 226 var(Var), !, fail. 227expr_to_bag(Old, Old) :- 228 simple(Old), !. 229expr_to_bag(Old, New) :- 230 functor(Old, F, N), 231 functor(Mid, F, N), 232 expr_to_bag(N, Old, Mid, yes, New). 233 234 expr_to_bag(0, _, Mid, yes, New) :- !, 235 eval(Mid, New). 236 expr_to_bag(0, _, Mid, no, New) :- 237 combine_bags(Mid, New). 238 expr_to_bag(N, Old, Mid, EvalP, New) :- 239 arg(N, Old, OldN), 240 expr_to_bag(OldN, MidN), 241 arg(N, Mid, MidN), 242 number_check(MidN, EvalP, EvalQ), 243 M is N-1, !, 244 expr_to_bag(M, Old, Mid, EvalQ, New). 245 246 number_check(N, EvalP, EvalP) :- 247 number(N), !. 248 number_check(_, _, no). % not a number 249 250 251combine_bags(X+Y, New) :- !, 252 combine_plus(X, Y, New). 253combine_bags(X-Y, New) :- 254 multiply_out(-1, Y, Z), !, 255 combine_plus(X, Z, New). 256combine_bags(-Y, New) :- !, 257 multiply_out(-1, Y, New). 258combine_bags(X*Y, New) :- !, 259 combine_times(X, Y, New). 260combine_bags(X/Y, New) :- !, 261 power_out(Y, -1, Z), 262 combine_times(X, Z, New). 263combine_bags(X^Y, New) :- !, 264 combine_power(X, Y, Mid), 265 user_tidy(Mid, New). 266combine_bags(Old, New) :- 267 functor(Old, F, N), 268 functor(Mid, F, N), 269 bag_to_tidy(N, Old, Mid), 270 user_tidy(Mid, New). 271 272 273user_tidy(Expr, Bag) :- % apply user's rules 274 simplify_axiom(Expr, Rewritten), 275 !, % omit expr_to_bag call if the 276 expr_to_bag(Rewritten, Bag). % Rewritten form is always tidy. 277user_tidy(Expr, Expr). 278 279 280bag_to_tidy(0, _, _) :- !. 281bag_to_tidy(N, Old, Mid) :- 282 arg(N, Old, OldN), 283 bag_to_tidy(OldN, MidN), 284 arg(N, Mid, MidN), 285 M is N-1, !, 286 bag_to_tidy(M, Old, Mid). 287 288bag_to_tidy(+(T+R, R, 0), T) :- !. 289bag_to_tidy(+( T , N, N), T) :- !. 290bag_to_tidy(*( _, _, 0), 0) :- !. 291bag_to_tidy(*(T*R, R, 1), T) :- !. 292bag_to_tidy(*( T , N, N), T) :- !. 293bag_to_tidy(_^0, 1) :- !. % B^0 = 1 294bag_to_tidy(0^_, 0) :- !. % 0^X = 0 295bag_to_tidy(1^_, 1) :- !. % 1^X = 1 296bag_to_tidy(B^1, B) :- !. % B^1 = B (B already <tidy>) 297bag_to_tidy(M^ *(T*R,R,N), B^T) :- % M^(N*X) = (M^N)^X 298 number(M), 299 power(M, N, B), !. 300bag_to_tidy(B^X, B^T) :- !, % B^X, where X is <baggy> 301 bag_to_tidy(X, T). 302 303 bag_to_tidy(*(_, _, _), _). 304 305bag_to_tidy(Old, Old). 306 307 308combine_plus(+(T1, H1, N1), +(T2, T1, N2), +(T2, H1, N3)) :- !, 309 add(N1, N2, N3). 310combine_plus(+(T1, H1, N1), N2, +(T1, H1, N3)) :- 311 number(N2), !, 312 add(N1, N2, N3). 313combine_plus(+(T1, H1, N1), E2, +(T1+E4, H1, N1)) :- !, 314 bag_to_tidy(E2, E4). 315combine_plus(0, E2, E2) :- !. 316combine_plus(N1, +(T2, H2, N2), +(T2, H2, N3)) :- 317 number(N1), !, 318 add(N1, N2, N3). 319combine_plus(E1, +(T2, H2, N2), +(T2+E3, H2, N2)) :- !, 320 bag_to_tidy(E1, E3). 321combine_plus(E1, 0, E1) :- !. 322combine_plus(E1, N2, +(H+E3, H, N2)) :- 323 number(N2), !, 324 bag_to_tidy(E1, E3). 325combine_plus(N1, E2, +(H+E4, H, N1)) :- 326 number(N1), !, 327 bag_to_tidy(E2, E4). 328combine_plus(E1, E2, +((H+E3)+E4, H, 0)) :- 329 bag_to_tidy(E1, E3), 330 bag_to_tidy(E2, E4). 331 332 333combine_times(*(T1, H1, N1), *(T2, T1, N2), *(T2, H1, N3)) :- !, 334 multiply(N1, N2, N3). 335combine_times(N1, E2, Ans) :- 336 number(N1), !, 337 multiply_out(N1, E2, Ans). 338combine_times(E1, N2, Ans) :- 339 number(N2), !, 340 multiply_out(N2, E1, Ans). 341combine_times(*(T1, H1, N1), E2, *(T1*E4, H1, N1)) :- !, 342 bag_to_tidy(E2, E4). 343combine_times(E1, *(T2, H2, N2), *(T2*E3, H2, N2)) :- !, 344 bag_to_tidy(E1, E3). 345combine_times(E1, E2, *((H*E3)*E4, H, 1)) :- 346 bag_to_tidy(E1, E3), 347 bag_to_tidy(E2, E4). 348 349 350multiply_out(0, _, 0) :- !. 351multiply_out(1, Old, Old) :- !. 352/* The next clause has been replaced by the two following clauses for the 353 sake of Press and attraction. This clause is correct, but alas, when 354 attraction moves a number out (N*X+N*X)->N*(X+X) tidy moves it back in. 355 356multiply_out(N, +(OldTree, Hole, OldNum), +(NewTree, Hole, NewNum)) :- 357 multiply(N, OldNum, NewNum), !, 358 multiply_out(OldTree, Hole, N, NewTree). 359*/ 360multiply_out(-1, +(OldTree, Hole, OldNum), +(NewTree, Hole, NewNum)) :- 361 multiply(-1, OldNum, NewNum), !, 362 multiply_out(OldTree, Hole, -1, NewTree). 363multiply_out(N, +(OldTree, Hole, OldNum), +(NewHole+N*Exp, NewHole, NewNum)) :- 364 multiply(N, OldNum, NewNum), !, 365 bag_to_tidy(+(OldTree, Hole, 0), Exp). 366multiply_out(N, *(OldTree, Hole, OldNum), *(OldTree, Hole, NewNum)) :- !, 367 multiply(N, OldNum, NewNum). 368multiply_out(N, M, P) :- 369 number(M), !, 370 multiply(N, M, P). 371multiply_out(N, Old, *(Hole*Exp, Hole, N)) :- !, 372 bag_to_tidy(Old, Exp). 373 374multiply_out(Bottom, Hole, _, Bottom) :- 375 Bottom == Hole. 376multiply_out(OldX + OldY, Hole, N, NewX + NewY) :- 377 multiply_exp(OldY, N, NewY), !, 378 multiply_out(OldX, Hole, N, NewX). 379 380multiply_exp(OldX * OldY, N, NewX * OldY) :- !, 381 multiply_exp(OldX, N, NewX). 382multiply_exp(OldX + OldY, N, NewX + NewY) :- 383 multiply_exp(OldY, N, NewY), !, 384 multiply_exp(OldX, N, NewX). 385multiply_exp(OldNum, N, NewNum) :- 386 number(OldNum), !, 387 multiply(N, OldNum, NewNum). 388multiply_exp(Old, N, N*Old). 389 390 391combine_power(B^E1, E2, B^E3) :- !, 392 combine_times(E1, E2, E3). 393combine_power(B, N2, Ans) :- 394 number(N2), !, 395 power_out(B, N2, Ans). 396combine_power(E1, E2, E3^E4) :- 397 bag_to_tidy(E1, E3), !, 398 bag_to_tidy(E2, E4). 399 400 401power_out(_, 0, 1) :- !. 402power_out(B, 1, B) :- !. 403power_out(B^E1, P, B^E2) :- !, 404 multiply_out(P, E1, E2). 405power_out(*(H1*T1, H1, 1), P, Ans) :- 406 var(H1), !, 407 power_out(T1, P, Ans). 408power_out(*(T1, H1, N1), P, *(T2, H1, N2)) :- 409 power(N1, P, N2), !, 410 power_out(T1, H1, P, T2). 411power_out(*(T1, H2*N1, N1), P, *(T2, H2, 1)) :- !, 412 power_out(T1, H2, P, T2). 413power_out(+(H0+T1, H1, 0), P, Ans) :- 414 H0 == H1 /*DRAT*/, !, 415 power_out(T1, P, Ans). 416power_out(N, P, M) :- 417 number(N), 418 power(N, P, M), !. 419power_out(B, P, E^P) :- 420 bag_to_tidy(B, E). 421 422 423power_out(Bottom, Hole, _, Bottom) :- 424 Bottom == Hole, !. 425power_out(OldX * (OldB^OldP), Hole, Num, NewX * NewB) :- 426 multiply_exp(OldP, Num, NewP), 427 ( NewP = 1, NewB = OldB 428 ; NewB = OldB^NewP 429 ), !, 430 power_out(OldX, Hole, Num, NewX). 431power_out(OldX * OldY, Hole, Num, NewX * (OldY^Num)) :- !, 432 power_out(OldX, Hole, Num, NewX). 433 434