test/Tools/isac/Knowledge/eqsystem.sml
author Walther Neuper <walther.neuper@jku.at>
Mon, 13 Apr 2020 15:31:23 +0200
changeset 59871 82428ca0d23e
parent 59868 d77aa0992e0f
child 59877 e5a83a9fe58d
permissions -rw-r--r--
reorganise struct. ThmC, part 1
     1 (* tests on systems of equations
     2    author: Walther Neuper 050826,
     3    (c) due to copyright terms
     4 *)
     5 
     6 trace_rewrite := false;
     7 "-----------------------------------------------------------------";
     8 "table of contents -----------------------------------------------";
     9 "-----------------------------------------------------------------";
    10 "----------- occur_exactly_in ------------------------------------";
    11 "----------- problems --------------------------------------------";
    12 "----------- rewrite-order ord_simplify_System -------------------";
    13 "----------- rewrite in [EqSystem,normalise,2x2] -----------------";
    14 "----------- rewrite example from 2nd [EqSystem,normalise,2x2] ---";
    15 "----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
    16 "----------- rewrite in [EqSystem,normalise,4x4] -----------------";
    17 "----------- script [EqSystem,top_down_substitution,2x2] Vers.1 --";
    18 "----------- refine [linear,system]-------------------------------";
    19 "----------- refine [2x2,linear,system] search error--------------";
    20 "----------- me [EqSystem,normalise,2x2] -------------------------";
    21 "----------- me [linear,system] ..normalise..top_down_sub..-------";
    22 "----------- all systems from Biegelinie -------------------------";
    23 "----------- 4x4 systems from Biegelinie -------------------------";
    24 "-----------------------------------------------------------------";
    25 "-----------------------------------------------------------------";
    26 "-----------------------------------------------------------------";
    27 
    28 val thy = @{theory "EqSystem"};
    29 val ctxt = Proof_Context.init_global thy;
    30 
    31 "----------- occur_exactly_in ------------------------------------";
    32 "----------- occur_exactly_in ------------------------------------";
    33 "----------- occur_exactly_in ------------------------------------";
    34 val all = [str2term"c", str2term"c_2", str2term"c_3"];
    35 val t = str2term"0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
    36 
    37 if occur_exactly_in [str2term"c", str2term"c_2"] all t
    38 then () else error "eqsystem.sml occur_exactly_in 1";
    39 
    40 if not (occur_exactly_in [str2term"c", str2term"c_2", str2term"c_3"] all t)
    41 then () else error "eqsystem.sml occur_exactly_in 2";
    42 
    43 if not (occur_exactly_in [str2term"c_2"] all t)
    44 then () else error "eqsystem.sml occur_exactly_in 3";
    45 
    46 val t = str2term"[c,c_2] from [c,c_2,c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
    47 eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
    48 val SOME (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
    49 if str = "[c, c_2] from [c, c_2,\n" ^
    50   "               c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = True"
    51 then () else error "eval_occur_exactly_in [c, c_2]";
    52 
    53 val t = str2term ("[c,c_2,c_3] from [c,c_2,c_3] occur_exactly_in " ^
    54 		  "-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2");
    55 val SOME (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
    56 if str = "[c, c_2,\n c_3] from [c, c_2,\n" ^
    57 "            c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = False"
    58 then () else error "eval_occur_exactly_in [c, c_2, c_3]";
    59 
    60 val t = str2term"[c_2] from [c,c_2,c_3] occur_exactly_in \
    61 		\-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
    62 val SOME (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
    63 if str = "[c_2] from [c, c_2,\n" ^
    64   "            c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = False"
    65 then () else error "eval_occur_exactly_in [c, c_2, c_3]";
    66 
    67 val t = str2term"[] from [c,c_2,c_3] occur_exactly_in 0";
    68 val SOME (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
    69 if str = "[] from [c, c_2, c_3] occur_exactly_in 0 = True" then ()
    70 else error "eval_occur_exactly_in [c, c_2, c_3]";
    71 
    72 val t = 
    73     str2term
    74 	"[] from [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) /2";
    75 val SOME (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
    76 if str = "[] from [c, c_2, c_3, c_4] occur_exactly_in \
    77 	 \-1 * (q_0 * L ^^^ 2) / 2 = True" then ()
    78 else error "eval_occur_exactly_in [c, c_2, c_3, c_4]";
    79 
    80 "----------- problems --------------------------------------------";
    81 "----------- problems --------------------------------------------";
    82 "----------- problems --------------------------------------------";
    83 val t = str2term "LENGTH [x+y=1,y=2] = 2";
    84 atomty t;
    85 val testrls = Rule_Set.append_rules "testrls" Rule_Set.empty 
    86 			 [(Thm ("LENGTH_NIL",ThmC.numerals_to_Free @{thm LENGTH_NIL})),
    87 			  (Thm ("LENGTH_CONS",ThmC.numerals_to_Free @{thm LENGTH_CONS})),
    88 			  Num_Calc ("Groups.plus_class.plus", eval_binop "#add_"),
    89 			  Num_Calc ("HOL.eq",eval_equal "#equal_")
    90 			  ];
    91 val SOME (t',_) = rewrite_set_ thy false testrls t;
    92 if UnparseC.term t' = "True" then () 
    93 else error "eqsystem.sml: length_ [x+y=1,y=2] = 2";
    94 
    95 val SOME t = parse thy "solution LL";
    96 atomty (Thm.term_of t);
    97 val SOME t = parse thy "solution LL";
    98 atomty (Thm.term_of t);
    99 
   100 val t = str2term 
   101 "(tl (tl (tl v_s))) from v_s occur_exactly_in (NTH 1 (e_s::bool list))";
   102 atomty t;
   103 val t = str2term ("(tl (tl (tl [c, c_2, c_3, c_4]))) from [c, c_2, c_3, c_4] occur_exactly_in " ^
   104   "(NTH 1 [c_4 = 1, 2 = 2, 3 = 3, 4 = 4])");
   105 val SOME (t,_) = 
   106     rewrite_set_ thy true 
   107 		 (Rule_Set.append_rules "prls_" Rule_Set.empty 
   108 			     [Thm ("NTH_CONS",ThmC.numerals_to_Free @{thm NTH_CONS}),
   109 			      Thm ("NTH_NIL",ThmC.numerals_to_Free @{thm NTH_NIL}),
   110 			      Thm ("TL_CONS",ThmC.numerals_to_Free @{thm tl_Cons}),
   111 			      Thm ("TL_NIL",ThmC.numerals_to_Free @{thm tl_Nil}),
   112 			      Num_Calc ("EqSystem.occur'_exactly'_in", eval_occur_exactly_in "#eval_occur_exactly_in_")
   113 			      ]) t;
   114 if t = @{term True} then () 
   115 else error "eqsystem.sml ..occur_exactly_in (nth_ 1 [c_4..";
   116 
   117 "----------- rewrite-order ord_simplify_System -------------------";
   118 "----------- rewrite-order ord_simplify_System -------------------";
   119 "----------- rewrite-order ord_simplify_System -------------------";
   120 "M_b x = c * x + -1 * q_0 * (x ^^^ 2 / 2) + c_2";
   121 "--- add.commute ---"; (* ... add_commute cf. b42e334c97ee *)
   122 if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2)", 
   123 				       str2term"c * x") then ()
   124 else error "integrate.sml, (-1 * q_0 * (x ^^^ 2 / 2)) < (c * x) not#1";
   125 
   126 if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2)", 
   127 				       str2term"c_2") then ()
   128 else error "integrate.sml, (-1 * q_0 * (x ^^^ 2 / 2)) < (c_2) not#2";
   129 
   130 if ord_simplify_System false thy [] (str2term"c * x", 
   131 				       str2term"c_2") then ()
   132 else error "integrate.sml, (c * x) < (c_2) not#3";
   133 
   134 "--- mult_commute ---";
   135 if ord_simplify_System false thy [] (str2term"x * c", 
   136 				       str2term"c * x") then ()
   137 else error "integrate.sml, (x * c) < (c * x) not#4";
   138 
   139 if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2) * c", 
   140 				       str2term"-1 * q_0 * c * (x ^^^ 2 / 2)") 
   141 then () else error "integrate.sml, (. * .) < (. * .) not#5";
   142 
   143 if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2) * c", 
   144 				       str2term"c * -1 * q_0 * (x ^^^ 2 / 2)") 
   145 then () else error "integrate.sml, (. * .) < (. * .) not#6";
   146 
   147 
   148 "----------- rewrite in [EqSystem,normalise,2x2] -----------------";
   149 "----------- rewrite in [EqSystem,normalise,2x2] -----------------";
   150 "----------- rewrite in [EqSystem,normalise,2x2] -----------------";
   151 val t = str2term"[0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2,\
   152 	        \0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2]";
   153 val bdvs = [(str2term"bdv_1",str2term"c"),
   154 	    (str2term"bdv_2",str2term"c_2")];
   155 val SOME(t,_)= rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
   156 if UnparseC.term t = "[0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2), 0 = c_2]"
   157 then () else error "eqsystem.sml rewrite in 2x2 simplify_System_par.1";
   158 
   159 val SOME (t,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs t;
   160 if UnparseC.term t = "[L * c + c_2 = 0 + -1 * (-1 * q_0 * L ^^^ 2 / 2), c_2 = 0]"then () else error "eqsystem.sml rewrite in 2x2 isolate_bdvs";
   161 
   162 val SOME(t,_)= rewrite_set_inst_ thy true bdvs simplify_System t;
   163 if UnparseC.term t = "[L * c + c_2 = q_0 * L ^^^ 2 / 2, c_2 = 0]"
   164 then () else error "eqsystem.sml rewrite in 2x2 simplify_System_par.2";
   165 
   166 "--- 3--- see EqSystem.thy (*..if replaced by 'and' ...";
   167 val SOME (t,_) = rewrite_set_ thy true order_system t;
   168 if UnparseC.term t = "[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]"
   169 then () else error "eqsystem.sml rewrite in 2x2 simplify_System_par.3";
   170 "--- 4---";
   171 
   172 "----------- rewrite example from 2nd [EqSystem,normalise,2x2] ---";
   173 "----------- rewrite example from 2nd [EqSystem,normalise,2x2] ---";
   174 "----------- rewrite example from 2nd [EqSystem,normalise,2x2] ---";
   175 val thy = @{theory "Isac_Knowledge"} (*because of Undeclared constant "Biegelinie.EI*);
   176 val t = 
   177     str2term"[0 = c_2 + c * 0 + 1 / EI * (L * q_0 / 12 * 0 ^^^ 3 +         \
   178 	    \                                     -1 * q_0 / 24 * 0 ^^^ 4),\
   179 	    \ 0 = c_2 + c * L + 1 / EI * (L * q_0 / 12 * L ^^^ 3 +         \
   180 	    \                                     -1 * q_0 / 24 * L ^^^ 4)]";
   181 val SOME (t,_) = rewrite_set_ thy true norm_Rational t;
   182 if UnparseC.term t =
   183     "[0 = c_2, 0 = (24 * c_2 * EI + 24 * L * c * EI + L ^^^ 4 * q_0) / (24 * EI)]"
   184 then () else error "eqsystem.sml rewrite in 2x2 simplify_System_par.0b";
   185 
   186 val SOME(t,_)= rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
   187 if UnparseC.term t = (*"[0 = 0 / EI + c_2, 0 = q_0 * L ^^^ 4 / (24 * EI) + (L * c + c_2)]"*)
   188                            "[0 = c_2, 0 = q_0 * L ^^^ 4 / (24 * EI) + (L * c + c_2)]"
   189 then () else error "eqsystem.sml rewrite in 2x2 simplify_System_par.1b";
   190 
   191 val SOME (t,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs t;
   192 if UnparseC.term t = (*"[c_2 = 0 + -1 * (0 / EI),\n L * c + c_2 = 0 + -1 * (q_0 * L ^^^ 4 / (24 * EI))]"*)
   193                                     "[c_2 = 0, L * c + c_2 = 0 + -1 * (q_0 * L ^^^ 4 / (24 * EI))]"
   194 then () else error "eqsystem.sml rewrite in 2x2 isolate_bdvs b";
   195 
   196 val SOME(t,_)= rewrite_set_inst_ thy true bdvs simplify_System t;
   197 if UnparseC.term t = (*"[c_2 = 0 / EI, L * c + c_2 = -1 * q_0 * L ^^^ 4 / (24 * EI)]"*)
   198                        "[c_2 = 0, L * c + c_2 = -1 * q_0 * L ^^^ 4 / (24 * EI)]"
   199 then () else error "eqsystem.sml rewrite in 2x2 simplify_System.2b";
   200 
   201 val xxx = rewrite_set_ thy true order_system t;
   202 if is_none xxx
   203 then () else error "eqsystem.sml rewrite in 2x2 simplify_System.3b";
   204 
   205 
   206 "----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
   207 "----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
   208 "----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
   209 val e1__ = str2term "c_2 = 77";
   210 val e2__ = str2term "L * c + c_2 = q_0 * L ^^^ 2 / 2";
   211 val bdvs = [(str2term"bdv_1",str2term"c"),
   212 	    (str2term"bdv_2",str2term"c_2")];
   213 val SOME (e2__,_) = rewrite_terms_ thy dummy_ord Rule_Set.Empty [e1__] e2__;
   214 if UnparseC.term e2__ = "L * c + 77 = q_0 * L ^^^ 2 / 2" then ()
   215 else error "eqsystem.sml top_down_substitution,2x2] subst";
   216 
   217 val SOME (e2__,_) = 
   218     rewrite_set_inst_ thy true bdvs simplify_System_parenthesized e2__;
   219 if UnparseC.term e2__ = "77 + L * c = q_0 * L ^^^ 2 / 2" then ()
   220 else error "eqsystem.sml top_down_substitution,2x2] simpl_par";
   221 
   222 val SOME (e2__,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs e2__;
   223 if UnparseC.term e2__ = "c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L" then ()
   224 else error "eqsystem.sml top_down_substitution,2x2] isolate";
   225 
   226 val t = str2term "[c_2 = 77, c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L]";
   227 val SOME (t,_) = rewrite_set_ thy true order_system t;
   228 if UnparseC.term t = "[c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L, c_2 = 77]" then ()
   229 else error "eqsystem.sml top_down_substitution,2x2] order_system";
   230 
   231 if not (ord_simplify_System
   232 	    false thy [] 
   233 	    (str2term"[c_2 = 77, c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L]", 
   234 	     str2term"[c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L, c_2 = 77]")) 
   235 then () else error "eqsystem.sml, order_result rew_ord";
   236 
   237 
   238 "----------- rewrite in [EqSystem,normalise,4x4] -----------------";
   239 "----------- rewrite in [EqSystem,normalise,4x4] -----------------";
   240 "----------- rewrite in [EqSystem,normalise,4x4] -----------------";
   241 (*STOPPED.WN06?: revise rewrite in [EqSystem,normalise,4x4] from before 0609*)
   242 val t = str2term"[0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c_3 + c_4,\
   243 	        \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c_3 + c_4,\
   244 		\c + c_2 + c_3 + c_4 = 0,\
   245 		\c_2 + c_3 + c_4 = 0]";
   246 val bdvs = [(str2term"bdv_1",str2term"c"),
   247 	    (str2term"bdv_2",str2term"c_2"),
   248 	    (str2term"bdv_3",str2term"c_3"),
   249 	    (str2term"bdv_4",str2term"c_4")];
   250 val SOME (t,_) = 
   251     rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
   252 if UnparseC.term t = "[0 = c_4, 0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c_3 + c_4),\n\
   253 	        \ c + (c_2 + (c_3 + c_4)) = 0, c_2 + (c_3 + c_4) = 0]"
   254 then () else error "eqsystem.sml rewrite in 4x4 simplify_System_paren";
   255 
   256 val SOME (t,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs t;
   257 if UnparseC.term t = "[c_4 = 0, \
   258 	        \L * c_3 + c_4 = 0 + -1 * (-1 * q_0 * L ^^^ 2 / 2),\n \
   259 		\c + (c_2 + (c_3 + c_4)) = 0, c_2 + (c_3 + c_4) = 0]"
   260 then () else error "eqsystem.sml rewrite in 4x4 isolate_bdvs";
   261 
   262 val SOME(t,_)= rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
   263 if UnparseC.term t = "[c_4 = 0,\
   264 		\ L * c_3 + c_4 = q_0 * L ^^^ 2 / 2,\
   265 		\ c + (c_2 + (c_3 + c_4)) = 0,\n\
   266 		\ c_2 + (c_3 + c_4) = 0]"
   267 then () else error "eqsystem.sml rewrite in 4x4 simplify_System_p..2";
   268 
   269 val SOME (t,_) = rewrite_set_ thy true order_system t;
   270 if UnparseC.term t = "[c_4 = 0,\
   271 		\ L * c_3 + c_4 = q_0 * L ^^^ 2 / 2,\
   272 		\ c_2 + (c_3 + c_4) = 0,\n\
   273 		\ c + (c_2 + (c_3 + c_4)) = 0]"
   274 then () else error "eqsystem.sml rewrite in 4x4 order_system";
   275 
   276 "----------- refine [linear,system]-------------------------------";
   277 "----------- refine [linear,system]-------------------------------";
   278 "----------- refine [linear,system]-------------------------------";
   279 val fmz =
   280   ["equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2," ^
   281                "0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + (c_2::real)]", 
   282 	   "solveForVars [c, c_2]", "solution LL"];
   283 
   284 (*WN120313 in "solution L" above "refine fmz ["LINEAR","system"]" caused an error...*)
   285 "~~~~~ fun refine, args:"; val ((fmz:fmz_), (pblID:pblID)) = (fmz, ["LINEAR","system"]);
   286 "~~~~~ fun refin', args:"; val ((pblRD: pblRD), fmz, pbls, ((Ptyp (pI, [py], [])): pbt ptyp)) =
   287    ((rev o tl) pblID, fmz, [(*match list*)],
   288      ((Ptyp ("LINEAR", [get_pbt ["LINEAR","system"]], [])): pbt ptyp));
   289       val {thy, ppc, where_, prls, ...} = py ;
   290 "~~~~~ fun prep_ori, args:"; val (fmz, thy, pbt) = (fmz, thy, ppc);
   291         val ctxt = Proof_Context.init_global thy;
   292 "~~~~~ fun declare_constraints, args:"; val (t, ctxt) = (nth 1 fmz, ctxt);
   293       fun get_vars ((v,T)::vs) = (case raw_explode v |> Library.read_int of
   294               (_, _::_) => (Free (v,T)::get_vars vs)
   295             | (_, []  ) => get_vars vs) (*filter out nums as long as 
   296                                           we have Free ("123",_)*)
   297         | get_vars [] = [];
   298                                         t = "equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,"^
   299                                             "0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + (c_2::real)]";
   300       val ts = Term.add_frees (Syntax.read_term ctxt t) [] |> get_vars;
   301 val ctxt = Variable.declare_constraints (nth 1 ts) ctxt;
   302 val ctxt = Variable.declare_constraints (nth 2 ts) ctxt;
   303 val ctxt = Variable.declare_constraints (nth 3 ts) ctxt;
   304 val ctxt = Variable.declare_constraints (nth 4 ts) ctxt;
   305                                         val t = nth 2 fmz; t = "solveForVars [c, c_2]";
   306       val ts = Term.add_frees (Syntax.read_term ctxt t) [] |> get_vars;
   307 val ctxt = Variable.declare_constraints (nth 1 ts) ctxt;
   308                                         val t = nth 3 fmz; t = "solution LL";
   309       (*(Syntax.read_term ctxt t); 
   310 Type unification failed: Clash of types "real" and "_ list"
   311 Type error in application: incompatible operand type
   312 
   313 Operator:  solution :: bool list \<Rightarrow> toreall
   314 Operand:   L :: real                 ========== L was already present in equalities ========== *)
   315 
   316 "===== case 1 =====";
   317 val matches = refine fmz ["LINEAR","system"];
   318 case matches of 
   319  [Matches (["LINEAR", "system"], _),
   320   Matches (["2x2", "LINEAR", "system"], _),
   321   NoMatch (["triangular", "2x2", "LINEAR", "system"], _),
   322 		  Matches (["normalise", "2x2", "LINEAR", "system"],
   323 			    {Find = [Correct "solution LL"],
   324 			     With = [],
   325 			     Given =
   326 			       [Correct
   327 				"equalities\n [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\n  0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]",
   328 				        Correct "solveForVars [c, c_2]"],
   329 				     Where = [],
   330 				     Relate = []})] => ()
   331 | _ => error "eqsystem.sml refine ['normalise','2x2'...]";
   332 
   333 "===== case 2 =====";
   334 val fmz = ["equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]", 
   335 	   "solveForVars [c, c_2]", "solution LL"];
   336 val matches = refine fmz ["LINEAR","system"];
   337 case matches of [_,_,
   338 		  Matches
   339 		    (["triangular", "2x2", "LINEAR", "system"],
   340 		      {Find = [Correct "solution LL"],
   341 		       With = [],
   342 		       Given =
   343 		        [Correct "equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]",
   344 		         Correct "solveForVars [c, c_2]"],
   345 		       Where = [Correct
   346 			"tl [c, c_2] from [c, c_2] occur_exactly_in NTH 1\n      [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]",
   347 			                Correct
   348 				"[c, c_2] from [c, c_2] occur_exactly_in NTH 2\n   [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]"],
   349 		       Relate = []})] => ()
   350 | _ => error "eqsystem.sml refine ['triangular','2x2'...]";
   351 
   352 (*WN051014---------------------------------------------------------------- 
   353   the above 'val matches = refine fmz ["LINEAR","system"]'
   354   didn't work anymore; we investigated in these steps:*)
   355 val fmz = ["equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]", 
   356 	  "solveForVars [c, c_2]", "solution LL"];
   357 val matches = refine fmz ["triangular", "2x2", "LINEAR","system"];
   358 (*... resulted in 
   359    False "[c, c_2] from_ [c, c_2] occur_exactly_in nth_ 2\n    
   360           [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]"]*)
   361 val t = str2term ("[c, c_2] from [c, c_2] occur_exactly_in NTH 2" ^   
   362 		  "[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]");
   363 trace_rewrite := false;
   364 val SOME (t',_) = rewrite_set_ thy false prls_triangular t;
   365 (*found:...
   366 ##  try thm: NTH_CONS
   367 ###  eval asms: 1 < 2 + - 1
   368 ==> nth_ (2 + - 1) [L * c + c_2 = q_0 * L ^^^ 2 / 2] =
   369     nth_ (2 + - 1 + - 1) []
   370 ####  rls: erls_prls_triangular on: 1 < 2 + - 1
   371 #####  try calc: op <'
   372 ###  asms accepted: ["1 < 2 + - 1"]   stored: ["1 < 2 + -1"]
   373 
   374 ... i.e Num_Calc ("Groups.plus_class.plus", eval_binop "#add_") was missing in erls_prls_triangular*)
   375 trace_rewrite:=false;
   376 
   377 "===== case 3: relaxed preconditions for triangular system =====";
   378 val fmz = ["equalities [L * q_0 = c,                               \
   379 	   \            0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2,\
   380 	   \            0 = c_4,                                           \
   381 	   \            0 = c_3]", 
   382 	   "solveForVars [c, c_2, c_3, c_4]", "solution LL"];
   383 (*============ inhibit exn WN120314 TODO: investigate type error (same) in these 2 cases:
   384 probably exn thrown by fun declare_constraints
   385 /-------------------------------------------------------\
   386 Type unification failed
   387 Type error in application: incompatible operand type
   388 
   389 Operator:  op # c_3 :: 'a list \<Rightarrow> 'a list
   390 Operand:   [c_4] :: 'b list
   391 \-------------------------------------------------------/
   392 val matches = refine fmz ["LINEAR","system"];
   393 case matches of 
   394     [Matches (["LINEAR", "system"], _),
   395      NoMatch (["2x2", "LINEAR", "system"], _),
   396      NoMatch (["3x3", "LINEAR", "system"], _),
   397      Matches (["4x4", "LINEAR", "system"], _),
   398      NoMatch (["triangular", "4x4", "LINEAR", "system"], _),
   399      Matches (["normalise", "4x4", "LINEAR", "system"], _)] => ()
   400   | _ => error "eqsystem.sml: refine relaxed triangular sys NoMatch";
   401 (*WN060914 does NOT match, because 3rd and 4th equ are not ordered*)
   402 
   403 "===== case 4 =====";
   404 val fmz = ["equalities [L * q_0 = c,                                       \
   405 	   \            0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2,\
   406 	   \            0 = c_3,                           \
   407 	   \            0 = c_4]", 
   408 	   "solveForVars [c, c_2, c_3, c_4]", "solution LL"];
   409 val matches = refine fmz ["triangular", "4x4", "LINEAR","system"];
   410 case matches of 
   411     [Matches (["triangular", "4x4", "LINEAR", "system"], _)] => ()
   412   | _ => error "eqsystem.sml: refine relaxed triangular sys Matches";
   413 val matches = refine fmz ["LINEAR","system"];
   414 ============ inhibit exn WN120314 ==============================================*)
   415 
   416 "----------- refine [2x2,linear,system] search error--------------";
   417 "----------- refine [2x2,linear,system] search error--------------";
   418 "----------- refine [2x2,linear,system] search error--------------";
   419 (*didn't go into ["2x2", "LINEAR", "system"]; 
   420   we investigated in these steps:*)
   421 val fmz = ["equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\
   422 	               \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]", 
   423 	   "solveForVars [c, c_2]", "solution LL"];
   424 trace_rewrite := false;
   425 val matches = refine fmz ["2x2", "LINEAR","system"];
   426 trace_rewrite:=false;
   427 (*default_print_depth 11;*) matches; (*default_print_depth 3;*)
   428 (*brought: 'False "length_ es_ = 2"'*)
   429 
   430 (*-----fun refin' (pblRD:pblRD) fmz pbls ((Ptyp (pI,[py],[])):pbt ptyp) =
   431 (* val ((pblRD:pblRD), fmz, pbls, ((Ptyp (pI,[py],[])):pbt ptyp)) =
   432        (rev ["LINEAR","system"], fmz, [(*match list*)],
   433 	((Ptyp ("2x2",[get_pbt ["2x2","LINEAR","system"]],[])):pbt ptyp));
   434    *)
   435 > show_types:=true; UnparseC.term (hd where_); show_types:=false;
   436 val it = "length_ (es_::real list) = (2::real)" : string
   437 
   438 =========================================================================\
   439 -------fun prep_pbt
   440 (* val (thy, (pblID, dsc_dats: (string * (string list)) list, 
   441 		  ev:rls, ca: string option, metIDs:metID list)) =
   442        (EqSystem.thy, (["system"],
   443 		       [("#Given" ,["equalities es_", "solveForVars v_s"]),
   444 			("#Find"  ,["solution ss___"](*___ is copy-named*))
   445 			],
   446 		       Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)], 
   447 		       SOME "solveSystem es_ v_s", 
   448 		       []));
   449    *)
   450 > val [("#Given", [equalities_es_, "solveForVars v_s"])] = gi;
   451 val equalities_es_ = "equalities es_" : string
   452 > val (dd, ii) = (split_did o Thm.term_of o the o (parse thy)) equalities_es_;
   453 > show_types:=true; UnparseC.term ii; show_types:=false;
   454 val it = "es_::bool list" : string
   455 ~~~~~~~~~~~~~~~^^^^^^^^^ OK~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   456 
   457 > val {where_,...} = get_pbt ["2x2", "LINEAR","system"];
   458 > show_types:=true; UnparseC.term (hd where_); show_types:=false;
   459 
   460 =========================================================================/
   461 
   462 -----fun refin' ff:
   463 > (writeln o (itms2str_ (thy2ctxt @{theory Isac_Knowledge}))) itms;
   464 [
   465 (1 ,[1] ,true ,#Given ,Cor equalities
   466  [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
   467   0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2] ,(es_, [[0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
   468  0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]])),
   469 (2 ,[1] ,true ,#Given ,Cor solveForVars [c, c_2] ,(v_s, [[c, c_2]])),
   470 (3 ,[1] ,true ,#Find ,Cor solution L ,(ss___, [L]))]
   471 
   472 > (writeln o pres2str) pre';
   473 [
   474 (false, length_ es_ = 2),
   475 (true, length_ [c, c_2] = 2)]
   476 
   477 ----- fun match_oris':
   478 > (writeln o (itms2str_ (thy2ctxt @{theory Isac_Knowledge}))) itms;
   479 > (writeln o pres2str) pre';
   480 ..as in refin'
   481 
   482 ----- fun check_preconds'
   483 > (writeln o env2str) env;
   484 ["
   485 (es_, [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
   486  0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2])","
   487 (v_s, [c, c_2])","
   488 (ss___, L)"]
   489 
   490 > val es_ = (fst o hd) env;
   491 val es_ = Free ("es_", "bool List.list") : Term.term
   492 
   493 > val pre1 = hd pres;
   494 atomty pre1;
   495 ***
   496 *** Const (op =, [real, real] => bool)
   497 *** . Const (ListG.length_, real list => real)
   498 *** . . Free (es_, real list)
   499 ~~~~~~~~~~~~~~~~~~~^^^^^^^^^ should be bool list~~~~~~~~~~~~~~~~~~~
   500 *** . Free (2, real)
   501 ***
   502 
   503 THE REASON WAS A non-type-constrained variable IN #WHERE OF PROBLEM
   504 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   505 *)
   506 
   507 "----------- me [EqSystem,normalise,2x2] -------------------------";
   508 "----------- me [EqSystem,normalise,2x2] -------------------------";
   509 "----------- me [EqSystem,normalise,2x2] -------------------------";
   510 val fmz = ["equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\
   511 	               \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]", 
   512 	   "solveForVars [c, c_2]", "solution LL"];
   513 val (dI',pI',mI') =
   514   ("Biegelinie",["normalise", "2x2", "LINEAR", "system"],
   515    ["EqSystem","normalise","2x2"]);
   516 val p = e_pos'; val c = []; 
   517 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   518 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   519 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   520 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   521 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   522 case nxt of Specify_Method ["EqSystem", "normalise", "2x2"] => ()
   523 	  | _ => error "eqsystem.sml [EqSystem,normalise,2x2] specify";
   524 
   525 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   526 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   527 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f(*["(bdv_1, c)", "(bdv_2, hd (tl [c, c_2] ... corrected srls; ran only AFTER use"RCODE-root.sml", store_met was NOT SUFFICIENT*);
   528 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   529 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   530 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   531 case nxt of
   532     (Subproblem ("Biegelinie", ["triangular", "2x2", "LINEAR",_])) => ()
   533   | _ => error "eqsystem.sml me [EqSystem,normalise,2x2] SubProblem";
   534 
   535 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   536 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   537 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   538 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   539 case nxt of
   540     (Specify_Method ["EqSystem", "top_down_substitution", "2x2"]) => ()
   541   | _ => error "eqsystem.sml me [EqSys...2x2] top_down_substitution";
   542 
   543 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   544 val PblObj {probl,...} = get_obj I pt [5];
   545     (writeln o (itms2str_ (thy2ctxt @{theory Isac_Knowledge}))) probl;
   546 (*[
   547 (1 ,[1] ,true ,#Given ,Cor equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2] ,(es_, [[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]])),
   548 (2 ,[1] ,true ,#Given ,Cor solveForVars [c, c_2] ,(v_s, [[c, c_2]])),
   549 (3 ,[1] ,true ,#Find ,Cor solution ss___ ,(ss___, [ss___]))]
   550 *)
   551 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   552 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   553 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   554 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   555 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   556 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   557 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   558 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   559 case nxt of
   560     (Check_Postcond ["triangular", "2x2", "LINEAR", "system"]) => ()
   561   | _ => error "eqsystem.sml me Subpbl .[EqSys...2x2] finished";
   562 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   563 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   564 if f2str f = "[c = L * q_0 / 2, c_2 = 0]" then ()
   565 else error "eqsystem.sml me [EqSys...2x2] finished f2str f";
   566 case nxt of
   567     (End_Proof') => ()
   568   | _ => error "eqsystem.sml me [EqSys...2x2] finished End_Proof'";
   569 
   570 "----------- me [linear,system] ..normalise..top_down_sub..-------";
   571 "----------- me [linear,system] ..normalise..top_down_sub..-------";
   572 "----------- me [linear,system] ..normalise..top_down_sub..-------";
   573 val fmz = 
   574     ["equalities\
   575      \[0 = c_2 + c * 0 + 1 / EI * (L * q_0 / 12 * 0 ^^^ 3 +                \
   576      \                                            -1 * q_0 / 24 * 0 ^^^ 4),\
   577      \ 0 = c_2 + c * L + 1 / EI * (L * q_0 / 12 * L ^^^ 3 +                \
   578      \                                            -1 * q_0 / 24 * L ^^^ 4)]",
   579      "solveForVars [c, c_2]", "solution LL"];
   580 val (dI',pI',mI') =
   581   ("Biegelinie",["LINEAR", "system"], ["no_met"]);
   582 val p = e_pos'; val c = []; 
   583 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   584 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   585 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   586 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   587 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   588 case nxt of (Specify_Method ["EqSystem", "normalise", "2x2"]) => ()
   589 	  | _ => error "eqsystem.sml [linear,system] specify b";
   590 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   591 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   592 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   593 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   594 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   595 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   596 if f2str f = 
   597 "[c_2 = 0, L * c + c_2 = -1 * q_0 * L ^^^ 4 / (24 * EI)]"
   598 then () else error "eqsystem.sml me simpl. before SubProblem b";
   599 case nxt of
   600     (Subproblem ("Biegelinie", ["triangular", "2x2", "LINEAR",_])) => ()
   601   | _ => error "eqsystem.sml me [linear,system] SubProblem b";
   602 
   603 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   604 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   605 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   606 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   607 case nxt of
   608     (Specify_Method ["EqSystem", "top_down_substitution", "2x2"]) => ()
   609   | _ => error "eqsystem.sml me [EqSys...2x2] top_down_substitution b";
   610 
   611 val (p,_,f,nxt,_,pt) = me nxt p c pt;
   612 val PblObj {probl,...} = get_obj I pt [5];
   613     (writeln o (itms2str_ (thy2ctxt @{theory Isac_Knowledge}))) probl;
   614 (*[
   615 (1 ,[1] ,true ,#Given ,Cor equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2] ,(es_, [[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]])),
   616 (2 ,[1] ,true ,#Given ,Cor solveForVars [c, c_2] ,(v_s, [[c, c_2]])),
   617 (3 ,[1] ,true ,#Find ,Cor solution ss___ ,(ss___, [ss___]))]
   618 *)
   619 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   620 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   621 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   622 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   623 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   624 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   625 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   626 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   627 case nxt of
   628     (Check_Postcond ["triangular", "2x2", "LINEAR", "system"]) => ()
   629   | _ => error "eqsystem.sml me Subpbl .[EqSys...2x2] finished b";
   630 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   631 val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
   632 
   633 if f2str f = "[c = -1 * q_0 * L ^^^ 3 / (24 * EI), c_2 = 0]"
   634 then () else error "eqsystem.sml me [EqSys...2x2] finished f2str f b";
   635 case nxt of
   636     (End_Proof') => ()
   637   | _ => error "eqsystem.sml me [EqSys...2x2] finished End_Proof'";
   638 
   639 
   640 "----------- all systems from Biegelinie -------------------------";
   641 "----------- all systems from Biegelinie -------------------------";
   642 "----------- all systems from Biegelinie -------------------------";
   643 val thy = @{theory Isac_Knowledge}
   644 val subst = 
   645   [(str2term "bdv_1", str2term "c"), (str2term "bdv_2", str2term "c_2"),
   646 	(str2term "bdv_3", str2term "c_3"), (str2term "bdv_4", str2term "c_4")]; 
   647 
   648 "------- Bsp 7.27";
   649 reset_states ();
   650 CalcTree [(
   651   ["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
   652 	  "Randbedingungen [y 0 = (0::real), y L = 0, M_b 0 = 0, M_b L = 0]", "FunktionsVariable x"],
   653 	("Biegelinie", ["Biegelinien"], ["IntegrierenUndKonstanteBestimmen2"]))];
   654 moveActiveRoot 1;
   655 (*
   656 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   657 ##7.27##          ordered           substs
   658           c_4       c_2           
   659 c c_2 c_3 c_4     c c_2             1->2: c
   660   c_2                       c_4	  
   661 c c_2             c c_2 c_3 c_4     [2':c, 1:c_2, 3:c_4] -> 4:c_3*)
   662 val t = str2term
   663   ("[0 = c_4, " ^
   664   "0 = c_4 + L * c_3 +(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI), " ^
   665   "0 = c_2, " ^
   666   "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]");
   667 val SOME (t, _) = rewrite_set_ thy false isolate_bdvs_4x4 t;
   668 if UnparseC.term t =
   669 "[c_4 = 0,\n (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI) =\n -1 * (c_4 + L * c_3) + 0,\n c_2 = 0, (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2 = 0]"
   670 then () else error "Bsp 7.27";
   671 
   672 "----- Bsp 7.27 go through the rewrites in met_eqsys_norm_4x4";
   673 val t = str2term "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2";
   674 val NONE = rewrite_set_ thy false norm_Rational t;
   675 val SOME (t,_) = 
   676     rewrite_set_inst_ thy false subst simplify_System_parenthesized t;
   677 if UnparseC.term t = "0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2)"
   678 then () else error "Bsp 7.27 go through the rewrites in met_eqsys_norm_4x4";
   679 
   680 "--- isolate_bdvs_4x4";
   681 (*
   682 val SOME (t,_) = rewrite_set_inst_ thy false subst isolate_bdvs_4x4 t;
   683 UnparseC.term t;
   684 val SOME (t,_) = rewrite_set_inst_ thy false subst simplify_System t;
   685 UnparseC.term t;
   686 val SOME (t,_) = rewrite_set_ thy false order_system t;
   687 UnparseC.term t;
   688 *)
   689 
   690 "------- Bsp 7.28 ---------------vvvvvvvvvvvvv Momentenlinie postponed";
   691 reset_states ();
   692 CalcTree [((*WN130908  <ERROR> error in kernel </ERROR>*)
   693   ["Traegerlaenge L","Momentenlinie (-q_0 / L * x^^^3 / 6)",
   694 	    "Biegelinie y",
   695 	    "Randbedingungen [y L = 0, y' L = 0]",
   696 	    "FunktionsVariable x"],
   697 	   ("Biegelinie", ["vonMomentenlinieZu","Biegelinien"],
   698 	    ["Biegelinien", "AusMomentenlinie"]))];
   699 (*
   700 moveActiveRoot 1;
   701 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   702 *)
   703 
   704 "------- Bsp 7.69";
   705 reset_states ();
   706 CalcTree [(
   707   ["Traegerlaenge L", "Streckenlast q_0", "Biegelinie y",
   708 	  "Randbedingungen [y 0 = (0::real), y L = 0, y' 0 = 0, y' L = 0]", "FunktionsVariable x"],
   709 	("Biegelinie", ["Biegelinien"], ["IntegrierenUndKonstanteBestimmen2"]))];
   710 moveActiveRoot 1;
   711 (*
   712 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   713 ##7.69##          ordered           subst                   2x2
   714           c_4           c_3         
   715 c c_2 c_3 c_4     c c_2 c_3	    1:c_3 -> 2:c c_2        2:         c c_2
   716       c_3                   c_4	 			   
   717 c c_2 c_3         c c_2 c_3 c_4     3:c_4 -> 4:c c_2 c_3    1:c_3 -> 4:c c_2*)
   718 val t = str2term 
   719   ("[0 = c_4 + 0 / (-1 * EI), " ^
   720   "0 = c_4 + L * c_3 + (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI), " ^
   721   "0 = c_3 + 0 / (-1 * EI), " ^
   722   "0 = c_3 + (6 * L * c_2 + 3 * L ^^^ 2 * c + -1 * L ^^^ 3 * q_0) / (-6 * EI)]");
   723 
   724 "------- Bsp 7.70";
   725 reset_states ();
   726 CalcTree [(
   727   ["Traegerlaenge L", "Streckenlast q_0", "Biegelinie y",
   728 	  "Randbedingungen [Q 0 = q_0 * L, M_b L = 0, y 0 = (0::real), y' 0 = 0]", "FunktionsVariable x"],
   729 	("Biegelinie", ["Biegelinien"], ["IntegrierenUndKonstanteBestimmen2"] ))];
   730 moveActiveRoot 1;
   731 (*
   732 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   733 ##7.70##        |subst
   734 c		|
   735 c c_2           |1:c -> 2:c_2
   736       c_3	|
   737           c_4   |            STOPPED.WN06? test methods @@@@@@@@@@@@@@@@@@@@@@@*)
   738 
   739 "----- 7.70 go through the rewrites in met_eqsys_norm_4x4";
   740 val t = str2term
   741   ("[L * q_0 = c, " ^
   742   "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2, " ^
   743   "0 = c_4, " ^
   744   "0 = c_3]");
   745 val SOME (t,_) = rewrite_ thy e_rew_ord Rule_Set.empty false (ThmC.numerals_to_Free @{thm commute_0_equality}) t;
   746 val SOME (t,_) = rewrite_ thy e_rew_ord Rule_Set.empty false (ThmC.numerals_to_Free @{thm commute_0_equality}) t;
   747 val SOME (t,_) = rewrite_ thy e_rew_ord Rule_Set.empty false (ThmC.numerals_to_Free @{thm commute_0_equality}) t;
   748 if UnparseC.term t = 
   749   "[L * q_0 = c, (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2 = 0, c_4 = 0,\n c_3 = 0]"
   750 then () else error "7.70 go through the rewrites in met_eqsys_norm_4x4, 1";
   751 
   752 val SOME (t,_) = rewrite_set_inst_ thy false subst simplify_System_parenthesized t;
   753 if UnparseC.term t = "[L * q_0 = c, -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2) = 0, c_4 = 0, c_3 = 0]"
   754 then () else error "7.70 go through the rewrites in met_eqsys_norm_4x4, 2";
   755 
   756 val SOME (t,_) = rewrite_set_inst_ thy false subst isolate_bdvs_4x4 t;
   757 if UnparseC.term t =
   758    "[c = (-1 * (L * q_0) + 0) / -1,\n" ^ 
   759    " L * c + c_2 = -1 * (-1 * q_0 * L ^^^ 2 / 2) + 0, c_4 = 0, c_3 = 0]"
   760 then () else error "7.70 go through the rewrites in met_eqsys_norm_4x4, 3";
   761 
   762 val SOME (t,_) = rewrite_set_inst_ thy false subst simplify_System_parenthesized t;
   763 if UnparseC.term t = "[c = -1 * L * q_0 / -1, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_4 = 0, c_3 = 0]"
   764 then () else error "7.70 go through the rewrites in met_eqsys_norm_4x4, 4";
   765 
   766 val SOME (t, _) = rewrite_set_ thy false order_system t;
   767 if UnparseC.term t = "[c = -1 * L * q_0 / -1, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_3 = 0, c_4 = 0]"
   768 then () else error "eqsystem.sml: exp 7.70 normalise 4x4 by rewrite changed";
   769 
   770 "----- 7.70 with met normalise: ";
   771 val fmz = ["equalities" ^
   772   "[L * q_0 = c, " ^
   773   "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2, " ^
   774   "0 = c_4, " ^
   775   "0 = c_3]", "solveForVars [c, c_2, c_3, c_4]", "solution LL"];
   776 val (dI',pI',mI') = ("Biegelinie",["LINEAR", "system"], ["no_met"]);
   777 val p = e_pos'; val c = [];
   778 
   779 (*============ inhibit exn WN120314 TODO: investigate type error (same as above)==
   780   in next but one test below the same type error.
   781 /-------------------------------------------------------\
   782 Type unification failed
   783 Type error in application: incompatible operand type
   784 
   785 Operator:  op # c_3 :: 'a list \<Rightarrow> 'a list
   786 Operand:   [c_4] :: 'b list
   787 \-------------------------------------------------------/
   788 
   789 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   790 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   791 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   792 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   793 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   794 case nxt of (_,Apply_Method ["EqSystem", "normalise", "4x4"]) => ()
   795 	  | _ => error "eqsystem.sml [EqSystem,normalise,4x4] specify";
   796 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   797 
   798 "----- outcommented before Isabelle2002 --> 2011 -------------------------";
   799 (*-----------------------------------vvvWN080102 Exception- Match raised 
   800   since associate Rewrite .. Rewrite'_Set
   801 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   802 
   803 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   804 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   805 
   806 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   807 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   808 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   809 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   810 if f2str f ="[c = L * q_0, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_3 = 0, c_4 = 0]" 
   811 then () else error "eqsystem.sml: exp 7.70 normalise 4x4 by met changed";
   812 --------------------------------------------------------------------------*)
   813 
   814 "----- 7.70 with met top_down_: me";
   815 val fmz = ["equalities                                         \
   816 	    \[c = L * q_0, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_3 = 0, c_4 = 0]",
   817 	    "solveForVars [c, c_2, c_3, c_4]", "solution LL"];
   818 val (dI',pI',mI') =
   819   ("Biegelinie",["LINEAR", "system"],["no_met"]);
   820 val p = e_pos'; val c = []; 
   821 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   822 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   823 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   824 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   825 val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
   826 case nxt of (_,Apply_Method ["EqSystem", "top_down_substitution", "4x4"]) => ()
   827 	  | _ => error "eqsystem.sml [EqSystem,top_down_,4x4] specify";
   828 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   829 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   830 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   831 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   832 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   833 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   834 if nxt = ("End_Proof'", End_Proof') andalso
   835    f2str f = "[c = L * q_0, c_2 = -1 * L ^^^ 2 * q_0 / 2, c_3 = 0, c_4 = 0]"
   836 then () else error "eqsystem.sml: 7.70 with met top_down_: me";
   837 ============ inhibit exn WN120314 ==============================================*)
   838 
   839 "------- Bsp 7.71";
   840 reset_states ();
   841 CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
   842 	     "Randbedingungen [M_b L = 0, y 0 = (0::real), y L = 0, y' 0 = 0]",
   843 	     "FunktionsVariable x", "GleichungsVariablen [c, c_2, c_3, c_4]",
   844 	     "AbleitungBiegelinie dy"],
   845 	    ("Biegelinie", ["Biegelinien"],
   846 	     ["IntegrierenUndKonstanteBestimmen2"] ))];
   847 moveActiveRoot 1;
   848 (*
   849 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   850 ##7.71##       |ordered       |subst.singles (recurs) |2x2       |diagonal
   851 c c_2          |c c_2	      |1'		      |1': c c_2 |
   852           c_4  |      c_3     |2:c_3 -> 4' :c c_2 c_4 |	         |
   853 c c_2 c_3 c_4  |          c_4 |3'                     |	         |
   854       c_3      |c c_2 c_3 c_4 |3:c_4 -> 4'':c c_2     |4'':c c_2 |      *)
   855 val t = str2term"[0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2, \
   856 \ 0 = c_4 + 0 / (-1 * EI),                            \
   857 \ 0 = c_4 + L * c_3 +(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) /(-24 * EI),\
   858 \ 0 = c_3 + 0 / (-1 * EI)]";
   859 
   860 "------- Bsp 7.72a ---------------vvvvvvvvvvvvv Momentenlinie postponed";
   861 reset_states ();
   862 CalcTree [(["Traegerlaenge L",
   863 	    "Momentenlinie ((q_0 * L)/ 6 * x - q_0 /(6 * L) * x^3)",
   864 	    "Biegelinie y",
   865 	    "Randbedingungen [y 0 = (0::real), y L = 0]",
   866 	    "FunktionsVariable x"],
   867 	   ("Biegelinie", ["vonMomentenlinieZu","Biegelinien"],
   868 	    ["Biegelinien", "AusMomentenlinie"]))];
   869 moveActiveRoot 1;
   870 (*
   871 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   872 *)
   873 
   874 "------- Bsp 7.72b";
   875 reset_states ();
   876 CalcTree [(["Traegerlaenge L","Streckenlast (q_0 / L * x)","Biegelinie y",
   877 	    "Randbedingungen [M_b 0 = 0, M_b L = 0, y 0 = (0::real), y L = 0]",
   878 	    "FunktionsVariable x", "GleichungsVariablen [c, c_2, c_3, c_4]",
   879 	    "AbleitungBiegelinie dy"],
   880 	   ("Biegelinie", ["Biegelinien"],
   881 	    ["IntegrierenUndKonstanteBestimmen2"] ))];
   882 moveActiveRoot 1;
   883 (*
   884 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   885 ##7.72b##      |ord. |subst.singles         |ord.triang.
   886   c_2          |     |			    |c_2  
   887 c c_2	       |     |1:c_2 -> 2':c	    |c_2 c
   888           c_4  |     |			    |
   889 c c_2 c_3 c_4  |     |3:c_4 -> 4':c c_2 c_3 |c_2 c c_3*)
   890 val t = str2term"[0 = c_2,                                            \
   891 \ 0 = (6 * c_2 + 6 * L * c + -1 * L ^^^ 2 * q_0) / 6, \
   892 \ 0 = c_4 + 0 / (-1 * EI),                            \
   893 \ 0 = c_4 + L * c_3 + (60 * L ^^^ 2 * c_2 + 20 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-120 * EI)]";
   894 
   895 "------- Bsp 7.73 ---------------vvvvvvvvvvvvv Momentenlinie postponed";
   896 reset_states ();
   897 CalcTree [(["Traegerlaenge L","Momentenlinie ???",(*description unclear*)
   898 	    "Biegelinie y",
   899 	    "Randbedingungen [y L = 0, y' L = 0]",
   900 	    "FunktionsVariable x"],
   901 	   ("Biegelinie", ["vonMomentenlinieZu","Biegelinien"],
   902 	    ["Biegelinien", "AusMomentenlinie"]))];
   903 moveActiveRoot 1;
   904 (*
   905 trace_LI := true; autoCalculate 1 CompleteCalc; trace_LI := false;
   906 *)
   907 
   908 "----------- 4x4 systems from Biegelinie -------------------------";
   909 "----------- 4x4 systems from Biegelinie -------------------------";
   910 "----------- 4x4 systems from Biegelinie -------------------------";
   911 (*STOPPED.WN08?? replace this test with 7.70 *)
   912 "----- Bsp 7.27";
   913 val fmz = ["equalities \
   914 	   \[0 = c_4,                           \
   915 	   \ 0 = c_4 + L * c_3 +(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI),                                       \
   916 	   \ 0 = c_2,                                           \
   917 	   \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]", 
   918 	   "solveForVars [c, c_2, c_3, c_4]", "solution LL"];
   919 val (dI',pI',mI') =
   920   ("Biegelinie",["normalise", "4x4", "LINEAR", "system"],
   921    ["EqSystem","normalise","4x4"]);
   922 val p = e_pos'; val c = []; 
   923 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   924 val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
   925 val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
   926 val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
   927 val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
   928 "------------------------------------------- Apply_Method...";
   929 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   930 "[0 = c_4,                                          \
   931 \ 0 = c_4 + L * c_3 +\n (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI),                                   \
   932 \ 0 = c_2,                                          \
   933 \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]";
   934 (*vvvWN080102 Exception- Match raised 
   935   since associate Rewrite .. Rewrite'_Set
   936 "------------------------------------------- simplify_System_parenthesized...";
   937 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   938 "[0 = c_4,                                  \
   939 \ 0 = -1 * q_0 * L ^^^ 4 / (-24 * EI) +     \
   940 \     (4 * L ^^^ 3 * c / (-24 * EI) +       \
   941 \     (12 * L ^^^ 2 * c_2 / (-24 * EI) +    \
   942 \     (L * c_3 + c_4))),                    \
   943 \ 0 = c_2,                                  \
   944 \ 0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2)]";
   945 (*? "(4 * L ^^^ 3 / (-24 * EI) * c" statt "(4 * L ^^^ 3 * c / (-24 * EI)" ?*)
   946 "------------------------------------------- isolate_bdvs...";
   947 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   948 "[c_4 = 0,\
   949 \ c_4 = 0 + -1 * (-1 * q_0 * L ^^^ 4 / (-24 * EI)) + -1 * (4 * L ^^^ 3 * c / (-24 * EI)) + -1 * (12 * L ^^^ 2 * c_2 / (-24 * EI)) + -1 * (L * c_3),\
   950 \ c_2 = 0, \
   951 \ c_2 = 0 + -1 * (-1 * q_0 * L ^^^ 2 / 2) + -1 * (L * c)]";
   952 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
   953 
   954 ---------------------------------------------------------------------*)