test/Tools/isac/Knowledge/polyminus.sml
author wneuper <walther.neuper@jku.at>
Thu, 15 Jul 2021 14:10:18 +0200
changeset 60324 5c7128feb370
parent 60278 343efa173023
child 60325 a7c0e6ab4883
permissions -rw-r--r--
ewrite.sml + poly.sml + rational.sml: ok, repair rewrite-orders
     1 (* title:  Knowledge/polyminus.sml
     2    author: Walther Neuper
     3    WN071207,
     4    (c) due to copyright terms
     5 *)
     6 "--------------------------------------------------------";
     7 "--------------------------------------------------------";
     8 "table of contents --------------------------------------";
     9 "--------------------------------------------------------";
    10 "----------- fun contains_mult_pot_only --------------------------------------------------------";
    11 "----------- fun eval_kleiner, fun kleiner -----------------------------------------------------";
    12 "----------- fun ist_monom ---------------------------------------------------------------------";
    13 "----------- fun eval_ist_monom -------------------------";
    14 "----------- watch order_add_mult  ----------------------";
    15 "----------- build predicate for +- ordering ------------";
    16 "----------- build fasse_zusammen -----------------------";
    17 "----------- build verschoenere -------------------------";
    18 "----------- met simplification for_polynomials with_minu";
    19 "----------- me simplification.for_polynomials.with_minus";
    20 "----------- pbl polynom vereinfachen p.33 --------------";
    21 "----------- met probe fuer_polynom ---------------------";
    22 "----------- pbl polynom probe --------------------------";
    23 "----------- pbl klammer polynom vereinfachen p.34 ------";
    24 "----------- try fun applyTactics -----------------------";
    25 "----------- pbl binom polynom vereinfachen p.39 --------";
    26 "----------- pbl binom polynom vereinfachen: cube -------";
    27 "----------- Refine.refine Vereinfache -------------------------";
    28 "----------- *** Problem.prep_input: syntax error in '#Where' of [v";
    29 "--------------------------------------------------------";
    30 "--------------------------------------------------------";
    31 "--------------------------------------------------------";
    32 
    33 val thy = @{theory "PolyMinus"};
    34 
    35 "----------- fun contains_mult_pot_only --------------------------------------------------------";
    36 "----------- fun contains_mult_pot_only --------------------------------------------------------";
    37 "----------- fun contains_mult_pot_only --------------------------------------------------------";
    38 val t = @{term 0};
    39  if contains_mult_pot_only t then () else error "contains_mult_pot_only 1";
    40 
    41 val t = @{term "a"};
    42 if contains_mult_pot_only t then () else error "contains_mult_pot_only 2";
    43 
    44 val t = @{term "2 * a"};
    45 if contains_mult_pot_only t then () else error "contains_mult_pot_only 3";
    46 
    47 val t = @{term "2 * a * b"};
    48 if contains_mult_pot_only t then () else error "contains_mult_pot_only 4";
    49 
    50 val t = @{term "a * b"};
    51 if contains_mult_pot_only t then () else error "contains_mult_pot_only 5";
    52 
    53 val t = @{term "2 * a \<up> 2 * b"};
    54 if contains_mult_pot_only t then () else error "contains_mult_pot_only 6";
    55 
    56 val t = @{term "a \<up> 2 * b \<up> 3"};
    57 if contains_mult_pot_only t then () else error "contains_mult_pot_only 7";
    58 
    59 (* but also ..*)
    60 val t = @{term "a \<up> 2 * 4 * b \<up> 3 * 5"};
    61 if contains_mult_pot_only t then () else error "contains_mult_pot_only 8";
    62 
    63 
    64 "----------- fun eval_kleiner, fun kleiner -----------------------------------------------------";
    65 "----------- fun eval_kleiner, fun kleiner -----------------------------------------------------";
    66 "----------- fun eval_kleiner, fun kleiner -----------------------------------------------------";
    67 val t = TermC.str2term "12 kleiner 5 * e + 6 * f - 8 * g - 9 - 7 * e - 4 * f + 10 * (g::real)";
    68 
    69 val SOME ("12 kleiner 5 * e + 6 * f - 8 * g - 9 - 7 * e - 4 * f + 10 * g = True", _) =
    70            eval_kleiner "aaa" "bbb" t "ccc";
    71 "~~~~~ fun eval_kleiner , args:"; val (_, _, (p as (Const ("PolyMinus.kleiner",_) $ a $ b)), _) =
    72   ("aaa", "bbb", t, "ccc");
    73     (*if*) TermC.is_num b (*else*);
    74 
    75    	(*if*) identifier a < identifier b  (*else*);
    76 "~~~~~ fun identifier , args:"; val (t) = (a);
    77 
    78 (*+*)case a of
    79   Const ("Num.numeral_class.numeral", _) $ (Const ("Num.num.Bit0", _) $
    80     (Const ("Num.num.Bit0", _) $ (Const ("Num.num.Bit1", _) $ Const ("Num.num.One", _)))) => ()
    81 | _ => error "eval_kleiner CHANGED";
    82 
    83 
    84 "----------- fun eval_ist_monom ----------------------------------";
    85 "----------- fun eval_ist_monom ----------------------------------";
    86 "----------- fun eval_ist_monom ----------------------------------";
    87 ist_monom (TermC.str2term "12");
    88 case eval_ist_monom 0 0 (TermC.str2term "12 ist_monom") 0 of
    89     SOME ("12 ist_monom = True", _) => ()
    90   | _ => error "polyminus.sml: 12 ist_monom = True";
    91 
    92 case eval_ist_monom 0 0 (TermC.str2term "a ist_monom") 0 of
    93     SOME ("a ist_monom = True", _) => ()
    94   | _ => error "polyminus.sml: a ist_monom = True";
    95 
    96 case eval_ist_monom 0 0 (TermC.str2term "(3*a) ist_monom") 0 of
    97     SOME ("3 * a ist_monom = True", _) => ()
    98   | _ => error "polyminus.sml: 3 * a ist_monom = True";
    99 
   100 case eval_ist_monom 0 0 (TermC.str2term "(a \<up> 2) ist_monom") 0 of 
   101    SOME ("a \<up> 2 ist_monom = True", _) => ()
   102   | _ => error "polyminus.sml: a \<up> 2 ist_monom = True";
   103 
   104 case eval_ist_monom 0 0 (TermC.str2term "(3*a \<up> 2) ist_monom") 0 of
   105     SOME ("3 * a \<up> 2 ist_monom = True", _) => ()
   106   | _ => error "polyminus.sml: 3*a \<up> 2 ist_monom = True";
   107 
   108 case eval_ist_monom 0 0 (TermC.str2term "(a*b) ist_monom") 0 of
   109     SOME ("a * b ist_monom = True", _) => ()
   110   | _ => error "polyminus.sml: a*b ist_monom = True";
   111 
   112 case eval_ist_monom 0 0 (TermC.str2term "(3*a*b) ist_monom") 0 of
   113     SOME ("3 * a * b ist_monom = True", _) => ()
   114   | _ => error "polyminus.sml: 3*a*b ist_monom = True";
   115 
   116 
   117 "----------- watch order_add_mult  -------------------------------";
   118 "----------- watch order_add_mult  -------------------------------";
   119 "----------- watch order_add_mult  -------------------------------";
   120 "----- with these simple variables it works...";
   121 (*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
   122 Rewrite.trace_on:=false;
   123 val t = TermC.str2term "((a + d) + c) + b";
   124 val SOME (t,_) = rewrite_set_ thy false order_add_mult t; UnparseC.term t;
   125 if UnparseC.term t = "a + (b + (c + d))" then ()
   126 else error "polyminus.sml 1 watch order_add_mult";
   127 Rewrite.trace_on:=false;
   128 
   129 "----- the same stepwise...";
   130 val od = ord_make_polynomial true (@{theory "Poly"});
   131 val t = TermC.str2term "((a + d) + c) + b";
   132 "((a + d) + c) + b"; 
   133 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.commute} t; UnparseC.term t;
   134 "b + ((a + d) + c)";
   135 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.commute} t; UnparseC.term t;
   136 "b + (c + (a + d))";
   137 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
   138 "b + (a + (c + d))";
   139 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
   140 "a + (b + (c + d))";
   141 if UnparseC.term t = "a + (b + (c + d))" then ()
   142 else error "polyminus.sml 2 watch order_add_mult";
   143 
   144 "----- if parentheses are right, left_commute is (almost) sufficient...";
   145 val t = TermC.str2term "a + (d + (c + b))";
   146 "a + (d + (c + b))";
   147 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
   148 "a + (c + (d + b))";
   149 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.commute} t;UnparseC.term t;
   150 "a + (c + (b + d))";
   151 val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
   152 "a + (b + (c + d))";
   153 
   154 "----- but we do not want the parentheses at right; thus: cond.rew.";
   155 "WN0712707 complicated monomials do not yet work ...";
   156 val t = TermC.str2term "((5*a + 4*d) + 3*c) + 2*b";
   157 val SOME (t,_) = rewrite_set_ thy false order_add_mult t; UnparseC.term t;
   158 if UnparseC.term t = "2 * b + (3 * c + (4 * d + 5 * a))" then ()
   159 else error "polyminus.sml: order_add_mult changed";
   160 
   161 "----- here we see rew_sub going into subterm with ord.rew....";
   162 val od = ord_make_polynomial false (@{theory "Poly"});
   163 val t = TermC.str2term "b + a + c + d";
   164 val SOME (t,_) = rewrite_ thy od Rule_Set.empty false @{thm add.commute} t; UnparseC.term t;
   165 val SOME (t,_) = rewrite_ thy od Rule_Set.empty false @{thm add.commute} t; UnparseC.term t;
   166 (*@@@ rew_sub gosub: t = d + (b + a + c)
   167   @@@ rew_sub begin: t = b + a + c*)
   168 
   169 
   170 "----------- build predicate for +- ordering ---------------------";
   171 "----------- build predicate for +- ordering ---------------------";
   172 "----------- build predicate for +- ordering ---------------------";
   173 "a" < "b";
   174 "ba" < "ab";
   175 "123" < "a"; (*unused due to ---vvv*)
   176 "12" < "3"; (*true !!!*)
   177 
   178 " a kleiner b ==> (b + a) = (a + b)";
   179 TermC.str2term "aaa";
   180 TermC.str2term "222 * aaa";
   181 
   182 case eval_kleiner 0 0 (TermC.str2term "123 kleiner 32") 0 of
   183     SOME ("123 kleiner 32 = False", _) => ()
   184   | _ => error "polyminus.sml: 12 kleiner 9 = False";
   185 
   186 case eval_kleiner 0 0 (TermC.str2term "a kleiner b") 0 of
   187     SOME ("a kleiner b = True", _) => ()
   188   | _ => error "polyminus.sml: a kleiner b = True";
   189 
   190 case eval_kleiner 0 0 (TermC.str2term "(10*g) kleiner f") 0 of
   191     SOME ("10 * g kleiner f = False", _) => ()
   192   | _ => error "polyminus.sml: 10 * g kleiner f = False";
   193 
   194 case eval_kleiner 0 0 (TermC.str2term "(a \<up> 2) kleiner b") 0 of
   195     SOME ("a \<up> 2 kleiner b = True", _) => ()
   196   | _ => error "polyminus.sml: a \<up> 2 kleiner b = True";
   197 
   198 case eval_kleiner 0 0 (TermC.str2term "(3*a \<up> 2) kleiner b") 0 of
   199     SOME ("3 * a \<up> 2 kleiner b = True", _) => ()
   200   | _ => error "polyminus.sml: 3 * a \<up> 2 kleiner b = True";
   201 
   202 case eval_kleiner 0 0 (TermC.str2term "(a*b) kleiner c") 0 of
   203     SOME ("a * b kleiner c = True", _) => ()
   204   | _ => error "polyminus.sml: a * b kleiner b = True";
   205 
   206 case eval_kleiner 0 0 (TermC.str2term "(3*a*b) kleiner c") 0 of
   207     SOME ("3 * a * b kleiner c = True", _) => ()
   208   | _ => error "polyminus.sml: 3 * a * b kleiner b = True";
   209 
   210 "======= compare tausche_plus with real_num_collect";
   211 val od = dummy_ord;
   212 
   213 val erls = erls_ordne_alphabetisch;
   214 val t = TermC.str2term "b + a";
   215 val SOME (t,_) = rewrite_ thy od erls false @{thm tausche_plus} t; UnparseC.term t;
   216 if UnparseC.term t = "a + b" then ()
   217 else error "polyminus.sml: ordne_alphabetisch1 b + a";
   218 
   219 val erls = Atools_erls;
   220 val t = TermC.str2term "2*a + 3*a";
   221 val SOME (t,_) = rewrite_ thy od erls false @{thm real_num_collect} t; UnparseC.term t;
   222 
   223 "======= test rewrite_, rewrite_set_";
   224 (*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
   225 val erls = erls_ordne_alphabetisch;
   226 val t = TermC.str2term "b + a";
   227 val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
   228 if UnparseC.term t = "a + b" then ()
   229 else error "polyminus.sml: ordne_alphabetisch a + b";
   230 
   231 val t = TermC.str2term "2*b + a";
   232 val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
   233 if UnparseC.term t = "a + 2 * b" then ()
   234 else error "polyminus.sml: ordne_alphabetisch a + 2 * b";
   235 
   236 val t = TermC.str2term "a + c + b";
   237 val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
   238 if UnparseC.term t = "a + b + c" then ()
   239 else error "polyminus.sml: ordne_alphabetisch a + b + c";
   240 
   241 "======= rewrite goes into subterms";
   242 val t = TermC.str2term "a + c + b + d";
   243 val SOME (t,_) = rewrite_ thy od erls false @{thm tausche_plus_plus} t; UnparseC.term t;
   244 if UnparseC.term t = "a + b + c + d" then ()
   245 else error "polyminus.sml: ordne_alphabetisch1 a + b + c + d";
   246 
   247 val t = TermC.str2term "a + c + d + b";
   248 val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
   249 if UnparseC.term t = "a + b + c + d" then ()
   250 else error "polyminus.sml: ordne_alphabetisch2 a + b + c + d";
   251 
   252 "======= here we see rew_sub going into subterm with cond.rew....";
   253 val t = TermC.str2term "b + a + c + d";
   254 val SOME (t,_) = rewrite_ thy od erls false @{thm tausche_plus} t; UnparseC.term t;
   255 if UnparseC.term t = "a + b + c + d" then ()
   256 else error "polyminus.sml: ordne_alphabetisch3 a + b + c + d";
   257 
   258 "======= compile rls for the most complicated terms";
   259 val t = TermC.str2term "5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12";
   260 "5 * e + 6 * f - 8 * g - 9 - 7 * e - 4 * f + 10 * g + 12";
   261 val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; 
   262 if UnparseC.term t = "- 9 + 12 + 5 * e - 7 * e + 6 * f - 4 * f - 8 * g + 10 * g"
   263 then () else error "polyminus.sml: ordne_alphabetisch finished";
   264 
   265 
   266 "----------- build fasse_zusammen --------------------------------";
   267 "----------- build fasse_zusammen --------------------------------";
   268 "----------- build fasse_zusammen --------------------------------";
   269 val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + 6 * f - 4 * f - 8 * g + 10 * g";
   270 val SOME (t,_) = rewrite_set_ thy false fasse_zusammen t;
   271 if UnparseC.term t = "3 + -2 * e + 2 * f + 2 * g" then ()
   272 else error "polyminus.sml: fasse_zusammen finished";
   273 
   274 "----------- build verschoenere ----------------------------------";
   275 "----------- build verschoenere ----------------------------------";
   276 "----------- build verschoenere ----------------------------------";
   277 val t = TermC.str2term "3 + -2 * e + 2 * f + 2 * g";
   278 val SOME (t,_) = rewrite_set_ thy false verschoenere t;
   279 if UnparseC.term t = "3 - 2 * e + 2 * f + 2 * g" then ()
   280 else error "polyminus.sml: verschoenere 3 + -2 * e ...";
   281 
   282 (*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
   283 Rewrite.trace_on:=false;
   284 
   285 "----------- met simplification for_polynomials with_minus -------";
   286 "----------- met simplification for_polynomials with_minus -------";
   287 "----------- met simplification for_polynomials with_minus -------";
   288 val str = 
   289 "Program SimplifyScript (t_t::real) =                \
   290 \  (((Try (Rewrite_Set ordne_alphabetisch False)) #>     \
   291 \    (Try (Rewrite_Set fasse_zusammen False)) #>     \
   292 \    (Try (Rewrite_Set verschoenere False))) t_t)"
   293 val sc = (inst_abs o Thm.term_of o the o (TermC.parse thy)) str;
   294 TermC.atomty sc;
   295 
   296 "----------- me simplification.for_polynomials.with_minus";
   297 "----------- me simplification.for_polynomials.with_minus";
   298 "----------- me simplification.for_polynomials.with_minus";
   299 val c = [];
   300 val (p,_,f,nxt,_,pt) = 
   301       CalcTreeTEST 
   302         [(["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
   303            "normalform N"],
   304 	          ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   305 	           ["simplification", "for_polynomials", "with_minus"]))];
   306 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   307 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   308 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   309 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   310 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   311 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   312 
   313 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   314 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   315 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   316 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   317 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   318 if f2str f = "3 - 2 * e + 2 * f + 2 * g" 
   319 then case nxt of End_Proof' => () | _ =>  error "me simplification.for_polynomials.with_minus 1"
   320 else error "polyminus.sml: me simplification.for_polynomials.with_minus 2";
   321 
   322 "----------- pbl polynom vereinfachen p.33 -----------------------";
   323 "----------- pbl polynom vereinfachen p.33 -----------------------";
   324 "----------- pbl polynom vereinfachen p.33 -----------------------";
   325 "----------- 140 c ---";
   326 reset_states ();
   327 CalcTree [(["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
   328 	    "normalform N"],
   329 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   330 	    ["simplification", "for_polynomials", "with_minus"]))];
   331 moveActiveRoot 1;
   332 autoCalculate 1 CompleteCalc;
   333 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   334 if p = ([], Res) andalso 
   335    UnparseC.term (get_obj g_res pt (fst p)) = "3 - 2 * e + 2 * f + 2 * g"
   336 then () else error "polyminus.sml: Vereinfache (3 - 2 * e + 2 * f...";
   337 
   338 "======= 140 d ---";
   339 reset_states ();
   340 CalcTree [(["Term (-r - 2*s - 3*t + 5 + 4*r + 8*s - 5*t - 2)",
   341 	    "normalform N"],
   342 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   343 	    ["simplification", "for_polynomials", "with_minus"]))];
   344 moveActiveRoot 1;
   345 autoCalculate 1 CompleteCalc;
   346 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   347 if p = ([], Res) andalso 
   348    UnparseC.term (get_obj g_res pt (fst p)) = "3 + 3 * r + 6 * s - 8 * t"
   349 then () else error "polyminus.sml: Vereinfache 140 d)";
   350 
   351 "======= 139 c ---";
   352 reset_states ();
   353 CalcTree [(["Term (3*e - 6*f - 8*e - 4*f + 5*e + 7*f)",
   354 	    "normalform N"],
   355 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   356 	    ["simplification", "for_polynomials", "with_minus"]))];
   357 moveActiveRoot 1;
   358 autoCalculate 1 CompleteCalc;
   359 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   360 if p = ([], Res) andalso 
   361    UnparseC.term (get_obj g_res pt (fst p)) = "- (3 * f)"
   362 then () else error "polyminus.sml: Vereinfache 139 c)";
   363 
   364 "======= 139 b ---";
   365 reset_states ();
   366 CalcTree [(["Term (8*u - 5*v - 5*u + 7*v - 6*u - 3*v)",
   367 	    "normalform N"],
   368 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   369 	    ["simplification", "for_polynomials", "with_minus"]))];
   370 moveActiveRoot 1;
   371 autoCalculate 1 CompleteCalc;
   372 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   373 if p = ([], Res) andalso 
   374    UnparseC.term (get_obj g_res pt (fst p)) = "-3 * u - v"
   375 then () else error "polyminus.sml: Vereinfache 139 b)";
   376 
   377 "======= 138 a ---";
   378 reset_states ();
   379 CalcTree [(["Term (2*u - 3*v - 6*u + 5*v)",
   380 	    "normalform N"],
   381 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   382 	    ["simplification", "for_polynomials", "with_minus"]))];
   383 moveActiveRoot 1;
   384 autoCalculate 1 CompleteCalc;
   385 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   386 if p = ([], Res) andalso 
   387    UnparseC.term (get_obj g_res pt (fst p)) = "-4 * u + 2 * v"
   388 then () else error "polyminus.sml: Vereinfache 138 a)";
   389 
   390 "----------- met probe fuer_polynom ------------------------------";
   391 "----------- met probe fuer_polynom ------------------------------";
   392 "----------- met probe fuer_polynom ------------------------------";
   393 val str = 
   394 "Program ProbeScript (e_e::bool) (w_s::bool list) =\
   395 \ (let e_e = Take e_e;                             \
   396 \      e_e = Substitute w_s e_e                    \
   397 \ in (Repeat((Try (Repeat (Calculate ''TIMES''))) #>  \
   398 \            (Try (Repeat (Calculate ''PLUS''))) #>  \
   399 \            (Try (Repeat (Calculate ''MINUS''))))) e_e)"
   400 val sc = (inst_abs o Thm.term_of o the o (TermC.parse thy)) str;
   401 TermC.atomty sc;
   402 
   403 "----------- pbl polynom probe -----------------------------------";
   404 "----------- pbl polynom probe -----------------------------------";
   405 "----------- pbl polynom probe -----------------------------------";
   406 reset_states ();
   407 CalcTree [(["Pruefe ((5::int)*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12 =\
   408 	    \3 - 2 * e + 2 * f + 2 * (g::int))",
   409 	    "mitWert [e = (1::int), f = (2::int), g = (3::int)]",
   410 	    "Geprueft b"],
   411 	   ("PolyMinus",["polynom", "probe"],
   412 	    ["probe", "fuer_polynom"]))];
   413 moveActiveRoot 1;
   414 autoCalculate 1 CompleteCalc;
   415 (* autoCalculate 1 CompleteCalcHead;
   416    autoCalculate 1 (Steps 1);
   417    autoCalculate 1 (Steps 1);
   418    val ((pt,p),_) = get_calc 1; UnparseC.term (get_obj g_res pt (fst p));
   419 @@@@@WN081114 gives "??.empty", all "Pruefe" are the same,
   420 although analogies work in interface.sml: FIXME.WN081114 in "Pruefe"*)
   421 val ((pt,p),_) = get_calc 1;
   422 if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "11 = 11"
   423 then () else error "polyminus.sml: Probe 11 = 11";
   424 Test_Tool.show_pt pt;
   425 
   426 "----------- pbl klammer polynom vereinfachen p.34 ---------------";
   427 "----------- pbl klammer polynom vereinfachen p.34 ---------------";
   428 "----------- pbl klammer polynom vereinfachen p.34 ---------------";
   429 reset_states ();
   430 CalcTree [(["Term (2*u - 5 - (3 - 4*u) + (8*u + 9))",
   431 	    "normalform N"],
   432 	   ("PolyMinus",["klammer", "polynom", "vereinfachen"],
   433 	    ["simplification", "for_polynomials", "with_parentheses"]))];
   434 moveActiveRoot 1;
   435 autoCalculate 1 CompleteCalc;
   436 val ((pt,p),_) = get_calc 1;
   437 if p = ([], Res) andalso 
   438    UnparseC.term (get_obj g_res pt (fst p)) = "1 + 14 * u"
   439 then () else error "polyminus.sml: Vereinfache (2*u - 5 - (3 - ...";
   440 Test_Tool.show_pt pt;
   441 
   442 "======= probe p.34 -----";
   443 reset_states ();
   444 CalcTree [(["Pruefe (2*u - 5 - (3 - 4*u) + (8*u + 9) = 1 + 14 * (u::int))",
   445 	    "mitWert [u = (2::int)]",
   446 	    "Geprueft b"],
   447 	   ("PolyMinus",["polynom", "probe"],
   448 	    ["probe", "fuer_polynom"]))];
   449 moveActiveRoot 1;
   450 autoCalculate 1 CompleteCalc;
   451 val ((pt,p),_) = get_calc 1;
   452 if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "29 = 29"
   453 then () else error "polyminus.sml: Probe 29 = 29";
   454 Test_Tool.show_pt pt;
   455 
   456 "----------- try fun applyTactics --------------------------------";
   457 "----------- try fun applyTactics --------------------------------";
   458 "----------- try fun applyTactics --------------------------------";
   459 reset_states ();
   460 CalcTree [(["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
   461 	    "normalform N"],
   462 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   463 	    ["simplification", "for_polynomials", "with_minus"]))];
   464 moveActiveRoot 1;
   465 autoCalculate 1 CompleteCalcHead;
   466 autoCalculate 1 (Steps 1);
   467 autoCalculate 1 (Steps 1);
   468 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   469 "----- 1  \<up> ";
   470 fetchApplicableTactics 1 0 p;
   471 val appltacs = specific_from_prog pt p;
   472 applyTactic 1 p (hd appltacs) (*addiere_x_plus_minus*);
   473 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   474 "----- 2  \<up> ";
   475 (*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
   476 val erls = erls_ordne_alphabetisch;
   477 val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
   478 val SOME (t',_) = 
   479     rewrite_ (@{theory "Isac_Knowledge"}) e_rew_ord erls false @{thm tausche_minus} t;
   480 UnparseC.term t';     "- 9 + 12 + 5 * e - 7 * e + (- 4 + 6) * f - 8 * g + 10 * g";
   481 
   482 val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
   483 val NONE = 
   484     rewrite_ (@{theory "Isac_Knowledge"}) e_rew_ord erls false @{thm tausche_minus_plus} t;
   485 
   486 val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
   487 val SOME (t',_) = 
   488     rewrite_set_ (@{theory "Isac_Knowledge"}) false ordne_alphabetisch t;
   489 UnparseC.term t';     "- 9 + 12 + 5 * e - 7 * e - 8 * g + 10 * g + (- 4 + 6) * f";
   490 Rewrite.trace_on := false;
   491 
   492 
   493 applyTactic 1 p (hd (specific_from_prog pt p)) (*tausche_minus*);
   494 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   495 "----- 3  \<up> ";
   496 applyTactic 1 p (hd (specific_from_prog pt p)) (**);
   497 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   498 "----- 4  \<up> ";
   499 applyTactic 1 p (hd (specific_from_prog pt p)) (**);
   500 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   501 "----- 5  \<up> ";
   502 applyTactic 1 p (hd (specific_from_prog pt p)) (**);
   503 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   504 "----- 6  \<up> ";
   505 
   506 (*<CALCMESSAGE> failure </CALCMESSAGE>
   507 applyTactic 1 p (hd (specific_from_prog pt p)) (**);
   508 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   509 "----- 7  \<up> ";
   510 *)
   511 autoCalculate 1 CompleteCalc;
   512 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   513 (*independent from failure above: met_simp_poly_minus not confluent:
   514 (([9], Res), - (8 * g) + 10 * g + (3 - 2 * e + 2 * f)),
   515 (([], Res), - (8 * g) + 10 * g + (3 - 2 * e + 2 * f))]
   516 ~~~~~~~~~~~###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
   517 
   518 
   519 "#############################################################################";
   520 reset_states ();
   521 CalcTree [(["Term (- (8 * g) + 10 * g + h)",
   522 	    "normalform N"],
   523 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   524 	    ["simplification", "for_polynomials", "with_minus"]))];
   525 moveActiveRoot 1;
   526 autoCalculate 1 CompleteCalc;
   527 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   528 if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "2 * g + h"
   529 then () else error "polyminus.sml: addiere_vor_minus";
   530 
   531 
   532 "#############################################################################";
   533 reset_states ();
   534 CalcTree [(["Term (- (8 * g) + 10 * g + f)",
   535 	    "normalform N"],
   536 	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
   537 	    ["simplification", "for_polynomials", "with_minus"]))];
   538 moveActiveRoot 1;
   539 autoCalculate 1 CompleteCalc;
   540 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   541 if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "f + 2 * g"
   542 then () else error "polyminus.sml: tausche_vor_plus";
   543 
   544 "----------- pbl binom polynom vereinfachen p.39 -----------------";
   545 "----------- pbl binom polynom vereinfachen p.39 -----------------";
   546 "----------- pbl binom polynom vereinfachen p.39 -----------------";
   547 val rls = klammern_ausmultiplizieren;
   548 val t = TermC.str2term "(3 * a + 2) * (4 * a - 1)";
   549 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   550 "3 * a * (4 * a) - 3 * a * 1 + (2 * (4 * a) - 2 * 1)";
   551 val rls = discard_parentheses;
   552 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   553 "3 * a * 4 * a - 3 * a * 1 + (2 * 4 * a - 2 * 1)";
   554 val rls = ordne_monome;
   555 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   556 "3 * 4 * a * a - 1 * 3 * a + (2 * 4 * a - 1 * 2)";
   557 (*
   558 val t = TermC.str2term "3 * a * 4 * a";
   559 val rls = ordne_monome;
   560 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   561 *)
   562 val rls = klammern_aufloesen;
   563 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   564 "3 * 4 * a * a - 1 * 3 * a + 2 * 4 * a - 1 * 2";
   565 val rls = ordne_alphabetisch;
   566 (*TODO: make is_monom more general, a*a=a^2, ...*)
   567 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   568 "3 * 4 * a * a - 1 * 2 - 1 * 3 * a + 2 * 4 * a";
   569 (*STOPPED.WN080104
   570 val rls = fasse_zusammen;
   571 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   572 val rls = verschoenere;
   573 val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
   574 *)
   575 
   576 (*@@@@@@@*)
   577 reset_states ();
   578 CalcTree [(["Term ((3*a + 2) * (4*a - 1))",
   579 	    "normalform N"],
   580 	   ("PolyMinus",["binom_klammer", "polynom", "vereinfachen"],
   581 	    ["simplification", "for_polynomials", "with_parentheses_mult"]))];
   582 moveActiveRoot 1;
   583 autoCalculate 1 CompleteCalc;
   584 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   585 if p = ([], Res) andalso 
   586    UnparseC.term (get_obj g_res pt (fst p)) = "-2 + 12 * a \<up> 2 + 5 * a"
   587 then () else error "polyminus.sml: Vereinfache (2*u - 5 - (3 - ...";
   588 
   589 "----------- pbl binom polynom vereinfachen: cube ----------------";
   590 "----------- pbl binom polynom vereinfachen: cube ----------------";
   591 "----------- pbl binom polynom vereinfachen: cube ----------------";
   592 reset_states ();
   593 CalcTree [(["Term (8*(a - q) + a - 2*q + 3*(a - 2*q))", "normalform N"],
   594 	   ("PolyMinus",["binom_klammer", "polynom", "vereinfachen"],
   595 	    ["simplification", "for_polynomials", "with_parentheses_mult"]))];
   596 moveActiveRoot 1;
   597 autoCalculate 1 CompleteCalc;
   598 val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
   599 if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "12 * a - 16 * q" 
   600 then () else error "pbl binom polynom vereinfachen: cube";
   601 
   602 "----------- Refine.refine Vereinfache ----------------------------------";
   603 "----------- Refine.refine Vereinfache ----------------------------------";
   604 "----------- Refine.refine Vereinfache ----------------------------------";
   605 val fmz = ["Term (8*(a - q) + a - 2*q + 3*(a - 2*(q::real)))", "normalform (N::real)"];
   606 (*default_print_depth 11;*)
   607 val matches = Refine.refine fmz ["vereinfachen"];
   608 (*default_print_depth 3;*)
   609 
   610 "----- go into details, if it seems not to work -----";
   611 "--- does the predicate evaluate correctly ?";
   612 val t = TermC.str2term 
   613 	    "matchsub (?a * (?b - ?c)) (8 * (a - q) + a - 2 * q + 3 * (a - 2 * (q::real)))";
   614 val ma = eval_matchsub "" "Prog_Expr.matchsub" t thy;
   615 case ma of
   616     SOME ("matchsub (?a * (?b - ?c)) (8 * (a - q) + \
   617 	  \a - 2 * q + 3 * (a - 2 * q)) = True", _) => ()
   618   | _ => error "polyminus.sml matchsub (?a * (?b - ?c)...A";
   619 
   620 "--- does the respective prls rewrite ?";
   621 val prls = Rule_Set.append_rules "prls_pbl_vereinf_poly" Rule_Set.empty 
   622 	     [Eval ("Poly.is_polyexp", eval_is_polyexp ""),
   623 	      Eval ("Prog_Expr.matchsub", eval_matchsub ""),
   624 	      Thm ("or_true",@{thm or_true}),
   625 	      (*"(?a | True) = True"*)
   626 	      Thm ("or_false",@{thm or_false}),
   627 	      (*"(?a | False) = ?a"*)
   628 	      Thm ("not_true",ThmC.numerals_to_Free @{thm not_true}),
   629 	      (*"(~ True) = False"*)
   630 	      Thm ("not_false",ThmC.numerals_to_Free @{thm not_false})
   631 	      (*"(~ False) = True"*)];
   632 (*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
   633 val SOME (t', _) = rewrite_set_ thy false prls t;
   634 Rewrite.trace_on := false;
   635 
   636 "--- does the respective prls rewrite the whole predicate ?";
   637 val t = TermC.str2term 
   638 	    "Not (matchsub (?a * (?b + ?c)) (8 * (a - q) + a - 2 * q) | \
   639 	    \     matchsub (?a * (?b - ?c)) (8 * (a - q) + a - 2 * q) | \
   640 	    \     matchsub ((?b + ?c) * ?a) (8 * (a - q) + a - 2 * q) | \
   641 	    \     matchsub ((?b - ?c) * ?a) (8 * (a - q) + a - 2 * q) )";
   642 (*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
   643 val SOME (t', _) = rewrite_set_ thy false prls t;
   644 Rewrite.trace_on := false;
   645 if UnparseC.term t' = "False" then ()
   646 else error "polyminus.sml Not (matchsub (?a * (?b + ?c)) (8 ...";
   647 
   648 "----------- *** Problem.prep_input: syntax error in '#Where' of [v";
   649 "----------- *** Problem.prep_input: syntax error in '#Where' of [v";
   650 "----------- *** Problem.prep_input: syntax error in '#Where' of [v";
   651 (*see test/../termC.sml for details*)
   652 val t = TermC.parse_patt thy "t_t is_polyexp";
   653 val t = TermC.parse_patt thy ("Not (matchsub (?a + (?b + ?c)) t_t | " ^
   654 	                "     matchsub (?a + (?b - ?c)) t_t | " ^
   655 	                "     matchsub (?a - (?b + ?c)) t_t | " ^
   656 	                "     matchsub (?a + (?b - ?c)) t_t )");
   657 (*show_types := true;
   658 if UnparseC.term t = "~ (matchsub ((?a::real) + ((?b::real) + (?c::real))) (t_t::real) |\n   matchsub (?a + (?b - ?c)) t_t |\n   matchsub (?a - (?b + ?c)) t_t | matchsub (?a + (?b - ?c)) t_t)"
   659 then () else error "polyminus.sml type-structure of \"?a :: real\" changed 1";
   660 show_types := false;*)
   661 if UnparseC.term t =
   662   "\<not> (matchsub (?a + (?b + ?c)) t_t \<or>\n        " ^
   663   "matchsub (?a + (?b - ?c)) t_t \<or>\n        " ^
   664   "matchsub (?a - (?b + ?c)) t_t \<or> " ^
   665   "matchsub (?a + (?b - ?c)) t_t)"
   666 then () else error "polyminus.sml type-structure of \"?a :: real\" changed 1";
   667