1.1 --- a/src/Tools/isac/Build_Isac.thy Fri Aug 27 10:39:12 2010 +0200
1.2 +++ b/src/Tools/isac/Build_Isac.thy Fri Aug 27 14:56:54 2010 +0200
1.3 @@ -64,14 +64,14 @@
1.4 use_thy "Knowledge/Typefix"
1.5 use_thy "Knowledge/Descript"
1.6
1.7 -use_thy "Knowledge/Atools"
1.8 -
1.9 -
1.10 ML {*
1.11 111;
1.12 *}
1.13
1.14 (*
1.15 +use_thy "Knowledge/Atools"
1.16 +
1.17 +
1.18 use_thy "Knowledge/Simplify"
1.19 use_thy "Knowledge/Poly"
1.20 use_thy "Knowledge/Rational"
2.1 --- a/src/Tools/isac/Knowledge/AlgEin.ML Fri Aug 27 10:39:12 2010 +0200
2.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
2.3 @@ -1,139 +0,0 @@
2.4 -(* Algebra Einf"uhrung, Unterrichtsversuch IMST-Projekt
2.5 - author: Walther Neuper 2007
2.6 - (c) due to copyright terms
2.7 -
2.8 -use"Knowledge/AlgEin.ML";
2.9 -use"AlgEin.ML";
2.10 -
2.11 -remove_thy"Typefix";
2.12 -remove_thy"AlgEin";
2.13 -use_thy"Knowledge/Isac";
2.14 -*)
2.15 -
2.16 -(** interface isabelle -- isac **)
2.17 -
2.18 -theory' := overwritel (!theory', [("(theory "AlgEin")",(theory "AlgEin"))]);
2.19 -
2.20 -(** problems **)
2.21 -
2.22 -store_pbt
2.23 - (prep_pbt (theory "AlgEin") "pbl_algein" [] e_pblID
2.24 - (["Berechnung"], [], e_rls, NONE,
2.25 - []));
2.26 -(* WN070405
2.27 -store_pbt
2.28 - (prep_pbt (theory "AlgEin") "pbl_algein_num" [] e_pblID
2.29 - (["numerische", "Berechnung"],
2.30 - [("#Given" ,["KantenUnten u_", "KantenSenkrecht s_", "KantenOben o_"]),
2.31 - ("#Find" ,["GesamtLaenge l_"])
2.32 - ],
2.33 - append_rls "e_rls" e_rls [],
2.34 - NONE,
2.35 - []));
2.36 -*)
2.37 -store_pbt
2.38 - (prep_pbt (theory "AlgEin") "pbl_algein_numsym" [] e_pblID
2.39 - (["numerischSymbolische", "Berechnung"],
2.40 - [("#Given" ,["KantenLaenge k_","Querschnitt q__"(*q_ in Biegelinie.thy*),
2.41 - "KantenUnten u_", "KantenSenkrecht s_", "KantenOben o_"]),
2.42 - ("#Find" ,["GesamtLaenge l_"])
2.43 - ],
2.44 - e_rls,
2.45 - NONE,
2.46 - [["Berechnung","erstNumerisch"],["Berechnung","erstSymbolisch"]]));
2.47 -
2.48 -(* show_ptyps();
2.49 - *)
2.50 -
2.51 -
2.52 -(** methods **)
2.53 -
2.54 -store_met
2.55 - (prep_met (theory "AlgEin") "met_algein" [] e_metID
2.56 - (["Berechnung"],
2.57 - [],
2.58 - {rew_ord'="tless_true", rls'= Erls, calc = [],
2.59 - srls = Erls, prls = Erls,
2.60 - crls =Erls , nrls = Erls},
2.61 -"empty_script"
2.62 -));
2.63 -
2.64 -store_met
2.65 - (prep_met (theory "AlgEin") "met_algein_numsym" [] e_metID
2.66 - (["Berechnung","erstNumerisch"],
2.67 - [],
2.68 - {rew_ord'="tless_true", rls'= Erls, calc = [],
2.69 - srls = Erls, prls = Erls,
2.70 - crls =Erls , nrls = Erls},
2.71 -"empty_script"
2.72 -));
2.73 -
2.74 -store_met
2.75 - (prep_met (theory "AlgEin") "met_algein_numsym" [] e_metID
2.76 - (["Berechnung","erstNumerisch"],
2.77 - [("#Given" ,["KantenLaenge k_","Querschnitt q__",
2.78 - "KantenUnten u_", "KantenSenkrecht s_",
2.79 - "KantenOben o_"]),
2.80 - ("#Find" ,["GesamtLaenge l_"])
2.81 - ],
2.82 - {rew_ord'="tless_true", rls'= e_rls, calc = [],
2.83 - srls = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
2.84 - [Calc ("Atools.boollist2sum",
2.85 - eval_boollist2sum "")],
2.86 - prls = e_rls, crls =e_rls , nrls = norm_Rational},
2.87 -"Script RechnenSymbolScript (k_::bool) (q__::bool) " ^
2.88 -"(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =" ^
2.89 -" (let t_ = Take (l_ = oben + senkrecht + unten); " ^
2.90 -" sum_ = boollist2sum o_; " ^
2.91 -" t_ = Substitute [oben = sum_] t_; " ^
2.92 -" t_ = Substitute o_ t_; " ^
2.93 -" t_ = Substitute [k_, q__] t_; " ^
2.94 -" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
2.95 -" sum_ = boollist2sum s_; " ^
2.96 -" t_ = Substitute [senkrecht = sum_] t_; " ^
2.97 -" t_ = Substitute s_ t_; " ^
2.98 -" t_ = Substitute [k_, q__] t_; " ^
2.99 -" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
2.100 -" sum_ = boollist2sum u_; " ^
2.101 -" t_ = Substitute [unten = sum_] t_; " ^
2.102 -" t_ = Substitute u_ t_; " ^
2.103 -" t_ = Substitute [k_, q__] t_; " ^
2.104 -" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_ " ^
2.105 -" in (Try (Rewrite_Set norm_Poly False)) t_) "
2.106 -));
2.107 -
2.108 -store_met
2.109 - (prep_met (theory "AlgEin") "met_algein_symnum" [] e_metID
2.110 - (["Berechnung","erstSymbolisch"],
2.111 - [("#Given" ,["KantenLaenge k_","Querschnitt q__",
2.112 - "KantenUnten u_", "KantenSenkrecht s_",
2.113 - "KantenOben o_"]),
2.114 - ("#Find" ,["GesamtLaenge l_"])
2.115 - ],
2.116 - {rew_ord'="tless_true", rls'= e_rls, calc = [],
2.117 - srls = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
2.118 - [Calc ("Atools.boollist2sum",
2.119 - eval_boollist2sum "")],
2.120 - prls = e_rls,
2.121 - crls =e_rls , nrls = norm_Rational},
2.122 -"Script RechnenSymbolScript (k_::bool) (q__::bool) " ^
2.123 -"(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =" ^
2.124 -" (let t_ = Take (l_ = oben + senkrecht + unten); " ^
2.125 -" sum_ = boollist2sum o_; " ^
2.126 -" t_ = Substitute [oben = sum_] t_; " ^
2.127 -" t_ = Substitute o_ t_; " ^
2.128 -" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
2.129 -" sum_ = boollist2sum s_; " ^
2.130 -" t_ = Substitute [senkrecht = sum_] t_; " ^
2.131 -" t_ = Substitute s_ t_; " ^
2.132 -" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
2.133 -" sum_ = boollist2sum u_; " ^
2.134 -" t_ = Substitute [unten = sum_] t_; " ^
2.135 -" t_ = Substitute u_ t_; " ^
2.136 -" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
2.137 -" t_ = Substitute [k_, q__] t_ " ^
2.138 -" in (Try (Rewrite_Set norm_Poly False)) t_) "
2.139 -));
2.140 -
2.141 -(* show_mets();
2.142 - *)
3.1 --- a/src/Tools/isac/Knowledge/AlgEin.thy Fri Aug 27 10:39:12 2010 +0200
3.2 +++ b/src/Tools/isac/Knowledge/AlgEin.thy Fri Aug 27 14:56:54 2010 +0200
3.3 @@ -1,16 +1,9 @@
3.4 (* Algebra Einf"uhrung, Unterrichtsversuch IMST-Projekt
3.5 author: Walther Neuper 2007
3.6 (c) due to copyright terms
3.7 -
3.8 -remove_thy"AlgEin";
3.9 -use_thy"Knowledge/AlgEin";
3.10 -use_thy_only"Knowledge/AlgEin";
3.11 -
3.12 -remove_thy"AlgEin";
3.13 -use_thy"Knowledge/Isac";
3.14 *)
3.15
3.16 -AlgEin = Rational +
3.17 +theory AlgEin imports Rational begin
3.18 (*Poly + ..shouldbe sufficient, but norm_Poly *)
3.19
3.20 consts
3.21 @@ -28,10 +21,127 @@
3.22 bool] => bool"
3.23 ("((Script RechnenSymbolScript (_ _ _ _ _ _ =))// (_))" 9)
3.24
3.25 -(*
3.26 -rules
3.27 - (*this axiom creates a contradictory formal system,
3.28 - see problem TOOODO *)
3.29 +ML {*
3.30 +(** problems **)
3.31 +
3.32 +store_pbt
3.33 + (prep_pbt (theory "AlgEin") "pbl_algein" [] e_pblID
3.34 + (["Berechnung"], [], e_rls, NONE,
3.35 + []));
3.36 +(* WN070405
3.37 +store_pbt
3.38 + (prep_pbt (theory "AlgEin") "pbl_algein_num" [] e_pblID
3.39 + (["numerische", "Berechnung"],
3.40 + [("#Given" ,["KantenUnten u_", "KantenSenkrecht s_", "KantenOben o_"]),
3.41 + ("#Find" ,["GesamtLaenge l_"])
3.42 + ],
3.43 + append_rls "e_rls" e_rls [],
3.44 + NONE,
3.45 + []));
3.46 *)
3.47 +store_pbt
3.48 + (prep_pbt (theory "AlgEin") "pbl_algein_numsym" [] e_pblID
3.49 + (["numerischSymbolische", "Berechnung"],
3.50 + [("#Given" ,["KantenLaenge k_","Querschnitt q__"(*q_ in Biegelinie.thy*),
3.51 + "KantenUnten u_", "KantenSenkrecht s_", "KantenOben o_"]),
3.52 + ("#Find" ,["GesamtLaenge l_"])
3.53 + ],
3.54 + e_rls,
3.55 + NONE,
3.56 + [["Berechnung","erstNumerisch"],["Berechnung","erstSymbolisch"]]));
3.57 +
3.58 +(* show_ptyps();
3.59 + *)
3.60 +
3.61 +
3.62 +(** methods **)
3.63 +
3.64 +store_met
3.65 + (prep_met (theory "AlgEin") "met_algein" [] e_metID
3.66 + (["Berechnung"],
3.67 + [],
3.68 + {rew_ord'="tless_true", rls'= Erls, calc = [],
3.69 + srls = Erls, prls = Erls,
3.70 + crls =Erls , nrls = Erls},
3.71 +"empty_script"
3.72 +));
3.73 +
3.74 +store_met
3.75 + (prep_met (theory "AlgEin") "met_algein_numsym" [] e_metID
3.76 + (["Berechnung","erstNumerisch"],
3.77 + [],
3.78 + {rew_ord'="tless_true", rls'= Erls, calc = [],
3.79 + srls = Erls, prls = Erls,
3.80 + crls =Erls , nrls = Erls},
3.81 +"empty_script"
3.82 +));
3.83 +
3.84 +store_met
3.85 + (prep_met (theory "AlgEin") "met_algein_numsym" [] e_metID
3.86 + (["Berechnung","erstNumerisch"],
3.87 + [("#Given" ,["KantenLaenge k_","Querschnitt q__",
3.88 + "KantenUnten u_", "KantenSenkrecht s_",
3.89 + "KantenOben o_"]),
3.90 + ("#Find" ,["GesamtLaenge l_"])
3.91 + ],
3.92 + {rew_ord'="tless_true", rls'= e_rls, calc = [],
3.93 + srls = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
3.94 + [Calc ("Atools.boollist2sum",
3.95 + eval_boollist2sum "")],
3.96 + prls = e_rls, crls =e_rls , nrls = norm_Rational},
3.97 +"Script RechnenSymbolScript (k_::bool) (q__::bool) " ^
3.98 +"(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =" ^
3.99 +" (let t_ = Take (l_ = oben + senkrecht + unten); " ^
3.100 +" sum_ = boollist2sum o_; " ^
3.101 +" t_ = Substitute [oben = sum_] t_; " ^
3.102 +" t_ = Substitute o_ t_; " ^
3.103 +" t_ = Substitute [k_, q__] t_; " ^
3.104 +" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
3.105 +" sum_ = boollist2sum s_; " ^
3.106 +" t_ = Substitute [senkrecht = sum_] t_; " ^
3.107 +" t_ = Substitute s_ t_; " ^
3.108 +" t_ = Substitute [k_, q__] t_; " ^
3.109 +" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
3.110 +" sum_ = boollist2sum u_; " ^
3.111 +" t_ = Substitute [unten = sum_] t_; " ^
3.112 +" t_ = Substitute u_ t_; " ^
3.113 +" t_ = Substitute [k_, q__] t_; " ^
3.114 +" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_ " ^
3.115 +" in (Try (Rewrite_Set norm_Poly False)) t_) "
3.116 +));
3.117 +
3.118 +store_met
3.119 + (prep_met (theory "AlgEin") "met_algein_symnum" [] e_metID
3.120 + (["Berechnung","erstSymbolisch"],
3.121 + [("#Given" ,["KantenLaenge k_","Querschnitt q__",
3.122 + "KantenUnten u_", "KantenSenkrecht s_",
3.123 + "KantenOben o_"]),
3.124 + ("#Find" ,["GesamtLaenge l_"])
3.125 + ],
3.126 + {rew_ord'="tless_true", rls'= e_rls, calc = [],
3.127 + srls = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
3.128 + [Calc ("Atools.boollist2sum",
3.129 + eval_boollist2sum "")],
3.130 + prls = e_rls,
3.131 + crls =e_rls , nrls = norm_Rational},
3.132 +"Script RechnenSymbolScript (k_::bool) (q__::bool) " ^
3.133 +"(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =" ^
3.134 +" (let t_ = Take (l_ = oben + senkrecht + unten); " ^
3.135 +" sum_ = boollist2sum o_; " ^
3.136 +" t_ = Substitute [oben = sum_] t_; " ^
3.137 +" t_ = Substitute o_ t_; " ^
3.138 +" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
3.139 +" sum_ = boollist2sum s_; " ^
3.140 +" t_ = Substitute [senkrecht = sum_] t_; " ^
3.141 +" t_ = Substitute s_ t_; " ^
3.142 +" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
3.143 +" sum_ = boollist2sum u_; " ^
3.144 +" t_ = Substitute [unten = sum_] t_; " ^
3.145 +" t_ = Substitute u_ t_; " ^
3.146 +" t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_; " ^
3.147 +" t_ = Substitute [k_, q__] t_ " ^
3.148 +" in (Try (Rewrite_Set norm_Poly False)) t_) "
3.149 +));
3.150 +*}
3.151
3.152 end
4.1 --- a/src/Tools/isac/Knowledge/Atools.ML Fri Aug 27 10:39:12 2010 +0200
4.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
4.3 @@ -1,645 +0,0 @@
4.4 -(* tools for arithmetic
4.5 - WN.8.3.01
4.6 - use"../Knowledge/Atools.ML";
4.7 - use"Knowledge/Atools.ML";
4.8 - use"Atools.ML";
4.9 - *)
4.10 -
4.11 -(*
4.12 -copy from doc/math-eng.tex WN.28.3.03
4.13 -WN071228 extended
4.14 -
4.15 -\section{Coding standards}
4.16 -
4.17 -%WN071228 extended -----vvv
4.18 -\subsection{Identifiers}
4.19 -Naming is particularily crucial, because Isabelles name space is global, and isac does not yet use the novel locale features introduces by Isar. For instance, {\tt probe} sounds reasonable as (1) a description in the model of a problem-pattern, (2) as an element of the problem hierarchies key, (3) as a socalled CAS-command, (4) as the name of a related script etc. However, all the cases (1)..(4) require different typing for one and the same identifier {\tt probe} which is impossible, and actually leads to strange errors (for instance (1) is used as string, except in a script addressing a Subproblem).
4.20 -
4.21 -This are the preliminary rules for naming identifiers>
4.22 -\begin{description}
4.23 -\item [elements of a key] into the hierarchy of problems or methods must not contain capital letters and may contain underscrores, e.g. {\tt probe, for_polynomials}.
4.24 -\item [descriptions in problem-patterns] must contain at least 1 capital letter and must not contain underscores, e.g. {\tt Probe, forPolynomials}.
4.25 -\item [CAS-commands] follow the same rules as descriptions in problem-patterns above, thus beware of conflicts~!
4.26 -\item [script identifiers] always end with {\tt Script}, e.g. {\tt ProbeScript}.
4.27 -\item [???] ???
4.28 -\item [???] ???
4.29 -\end{description}
4.30 -%WN071228 extended -----^^^
4.31 -
4.32 -
4.33 -\subsection{Rule sets}
4.34 -The actual version of the coding standards for rulesets is in {\tt /Knowledge/Atools.ML where it can be viewed using the knowledge browsers.
4.35 -
4.36 -There are rulesets visible to the student, and there are rulesets visible (in general) only for math authors. There are also rulesets which {\em must} exist for {\em each} theory; these contain the identifier of the respective theory (including all capital letters) as indicated by {\it Thy} below.
4.37 -\begin{description}
4.38 -
4.39 -\item [norm\_{\it Thy}] exists for each theory, and {\em efficiently} calculates a normalform for all terms which can be expressed by the definitions of the respective theory (and the respective parents).
4.40 -
4.41 -\item [simplify\_{\it Thy}] exists for each theory, and calculates a normalform for all terms which can be expressed by the definitions of the respective theory (and the respective parents) such, that the rewrites can be presented to the student.
4.42 -
4.43 -\item [calculate\_{\it Thy}] exists for each theory, and evaluates terms with numerical constants only (i.e. all terms which can be expressed by the definitions of the respective theory and the respective parent theories). In particular, this ruleset includes evaluating in/equalities with numerical constants only.
4.44 -WN.3.7.03: may be dropped due to more generality: numericals and non-numericals are logically equivalent, where the latter often add to the assumptions (e.g. in Check_elementwise).
4.45 -
4.46 -\end{description}
4.47 -The above rulesets are all visible to the user, and also may be input; thus they must be contained in the global associationlist {\tt ruleset':= }~! All these rulesets must undergo a preparation using the function {\tt prep_rls}, which generates a script for stepwise rewriting etc.
4.48 -The following rulesets are used for internal purposes and usually invisible to the (naive) user:
4.49 -\begin{description}
4.50 -
4.51 -\item [*\_erls]
4.52 -\item [*\_prls]
4.53 -\item [*\_srls]
4.54 -
4.55 -\end{description}
4.56 -{\tt append_rls, merge_rls, remove_rls}
4.57 -*)
4.58 -
4.59 -"******* Atools.ML begin *******";
4.60 -theory' := overwritel (!theory', [("Atools.thy",Atools.thy)]);
4.61 -
4.62 -(** evaluation of numerals and special predicates on the meta-level **)
4.63 -(*-------------------------functions---------------------*)
4.64 -local (* rlang 09.02 *)
4.65 - (*.a 'c is coefficient of v' if v does occur in c.*)
4.66 - fun coeff_in v c = member op = (vars c) v;
4.67 -in
4.68 - fun occurs_in v t = coeff_in v t;
4.69 -end;
4.70 -
4.71 -(*("occurs_in", ("Atools.occurs'_in", eval_occurs_in ""))*)
4.72 -fun eval_occurs_in _ "Atools.occurs'_in"
4.73 - (p as (Const ("Atools.occurs'_in",_) $ v $ t)) _ =
4.74 - ((*writeln("@@@ eval_occurs_in: v= "^(term2str v));
4.75 - writeln("@@@ eval_occurs_in: t= "^(term2str t));*)
4.76 - if occurs_in v t
4.77 - then SOME ((term2str p) ^ " = True",
4.78 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
4.79 - else SOME ((term2str p) ^ " = False",
4.80 - Trueprop $ (mk_equality (p, HOLogic.false_const))))
4.81 - | eval_occurs_in _ _ _ _ = NONE;
4.82 -
4.83 -(*some of the (bound) variables (eg. in an eqsys) "vs" occur in term "t"*)
4.84 -fun some_occur_in vs t =
4.85 - let fun occurs_in' a b = occurs_in b a
4.86 - in foldl or_ (false, map (occurs_in' t) vs) end;
4.87 -
4.88 -(*("some_occur_in", ("Atools.some'_occur'_in",
4.89 - eval_some_occur_in "#eval_some_occur_in_"))*)
4.90 -fun eval_some_occur_in _ "Atools.some'_occur'_in"
4.91 - (p as (Const ("Atools.some'_occur'_in",_)
4.92 - $ vs $ t)) _ =
4.93 - if some_occur_in (isalist2list vs) t
4.94 - then SOME ((term2str p) ^ " = True",
4.95 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
4.96 - else SOME ((term2str p) ^ " = False",
4.97 - Trueprop $ (mk_equality (p, HOLogic.false_const)))
4.98 - | eval_some_occur_in _ _ _ _ = NONE;
4.99 -
4.100 -
4.101 -
4.102 -
4.103 -(*evaluate 'is_atom'*)
4.104 -(*("is_atom",("Atools.is'_atom",eval_is_atom "#is_atom_"))*)
4.105 -fun eval_is_atom (thmid:string) "Atools.is'_atom"
4.106 - (t as (Const(op0,_) $ arg)) thy =
4.107 - (case arg of
4.108 - Free (n,_) => SOME (mk_thmid thmid op0 n "",
4.109 - Trueprop $ (mk_equality (t, true_as_term)))
4.110 - | _ => SOME (mk_thmid thmid op0 "" "",
4.111 - Trueprop $ (mk_equality (t, false_as_term))))
4.112 - | eval_is_atom _ _ _ _ = NONE;
4.113 -
4.114 -(*evaluate 'is_even'*)
4.115 -fun even i = (i div 2) * 2 = i;
4.116 -(*("is_even",("Atools.is'_even",eval_is_even "#is_even_"))*)
4.117 -fun eval_is_even (thmid:string) "Atools.is'_even"
4.118 - (t as (Const(op0,_) $ arg)) thy =
4.119 - (case arg of
4.120 - Free (n,_) =>
4.121 - (case int_of_str n of
4.122 - SOME i =>
4.123 - if even i then SOME (mk_thmid thmid op0 n "",
4.124 - Trueprop $ (mk_equality (t, true_as_term)))
4.125 - else SOME (mk_thmid thmid op0 "" "",
4.126 - Trueprop $ (mk_equality (t, false_as_term)))
4.127 - | _ => NONE)
4.128 - | _ => NONE)
4.129 - | eval_is_even _ _ _ _ = NONE;
4.130 -
4.131 -(*evaluate 'is_const'*)
4.132 -(*("is_const",("Atools.is'_const",eval_const "#is_const_"))*)
4.133 -fun eval_const (thmid:string) _(*"Atools.is'_const" WN050820 diff.beh. rooteq*)
4.134 - (t as (Const(op0,t0) $ arg)) (thy:theory) =
4.135 - (*eval_const FIXXXXXME.WN.16.5.03 still forgets ComplexI*)
4.136 - (case arg of
4.137 - Const (n1,_) =>
4.138 - SOME (mk_thmid thmid op0 n1 "",
4.139 - Trueprop $ (mk_equality (t, false_as_term)))
4.140 - | Free (n1,_) =>
4.141 - if is_numeral n1
4.142 - then SOME (mk_thmid thmid op0 n1 "",
4.143 - Trueprop $ (mk_equality (t, true_as_term)))
4.144 - else SOME (mk_thmid thmid op0 n1 "",
4.145 - Trueprop $ (mk_equality (t, false_as_term)))
4.146 - | Const ("Float.Float",_) =>
4.147 - SOME (mk_thmid thmid op0 (term2str arg) "",
4.148 - Trueprop $ (mk_equality (t, true_as_term)))
4.149 - | _ => (*NONE*)
4.150 - SOME (mk_thmid thmid op0 (term2str arg) "",
4.151 - Trueprop $ (mk_equality (t, false_as_term))))
4.152 - | eval_const _ _ _ _ = NONE;
4.153 -
4.154 -(*. evaluate binary, associative, commutative operators: *,+,^ .*)
4.155 -(*("PLUS" ,("op +" ,eval_binop "#add_")),
4.156 - ("TIMES" ,("op *" ,eval_binop "#mult_")),
4.157 - ("POWER" ,("Atools.pow" ,eval_binop "#power_"))*)
4.158 -
4.159 -(* val (thmid,op_,t as(Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2)),thy) =
4.160 - ("xxxxxx",op_,t,thy);
4.161 - *)
4.162 -fun mk_thmid_f thmid ((v11, v12), (p11, p12)) ((v21, v22), (p21, p22)) =
4.163 - thmid ^ "Float ((" ^
4.164 - (string_of_int v11)^","^(string_of_int v12)^"), ("^
4.165 - (string_of_int p11)^","^(string_of_int p12)^")) __ (("^
4.166 - (string_of_int v21)^","^(string_of_int v22)^"), ("^
4.167 - (string_of_int p21)^","^(string_of_int p22)^"))";
4.168 -
4.169 -(*.convert int and float to internal floatingpoint prepresentation.*)
4.170 -fun numeral (Free (str, T)) =
4.171 - (case int_of_str str of
4.172 - SOME i => SOME ((i, 0), (0, 0))
4.173 - | NONE => NONE)
4.174 - | numeral (Const ("Float.Float", _) $
4.175 - (Const ("Pair", _) $
4.176 - (Const ("Pair", T) $ Free (v1, _) $ Free (v2,_)) $
4.177 - (Const ("Pair", _) $ Free (p1, _) $ Free (p2,_))))=
4.178 - (case (int_of_str v1, int_of_str v2, int_of_str p1, int_of_str p2) of
4.179 - (SOME v1', SOME v2', SOME p1', SOME p2') =>
4.180 - SOME ((v1', v2'), (p1', p2'))
4.181 - | _ => NONE)
4.182 - | numeral _ = NONE;
4.183 -
4.184 -(*.evaluate binary associative operations.*)
4.185 -fun eval_binop (thmid:string) (op_:string)
4.186 - (t as ( Const(op0,t0) $
4.187 - (Const(op0',t0') $ v $ t1) $ t2))
4.188 - thy = (*binary . (v.n1).n2*)
4.189 - if op0 = op0' then
4.190 - case (numeral t1, numeral t2) of
4.191 - (SOME n1, SOME n2) =>
4.192 - let val (T1,T2,Trange) = dest_binop_typ t0
4.193 - val res = calc (if op0 = "op -" then "op +" else op0) n1 n2
4.194 - (*WN071229 "HOL.divide" never tried*)
4.195 - val rhs = var_op_float v op_ t0 T1 res
4.196 - val prop = Trueprop $ (mk_equality (t, rhs))
4.197 - in SOME (mk_thmid_f thmid n1 n2, prop) end
4.198 - | _ => NONE
4.199 - else NONE
4.200 - | eval_binop (thmid:string) (op_:string)
4.201 - (t as
4.202 - (Const (op0, t0) $ t1 $
4.203 - (Const (op0', t0') $ t2 $ v)))
4.204 - thy = (*binary . n1.(n2.v)*)
4.205 - if op0 = op0' then
4.206 - case (numeral t1, numeral t2) of
4.207 - (SOME n1, SOME n2) =>
4.208 - if op0 = "op -" then NONE else
4.209 - let val (T1,T2,Trange) = dest_binop_typ t0
4.210 - val res = calc op0 n1 n2
4.211 - val rhs = float_op_var v op_ t0 T1 res
4.212 - val prop = Trueprop $ (mk_equality (t, rhs))
4.213 - in SOME (mk_thmid_f thmid n1 n2, prop) end
4.214 - | _ => NONE
4.215 - else NONE
4.216 -
4.217 - | eval_binop (thmid:string) (op_:string)
4.218 - (t as (Const (op0,t0) $ t1 $ t2)) thy = (*binary . n1.n2*)
4.219 - (case (numeral t1, numeral t2) of
4.220 - (SOME n1, SOME n2) =>
4.221 - let val (T1,T2,Trange) = dest_binop_typ t0;
4.222 - val res = calc op0 n1 n2;
4.223 - val rhs = term_of_float Trange res;
4.224 - val prop = Trueprop $ (mk_equality (t, rhs));
4.225 - in SOME (mk_thmid_f thmid n1 n2, prop) end
4.226 - | _ => NONE)
4.227 - | eval_binop _ _ _ _ = NONE;
4.228 -(*
4.229 -> val SOME (thmid, t) = eval_binop "#add_" "op +" (str2term "-1 + 2") thy;
4.230 -> term2str t;
4.231 -val it = "-1 + 2 = 1"
4.232 -> val t = str2term "-1 * (-1 * a)";
4.233 -> val SOME (thmid, t) = eval_binop "#mult_" "op *" t thy;
4.234 -> term2str t;
4.235 -val it = "-1 * (-1 * a) = 1 * a"*)
4.236 -
4.237 -
4.238 -
4.239 -(*.evaluate < and <= for numerals.*)
4.240 -(*("le" ,("op <" ,eval_equ "#less_")),
4.241 - ("leq" ,("op <=" ,eval_equ "#less_equal_"))*)
4.242 -fun eval_equ (thmid:string) (op_:string) (t as
4.243 - (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) thy =
4.244 - (case (int_of_str n1, int_of_str n2) of
4.245 - (SOME n1', SOME n2') =>
4.246 - if calc_equ (strip_thy op0) (n1', n2')
4.247 - then SOME (mk_thmid thmid op0 n1 n2,
4.248 - Trueprop $ (mk_equality (t, true_as_term)))
4.249 - else SOME (mk_thmid thmid op0 n1 n2,
4.250 - Trueprop $ (mk_equality (t, false_as_term)))
4.251 - | _ => NONE)
4.252 -
4.253 - | eval_equ _ _ _ _ = NONE;
4.254 -
4.255 -
4.256 -(*evaluate identity
4.257 -> reflI;
4.258 -val it = "(?t = ?t) = True"
4.259 -> val t = str2term "x = 0";
4.260 -> val NONE = rewrite_ thy dummy_ord e_rls false reflI t;
4.261 -
4.262 -> val t = str2term "1 = 0";
4.263 -> val NONE = rewrite_ thy dummy_ord e_rls false reflI t;
4.264 ------------ thus needs Calc !
4.265 -> val t = str2term "0 = 0";
4.266 -> val SOME (t',_) = rewrite_ thy dummy_ord e_rls false reflI t;
4.267 -> term2str t';
4.268 -val it = "True"
4.269 -
4.270 -val t = str2term "Not (x = 0)";
4.271 -atomt t; term2str t;
4.272 -*** -------------
4.273 -*** Const ( Not)
4.274 -*** . Const ( op =)
4.275 -*** . . Free ( x, )
4.276 -*** . . Free ( 0, )
4.277 -val it = "x ~= 0" : string*)
4.278 -
4.279 -(*.evaluate identity on the term-level, =!= ,i.e. without evaluation of
4.280 - the arguments: thus special handling by 'fun eval_binop'*)
4.281 -(*("ident" ,("Atools.ident",eval_ident "#ident_")):calc*)
4.282 -fun eval_ident (thmid:string) "Atools.ident" (t as
4.283 - (Const (op0,t0) $ t1 $ t2 )) thy =
4.284 - if t1 = t2
4.285 - then SOME (mk_thmid thmid op0
4.286 - ("("^(Syntax.string_of_term (thy2ctxt thy) t1)^")")
4.287 - ("("^(Syntax.string_of_term (thy2ctxt thy) t2)^")"),
4.288 - Trueprop $ (mk_equality (t, true_as_term)))
4.289 - else SOME (mk_thmid thmid op0
4.290 - ("("^(Syntax.string_of_term (thy2ctxt thy) t1)^")")
4.291 - ("("^(Syntax.string_of_term (thy2ctxt thy) t2)^")"),
4.292 - Trueprop $ (mk_equality (t, false_as_term)))
4.293 - | eval_ident _ _ _ _ = NONE;
4.294 -(* TODO
4.295 -> val t = str2term "x =!= 0";
4.296 -> val SOME (str, t') = eval_ident "ident_" "b" t thy;
4.297 -> term2str t';
4.298 -val str = "ident_(x)_(0)" : string
4.299 -val it = "(x =!= 0) = False" : string
4.300 -> val t = str2term "1 =!= 0";
4.301 -> val SOME (str, t') = eval_ident "ident_" "b" t thy;
4.302 -> term2str t';
4.303 -val str = "ident_(1)_(0)" : string
4.304 -val it = "(1 =!= 0) = False" : string
4.305 -> val t = str2term "0 =!= 0";
4.306 -> val SOME (str, t') = eval_ident "ident_" "b" t thy;
4.307 -> term2str t';
4.308 -val str = "ident_(0)_(0)" : string
4.309 -val it = "(0 =!= 0) = True" : string
4.310 -*)
4.311 -
4.312 -(*.evaluate identity of terms, which stay ready for evaluation in turn;
4.313 - thus returns False only for atoms.*)
4.314 -(*("equal" ,("op =",eval_equal "#equal_")):calc*)
4.315 -fun eval_equal (thmid:string) "op =" (t as
4.316 - (Const (op0,t0) $ t1 $ t2 )) thy =
4.317 - if t1 = t2
4.318 - then ((*writeln"... eval_equal: t1 = t2 --> True";*)
4.319 - SOME (mk_thmid thmid op0
4.320 - ("("^(Syntax.string_of_term (thy2ctxt thy) t1)^")")
4.321 - ("("^(Syntax.string_of_term (thy2ctxt thy) t2)^")"),
4.322 - Trueprop $ (mk_equality (t, true_as_term)))
4.323 - )
4.324 - else (case (is_atom t1, is_atom t2) of
4.325 - (true, true) =>
4.326 - ((*writeln"... eval_equal: t1<>t2, is_atom t1,t2 --> False";*)
4.327 - SOME (mk_thmid thmid op0
4.328 - ("("^(term2str t1)^")") ("("^(term2str t2)^")"),
4.329 - Trueprop $ (mk_equality (t, false_as_term)))
4.330 - )
4.331 - | _ => ((*writeln"... eval_equal: t1<>t2, NOT is_atom t1,t2 --> go-on";*)
4.332 - NONE))
4.333 - | eval_equal _ _ _ _ = (writeln"... eval_equal: error-exit";
4.334 - NONE);
4.335 -(*
4.336 -val t = str2term "x ~= 0";
4.337 -val NONE = eval_equal "equal_" "b" t thy;
4.338 -
4.339 -
4.340 -> val t = str2term "(x + 1) = (x + 1)";
4.341 -> val SOME (str, t') = eval_equal "equal_" "b" t thy;
4.342 -> term2str t';
4.343 -val str = "equal_(x + 1)_(x + 1)" : string
4.344 -val it = "(x + 1 = x + 1) = True" : string
4.345 -> val t = str2term "x = 0";
4.346 -> val NONE = eval_equal "equal_" "b" t thy;
4.347 -
4.348 -> val t = str2term "1 = 0";
4.349 -> val SOME (str, t') = eval_equal "equal_" "b" t thy;
4.350 -> term2str t';
4.351 -val str = "equal_(1)_(0)" : string
4.352 -val it = "(1 = 0) = False" : string
4.353 -> val t = str2term "0 = 0";
4.354 -> val SOME (str, t') = eval_equal "equal_" "b" t thy;
4.355 -> term2str t';
4.356 -val str = "equal_(0)_(0)" : string
4.357 -val it = "(0 = 0) = True" : string
4.358 -*)
4.359 -
4.360 -
4.361 -(** evaluation on the metalevel **)
4.362 -
4.363 -(*. evaluate HOL.divide .*)
4.364 -(*("DIVIDE" ,("HOL.divide" ,eval_cancel "#divide_"))*)
4.365 -fun eval_cancel (thmid:string) "HOL.divide" (t as
4.366 - (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) thy =
4.367 - (case (int_of_str n1, int_of_str n2) of
4.368 - (SOME n1', SOME n2') =>
4.369 - let
4.370 - val sg = sign2 n1' n2';
4.371 - val (T1,T2,Trange) = dest_binop_typ t0;
4.372 - val gcd' = gcd (abs n1') (abs n2');
4.373 - in if gcd' = abs n2'
4.374 - then let val rhs = term_of_num Trange (sg * (abs n1') div gcd')
4.375 - val prop = Trueprop $ (mk_equality (t, rhs))
4.376 - in SOME (mk_thmid thmid op0 n1 n2, prop) end
4.377 - else if 0 < n2' andalso gcd' = 1 then NONE
4.378 - else let val rhs = num_op_num T1 T2 (op0,t0) (sg * (abs n1') div gcd')
4.379 - ((abs n2') div gcd')
4.380 - val prop = Trueprop $ (mk_equality (t, rhs))
4.381 - in SOME (mk_thmid thmid op0 n1 n2, prop) end
4.382 - end
4.383 - | _ => ((*writeln"@@@ eval_cancel NONE";*)NONE))
4.384 -
4.385 - | eval_cancel _ _ _ _ = NONE;
4.386 -
4.387 -(*. get the argument from a function-definition.*)
4.388 -(*("argument_in" ,("Atools.argument'_in",
4.389 - eval_argument_in "Atools.argument'_in"))*)
4.390 -fun eval_argument_in _ "Atools.argument'_in"
4.391 - (t as (Const ("Atools.argument'_in", _) $ (f $ arg))) _ =
4.392 - if is_Free arg (*could be something to be simplified before*)
4.393 - then SOME (term2str t ^ " = " ^ term2str arg,
4.394 - Trueprop $ (mk_equality (t, arg)))
4.395 - else NONE
4.396 - | eval_argument_in _ _ _ _ = NONE;
4.397 -
4.398 -(*.check if the function-identifier of the first argument matches
4.399 - the function-identifier of the lhs of the second argument.*)
4.400 -(*("sameFunId" ,("Atools.sameFunId",
4.401 - eval_same_funid "Atools.sameFunId"))*)
4.402 -fun eval_sameFunId _ "Atools.sameFunId"
4.403 - (p as Const ("Atools.sameFunId",_) $
4.404 - (f1 $ _) $
4.405 - (Const ("op =", _) $ (f2 $ _) $ _)) _ =
4.406 - if f1 = f2
4.407 - then SOME ((term2str p) ^ " = True",
4.408 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
4.409 - else SOME ((term2str p) ^ " = False",
4.410 - Trueprop $ (mk_equality (p, HOLogic.false_const)))
4.411 -| eval_sameFunId _ _ _ _ = NONE;
4.412 -
4.413 -
4.414 -(*.from a list of fun-definitions "f x = ..." as 2nd argument
4.415 - filter the elements with the same fun-identfier in "f y"
4.416 - as the fst argument;
4.417 - this is, because Isabelles filter takes more than 1 sec.*)
4.418 -fun same_funid f1 (Const ("op =", _) $ (f2 $ _) $ _) = f1 = f2
4.419 - | same_funid f1 t = raise error ("same_funid called with t = ("
4.420 - ^term2str f1^") ("^term2str t^")");
4.421 -(*("filter_sameFunId" ,("Atools.filter'_sameFunId",
4.422 - eval_filter_sameFunId "Atools.filter'_sameFunId"))*)
4.423 -fun eval_filter_sameFunId _ "Atools.filter'_sameFunId"
4.424 - (p as Const ("Atools.filter'_sameFunId",_) $
4.425 - (fid $ _) $ fs) _ =
4.426 - let val fs' = ((list2isalist HOLogic.boolT) o
4.427 - (filter (same_funid fid))) (isalist2list fs)
4.428 - in SOME (term2str (mk_equality (p, fs')),
4.429 - Trueprop $ (mk_equality (p, fs'))) end
4.430 -| eval_filter_sameFunId _ _ _ _ = NONE;
4.431 -
4.432 -
4.433 -(*make a list of terms to a sum*)
4.434 -fun list2sum [] = error ("list2sum called with []")
4.435 - | list2sum [s] = s
4.436 - | list2sum (s::ss) =
4.437 - let fun sum su [s'] =
4.438 - Const ("op +", [HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
4.439 - $ su $ s'
4.440 - | sum su (s'::ss') =
4.441 - sum (Const ("op +", [HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
4.442 - $ su $ s') ss'
4.443 - in sum s ss end;
4.444 -
4.445 -(*make a list of equalities to the sum of the lhs*)
4.446 -(*("boollist2sum" ,("Atools.boollist2sum" ,eval_boollist2sum "")):calc*)
4.447 -fun eval_boollist2sum _ "Atools.boollist2sum"
4.448 - (p as Const ("Atools.boollist2sum", _) $
4.449 - (l as Const ("List.list.Cons", _) $ _ $ _)) _ =
4.450 - let val isal = isalist2list l
4.451 - val lhss = map lhs isal
4.452 - val sum = list2sum lhss
4.453 - in SOME ((term2str p) ^ " = " ^ (term2str sum),
4.454 - Trueprop $ (mk_equality (p, sum)))
4.455 - end
4.456 -| eval_boollist2sum _ _ _ _ = NONE;
4.457 -
4.458 -
4.459 -
4.460 -local
4.461 -
4.462 -open Term;
4.463 -
4.464 -in
4.465 -fun termlessI (_:subst) uv = termless uv;
4.466 -fun term_ordI (_:subst) uv = term_ord uv;
4.467 -end;
4.468 -
4.469 -
4.470 -(** rule set, for evaluating list-expressions in scripts 8.01.02 **)
4.471 -
4.472 -
4.473 -val list_rls =
4.474 - append_rls "list_rls" list_rls
4.475 - [Calc ("op *",eval_binop "#mult_"),
4.476 - Calc ("op +", eval_binop "#add_"),
4.477 - Calc ("op <",eval_equ "#less_"),
4.478 - Calc ("op <=",eval_equ "#less_equal_"),
4.479 - Calc ("Atools.ident",eval_ident "#ident_"),
4.480 - Calc ("op =",eval_equal "#equal_"),(*atom <> atom -> False*)
4.481 -
4.482 - Calc ("Tools.Vars",eval_var "#Vars_"),
4.483 -
4.484 - Thm ("if_True",num_str if_True),
4.485 - Thm ("if_False",num_str if_False)
4.486 - ];
4.487 -
4.488 -ruleset' := overwritelthy thy (!ruleset',
4.489 - [("list_rls",list_rls)
4.490 - ]);
4.491 -
4.492 -(*TODO.WN0509 reduce ids: tless_true = e_rew_ord' = e_rew_ord = dummy_ord*)
4.493 -val tless_true = dummy_ord;
4.494 -rew_ord' := overwritel (!rew_ord',
4.495 - [("tless_true", tless_true),
4.496 - ("e_rew_ord'", tless_true),
4.497 - ("dummy_ord", dummy_ord)]);
4.498 -
4.499 -val calculate_Atools =
4.500 - append_rls "calculate_Atools" e_rls
4.501 - [Calc ("op <",eval_equ "#less_"),
4.502 - Calc ("op <=",eval_equ "#less_equal_"),
4.503 - Calc ("op =",eval_equal "#equal_"),
4.504 -
4.505 - Thm ("real_unari_minus",num_str real_unari_minus),
4.506 - Calc ("op +",eval_binop "#add_"),
4.507 - Calc ("op -",eval_binop "#sub_"),
4.508 - Calc ("op *",eval_binop "#mult_")
4.509 - ];
4.510 -
4.511 -val Atools_erls =
4.512 - append_rls "Atools_erls" e_rls
4.513 - [Calc ("op =",eval_equal "#equal_"),
4.514 - Thm ("not_true",num_str not_true),
4.515 - (*"(~ True) = False"*)
4.516 - Thm ("not_false",num_str not_false),
4.517 - (*"(~ False) = True"*)
4.518 - Thm ("and_true",and_true),
4.519 - (*"(?a & True) = ?a"*)
4.520 - Thm ("and_false",and_false),
4.521 - (*"(?a & False) = False"*)
4.522 - Thm ("or_true",or_true),
4.523 - (*"(?a | True) = True"*)
4.524 - Thm ("or_false",or_false),
4.525 - (*"(?a | False) = ?a"*)
4.526 -
4.527 - Thm ("rat_leq1",rat_leq1),
4.528 - Thm ("rat_leq2",rat_leq2),
4.529 - Thm ("rat_leq3",rat_leq3),
4.530 - Thm ("refl",num_str refl),
4.531 - Thm ("le_refl",num_str le_refl),
4.532 - Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
4.533 -
4.534 - Calc ("op <",eval_equ "#less_"),
4.535 - Calc ("op <=",eval_equ "#less_equal_"),
4.536 -
4.537 - Calc ("Atools.ident",eval_ident "#ident_"),
4.538 - Calc ("Atools.is'_const",eval_const "#is_const_"),
4.539 - Calc ("Atools.occurs'_in",eval_occurs_in ""),
4.540 - Calc ("Tools.matches",eval_matches "")
4.541 - ];
4.542 -
4.543 -val Atools_crls =
4.544 - append_rls "Atools_crls" e_rls
4.545 - [Calc ("op =",eval_equal "#equal_"),
4.546 - Thm ("not_true",num_str not_true),
4.547 - Thm ("not_false",num_str not_false),
4.548 - Thm ("and_true",and_true),
4.549 - Thm ("and_false",and_false),
4.550 - Thm ("or_true",or_true),
4.551 - Thm ("or_false",or_false),
4.552 -
4.553 - Thm ("rat_leq1",rat_leq1),
4.554 - Thm ("rat_leq2",rat_leq2),
4.555 - Thm ("rat_leq3",rat_leq3),
4.556 - Thm ("refl",num_str refl),
4.557 - Thm ("le_refl",num_str le_refl),
4.558 - Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
4.559 -
4.560 - Calc ("op <",eval_equ "#less_"),
4.561 - Calc ("op <=",eval_equ "#less_equal_"),
4.562 -
4.563 - Calc ("Atools.ident",eval_ident "#ident_"),
4.564 - Calc ("Atools.is'_const",eval_const "#is_const_"),
4.565 - Calc ("Atools.occurs'_in",eval_occurs_in ""),
4.566 - Calc ("Tools.matches",eval_matches "")
4.567 - ];
4.568 -
4.569 -(*val atools_erls = ... waere zu testen ...
4.570 - merge_rls calculate_Atools
4.571 - (append_rls Atools_erls (*i.A. zu viele rules*)
4.572 - [Calc ("Atools.ident",eval_ident "#ident_"),
4.573 - Calc ("Atools.is'_const",eval_const "#is_const_"),
4.574 - Calc ("Atools.occurs'_in",
4.575 - eval_occurs_in "#occurs_in"),
4.576 - Calc ("Tools.matches",eval_matches "#matches")
4.577 - ] (*i.A. zu viele rules*)
4.578 - );*)
4.579 -(* val atools_erls = prep_rls(
4.580 - Rls {id="atools_erls",preconds = [], rew_ord = ("termlessI",termlessI),
4.581 - erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
4.582 - rules = [Thm ("refl",num_str refl),
4.583 - Thm ("le_refl",num_str le_refl),
4.584 - Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
4.585 - Thm ("not_true",num_str not_true),
4.586 - Thm ("not_false",num_str not_false),
4.587 - Thm ("and_true",and_true),
4.588 - Thm ("and_false",and_false),
4.589 - Thm ("or_true",or_true),
4.590 - Thm ("or_false",or_false),
4.591 - Thm ("and_commute",num_str and_commute),
4.592 - Thm ("or_commute",num_str or_commute),
4.593 -
4.594 - Calc ("op <",eval_equ "#less_"),
4.595 - Calc ("op <=",eval_equ "#less_equal_"),
4.596 -
4.597 - Calc ("Atools.ident",eval_ident "#ident_"),
4.598 - Calc ("Atools.is'_const",eval_const "#is_const_"),
4.599 - Calc ("Atools.occurs'_in",eval_occurs_in ""),
4.600 - Calc ("Tools.matches",eval_matches "")
4.601 - ],
4.602 - scr = Script ((term_of o the o (parse thy))
4.603 - "empty_script")
4.604 - }:rls);
4.605 -ruleset' := overwritelth thy
4.606 - (!ruleset',
4.607 - [("atools_erls",atools_erls)(*FIXXXME:del with rls.rls'*)
4.608 - ]);
4.609 -*)
4.610 -"******* Atools.ML end *******";
4.611 -
4.612 -calclist':= overwritel (!calclist',
4.613 - [("occurs_in",("Atools.occurs'_in", eval_occurs_in "#occurs_in_")),
4.614 - ("some_occur_in",
4.615 - ("Atools.some'_occur'_in", eval_some_occur_in "#some_occur_in_")),
4.616 - ("is_atom" ,("Atools.is'_atom",eval_is_atom "#is_atom_")),
4.617 - ("is_even" ,("Atools.is'_even",eval_is_even "#is_even_")),
4.618 - ("is_const" ,("Atools.is'_const",eval_const "#is_const_")),
4.619 - ("le" ,("op <" ,eval_equ "#less_")),
4.620 - ("leq" ,("op <=" ,eval_equ "#less_equal_")),
4.621 - ("ident" ,("Atools.ident",eval_ident "#ident_")),
4.622 - ("equal" ,("op =",eval_equal "#equal_")),
4.623 - ("PLUS" ,("op +" ,eval_binop "#add_")),
4.624 - ("minus" ,("op -",eval_binop "#sub_")), (*040207 only for prep_rls
4.625 - no script with "minus"*)
4.626 - ("TIMES" ,("op *" ,eval_binop "#mult_")),
4.627 - ("DIVIDE" ,("HOL.divide" ,eval_cancel "#divide_")),
4.628 - ("POWER" ,("Atools.pow" ,eval_binop "#power_")),
4.629 - ("boollist2sum",("Atools.boollist2sum",eval_boollist2sum ""))
4.630 - ]);
4.631 -
4.632 -val list_rls = prep_rls(
4.633 - merge_rls "list_erls"
4.634 - (Rls {id="replaced",preconds = [],
4.635 - rew_ord = ("termlessI", termlessI),
4.636 - erls = Rls {id="list_elrs", preconds = [],
4.637 - rew_ord = ("termlessI",termlessI),
4.638 - erls = e_rls,
4.639 - srls = Erls, calc = [], (*asm_thm = [],*)
4.640 - rules = [Calc ("op +", eval_binop "#add_"),
4.641 - Calc ("op <",eval_equ "#less_")
4.642 - (* ~~~~~~ for nth_Cons_*)
4.643 - ],
4.644 - scr = EmptyScr},
4.645 - srls = Erls, calc = [], (*asm_thm = [], *)
4.646 - rules = [], scr = EmptyScr})
4.647 - list_rls);
4.648 -ruleset' := overwritelthy thy (!ruleset', [("list_rls", list_rls)]);
5.1 --- a/src/Tools/isac/Knowledge/Atools.thy Fri Aug 27 10:39:12 2010 +0200
5.2 +++ b/src/Tools/isac/Knowledge/Atools.thy Fri Aug 27 14:56:54 2010 +0200
5.3 @@ -6,8 +6,8 @@
5.4 10 20 30 40 50 60 70 80
5.5 *)
5.6
5.7 -(*theory Atools imports Descript Typefix begin ...WOULD BE REQUIRED*)
5.8 -theory Atools imports Complex_Main
5.9 +theory Atools imports Descript Typefix (*...WOULD BE REQUIRED*)
5.10 +(*theory Atools imports Complex_Main*)
5.11 (*theory Atools imports "../Knowledge/Descript" "../Knowledge/Typefix" begin*)
5.12 uses ("../ProgLang/term.sml")
5.13 begin
6.1 --- a/src/Tools/isac/Knowledge/Biegelinie.ML Fri Aug 27 10:39:12 2010 +0200
6.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
6.3 @@ -1,459 +0,0 @@
6.4 -(* chapter 'Biegelinie' from the textbook:
6.5 - Timischl, Kaiser. Ingenieur-Mathematik 3. Wien 1999. p.268-271.
6.6 - authors: Walther Neuper 2005
6.7 - (c) due to copyright terms
6.8 -
6.9 -use"Knowledge/Biegelinie.ML";
6.10 -use"Biegelinie.ML";
6.11 -
6.12 -remove_thy"Typefix";
6.13 -remove_thy"Biegelinie";
6.14 -use_thy"Knowledge/Isac";
6.15 -*)
6.16 -
6.17 -(** interface isabelle -- isac **)
6.18 -
6.19 -theory' := overwritel (!theory', [("Biegelinie.thy",Biegelinie.thy)]);
6.20 -
6.21 -(** theory elements **)
6.22 -
6.23 -store_isa ["IsacKnowledge"] [];
6.24 -store_thy (theory "Biegelinie")
6.25 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.26 -store_isa ["IsacKnowledge", theory2thyID (theory "Biegelinie"), "Theorems"]
6.27 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.28 -store_thm (theory "Biegelinie") ("Belastung_Querkraft", Belastung_Querkraft)
6.29 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.30 -store_thm (theory "Biegelinie") ("Moment_Neigung", Moment_Neigung)
6.31 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.32 -store_thm (theory "Biegelinie") ("Moment_Querkraft", Moment_Querkraft)
6.33 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.34 -store_thm (theory "Biegelinie") ("Neigung_Moment", Neigung_Moment)
6.35 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.36 -store_thm (theory "Biegelinie") ("Querkraft_Belastung", Querkraft_Belastung)
6.37 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.38 -store_thm (theory "Biegelinie") ("Querkraft_Moment", Querkraft_Moment)
6.39 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.40 -store_thm (theory "Biegelinie") ("make_fun_explicit", make_fun_explicit)
6.41 - ["Walther Neuper 2005 supported by a grant from NMI Austria"];
6.42 -
6.43 -
6.44 -(** problems **)
6.45 -
6.46 -store_pbt
6.47 - (prep_pbt (theory "Biegelinie") "pbl_bieg" [] e_pblID
6.48 - (["Biegelinien"],
6.49 - [("#Given" ,["Traegerlaenge l_", "Streckenlast q__"]),
6.50 - (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
6.51 - ("#Find" ,["Biegelinie b_"]),
6.52 - ("#Relate",["Randbedingungen rb_"])
6.53 - ],
6.54 - append_rls "e_rls" e_rls [],
6.55 - NONE,
6.56 - [["IntegrierenUndKonstanteBestimmen2"]]));
6.57 -
6.58 -store_pbt
6.59 - (prep_pbt (theory "Biegelinie") "pbl_bieg_mom" [] e_pblID
6.60 - (["MomentBestimmte","Biegelinien"],
6.61 - [("#Given" ,["Traegerlaenge l_", "Streckenlast q__"]),
6.62 - (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
6.63 - ("#Find" ,["Biegelinie b_"]),
6.64 - ("#Relate",["RandbedingungenBiegung rb_","RandbedingungenMoment rm_"])
6.65 - ],
6.66 - append_rls "e_rls" e_rls [],
6.67 - NONE,
6.68 - [["IntegrierenUndKonstanteBestimmen"]]));
6.69 -
6.70 -store_pbt
6.71 - (prep_pbt (theory "Biegelinie") "pbl_bieg_momg" [] e_pblID
6.72 - (["MomentGegebene","Biegelinien"],
6.73 - [],
6.74 - append_rls "e_rls" e_rls [],
6.75 - NONE,
6.76 - [["IntegrierenUndKonstanteBestimmen","2xIntegrieren"]]));
6.77 -
6.78 -store_pbt
6.79 - (prep_pbt (theory "Biegelinie") "pbl_bieg_einf" [] e_pblID
6.80 - (["einfache","Biegelinien"],
6.81 - [],
6.82 - append_rls "e_rls" e_rls [],
6.83 - NONE,
6.84 - [["IntegrierenUndKonstanteBestimmen","4x4System"]]));
6.85 -
6.86 -store_pbt
6.87 - (prep_pbt (theory "Biegelinie") "pbl_bieg_momquer" [] e_pblID
6.88 - (["QuerkraftUndMomentBestimmte","Biegelinien"],
6.89 - [],
6.90 - append_rls "e_rls" e_rls [],
6.91 - NONE,
6.92 - [["IntegrierenUndKonstanteBestimmen","1xIntegrieren"]]));
6.93 -
6.94 -store_pbt
6.95 - (prep_pbt (theory "Biegelinie") "pbl_bieg_vonq" [] e_pblID
6.96 - (["vonBelastungZu","Biegelinien"],
6.97 - [("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
6.98 - ("#Find" ,["Funktionen funs___"])],
6.99 - append_rls "e_rls" e_rls [],
6.100 - NONE,
6.101 - [["Biegelinien","ausBelastung"]]));
6.102 -
6.103 -store_pbt
6.104 - (prep_pbt (theory "Biegelinie") "pbl_bieg_randbed" [] e_pblID
6.105 - (["setzeRandbedingungen","Biegelinien"],
6.106 - [("#Given" ,["Funktionen funs_","Randbedingungen rb_"]),
6.107 - ("#Find" ,["Gleichungen equs___"])],
6.108 - append_rls "e_rls" e_rls [],
6.109 - NONE,
6.110 - [["Biegelinien","setzeRandbedingungenEin"]]));
6.111 -
6.112 -store_pbt
6.113 - (prep_pbt (theory "Biegelinie") "pbl_equ_fromfun" [] e_pblID
6.114 - (["makeFunctionTo","equation"],
6.115 - [("#Given" ,["functionEq fun_","substitution sub_"]),
6.116 - ("#Find" ,["equality equ___"])],
6.117 - append_rls "e_rls" e_rls [],
6.118 - NONE,
6.119 - [["Equation","fromFunction"]]));
6.120 -
6.121 -
6.122 -(** methods **)
6.123 -
6.124 -val srls = Rls {id="srls_IntegrierenUnd..",
6.125 - preconds = [],
6.126 - rew_ord = ("termlessI",termlessI),
6.127 - erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
6.128 - [(*for asm in nth_Cons_ ...*)
6.129 - Calc ("op <",eval_equ "#less_"),
6.130 - (*2nd nth_Cons_ pushes n+-1 into asms*)
6.131 - Calc("op +", eval_binop "#add_")
6.132 - ],
6.133 - srls = Erls, calc = [],
6.134 - rules = [Thm ("nth_Cons_",num_str nth_Cons_),
6.135 - Calc("op +", eval_binop "#add_"),
6.136 - Thm ("nth_Nil_",num_str nth_Nil_),
6.137 - Calc("Tools.lhs", eval_lhs"eval_lhs_"),
6.138 - Calc("Tools.rhs", eval_rhs"eval_rhs_"),
6.139 - Calc("Atools.argument'_in",
6.140 - eval_argument_in "Atools.argument'_in")
6.141 - ],
6.142 - scr = EmptyScr};
6.143 -
6.144 -val srls2 =
6.145 - Rls {id="srls_IntegrierenUnd..",
6.146 - preconds = [],
6.147 - rew_ord = ("termlessI",termlessI),
6.148 - erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
6.149 - [(*for asm in nth_Cons_ ...*)
6.150 - Calc ("op <",eval_equ "#less_"),
6.151 - (*2nd nth_Cons_ pushes n+-1 into asms*)
6.152 - Calc("op +", eval_binop "#add_")
6.153 - ],
6.154 - srls = Erls, calc = [],
6.155 - rules = [Thm ("nth_Cons_",num_str nth_Cons_),
6.156 - Calc("op +", eval_binop "#add_"),
6.157 - Thm ("nth_Nil_", num_str nth_Nil_),
6.158 - Calc("Tools.lhs", eval_lhs "eval_lhs_"),
6.159 - Calc("Atools.filter'_sameFunId",
6.160 - eval_filter_sameFunId "Atools.filter'_sameFunId"),
6.161 - (*WN070514 just for smltest/../biegelinie.sml ...*)
6.162 - Calc("Atools.sameFunId", eval_sameFunId "Atools.sameFunId"),
6.163 - Thm ("filter_Cons", num_str filter_Cons),
6.164 - Thm ("filter_Nil", num_str filter_Nil),
6.165 - Thm ("if_True", num_str if_True),
6.166 - Thm ("if_False", num_str if_False),
6.167 - Thm ("hd_thm", num_str hd_thm)
6.168 - ],
6.169 - scr = EmptyScr};
6.170 -
6.171 -store_met
6.172 - (prep_met (theory "Biegelinie") "met_biege" [] e_metID
6.173 - (["IntegrierenUndKonstanteBestimmen"],
6.174 - [("#Given" ,["Traegerlaenge l_", "Streckenlast q__",
6.175 - "FunktionsVariable v_"]),
6.176 - (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
6.177 - ("#Find" ,["Biegelinie b_"]),
6.178 - ("#Relate",["RandbedingungenBiegung rb_",
6.179 - "RandbedingungenMoment rm_"])
6.180 - ],
6.181 - {rew_ord'="tless_true",
6.182 - rls' = append_rls "erls_IntegrierenUndK.." e_rls
6.183 - [Calc ("Atools.ident",eval_ident "#ident_"),
6.184 - Thm ("not_true",num_str not_true),
6.185 - Thm ("not_false",num_str not_false)],
6.186 - calc = [], srls = srls, prls = Erls,
6.187 - crls = Atools_erls, nrls = Erls},
6.188 -"Script BiegelinieScript " ^
6.189 -"(l_::real) (q__::real) (v_::real) (b_::real=>real) " ^
6.190 -"(rb_::bool list) (rm_::bool list) = " ^
6.191 -" (let q___ = Take (q_ v_ = q__); " ^
6.192 -" q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ " ^
6.193 -" (Rewrite Belastung_Querkraft True)) q___; " ^
6.194 -" (Q__:: bool) = " ^
6.195 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.196 -" [diff,integration,named]) " ^
6.197 -" [real_ (rhs q___), real_ v_, real_real_ Q]); " ^
6.198 -" Q__ = Rewrite Querkraft_Moment True Q__; " ^
6.199 -" (M__::bool) = " ^
6.200 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.201 -" [diff,integration,named]) " ^
6.202 -" [real_ (rhs Q__), real_ v_, real_real_ M_b]); " ^
6.203 -" e1__ = nth_ 1 rm_; " ^
6.204 -" (x1__::real) = argument_in (lhs e1__); " ^
6.205 -" (M1__::bool) = (Substitute [v_ = x1__]) M__; " ^
6.206 -" M1__ = (Substitute [e1__]) M1__ ; " ^
6.207 -" M2__ = Take M__; " ^
6.208 -(*without this Take 'Substitute [v_ = x2__]' takes _last formula from ctree_*)
6.209 -" e2__ = nth_ 2 rm_; " ^
6.210 -" (x2__::real) = argument_in (lhs e2__); " ^
6.211 -" (M2__::bool) = ((Substitute [v_ = x2__]) @@ " ^
6.212 -" (Substitute [e2__])) M2__; " ^
6.213 -" (c_1_2__::bool list) = " ^
6.214 -" (SubProblem (Biegelinie_,[linear,system],[no_met]) " ^
6.215 -" [booll_ [M1__, M2__], reall [c,c_2]]); " ^
6.216 -" M__ = Take M__; " ^
6.217 -" M__ = ((Substitute c_1_2__) @@ " ^
6.218 -" (Try (Rewrite_Set_Inst [(bdv_1, c),(bdv_2, c_2)]" ^
6.219 -" simplify_System False)) @@ " ^
6.220 -" (Rewrite Moment_Neigung False) @@ " ^
6.221 -" (Rewrite make_fun_explicit False)) M__; " ^
6.222 -(*----------------------- and the same once more ------------------------*)
6.223 -" (N__:: bool) = " ^
6.224 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.225 -" [diff,integration,named]) " ^
6.226 -" [real_ (rhs M__), real_ v_, real_real_ y']); " ^
6.227 -" (B__:: bool) = " ^
6.228 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.229 -" [diff,integration,named]) " ^
6.230 -" [real_ (rhs N__), real_ v_, real_real_ y]); " ^
6.231 -" e1__ = nth_ 1 rb_; " ^
6.232 -" (x1__::real) = argument_in (lhs e1__); " ^
6.233 -" (B1__::bool) = (Substitute [v_ = x1__]) B__; " ^
6.234 -" B1__ = (Substitute [e1__]) B1__ ; " ^
6.235 -" B2__ = Take B__; " ^
6.236 -" e2__ = nth_ 2 rb_; " ^
6.237 -" (x2__::real) = argument_in (lhs e2__); " ^
6.238 -" (B2__::bool) = ((Substitute [v_ = x2__]) @@ " ^
6.239 -" (Substitute [e2__])) B2__; " ^
6.240 -" (c_1_2__::bool list) = " ^
6.241 -" (SubProblem (Biegelinie_,[linear,system],[no_met]) " ^
6.242 -" [booll_ [B1__, B2__], reall [c,c_2]]); " ^
6.243 -" B__ = Take B__; " ^
6.244 -" B__ = ((Substitute c_1_2__) @@ " ^
6.245 -" (Rewrite_Set_Inst [(bdv, x)] make_ratpoly_in False)) B__ " ^
6.246 -" in B__)"
6.247 -));
6.248 -
6.249 -store_met
6.250 - (prep_met (theory "Biegelinie") "met_biege_2" [] e_metID
6.251 - (["IntegrierenUndKonstanteBestimmen2"],
6.252 - [("#Given" ,["Traegerlaenge l_", "Streckenlast q__",
6.253 - "FunktionsVariable v_"]),
6.254 - (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
6.255 - ("#Find" ,["Biegelinie b_"]),
6.256 - ("#Relate",["Randbedingungen rb_"])
6.257 - ],
6.258 - {rew_ord'="tless_true",
6.259 - rls' = append_rls "erls_IntegrierenUndK.." e_rls
6.260 - [Calc ("Atools.ident",eval_ident "#ident_"),
6.261 - Thm ("not_true",num_str not_true),
6.262 - Thm ("not_false",num_str not_false)],
6.263 - calc = [],
6.264 - srls = append_rls "erls_IntegrierenUndK.." e_rls
6.265 - [Calc("Tools.rhs", eval_rhs"eval_rhs_"),
6.266 - Calc ("Atools.ident",eval_ident "#ident_"),
6.267 - Thm ("last_thmI",num_str last_thmI),
6.268 - Thm ("if_True",num_str if_True),
6.269 - Thm ("if_False",num_str if_False)
6.270 - ],
6.271 - prls = Erls, crls = Atools_erls, nrls = Erls},
6.272 -"Script Biegelinie2Script " ^
6.273 -"(l_::real) (q__::real) (v_::real) (b_::real=>real) (rb_::bool list) = " ^
6.274 -" (let " ^
6.275 -" (funs_:: bool list) = " ^
6.276 -" (SubProblem (Biegelinie_,[vonBelastungZu,Biegelinien], " ^
6.277 -" [Biegelinien,ausBelastung]) " ^
6.278 -" [real_ q__, real_ v_]); " ^
6.279 -" (equs_::bool list) = " ^
6.280 -" (SubProblem (Biegelinie_,[setzeRandbedingungen,Biegelinien]," ^
6.281 -" [Biegelinien,setzeRandbedingungenEin]) " ^
6.282 -" [booll_ funs_, booll_ rb_]); " ^
6.283 -" (cons_::bool list) = " ^
6.284 -" (SubProblem (Biegelinie_,[linear,system],[no_met]) " ^
6.285 -" [booll_ equs_, reall [c,c_2,c_3,c_4]]); " ^
6.286 -" B_ = Take (lastI funs_); " ^
6.287 -" B_ = ((Substitute cons_) @@ " ^
6.288 -" (Rewrite_Set_Inst [(bdv, v_)] make_ratpoly_in False)) B_ " ^
6.289 -" in B_)"
6.290 -));
6.291 -
6.292 -store_met
6.293 - (prep_met (theory "Biegelinie") "met_biege_intconst_2" [] e_metID
6.294 - (["IntegrierenUndKonstanteBestimmen","2xIntegrieren"],
6.295 - [],
6.296 - {rew_ord'="tless_true", rls'=Erls, calc = [],
6.297 - srls = e_rls,
6.298 - prls=e_rls,
6.299 - crls = Atools_erls, nrls = e_rls},
6.300 -"empty_script"
6.301 -));
6.302 -
6.303 -store_met
6.304 - (prep_met (theory "Biegelinie") "met_biege_intconst_4" [] e_metID
6.305 - (["IntegrierenUndKonstanteBestimmen","4x4System"],
6.306 - [],
6.307 - {rew_ord'="tless_true", rls'=Erls, calc = [],
6.308 - srls = e_rls,
6.309 - prls=e_rls,
6.310 - crls = Atools_erls, nrls = e_rls},
6.311 -"empty_script"
6.312 -));
6.313 -
6.314 -store_met
6.315 - (prep_met (theory "Biegelinie") "met_biege_intconst_1" [] e_metID
6.316 - (["IntegrierenUndKonstanteBestimmen","1xIntegrieren"],
6.317 - [],
6.318 - {rew_ord'="tless_true", rls'=Erls, calc = [],
6.319 - srls = e_rls,
6.320 - prls=e_rls,
6.321 - crls = Atools_erls, nrls = e_rls},
6.322 -"empty_script"
6.323 -));
6.324 -
6.325 -store_met
6.326 - (prep_met (theory "Biegelinie") "met_biege2" [] e_metID
6.327 - (["Biegelinien"],
6.328 - [],
6.329 - {rew_ord'="tless_true", rls'=Erls, calc = [],
6.330 - srls = e_rls,
6.331 - prls=e_rls,
6.332 - crls = Atools_erls, nrls = e_rls},
6.333 -"empty_script"
6.334 -));
6.335 -
6.336 -store_met
6.337 - (prep_met (theory "Biegelinie") "met_biege_ausbelast" [] e_metID
6.338 - (["Biegelinien","ausBelastung"],
6.339 - [("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
6.340 - ("#Find" ,["Funktionen funs_"])],
6.341 - {rew_ord'="tless_true",
6.342 - rls' = append_rls "erls_ausBelastung" e_rls
6.343 - [Calc ("Atools.ident",eval_ident "#ident_"),
6.344 - Thm ("not_true",num_str not_true),
6.345 - Thm ("not_false",num_str not_false)],
6.346 - calc = [],
6.347 - srls = append_rls "srls_ausBelastung" e_rls
6.348 - [Calc("Tools.rhs", eval_rhs"eval_rhs_")],
6.349 - prls = e_rls, crls = Atools_erls, nrls = e_rls},
6.350 -"Script Belastung2BiegelScript (q__::real) (v_::real) = " ^
6.351 -" (let q___ = Take (q_ v_ = q__); " ^
6.352 -" q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ " ^
6.353 -" (Rewrite Belastung_Querkraft True)) q___; " ^
6.354 -" (Q__:: bool) = " ^
6.355 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.356 -" [diff,integration,named]) " ^
6.357 -" [real_ (rhs q___), real_ v_, real_real_ Q]); " ^
6.358 -" M__ = Rewrite Querkraft_Moment True Q__; " ^
6.359 -" (M__::bool) = " ^
6.360 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.361 -" [diff,integration,named]) " ^
6.362 -" [real_ (rhs M__), real_ v_, real_real_ M_b]); " ^
6.363 -" N__ = ((Rewrite Moment_Neigung False) @@ " ^
6.364 -" (Rewrite make_fun_explicit False)) M__; " ^
6.365 -" (N__:: bool) = " ^
6.366 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.367 -" [diff,integration,named]) " ^
6.368 -" [real_ (rhs N__), real_ v_, real_real_ y']); " ^
6.369 -" (B__:: bool) = " ^
6.370 -" (SubProblem (Biegelinie_,[named,integrate,function], " ^
6.371 -" [diff,integration,named]) " ^
6.372 -" [real_ (rhs N__), real_ v_, real_real_ y]) " ^
6.373 -" in [Q__, M__, N__, B__])"
6.374 -));
6.375 -
6.376 -store_met
6.377 - (prep_met (theory "Biegelinie") "met_biege_setzrand" [] e_metID
6.378 - (["Biegelinien","setzeRandbedingungenEin"],
6.379 - [("#Given" ,["Funktionen funs_","Randbedingungen rb_"]),
6.380 - ("#Find" ,["Gleichungen equs___"])],
6.381 - {rew_ord'="tless_true", rls'=Erls, calc = [],
6.382 - srls = srls2,
6.383 - prls=e_rls,
6.384 - crls = Atools_erls, nrls = e_rls},
6.385 -"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = " ^
6.386 -" (let b1_ = nth_ 1 rb_; " ^
6.387 -" fs_ = filter_sameFunId (lhs b1_) funs_; " ^
6.388 -" (e1_::bool) = " ^
6.389 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.390 -" [Equation,fromFunction]) " ^
6.391 -" [bool_ (hd fs_), bool_ b1_]); " ^
6.392 -" b2_ = nth_ 2 rb_; " ^
6.393 -" fs_ = filter_sameFunId (lhs b2_) funs_; " ^
6.394 -" (e2_::bool) = " ^
6.395 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.396 -" [Equation,fromFunction]) " ^
6.397 -" [bool_ (hd fs_), bool_ b2_]); " ^
6.398 -" b3_ = nth_ 3 rb_; " ^
6.399 -" fs_ = filter_sameFunId (lhs b3_) funs_; " ^
6.400 -" (e3_::bool) = " ^
6.401 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.402 -" [Equation,fromFunction]) " ^
6.403 -" [bool_ (hd fs_), bool_ b3_]); " ^
6.404 -" b4_ = nth_ 4 rb_; " ^
6.405 -" fs_ = filter_sameFunId (lhs b4_) funs_; " ^
6.406 -" (e4_::bool) = " ^
6.407 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.408 -" [Equation,fromFunction]) " ^
6.409 -" [bool_ (hd fs_), bool_ b4_]) " ^
6.410 -" in [e1_,e2_,e3_,e4_])"
6.411 -(* filter requires more than 1 sec !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6.412 -"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = " ^
6.413 -" (let b1_ = nth_ 1 rb_; " ^
6.414 -" fs_ = filter (sameFunId (lhs b1_)) funs_; " ^
6.415 -" (e1_::bool) = " ^
6.416 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.417 -" [Equation,fromFunction]) " ^
6.418 -" [bool_ (hd fs_), bool_ b1_]); " ^
6.419 -" b2_ = nth_ 2 rb_; " ^
6.420 -" fs_ = filter (sameFunId (lhs b2_)) funs_; " ^
6.421 -" (e2_::bool) = " ^
6.422 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.423 -" [Equation,fromFunction]) " ^
6.424 -" [bool_ (hd fs_), bool_ b2_]); " ^
6.425 -" b3_ = nth_ 3 rb_; " ^
6.426 -" fs_ = filter (sameFunId (lhs b3_)) funs_; " ^
6.427 -" (e3_::bool) = " ^
6.428 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.429 -" [Equation,fromFunction]) " ^
6.430 -" [bool_ (hd fs_), bool_ b3_]); " ^
6.431 -" b4_ = nth_ 4 rb_; " ^
6.432 -" fs_ = filter (sameFunId (lhs b4_)) funs_; " ^
6.433 -" (e4_::bool) = " ^
6.434 -" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
6.435 -" [Equation,fromFunction]) " ^
6.436 -" [bool_ (hd fs_), bool_ b4_]) " ^
6.437 -" in [e1_,e2_,e3_,e4_])"*)
6.438 -));
6.439 -
6.440 -store_met
6.441 - (prep_met (theory "Biegelinie") "met_equ_fromfun" [] e_metID
6.442 - (["Equation","fromFunction"],
6.443 - [("#Given" ,["functionEq fun_","substitution sub_"]),
6.444 - ("#Find" ,["equality equ___"])],
6.445 - {rew_ord'="tless_true", rls'=Erls, calc = [],
6.446 - srls = append_rls "srls_in_EquationfromFunc" e_rls
6.447 - [Calc("Tools.lhs", eval_lhs"eval_lhs_"),
6.448 - Calc("Atools.argument'_in",
6.449 - eval_argument_in
6.450 - "Atools.argument'_in")],
6.451 - prls=e_rls,
6.452 - crls = Atools_erls, nrls = e_rls},
6.453 -(*(M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2) (M_b L = 0) -->
6.454 - 0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2*)
6.455 -"Script Function2Equality (fun_::bool) (sub_::bool) =" ^
6.456 -" (let fun_ = Take fun_; " ^
6.457 -" bdv_ = argument_in (lhs fun_); " ^
6.458 -" val_ = argument_in (lhs sub_); " ^
6.459 -" equ_ = (Substitute [bdv_ = val_]) fun_; " ^
6.460 -" equ_ = (Substitute [sub_]) fun_ " ^
6.461 -" in (Rewrite_Set norm_Rational False) equ_) "
6.462 -));
7.1 --- a/src/Tools/isac/Knowledge/Biegelinie.thy Fri Aug 27 10:39:12 2010 +0200
7.2 +++ b/src/Tools/isac/Knowledge/Biegelinie.thy Fri Aug 27 14:56:54 2010 +0200
7.3 @@ -3,16 +3,9 @@
7.4 author: Walther Neuper
7.5 050826,
7.6 (c) due to copyright terms
7.7 -
7.8 -remove_thy"Biegelinie";
7.9 -use_thy"Knowledge/Biegelinie";
7.10 -use_thy_only"Knowledge/Biegelinie";
7.11 -
7.12 -remove_thy"Biegelinie";
7.13 -use_thy"Knowledge/Isac";
7.14 *)
7.15
7.16 -Biegelinie = Integrate + Equation + EqSystem +
7.17 +theory Biegelinie imports Integrate Equation EqSystem begin
7.18
7.19 consts
7.20
7.21 @@ -78,5 +71,450 @@
7.22 (*according to rls 'simplify_Integral': .. = 1/a * .. instead .. = ../ a*)
7.23 make_fun_explicit "Not (a =!= 0) ==> (a * (f x) = b) = (f x = 1/a * b)"
7.24
7.25 +ML {*
7.26 +(** theory elements for transfer into html **)
7.27 +
7.28 +store_isa ["IsacKnowledge"] [];
7.29 +store_thy (theory "Biegelinie")
7.30 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.31 +store_isa ["IsacKnowledge", theory2thyID (theory "Biegelinie"), "Theorems"]
7.32 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.33 +store_thm (theory "Biegelinie") ("Belastung_Querkraft", Belastung_Querkraft)
7.34 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.35 +store_thm (theory "Biegelinie") ("Moment_Neigung", Moment_Neigung)
7.36 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.37 +store_thm (theory "Biegelinie") ("Moment_Querkraft", Moment_Querkraft)
7.38 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.39 +store_thm (theory "Biegelinie") ("Neigung_Moment", Neigung_Moment)
7.40 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.41 +store_thm (theory "Biegelinie") ("Querkraft_Belastung", Querkraft_Belastung)
7.42 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.43 +store_thm (theory "Biegelinie") ("Querkraft_Moment", Querkraft_Moment)
7.44 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.45 +store_thm (theory "Biegelinie") ("make_fun_explicit", make_fun_explicit)
7.46 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
7.47 +
7.48 +
7.49 +(** problems **)
7.50 +
7.51 +store_pbt
7.52 + (prep_pbt (theory "Biegelinie") "pbl_bieg" [] e_pblID
7.53 + (["Biegelinien"],
7.54 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__"]),
7.55 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
7.56 + ("#Find" ,["Biegelinie b_"]),
7.57 + ("#Relate",["Randbedingungen rb_"])
7.58 + ],
7.59 + append_rls "e_rls" e_rls [],
7.60 + NONE,
7.61 + [["IntegrierenUndKonstanteBestimmen2"]]));
7.62 +
7.63 +store_pbt
7.64 + (prep_pbt (theory "Biegelinie") "pbl_bieg_mom" [] e_pblID
7.65 + (["MomentBestimmte","Biegelinien"],
7.66 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__"]),
7.67 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
7.68 + ("#Find" ,["Biegelinie b_"]),
7.69 + ("#Relate",["RandbedingungenBiegung rb_","RandbedingungenMoment rm_"])
7.70 + ],
7.71 + append_rls "e_rls" e_rls [],
7.72 + NONE,
7.73 + [["IntegrierenUndKonstanteBestimmen"]]));
7.74 +
7.75 +store_pbt
7.76 + (prep_pbt (theory "Biegelinie") "pbl_bieg_momg" [] e_pblID
7.77 + (["MomentGegebene","Biegelinien"],
7.78 + [],
7.79 + append_rls "e_rls" e_rls [],
7.80 + NONE,
7.81 + [["IntegrierenUndKonstanteBestimmen","2xIntegrieren"]]));
7.82 +
7.83 +store_pbt
7.84 + (prep_pbt (theory "Biegelinie") "pbl_bieg_einf" [] e_pblID
7.85 + (["einfache","Biegelinien"],
7.86 + [],
7.87 + append_rls "e_rls" e_rls [],
7.88 + NONE,
7.89 + [["IntegrierenUndKonstanteBestimmen","4x4System"]]));
7.90 +
7.91 +store_pbt
7.92 + (prep_pbt (theory "Biegelinie") "pbl_bieg_momquer" [] e_pblID
7.93 + (["QuerkraftUndMomentBestimmte","Biegelinien"],
7.94 + [],
7.95 + append_rls "e_rls" e_rls [],
7.96 + NONE,
7.97 + [["IntegrierenUndKonstanteBestimmen","1xIntegrieren"]]));
7.98 +
7.99 +store_pbt
7.100 + (prep_pbt (theory "Biegelinie") "pbl_bieg_vonq" [] e_pblID
7.101 + (["vonBelastungZu","Biegelinien"],
7.102 + [("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
7.103 + ("#Find" ,["Funktionen funs___"])],
7.104 + append_rls "e_rls" e_rls [],
7.105 + NONE,
7.106 + [["Biegelinien","ausBelastung"]]));
7.107 +
7.108 +store_pbt
7.109 + (prep_pbt (theory "Biegelinie") "pbl_bieg_randbed" [] e_pblID
7.110 + (["setzeRandbedingungen","Biegelinien"],
7.111 + [("#Given" ,["Funktionen funs_","Randbedingungen rb_"]),
7.112 + ("#Find" ,["Gleichungen equs___"])],
7.113 + append_rls "e_rls" e_rls [],
7.114 + NONE,
7.115 + [["Biegelinien","setzeRandbedingungenEin"]]));
7.116 +
7.117 +store_pbt
7.118 + (prep_pbt (theory "Biegelinie") "pbl_equ_fromfun" [] e_pblID
7.119 + (["makeFunctionTo","equation"],
7.120 + [("#Given" ,["functionEq fun_","substitution sub_"]),
7.121 + ("#Find" ,["equality equ___"])],
7.122 + append_rls "e_rls" e_rls [],
7.123 + NONE,
7.124 + [["Equation","fromFunction"]]));
7.125 +
7.126 +
7.127 +(** methods **)
7.128 +
7.129 +val srls = Rls {id="srls_IntegrierenUnd..",
7.130 + preconds = [],
7.131 + rew_ord = ("termlessI",termlessI),
7.132 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
7.133 + [(*for asm in nth_Cons_ ...*)
7.134 + Calc ("op <",eval_equ "#less_"),
7.135 + (*2nd nth_Cons_ pushes n+-1 into asms*)
7.136 + Calc("op +", eval_binop "#add_")
7.137 + ],
7.138 + srls = Erls, calc = [],
7.139 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
7.140 + Calc("op +", eval_binop "#add_"),
7.141 + Thm ("nth_Nil_",num_str nth_Nil_),
7.142 + Calc("Tools.lhs", eval_lhs"eval_lhs_"),
7.143 + Calc("Tools.rhs", eval_rhs"eval_rhs_"),
7.144 + Calc("Atools.argument'_in",
7.145 + eval_argument_in "Atools.argument'_in")
7.146 + ],
7.147 + scr = EmptyScr};
7.148 +
7.149 +val srls2 =
7.150 + Rls {id="srls_IntegrierenUnd..",
7.151 + preconds = [],
7.152 + rew_ord = ("termlessI",termlessI),
7.153 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
7.154 + [(*for asm in nth_Cons_ ...*)
7.155 + Calc ("op <",eval_equ "#less_"),
7.156 + (*2nd nth_Cons_ pushes n+-1 into asms*)
7.157 + Calc("op +", eval_binop "#add_")
7.158 + ],
7.159 + srls = Erls, calc = [],
7.160 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
7.161 + Calc("op +", eval_binop "#add_"),
7.162 + Thm ("nth_Nil_", num_str nth_Nil_),
7.163 + Calc("Tools.lhs", eval_lhs "eval_lhs_"),
7.164 + Calc("Atools.filter'_sameFunId",
7.165 + eval_filter_sameFunId "Atools.filter'_sameFunId"),
7.166 + (*WN070514 just for smltest/../biegelinie.sml ...*)
7.167 + Calc("Atools.sameFunId", eval_sameFunId "Atools.sameFunId"),
7.168 + Thm ("filter_Cons", num_str filter_Cons),
7.169 + Thm ("filter_Nil", num_str filter_Nil),
7.170 + Thm ("if_True", num_str if_True),
7.171 + Thm ("if_False", num_str if_False),
7.172 + Thm ("hd_thm", num_str hd_thm)
7.173 + ],
7.174 + scr = EmptyScr};
7.175 +
7.176 +store_met
7.177 + (prep_met (theory "Biegelinie") "met_biege" [] e_metID
7.178 + (["IntegrierenUndKonstanteBestimmen"],
7.179 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__",
7.180 + "FunktionsVariable v_"]),
7.181 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
7.182 + ("#Find" ,["Biegelinie b_"]),
7.183 + ("#Relate",["RandbedingungenBiegung rb_",
7.184 + "RandbedingungenMoment rm_"])
7.185 + ],
7.186 + {rew_ord'="tless_true",
7.187 + rls' = append_rls "erls_IntegrierenUndK.." e_rls
7.188 + [Calc ("Atools.ident",eval_ident "#ident_"),
7.189 + Thm ("not_true",num_str not_true),
7.190 + Thm ("not_false",num_str not_false)],
7.191 + calc = [], srls = srls, prls = Erls,
7.192 + crls = Atools_erls, nrls = Erls},
7.193 +"Script BiegelinieScript " ^
7.194 +"(l_::real) (q__::real) (v_::real) (b_::real=>real) " ^
7.195 +"(rb_::bool list) (rm_::bool list) = " ^
7.196 +" (let q___ = Take (q_ v_ = q__); " ^
7.197 +" q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ " ^
7.198 +" (Rewrite Belastung_Querkraft True)) q___; " ^
7.199 +" (Q__:: bool) = " ^
7.200 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.201 +" [diff,integration,named]) " ^
7.202 +" [real_ (rhs q___), real_ v_, real_real_ Q]); " ^
7.203 +" Q__ = Rewrite Querkraft_Moment True Q__; " ^
7.204 +" (M__::bool) = " ^
7.205 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.206 +" [diff,integration,named]) " ^
7.207 +" [real_ (rhs Q__), real_ v_, real_real_ M_b]); " ^
7.208 +" e1__ = nth_ 1 rm_; " ^
7.209 +" (x1__::real) = argument_in (lhs e1__); " ^
7.210 +" (M1__::bool) = (Substitute [v_ = x1__]) M__; " ^
7.211 +" M1__ = (Substitute [e1__]) M1__ ; " ^
7.212 +" M2__ = Take M__; " ^
7.213 +(*without this Take 'Substitute [v_ = x2__]' takes _last formula from ctree_*)
7.214 +" e2__ = nth_ 2 rm_; " ^
7.215 +" (x2__::real) = argument_in (lhs e2__); " ^
7.216 +" (M2__::bool) = ((Substitute [v_ = x2__]) @@ " ^
7.217 +" (Substitute [e2__])) M2__; " ^
7.218 +" (c_1_2__::bool list) = " ^
7.219 +" (SubProblem (Biegelinie_,[linear,system],[no_met]) " ^
7.220 +" [booll_ [M1__, M2__], reall [c,c_2]]); " ^
7.221 +" M__ = Take M__; " ^
7.222 +" M__ = ((Substitute c_1_2__) @@ " ^
7.223 +" (Try (Rewrite_Set_Inst [(bdv_1, c),(bdv_2, c_2)]" ^
7.224 +" simplify_System False)) @@ " ^
7.225 +" (Rewrite Moment_Neigung False) @@ " ^
7.226 +" (Rewrite make_fun_explicit False)) M__; " ^
7.227 +(*----------------------- and the same once more ------------------------*)
7.228 +" (N__:: bool) = " ^
7.229 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.230 +" [diff,integration,named]) " ^
7.231 +" [real_ (rhs M__), real_ v_, real_real_ y']); " ^
7.232 +" (B__:: bool) = " ^
7.233 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.234 +" [diff,integration,named]) " ^
7.235 +" [real_ (rhs N__), real_ v_, real_real_ y]); " ^
7.236 +" e1__ = nth_ 1 rb_; " ^
7.237 +" (x1__::real) = argument_in (lhs e1__); " ^
7.238 +" (B1__::bool) = (Substitute [v_ = x1__]) B__; " ^
7.239 +" B1__ = (Substitute [e1__]) B1__ ; " ^
7.240 +" B2__ = Take B__; " ^
7.241 +" e2__ = nth_ 2 rb_; " ^
7.242 +" (x2__::real) = argument_in (lhs e2__); " ^
7.243 +" (B2__::bool) = ((Substitute [v_ = x2__]) @@ " ^
7.244 +" (Substitute [e2__])) B2__; " ^
7.245 +" (c_1_2__::bool list) = " ^
7.246 +" (SubProblem (Biegelinie_,[linear,system],[no_met]) " ^
7.247 +" [booll_ [B1__, B2__], reall [c,c_2]]); " ^
7.248 +" B__ = Take B__; " ^
7.249 +" B__ = ((Substitute c_1_2__) @@ " ^
7.250 +" (Rewrite_Set_Inst [(bdv, x)] make_ratpoly_in False)) B__ " ^
7.251 +" in B__)"
7.252 +));
7.253 +
7.254 +store_met
7.255 + (prep_met (theory "Biegelinie") "met_biege_2" [] e_metID
7.256 + (["IntegrierenUndKonstanteBestimmen2"],
7.257 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__",
7.258 + "FunktionsVariable v_"]),
7.259 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
7.260 + ("#Find" ,["Biegelinie b_"]),
7.261 + ("#Relate",["Randbedingungen rb_"])
7.262 + ],
7.263 + {rew_ord'="tless_true",
7.264 + rls' = append_rls "erls_IntegrierenUndK.." e_rls
7.265 + [Calc ("Atools.ident",eval_ident "#ident_"),
7.266 + Thm ("not_true",num_str not_true),
7.267 + Thm ("not_false",num_str not_false)],
7.268 + calc = [],
7.269 + srls = append_rls "erls_IntegrierenUndK.." e_rls
7.270 + [Calc("Tools.rhs", eval_rhs"eval_rhs_"),
7.271 + Calc ("Atools.ident",eval_ident "#ident_"),
7.272 + Thm ("last_thmI",num_str last_thmI),
7.273 + Thm ("if_True",num_str if_True),
7.274 + Thm ("if_False",num_str if_False)
7.275 + ],
7.276 + prls = Erls, crls = Atools_erls, nrls = Erls},
7.277 +"Script Biegelinie2Script " ^
7.278 +"(l_::real) (q__::real) (v_::real) (b_::real=>real) (rb_::bool list) = " ^
7.279 +" (let " ^
7.280 +" (funs_:: bool list) = " ^
7.281 +" (SubProblem (Biegelinie_,[vonBelastungZu,Biegelinien], " ^
7.282 +" [Biegelinien,ausBelastung]) " ^
7.283 +" [real_ q__, real_ v_]); " ^
7.284 +" (equs_::bool list) = " ^
7.285 +" (SubProblem (Biegelinie_,[setzeRandbedingungen,Biegelinien]," ^
7.286 +" [Biegelinien,setzeRandbedingungenEin]) " ^
7.287 +" [booll_ funs_, booll_ rb_]); " ^
7.288 +" (cons_::bool list) = " ^
7.289 +" (SubProblem (Biegelinie_,[linear,system],[no_met]) " ^
7.290 +" [booll_ equs_, reall [c,c_2,c_3,c_4]]); " ^
7.291 +" B_ = Take (lastI funs_); " ^
7.292 +" B_ = ((Substitute cons_) @@ " ^
7.293 +" (Rewrite_Set_Inst [(bdv, v_)] make_ratpoly_in False)) B_ " ^
7.294 +" in B_)"
7.295 +));
7.296 +
7.297 +store_met
7.298 + (prep_met (theory "Biegelinie") "met_biege_intconst_2" [] e_metID
7.299 + (["IntegrierenUndKonstanteBestimmen","2xIntegrieren"],
7.300 + [],
7.301 + {rew_ord'="tless_true", rls'=Erls, calc = [],
7.302 + srls = e_rls,
7.303 + prls=e_rls,
7.304 + crls = Atools_erls, nrls = e_rls},
7.305 +"empty_script"
7.306 +));
7.307 +
7.308 +store_met
7.309 + (prep_met (theory "Biegelinie") "met_biege_intconst_4" [] e_metID
7.310 + (["IntegrierenUndKonstanteBestimmen","4x4System"],
7.311 + [],
7.312 + {rew_ord'="tless_true", rls'=Erls, calc = [],
7.313 + srls = e_rls,
7.314 + prls=e_rls,
7.315 + crls = Atools_erls, nrls = e_rls},
7.316 +"empty_script"
7.317 +));
7.318 +
7.319 +store_met
7.320 + (prep_met (theory "Biegelinie") "met_biege_intconst_1" [] e_metID
7.321 + (["IntegrierenUndKonstanteBestimmen","1xIntegrieren"],
7.322 + [],
7.323 + {rew_ord'="tless_true", rls'=Erls, calc = [],
7.324 + srls = e_rls,
7.325 + prls=e_rls,
7.326 + crls = Atools_erls, nrls = e_rls},
7.327 +"empty_script"
7.328 +));
7.329 +
7.330 +store_met
7.331 + (prep_met (theory "Biegelinie") "met_biege2" [] e_metID
7.332 + (["Biegelinien"],
7.333 + [],
7.334 + {rew_ord'="tless_true", rls'=Erls, calc = [],
7.335 + srls = e_rls,
7.336 + prls=e_rls,
7.337 + crls = Atools_erls, nrls = e_rls},
7.338 +"empty_script"
7.339 +));
7.340 +
7.341 +store_met
7.342 + (prep_met (theory "Biegelinie") "met_biege_ausbelast" [] e_metID
7.343 + (["Biegelinien","ausBelastung"],
7.344 + [("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
7.345 + ("#Find" ,["Funktionen funs_"])],
7.346 + {rew_ord'="tless_true",
7.347 + rls' = append_rls "erls_ausBelastung" e_rls
7.348 + [Calc ("Atools.ident",eval_ident "#ident_"),
7.349 + Thm ("not_true",num_str not_true),
7.350 + Thm ("not_false",num_str not_false)],
7.351 + calc = [],
7.352 + srls = append_rls "srls_ausBelastung" e_rls
7.353 + [Calc("Tools.rhs", eval_rhs"eval_rhs_")],
7.354 + prls = e_rls, crls = Atools_erls, nrls = e_rls},
7.355 +"Script Belastung2BiegelScript (q__::real) (v_::real) = " ^
7.356 +" (let q___ = Take (q_ v_ = q__); " ^
7.357 +" q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ " ^
7.358 +" (Rewrite Belastung_Querkraft True)) q___; " ^
7.359 +" (Q__:: bool) = " ^
7.360 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.361 +" [diff,integration,named]) " ^
7.362 +" [real_ (rhs q___), real_ v_, real_real_ Q]); " ^
7.363 +" M__ = Rewrite Querkraft_Moment True Q__; " ^
7.364 +" (M__::bool) = " ^
7.365 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.366 +" [diff,integration,named]) " ^
7.367 +" [real_ (rhs M__), real_ v_, real_real_ M_b]); " ^
7.368 +" N__ = ((Rewrite Moment_Neigung False) @@ " ^
7.369 +" (Rewrite make_fun_explicit False)) M__; " ^
7.370 +" (N__:: bool) = " ^
7.371 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.372 +" [diff,integration,named]) " ^
7.373 +" [real_ (rhs N__), real_ v_, real_real_ y']); " ^
7.374 +" (B__:: bool) = " ^
7.375 +" (SubProblem (Biegelinie_,[named,integrate,function], " ^
7.376 +" [diff,integration,named]) " ^
7.377 +" [real_ (rhs N__), real_ v_, real_real_ y]) " ^
7.378 +" in [Q__, M__, N__, B__])"
7.379 +));
7.380 +
7.381 +store_met
7.382 + (prep_met (theory "Biegelinie") "met_biege_setzrand" [] e_metID
7.383 + (["Biegelinien","setzeRandbedingungenEin"],
7.384 + [("#Given" ,["Funktionen funs_","Randbedingungen rb_"]),
7.385 + ("#Find" ,["Gleichungen equs___"])],
7.386 + {rew_ord'="tless_true", rls'=Erls, calc = [],
7.387 + srls = srls2,
7.388 + prls=e_rls,
7.389 + crls = Atools_erls, nrls = e_rls},
7.390 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = " ^
7.391 +" (let b1_ = nth_ 1 rb_; " ^
7.392 +" fs_ = filter_sameFunId (lhs b1_) funs_; " ^
7.393 +" (e1_::bool) = " ^
7.394 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.395 +" [Equation,fromFunction]) " ^
7.396 +" [bool_ (hd fs_), bool_ b1_]); " ^
7.397 +" b2_ = nth_ 2 rb_; " ^
7.398 +" fs_ = filter_sameFunId (lhs b2_) funs_; " ^
7.399 +" (e2_::bool) = " ^
7.400 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.401 +" [Equation,fromFunction]) " ^
7.402 +" [bool_ (hd fs_), bool_ b2_]); " ^
7.403 +" b3_ = nth_ 3 rb_; " ^
7.404 +" fs_ = filter_sameFunId (lhs b3_) funs_; " ^
7.405 +" (e3_::bool) = " ^
7.406 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.407 +" [Equation,fromFunction]) " ^
7.408 +" [bool_ (hd fs_), bool_ b3_]); " ^
7.409 +" b4_ = nth_ 4 rb_; " ^
7.410 +" fs_ = filter_sameFunId (lhs b4_) funs_; " ^
7.411 +" (e4_::bool) = " ^
7.412 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.413 +" [Equation,fromFunction]) " ^
7.414 +" [bool_ (hd fs_), bool_ b4_]) " ^
7.415 +" in [e1_,e2_,e3_,e4_])"
7.416 +(* filter requires more than 1 sec !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7.417 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = " ^
7.418 +" (let b1_ = nth_ 1 rb_; " ^
7.419 +" fs_ = filter (sameFunId (lhs b1_)) funs_; " ^
7.420 +" (e1_::bool) = " ^
7.421 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.422 +" [Equation,fromFunction]) " ^
7.423 +" [bool_ (hd fs_), bool_ b1_]); " ^
7.424 +" b2_ = nth_ 2 rb_; " ^
7.425 +" fs_ = filter (sameFunId (lhs b2_)) funs_; " ^
7.426 +" (e2_::bool) = " ^
7.427 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.428 +" [Equation,fromFunction]) " ^
7.429 +" [bool_ (hd fs_), bool_ b2_]); " ^
7.430 +" b3_ = nth_ 3 rb_; " ^
7.431 +" fs_ = filter (sameFunId (lhs b3_)) funs_; " ^
7.432 +" (e3_::bool) = " ^
7.433 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.434 +" [Equation,fromFunction]) " ^
7.435 +" [bool_ (hd fs_), bool_ b3_]); " ^
7.436 +" b4_ = nth_ 4 rb_; " ^
7.437 +" fs_ = filter (sameFunId (lhs b4_)) funs_; " ^
7.438 +" (e4_::bool) = " ^
7.439 +" (SubProblem (Biegelinie_,[makeFunctionTo,equation]," ^
7.440 +" [Equation,fromFunction]) " ^
7.441 +" [bool_ (hd fs_), bool_ b4_]) " ^
7.442 +" in [e1_,e2_,e3_,e4_])"*)
7.443 +));
7.444 +
7.445 +store_met
7.446 + (prep_met (theory "Biegelinie") "met_equ_fromfun" [] e_metID
7.447 + (["Equation","fromFunction"],
7.448 + [("#Given" ,["functionEq fun_","substitution sub_"]),
7.449 + ("#Find" ,["equality equ___"])],
7.450 + {rew_ord'="tless_true", rls'=Erls, calc = [],
7.451 + srls = append_rls "srls_in_EquationfromFunc" e_rls
7.452 + [Calc("Tools.lhs", eval_lhs"eval_lhs_"),
7.453 + Calc("Atools.argument'_in",
7.454 + eval_argument_in
7.455 + "Atools.argument'_in")],
7.456 + prls=e_rls,
7.457 + crls = Atools_erls, nrls = e_rls},
7.458 +(*(M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2) (M_b L = 0) -->
7.459 + 0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2*)
7.460 +"Script Function2Equality (fun_::bool) (sub_::bool) =" ^
7.461 +" (let fun_ = Take fun_; " ^
7.462 +" bdv_ = argument_in (lhs fun_); " ^
7.463 +" val_ = argument_in (lhs sub_); " ^
7.464 +" equ_ = (Substitute [bdv_ = val_]) fun_; " ^
7.465 +" equ_ = (Substitute [sub_]) fun_ " ^
7.466 +" in (Rewrite_Set norm_Rational False) equ_) "
7.467 +));
7.468 +*}
7.469 +
7.470 end
7.471
8.1 --- a/src/Tools/isac/Knowledge/Diff.ML Fri Aug 27 10:39:12 2010 +0200
8.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
8.3 @@ -1,346 +0,0 @@
8.4 -(* tools for differentiation
8.5 - WN.11.99
8.6 -
8.7 -use"Knowledge/Diff.ML";
8.8 -use"Diff.ML";
8.9 - *)
8.10 -
8.11 -
8.12 -(** interface isabelle -- isac **)
8.13 -
8.14 -theory' := overwritel (!theory', [("Diff.thy",Diff.thy)]);
8.15 -
8.16 -
8.17 -(** eval functions **)
8.18 -
8.19 -fun primed (Const (id, T)) = Const (id ^ "'", T)
8.20 - | primed (Free (id, T)) = Free (id ^ "'", T)
8.21 - | primed t = raise error ("primed called with arg = '"^ term2str t ^"'");
8.22 -
8.23 -(*("primed", ("Diff.primed", eval_primed "#primed"))*)
8.24 -fun eval_primed _ _ (p as (Const ("Diff.primed",_) $ t)) _ =
8.25 - SOME ((term2str p) ^ " = " ^ term2str (primed t),
8.26 - Trueprop $ (mk_equality (p, primed t)))
8.27 - | eval_primed _ _ _ _ = NONE;
8.28 -
8.29 -calclist':= overwritel (!calclist',
8.30 - [("primed", ("Diff.primed", eval_primed "#primed"))
8.31 - ]);
8.32 -
8.33 -
8.34 -(** rulesets **)
8.35 -
8.36 -(*.converts a term such that differentiation works optimally.*)
8.37 -val diff_conv =
8.38 - Rls {id="diff_conv",
8.39 - preconds = [],
8.40 - rew_ord = ("termlessI",termlessI),
8.41 - erls = append_rls "erls_diff_conv" e_rls
8.42 - [Calc ("Atools.occurs'_in", eval_occurs_in ""),
8.43 - Thm ("not_true",num_str not_true),
8.44 - Thm ("not_false",num_str not_false),
8.45 - Calc ("op <",eval_equ "#less_"),
8.46 - Thm ("and_true",num_str and_true),
8.47 - Thm ("and_false",num_str and_false)
8.48 - ],
8.49 - srls = Erls, calc = [],
8.50 - rules = [Thm ("frac_conv", num_str frac_conv),
8.51 - Thm ("sqrt_conv_bdv", num_str sqrt_conv_bdv),
8.52 - Thm ("sqrt_conv_bdv_n", num_str sqrt_conv_bdv_n),
8.53 - Thm ("sqrt_conv", num_str sqrt_conv),
8.54 - Thm ("root_conv", num_str root_conv),
8.55 - Thm ("realpow_pow_bdv", num_str realpow_pow_bdv),
8.56 - Calc ("op *", eval_binop "#mult_"),
8.57 - Thm ("rat_mult",num_str rat_mult),
8.58 - (*a / b * (c / d) = a * c / (b * d)*)
8.59 - Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
8.60 - (*?x * (?y / ?z) = ?x * ?y / ?z*)
8.61 - Thm ("real_times_divide2_eq",num_str real_times_divide2_eq)
8.62 - (*?y / ?z * ?x = ?y * ?x / ?z*)
8.63 - (*
8.64 - Thm ("", num_str ),*)
8.65 - ],
8.66 - scr = EmptyScr};
8.67 -
8.68 -(*.beautifies a term after differentiation.*)
8.69 -val diff_sym_conv =
8.70 - Rls {id="diff_sym_conv",
8.71 - preconds = [],
8.72 - rew_ord = ("termlessI",termlessI),
8.73 - erls = append_rls "erls_diff_sym_conv" e_rls
8.74 - [Calc ("op <",eval_equ "#less_")
8.75 - ],
8.76 - srls = Erls, calc = [],
8.77 - rules = [Thm ("frac_sym_conv", num_str frac_sym_conv),
8.78 - Thm ("sqrt_sym_conv", num_str sqrt_sym_conv),
8.79 - Thm ("root_sym_conv", num_str root_sym_conv),
8.80 - Thm ("sym_real_mult_minus1",
8.81 - num_str (real_mult_minus1 RS sym)),
8.82 - (*- ?z = "-1 * ?z"*)
8.83 - Thm ("rat_mult",num_str rat_mult),
8.84 - (*a / b * (c / d) = a * c / (b * d)*)
8.85 - Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
8.86 - (*?x * (?y / ?z) = ?x * ?y / ?z*)
8.87 - Thm ("real_times_divide2_eq",num_str real_times_divide2_eq),
8.88 - (*?y / ?z * ?x = ?y * ?x / ?z*)
8.89 - Calc ("op *", eval_binop "#mult_")
8.90 - ],
8.91 - scr = EmptyScr};
8.92 -
8.93 -(*..*)
8.94 -val srls_diff =
8.95 - Rls {id="srls_differentiate..",
8.96 - preconds = [],
8.97 - rew_ord = ("termlessI",termlessI),
8.98 - erls = e_rls,
8.99 - srls = Erls, calc = [],
8.100 - rules = [Calc("Tools.lhs", eval_lhs "eval_lhs_"),
8.101 - Calc("Tools.rhs", eval_rhs "eval_rhs_"),
8.102 - Calc("Diff.primed", eval_primed "Diff.primed")
8.103 - ],
8.104 - scr = EmptyScr};
8.105 -
8.106 -(*..*)
8.107 -val erls_diff =
8.108 - append_rls "erls_differentiate.." e_rls
8.109 - [Thm ("not_true",num_str not_true),
8.110 - Thm ("not_false",num_str not_false),
8.111 -
8.112 - Calc ("Atools.ident",eval_ident "#ident_"),
8.113 - Calc ("Atools.is'_atom",eval_is_atom "#is_atom_"),
8.114 - Calc ("Atools.occurs'_in",eval_occurs_in ""),
8.115 - Calc ("Atools.is'_const",eval_const "#is_const_")
8.116 - ];
8.117 -
8.118 -(*.rules for differentiation, _no_ simplification.*)
8.119 -val diff_rules =
8.120 - Rls {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI),
8.121 - erls = erls_diff, srls = Erls, calc = [],
8.122 - rules = [Thm ("diff_sum",num_str diff_sum),
8.123 - Thm ("diff_dif",num_str diff_dif),
8.124 - Thm ("diff_prod_const",num_str diff_prod_const),
8.125 - Thm ("diff_prod",num_str diff_prod),
8.126 - Thm ("diff_quot",num_str diff_quot),
8.127 - Thm ("diff_sin",num_str diff_sin),
8.128 - Thm ("diff_sin_chain",num_str diff_sin_chain),
8.129 - Thm ("diff_cos",num_str diff_cos),
8.130 - Thm ("diff_cos_chain",num_str diff_cos_chain),
8.131 - Thm ("diff_pow",num_str diff_pow),
8.132 - Thm ("diff_pow_chain",num_str diff_pow_chain),
8.133 - Thm ("diff_ln",num_str diff_ln),
8.134 - Thm ("diff_ln_chain",num_str diff_ln_chain),
8.135 - Thm ("diff_exp",num_str diff_exp),
8.136 - Thm ("diff_exp_chain",num_str diff_exp_chain),
8.137 -(*
8.138 - Thm ("diff_sqrt",num_str diff_sqrt),
8.139 - Thm ("diff_sqrt_chain",num_str diff_sqrt_chain),
8.140 -*)
8.141 - Thm ("diff_const",num_str diff_const),
8.142 - Thm ("diff_var",num_str diff_var)
8.143 - ],
8.144 - scr = EmptyScr};
8.145 -
8.146 -(*.normalisation for checking user-input.*)
8.147 -val norm_diff =
8.148 - Rls {id="diff_rls", preconds = [], rew_ord = ("termlessI",termlessI),
8.149 - erls = Erls, srls = Erls, calc = [],
8.150 - rules = [Rls_ diff_rules,
8.151 - Rls_ norm_Poly
8.152 - ],
8.153 - scr = EmptyScr};
8.154 -ruleset' :=
8.155 -overwritelthy thy (!ruleset',
8.156 - [("diff_rules", prep_rls norm_diff),
8.157 - ("norm_diff", prep_rls norm_diff),
8.158 - ("diff_conv", prep_rls diff_conv),
8.159 - ("diff_sym_conv", prep_rls diff_sym_conv)
8.160 - ]);
8.161 -
8.162 -
8.163 -(** problem types **)
8.164 -
8.165 -store_pbt
8.166 - (prep_pbt (theory "Diff") "pbl_fun" [] e_pblID
8.167 - (["function"], [], e_rls, NONE, []));
8.168 -
8.169 -store_pbt
8.170 - (prep_pbt (theory "Diff") "pbl_fun_deriv" [] e_pblID
8.171 - (["derivative_of","function"],
8.172 - [("#Given" ,["functionTerm f_","differentiateFor v_"]),
8.173 - ("#Find" ,["derivative f_'_"])
8.174 - ],
8.175 - append_rls "e_rls" e_rls [],
8.176 - SOME "Diff (f_, v_)", [["diff","differentiate_on_R"],
8.177 - ["diff","after_simplification"]]));
8.178 -
8.179 -(*here "named" is used differently from Integration"*)
8.180 -store_pbt
8.181 - (prep_pbt (theory "Diff") "pbl_fun_deriv_nam" [] e_pblID
8.182 - (["named","derivative_of","function"],
8.183 - [("#Given" ,["functionEq f_","differentiateFor v_"]),
8.184 - ("#Find" ,["derivativeEq f_'_"])
8.185 - ],
8.186 - append_rls "e_rls" e_rls [],
8.187 - SOME "Differentiate (f_, v_)", [["diff","differentiate_equality"]]));
8.188 -
8.189 -
8.190 -(** methods **)
8.191 -
8.192 -store_met
8.193 - (prep_met (theory "Diff") "met_diff" [] e_metID
8.194 - (["diff"], [],
8.195 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
8.196 - crls = Atools_erls, nrls = norm_diff}, "empty_script"));
8.197 -
8.198 -store_met
8.199 - (prep_met (theory "Diff") "met_diff_onR" [] e_metID
8.200 - (["diff","differentiate_on_R"],
8.201 - [("#Given" ,["functionTerm f_","differentiateFor v_"]),
8.202 - ("#Find" ,["derivative f_'_"])
8.203 - ],
8.204 - {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
8.205 - prls=e_rls, crls = Atools_erls, nrls = norm_diff},
8.206 -"Script DiffScr (f_::real) (v_::real) = " ^
8.207 -" (let f'_ = Take (d_d v_ f_) " ^
8.208 -" in (((Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ " ^
8.209 -" (Repeat " ^
8.210 -" ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or " ^
8.211 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or " ^
8.212 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or " ^
8.213 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or " ^
8.214 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or " ^
8.215 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or " ^
8.216 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or " ^
8.217 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or " ^
8.218 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or " ^
8.219 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or " ^
8.220 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or " ^
8.221 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or " ^
8.222 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or " ^
8.223 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or " ^
8.224 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or " ^
8.225 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or " ^
8.226 -" (Repeat (Rewrite_Set make_polynomial False)))) @@ " ^
8.227 -" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)))) f'_)"
8.228 -));
8.229 -
8.230 -store_met
8.231 - (prep_met (theory "Diff") "met_diff_simpl" [] e_metID
8.232 - (["diff","diff_simpl"],
8.233 - [("#Given" ,["functionTerm f_","differentiateFor v_"]),
8.234 - ("#Find" ,["derivative f_'_"])
8.235 - ],
8.236 - {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
8.237 - prls=e_rls, crls = Atools_erls, nrls = norm_diff},
8.238 -"Script DiffScr (f_::real) (v_::real) = " ^
8.239 -" (let f'_ = Take (d_d v_ f_) " ^
8.240 -" in (( " ^
8.241 -" (Repeat " ^
8.242 -" ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or " ^
8.243 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or " ^
8.244 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or " ^
8.245 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or " ^
8.246 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or " ^
8.247 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or " ^
8.248 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or " ^
8.249 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or " ^
8.250 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or " ^
8.251 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or " ^
8.252 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or " ^
8.253 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or " ^
8.254 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or " ^
8.255 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or " ^
8.256 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or " ^
8.257 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or " ^
8.258 -" (Repeat (Rewrite_Set make_polynomial False)))) " ^
8.259 -" )) f'_)"
8.260 - ));
8.261 -
8.262 -store_met
8.263 - (prep_met (theory "Diff") "met_diff_equ" [] e_metID
8.264 - (["diff","differentiate_equality"],
8.265 - [("#Given" ,["functionEq f_","differentiateFor v_"]),
8.266 - ("#Find" ,["derivativeEq f_'_"])
8.267 - ],
8.268 - {rew_ord'="tless_true", rls' = erls_diff, calc = [],
8.269 - srls = srls_diff, prls=e_rls, crls=Atools_erls, nrls = norm_diff},
8.270 -"Script DiffEqScr (f_::bool) (v_::real) = " ^
8.271 -" (let f'_ = Take ((primed (lhs f_)) = d_d v_ (rhs f_)) " ^
8.272 -" in (((Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ " ^
8.273 -" (Repeat " ^
8.274 -" ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or " ^
8.275 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_dif False)) Or " ^
8.276 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or " ^
8.277 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or " ^
8.278 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or " ^
8.279 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or " ^
8.280 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or " ^
8.281 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or " ^
8.282 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or " ^
8.283 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or " ^
8.284 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or " ^
8.285 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or " ^
8.286 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or " ^
8.287 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or " ^
8.288 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or " ^
8.289 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or " ^
8.290 -" (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or " ^
8.291 -" (Repeat (Rewrite_Set make_polynomial False)))) @@ " ^
8.292 -" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)))) f'_)"
8.293 -));
8.294 -
8.295 -store_met
8.296 - (prep_met (theory "Diff") "met_diff_after_simp" [] e_metID
8.297 - (["diff","after_simplification"],
8.298 - [("#Given" ,["functionTerm f_","differentiateFor v_"]),
8.299 - ("#Find" ,["derivative f_'_"])
8.300 - ],
8.301 - {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, prls=e_rls,
8.302 - crls=Atools_erls, nrls = norm_Rational},
8.303 -"Script DiffScr (f_::real) (v_::real) = " ^
8.304 -" (let f'_ = Take (d_d v_ f_) " ^
8.305 -" in ((Try (Rewrite_Set norm_Rational False)) @@ " ^
8.306 -" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ " ^
8.307 -" (Try (Rewrite_Set_Inst [(bdv,v_)] norm_diff False)) @@ " ^
8.308 -" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)) @@ " ^
8.309 -" (Try (Rewrite_Set norm_Rational False))) f'_)"
8.310 -));
8.311 -
8.312 -
8.313 -(** CAS-commands **)
8.314 -
8.315 -(*.handle cas-input like "Diff (a * x^3 + b, x)".*)
8.316 -(* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
8.317 - val [Const ("Pair", _) $ t $ bdv] = pairl;
8.318 - *)
8.319 -fun argl2dtss [Const ("Pair", _) $ t $ bdv] =
8.320 - [((term_of o the o (parse thy)) "functionTerm", [t]),
8.321 - ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
8.322 - ((term_of o the o (parse thy)) "derivative",
8.323 - [(term_of o the o (parse thy)) "f_'_"])
8.324 - ]
8.325 - | argl2dtss _ = raise error "Diff.ML: wrong argument for argl2dtss";
8.326 -castab :=
8.327 -overwritel (!castab,
8.328 - [((term_of o the o (parse thy)) "Diff",
8.329 - (("Isac.thy", ["derivative_of","function"], ["no_met"]),
8.330 - argl2dtss))
8.331 - ]);
8.332 -
8.333 -(*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
8.334 -(* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
8.335 - val [Const ("Pair", _) $ t $ bdv] = pairl;
8.336 - *)
8.337 -fun argl2dtss [Const ("Pair", _) $ t $ bdv] =
8.338 - [((term_of o the o (parse thy)) "functionEq", [t]),
8.339 - ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
8.340 - ((term_of o the o (parse thy)) "derivativeEq",
8.341 - [(term_of o the o (parse thy)) "f_'_::bool"])
8.342 - ]
8.343 - | argl2dtss _ = raise error "Diff.ML: wrong argument for argl2dtss";
8.344 -castab :=
8.345 -overwritel (!castab,
8.346 - [((term_of o the o (parse thy)) "Differentiate",
8.347 - (("Isac.thy", ["named","derivative_of","function"], ["no_met"]),
8.348 - argl2dtss))
8.349 - ]);
9.1 --- a/src/Tools/isac/Knowledge/Diff.thy Fri Aug 27 10:39:12 2010 +0200
9.2 +++ b/src/Tools/isac/Knowledge/Diff.thy Fri Aug 27 14:56:54 2010 +0200
9.3 @@ -1,13 +1,9 @@
9.4 (* differentiation over the reals
9.5 author: Walther Neuper
9.6 000516
9.7 -
9.8 -remove_thy"Diff";
9.9 -use_thy_only"Knowledge/Diff";
9.10 -use_thy"Knowledge/Isac";
9.11 *)
9.12
9.13 -Diff = Calculus + Trig + LogExp + Rational + Root + Poly + Atools +
9.14 +theory Diff imports Calculus Trig LogExp Rational Root Poly Atools begin
9.15
9.16 consts
9.17
9.18 @@ -37,19 +33,31 @@
9.19 DiffEqScr :: "[bool,real, bool] => bool"
9.20 ("((Script DiffEqScr (_ _ =))// (_))" 9)
9.21
9.22 +text {*a variant of the derivatives defintion:
9.23
9.24 -rules (*stated as axioms, todo: prove as theorems
9.25 + d_d :: "(real => real) => (real => real)"
9.26 +
9.27 + advantages:
9.28 +(1) no variable 'bdv' on the meta-level required
9.29 +(2) chain_rule "d_d (%x. (u (v x))) = (%x. (d_d u)) (v x) * d_d v"
9.30 +(3) and no specialized chain-rules required like
9.31 + diff_sin_chain "d_d bdv (sin u) = cos u * d_d bdv u"
9.32 +
9.33 + disadvantage: d_d (%x. 1 + x^2) = ... differs from high-school notation
9.34 +*}
9.35 +
9.36 +axioms (*stated as axioms, todo: prove as theorems
9.37 'bdv' is a constant on the meta-level *)
9.38 diff_const "[| Not (bdv occurs_in a) |] ==> d_d bdv a = 0"
9.39 diff_var "d_d bdv bdv = 1"
9.40 - diff_prod_const"[| Not (bdv occurs_in u) |] ==> \
9.41 - \d_d bdv (u * v) = u * d_d bdv v"
9.42 + diff_prod_const"[| Not (bdv occurs_in u) |] ==>
9.43 + d_d bdv (u * v) = u * d_d bdv v"
9.44
9.45 diff_sum "d_d bdv (u + v) = d_d bdv u + d_d bdv v"
9.46 diff_dif "d_d bdv (u - v) = d_d bdv u - d_d bdv v"
9.47 diff_prod "d_d bdv (u * v) = d_d bdv u * v + u * d_d bdv v"
9.48 - diff_quot "Not (v = 0) ==> (d_d bdv (u / v) = \
9.49 - \(d_d bdv u * v - u * d_d bdv v) / v ^^^ 2)"
9.50 + diff_quot "Not (v = 0) ==> (d_d bdv (u / v) =
9.51 + (d_d bdv u * v - u * d_d bdv v) / v ^^^ 2)"
9.52
9.53 diff_sin "d_d bdv (sin bdv) = cos bdv"
9.54 diff_sin_chain "d_d bdv (sin u) = cos u * d_d bdv u"
9.55 @@ -67,8 +75,8 @@
9.56 *)
9.57 (*...*)
9.58
9.59 - frac_conv "[| bdv occurs_in b; 0 < n |] ==> \
9.60 - \ a / (b ^^^ n) = a * b ^^^ (-n)"
9.61 + frac_conv "[| bdv occurs_in b; 0 < n |] ==>
9.62 + a / (b ^^^ n) = a * b ^^^ (-n)"
9.63 frac_sym_conv "n < 0 ==> a * b ^^^ n = a / b ^^^ (-n)"
9.64
9.65 sqrt_conv_bdv "sqrt bdv = bdv ^^^ (1 / 2)"
9.66 @@ -81,17 +89,340 @@
9.67
9.68 realpow_pow_bdv "(bdv ^^^ b) ^^^ c = bdv ^^^ (b * c)"
9.69
9.70 +ML {*
9.71 +(** eval functions **)
9.72 +
9.73 +fun primed (Const (id, T)) = Const (id ^ "'", T)
9.74 + | primed (Free (id, T)) = Free (id ^ "'", T)
9.75 + | primed t = raise error ("primed called with arg = '"^ term2str t ^"'");
9.76 +
9.77 +(*("primed", ("Diff.primed", eval_primed "#primed"))*)
9.78 +fun eval_primed _ _ (p as (Const ("Diff.primed",_) $ t)) _ =
9.79 + SOME ((term2str p) ^ " = " ^ term2str (primed t),
9.80 + Trueprop $ (mk_equality (p, primed t)))
9.81 + | eval_primed _ _ _ _ = NONE;
9.82 +
9.83 +calclist':= overwritel (!calclist',
9.84 + [("primed", ("Diff.primed", eval_primed "#primed"))
9.85 + ]);
9.86 +
9.87 +
9.88 +(** rulesets **)
9.89 +
9.90 +(*.converts a term such that differentiation works optimally.*)
9.91 +val diff_conv =
9.92 + Rls {id="diff_conv",
9.93 + preconds = [],
9.94 + rew_ord = ("termlessI",termlessI),
9.95 + erls = append_rls "erls_diff_conv" e_rls
9.96 + [Calc ("Atools.occurs'_in", eval_occurs_in ""),
9.97 + Thm ("not_true",num_str not_true),
9.98 + Thm ("not_false",num_str not_false),
9.99 + Calc ("op <",eval_equ "#less_"),
9.100 + Thm ("and_true",num_str and_true),
9.101 + Thm ("and_false",num_str and_false)
9.102 + ],
9.103 + srls = Erls, calc = [],
9.104 + rules = [Thm ("frac_conv", num_str frac_conv),
9.105 + Thm ("sqrt_conv_bdv", num_str sqrt_conv_bdv),
9.106 + Thm ("sqrt_conv_bdv_n", num_str sqrt_conv_bdv_n),
9.107 + Thm ("sqrt_conv", num_str sqrt_conv),
9.108 + Thm ("root_conv", num_str root_conv),
9.109 + Thm ("realpow_pow_bdv", num_str realpow_pow_bdv),
9.110 + Calc ("op *", eval_binop "#mult_"),
9.111 + Thm ("rat_mult",num_str rat_mult),
9.112 + (*a / b * (c / d) = a * c / (b * d)*)
9.113 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
9.114 + (*?x * (?y / ?z) = ?x * ?y / ?z*)
9.115 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq)
9.116 + (*?y / ?z * ?x = ?y * ?x / ?z*)
9.117 + (*
9.118 + Thm ("", num_str ),*)
9.119 + ],
9.120 + scr = EmptyScr};
9.121 +
9.122 +(*.beautifies a term after differentiation.*)
9.123 +val diff_sym_conv =
9.124 + Rls {id="diff_sym_conv",
9.125 + preconds = [],
9.126 + rew_ord = ("termlessI",termlessI),
9.127 + erls = append_rls "erls_diff_sym_conv" e_rls
9.128 + [Calc ("op <",eval_equ "#less_")
9.129 + ],
9.130 + srls = Erls, calc = [],
9.131 + rules = [Thm ("frac_sym_conv", num_str frac_sym_conv),
9.132 + Thm ("sqrt_sym_conv", num_str sqrt_sym_conv),
9.133 + Thm ("root_sym_conv", num_str root_sym_conv),
9.134 + Thm ("sym_real_mult_minus1",
9.135 + num_str (real_mult_minus1 RS sym)),
9.136 + (*- ?z = "-1 * ?z"*)
9.137 + Thm ("rat_mult",num_str rat_mult),
9.138 + (*a / b * (c / d) = a * c / (b * d)*)
9.139 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
9.140 + (*?x * (?y / ?z) = ?x * ?y / ?z*)
9.141 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq),
9.142 + (*?y / ?z * ?x = ?y * ?x / ?z*)
9.143 + Calc ("op *", eval_binop "#mult_")
9.144 + ],
9.145 + scr = EmptyScr};
9.146 +
9.147 +(*..*)
9.148 +val srls_diff =
9.149 + Rls {id="srls_differentiate..",
9.150 + preconds = [],
9.151 + rew_ord = ("termlessI",termlessI),
9.152 + erls = e_rls,
9.153 + srls = Erls, calc = [],
9.154 + rules = [Calc("Tools.lhs", eval_lhs "eval_lhs_"),
9.155 + Calc("Tools.rhs", eval_rhs "eval_rhs_"),
9.156 + Calc("Diff.primed", eval_primed "Diff.primed")
9.157 + ],
9.158 + scr = EmptyScr};
9.159 +
9.160 +(*..*)
9.161 +val erls_diff =
9.162 + append_rls "erls_differentiate.." e_rls
9.163 + [Thm ("not_true",num_str not_true),
9.164 + Thm ("not_false",num_str not_false),
9.165 +
9.166 + Calc ("Atools.ident",eval_ident "#ident_"),
9.167 + Calc ("Atools.is'_atom",eval_is_atom "#is_atom_"),
9.168 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
9.169 + Calc ("Atools.is'_const",eval_const "#is_const_")
9.170 + ];
9.171 +
9.172 +(*.rules for differentiation, _no_ simplification.*)
9.173 +val diff_rules =
9.174 + Rls {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI),
9.175 + erls = erls_diff, srls = Erls, calc = [],
9.176 + rules = [Thm ("diff_sum",num_str diff_sum),
9.177 + Thm ("diff_dif",num_str diff_dif),
9.178 + Thm ("diff_prod_const",num_str diff_prod_const),
9.179 + Thm ("diff_prod",num_str diff_prod),
9.180 + Thm ("diff_quot",num_str diff_quot),
9.181 + Thm ("diff_sin",num_str diff_sin),
9.182 + Thm ("diff_sin_chain",num_str diff_sin_chain),
9.183 + Thm ("diff_cos",num_str diff_cos),
9.184 + Thm ("diff_cos_chain",num_str diff_cos_chain),
9.185 + Thm ("diff_pow",num_str diff_pow),
9.186 + Thm ("diff_pow_chain",num_str diff_pow_chain),
9.187 + Thm ("diff_ln",num_str diff_ln),
9.188 + Thm ("diff_ln_chain",num_str diff_ln_chain),
9.189 + Thm ("diff_exp",num_str diff_exp),
9.190 + Thm ("diff_exp_chain",num_str diff_exp_chain),
9.191 +(*
9.192 + Thm ("diff_sqrt",num_str diff_sqrt),
9.193 + Thm ("diff_sqrt_chain",num_str diff_sqrt_chain),
9.194 +*)
9.195 + Thm ("diff_const",num_str diff_const),
9.196 + Thm ("diff_var",num_str diff_var)
9.197 + ],
9.198 + scr = EmptyScr};
9.199 +
9.200 +(*.normalisation for checking user-input.*)
9.201 +val norm_diff =
9.202 + Rls {id="diff_rls", preconds = [], rew_ord = ("termlessI",termlessI),
9.203 + erls = Erls, srls = Erls, calc = [],
9.204 + rules = [Rls_ diff_rules,
9.205 + Rls_ norm_Poly
9.206 + ],
9.207 + scr = EmptyScr};
9.208 +ruleset' :=
9.209 +overwritelthy thy (!ruleset',
9.210 + [("diff_rules", prep_rls norm_diff),
9.211 + ("norm_diff", prep_rls norm_diff),
9.212 + ("diff_conv", prep_rls diff_conv),
9.213 + ("diff_sym_conv", prep_rls diff_sym_conv)
9.214 + ]);
9.215 +
9.216 +
9.217 +(** problem types **)
9.218 +
9.219 +store_pbt
9.220 + (prep_pbt (theory "Diff") "pbl_fun" [] e_pblID
9.221 + (["function"], [], e_rls, NONE, []));
9.222 +
9.223 +store_pbt
9.224 + (prep_pbt (theory "Diff") "pbl_fun_deriv" [] e_pblID
9.225 + (["derivative_of","function"],
9.226 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
9.227 + ("#Find" ,["derivative f_'_"])
9.228 + ],
9.229 + append_rls "e_rls" e_rls [],
9.230 + SOME "Diff (f_, v_)", [["diff","differentiate_on_R"],
9.231 + ["diff","after_simplification"]]));
9.232 +
9.233 +(*here "named" is used differently from Integration"*)
9.234 +store_pbt
9.235 + (prep_pbt (theory "Diff") "pbl_fun_deriv_nam" [] e_pblID
9.236 + (["named","derivative_of","function"],
9.237 + [("#Given" ,["functionEq f_","differentiateFor v_"]),
9.238 + ("#Find" ,["derivativeEq f_'_"])
9.239 + ],
9.240 + append_rls "e_rls" e_rls [],
9.241 + SOME "Differentiate (f_, v_)", [["diff","differentiate_equality"]]));
9.242 +
9.243 +
9.244 +(** methods **)
9.245 +
9.246 +store_met
9.247 + (prep_met (theory "Diff") "met_diff" [] e_metID
9.248 + (["diff"], [],
9.249 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
9.250 + crls = Atools_erls, nrls = norm_diff}, "empty_script"));
9.251 +
9.252 +store_met
9.253 + (prep_met (theory "Diff") "met_diff_onR" [] e_metID
9.254 + (["diff","differentiate_on_R"],
9.255 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
9.256 + ("#Find" ,["derivative f_'_"])
9.257 + ],
9.258 + {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
9.259 + prls=e_rls, crls = Atools_erls, nrls = norm_diff},
9.260 +"Script DiffScr (f_::real) (v_::real) = " ^
9.261 +" (let f'_ = Take (d_d v_ f_) " ^
9.262 +" in (((Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ " ^
9.263 +" (Repeat " ^
9.264 +" ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or " ^
9.265 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or " ^
9.266 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or " ^
9.267 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or " ^
9.268 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or " ^
9.269 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or " ^
9.270 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or " ^
9.271 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or " ^
9.272 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or " ^
9.273 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or " ^
9.274 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or " ^
9.275 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or " ^
9.276 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or " ^
9.277 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or " ^
9.278 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or " ^
9.279 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or " ^
9.280 +" (Repeat (Rewrite_Set make_polynomial False)))) @@ " ^
9.281 +" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)))) f'_)"
9.282 +));
9.283 +
9.284 +store_met
9.285 + (prep_met (theory "Diff") "met_diff_simpl" [] e_metID
9.286 + (["diff","diff_simpl"],
9.287 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
9.288 + ("#Find" ,["derivative f_'_"])
9.289 + ],
9.290 + {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
9.291 + prls=e_rls, crls = Atools_erls, nrls = norm_diff},
9.292 +"Script DiffScr (f_::real) (v_::real) = " ^
9.293 +" (let f'_ = Take (d_d v_ f_) " ^
9.294 +" in (( " ^
9.295 +" (Repeat " ^
9.296 +" ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or " ^
9.297 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or " ^
9.298 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or " ^
9.299 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or " ^
9.300 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or " ^
9.301 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or " ^
9.302 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or " ^
9.303 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or " ^
9.304 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or " ^
9.305 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or " ^
9.306 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or " ^
9.307 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or " ^
9.308 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or " ^
9.309 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or " ^
9.310 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or " ^
9.311 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or " ^
9.312 +" (Repeat (Rewrite_Set make_polynomial False)))) " ^
9.313 +" )) f'_)"
9.314 + ));
9.315 +
9.316 +store_met
9.317 + (prep_met (theory "Diff") "met_diff_equ" [] e_metID
9.318 + (["diff","differentiate_equality"],
9.319 + [("#Given" ,["functionEq f_","differentiateFor v_"]),
9.320 + ("#Find" ,["derivativeEq f_'_"])
9.321 + ],
9.322 + {rew_ord'="tless_true", rls' = erls_diff, calc = [],
9.323 + srls = srls_diff, prls=e_rls, crls=Atools_erls, nrls = norm_diff},
9.324 +"Script DiffEqScr (f_::bool) (v_::real) = " ^
9.325 +" (let f'_ = Take ((primed (lhs f_)) = d_d v_ (rhs f_)) " ^
9.326 +" in (((Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ " ^
9.327 +" (Repeat " ^
9.328 +" ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or " ^
9.329 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_dif False)) Or " ^
9.330 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or " ^
9.331 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or " ^
9.332 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or " ^
9.333 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or " ^
9.334 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or " ^
9.335 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or " ^
9.336 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or " ^
9.337 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or " ^
9.338 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or " ^
9.339 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or " ^
9.340 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or " ^
9.341 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or " ^
9.342 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or " ^
9.343 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or " ^
9.344 +" (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or " ^
9.345 +" (Repeat (Rewrite_Set make_polynomial False)))) @@ " ^
9.346 +" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)))) f'_)"
9.347 +));
9.348 +
9.349 +store_met
9.350 + (prep_met (theory "Diff") "met_diff_after_simp" [] e_metID
9.351 + (["diff","after_simplification"],
9.352 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
9.353 + ("#Find" ,["derivative f_'_"])
9.354 + ],
9.355 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, prls=e_rls,
9.356 + crls=Atools_erls, nrls = norm_Rational},
9.357 +"Script DiffScr (f_::real) (v_::real) = " ^
9.358 +" (let f'_ = Take (d_d v_ f_) " ^
9.359 +" in ((Try (Rewrite_Set norm_Rational False)) @@ " ^
9.360 +" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ " ^
9.361 +" (Try (Rewrite_Set_Inst [(bdv,v_)] norm_diff False)) @@ " ^
9.362 +" (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)) @@ " ^
9.363 +" (Try (Rewrite_Set norm_Rational False))) f'_)"
9.364 +));
9.365 +
9.366 +
9.367 +(** CAS-commands **)
9.368 +
9.369 +(*.handle cas-input like "Diff (a * x^3 + b, x)".*)
9.370 +(* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
9.371 + val [Const ("Pair", _) $ t $ bdv] = pairl;
9.372 + *)
9.373 +fun argl2dtss [Const ("Pair", _) $ t $ bdv] =
9.374 + [((term_of o the o (parse thy)) "functionTerm", [t]),
9.375 + ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
9.376 + ((term_of o the o (parse thy)) "derivative",
9.377 + [(term_of o the o (parse thy)) "f_'_"])
9.378 + ]
9.379 + | argl2dtss _ = raise error "Diff.ML: wrong argument for argl2dtss";
9.380 +castab :=
9.381 +overwritel (!castab,
9.382 + [((term_of o the o (parse thy)) "Diff",
9.383 + (("Isac.thy", ["derivative_of","function"], ["no_met"]),
9.384 + argl2dtss))
9.385 + ]);
9.386 +
9.387 +(*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
9.388 +(* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
9.389 + val [Const ("Pair", _) $ t $ bdv] = pairl;
9.390 + *)
9.391 +fun argl2dtss [Const ("Pair", _) $ t $ bdv] =
9.392 + [((term_of o the o (parse thy)) "functionEq", [t]),
9.393 + ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
9.394 + ((term_of o the o (parse thy)) "derivativeEq",
9.395 + [(term_of o the o (parse thy)) "f_'_::bool"])
9.396 + ]
9.397 + | argl2dtss _ = raise error "Diff.ML: wrong argument for argl2dtss";
9.398 +castab :=
9.399 +overwritel (!castab,
9.400 + [((term_of o the o (parse thy)) "Differentiate",
9.401 + (("Isac.thy", ["named","derivative_of","function"], ["no_met"]),
9.402 + argl2dtss))
9.403 + ]);
9.404 +*}
9.405 +
9.406 end
9.407 -
9.408 -(* a variant of the derivatives defintion:
9.409 -
9.410 - d_d :: "(real => real) => (real => real)"
9.411 -
9.412 - advantages:
9.413 -(1) no variable 'bdv' on the meta-level required
9.414 -(2) chain_rule "d_d (%x. (u (v x))) = (%x. (d_d u)) (v x) * d_d v"
9.415 -(3) and no specialized chain-rules required like
9.416 - diff_sin_chain "d_d bdv (sin u) = cos u * d_d bdv u"
9.417 -
9.418 - disadvantage: d_d (%x. 1 + x^2) = ... differs from high-school notation
9.419 -*)
10.1 --- a/src/Tools/isac/Knowledge/DiffApp.ML Fri Aug 27 10:39:12 2010 +0200
10.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
10.3 @@ -1,225 +0,0 @@
10.4 -(* tools for applications of differetiation
10.5 - use"DiffApp.ML";
10.6 - use"Knowledge/DiffApp.ML";
10.7 - use"../Knowledge/DiffApp.ML";
10.8 -
10.9 -
10.10 -WN.6.5.03: old decisions in this file partially are being changed
10.11 - in a quick-and-dirty way to make scripts run: Maximum_value,
10.12 - Make_fun_by_new_variable, Make_fun_by_explicit.
10.13 -found to be reconsidered:
10.14 -- descriptions (Descript.thy)
10.15 -- penv: really need term list; or just rerun the whole example with num/var
10.16 -- mk_arg, itms2args ... env in script different from penv ?
10.17 -- L = SubProblem eq ... show some vars on the worksheet ? (other means for
10.18 - referencing are labels (no on worksheet))
10.19 -
10.20 -WN.6.5.03 quick-and-dirty: mk_arg, itms2args just make most convenient env
10.21 - from penv as is.
10.22 - *)
10.23 -
10.24 -
10.25 -(** interface isabelle -- isac **)
10.26 -
10.27 -theory' := overwritel (!theory', [("DiffApp.thy",DiffApp.thy)]);
10.28 -
10.29 -val eval_rls = prep_rls(
10.30 - Rls {id="eval_rls",preconds = [], rew_ord = ("termlessI",termlessI),
10.31 - erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
10.32 - rules = [Thm ("refl",num_str refl),
10.33 - Thm ("le_refl",num_str le_refl),
10.34 - Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
10.35 - Thm ("not_true",num_str not_true),
10.36 - Thm ("not_false",num_str not_false),
10.37 - Thm ("and_true",and_true),
10.38 - Thm ("and_false",and_false),
10.39 - Thm ("or_true",or_true),
10.40 - Thm ("or_false",or_false),
10.41 - Thm ("and_commute",num_str and_commute),
10.42 - Thm ("or_commute",num_str or_commute),
10.43 -
10.44 - Calc ("op <",eval_equ "#less_"),
10.45 - Calc ("op <=",eval_equ "#less_equal_"),
10.46 -
10.47 - Calc ("Atools.ident",eval_ident "#ident_"),
10.48 - Calc ("Atools.is'_const",eval_const "#is_const_"),
10.49 - Calc ("Atools.occurs'_in",eval_occurs_in ""),
10.50 - Calc ("Tools.matches",eval_matches "")
10.51 - ],
10.52 - scr = Script ((term_of o the o (parse thy))
10.53 - "empty_script")
10.54 - }:rls);
10.55 -ruleset' := overwritelthy thy
10.56 - (!ruleset',
10.57 - [("eval_rls",Atools_erls)(*FIXXXME:del with rls.rls'*)
10.58 - ]);
10.59 -
10.60 -
10.61 -(** problem types **)
10.62 -
10.63 -store_pbt
10.64 - (prep_pbt (theory "DiffApp") "pbl_fun_max" [] e_pblID
10.65 - (["maximum_of","function"],
10.66 - [("#Given" ,["fixedValues fix_"]),
10.67 - ("#Find" ,["maximum m_","valuesFor vs_"]),
10.68 - ("#Relate",["relations rs_"])
10.69 - ],
10.70 - e_rls, NONE, []));
10.71 -
10.72 -store_pbt
10.73 - (prep_pbt (theory "DiffApp") "pbl_fun_make" [] e_pblID
10.74 - (["make","function"]:pblID,
10.75 - [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
10.76 - ("#Find" ,["functionEq f_1_"])
10.77 - ],
10.78 - e_rls, NONE, []));
10.79 -store_pbt
10.80 - (prep_pbt (theory "DiffApp") "pbl_fun_max_expl" [] e_pblID
10.81 - (["by_explicit","make","function"]:pblID,
10.82 - [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
10.83 - ("#Find" ,["functionEq f_1_"])
10.84 - ],
10.85 - e_rls, NONE, [["DiffApp","make_fun_by_explicit"]]));
10.86 -store_pbt
10.87 - (prep_pbt (theory "DiffApp") "pbl_fun_max_newvar" [] e_pblID
10.88 - (["by_new_variable","make","function"]:pblID,
10.89 - [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
10.90 - (*WN.12.5.03: precond for distinction still missing*)
10.91 - ("#Find" ,["functionEq f_1_"])
10.92 - ],
10.93 - e_rls, NONE, [["DiffApp","make_fun_by_new_variable"]]));
10.94 -
10.95 -store_pbt
10.96 - (prep_pbt (theory "DiffApp") "pbl_fun_max_interv" [] e_pblID
10.97 - (["on_interval","maximum_of","function"]:pblID,
10.98 - [("#Given" ,["functionEq t_","boundVariable v_","interval itv_"]),
10.99 - (*WN.12.5.03: precond for distinction still missing*)
10.100 - ("#Find" ,["maxArgument v_0_"])
10.101 - ],
10.102 - e_rls, NONE, []));
10.103 -
10.104 -store_pbt
10.105 - (prep_pbt (theory "DiffApp") "pbl_tool" [] e_pblID
10.106 - (["tool"]:pblID,
10.107 - [],
10.108 - e_rls, NONE, []));
10.109 -
10.110 -store_pbt
10.111 - (prep_pbt (theory "DiffApp") "pbl_tool_findvals" [] e_pblID
10.112 - (["find_values","tool"]:pblID,
10.113 - [("#Given" ,["maxArgument ma_","functionEq f_","boundVariable v_"]),
10.114 - ("#Find" ,["valuesFor vls_"]),
10.115 - ("#Relate",["additionalRels rs_"])
10.116 - ],
10.117 - e_rls, NONE, []));
10.118 -
10.119 -
10.120 -(** methods, scripts not yet implemented **)
10.121 -
10.122 -store_met
10.123 - (prep_met Diff.thy "met_diffapp" [] e_metID
10.124 - (["DiffApp"],
10.125 - [],
10.126 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
10.127 - crls = Atools_erls, nrls=norm_Rational
10.128 - (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
10.129 -store_met
10.130 - (prep_met (theory "DiffApp") "met_diffapp_max" [] e_metID
10.131 - (["DiffApp","max_by_calculus"]:metID,
10.132 - [("#Given" ,["fixedValues fix_","maximum m_","relations rs_",
10.133 - "boundVariable v_","interval itv_","errorBound err_"]),
10.134 - ("#Find" ,["valuesFor vs_"]),
10.135 - ("#Relate",[])
10.136 - ],
10.137 - {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls=list_rls,prls=e_rls,
10.138 - crls = eval_rls, nrls=norm_Rational
10.139 - (*, asm_rls=[],asm_thm=[]*)},
10.140 - "Script Maximum_value(fix_::bool list)(m_::real) (rs_::bool list) " ^
10.141 - " (v_::real) (itv_::real set) (err_::bool) = " ^
10.142 - " (let e_ = (hd o (filterVar m_)) rs_; " ^
10.143 - " t_ = (if 1 < length_ rs_ " ^
10.144 - " then (SubProblem (DiffApp_,[make,function],[no_met]) " ^
10.145 - " [real_ m_, real_ v_, bool_list_ rs_]) " ^
10.146 - " else (hd rs_)); " ^
10.147 - " (mx_::real) = " ^
10.148 - "SubProblem(DiffApp_,[on_interval,maximum_of,function], " ^
10.149 - " [DiffApp,max_on_interval_by_calculus]) " ^
10.150 - " [bool_ t_, real_ v_, real_set_ itv_] " ^
10.151 - " in ((SubProblem (DiffApp_,[find_values,tool],[Isac,find_values]) " ^
10.152 - " [real_ mx_, real_ (Rhs t_), real_ v_, real_ m_, " ^
10.153 - " bool_list_ (dropWhile (ident e_) rs_)])::bool list)) "
10.154 - ));
10.155 -store_met
10.156 - (prep_met (theory "DiffApp") "met_diffapp_funnew" [] e_metID
10.157 - (["DiffApp","make_fun_by_new_variable"]:metID,
10.158 - [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
10.159 - ("#Find" ,["functionEq f_1_"])
10.160 - ],
10.161 - {rew_ord'="tless_true",rls'=eval_rls,srls=list_rls,prls=e_rls,
10.162 - calc=[], crls = eval_rls, nrls=norm_Rational(*,asm_rls=[],asm_thm=[]*)},
10.163 - "Script Make_fun_by_new_variable (f_::real) (v_::real) " ^
10.164 - " (eqs_::bool list) = " ^
10.165 - "(let h_ = (hd o (filterVar f_)) eqs_; " ^
10.166 - " es_ = dropWhile (ident h_) eqs_; " ^
10.167 - " vs_ = dropWhile (ident f_) (Vars h_); " ^
10.168 - " v_1 = nth_ 1 vs_; " ^
10.169 - " v_2 = nth_ 2 vs_; " ^
10.170 - " e_1 = (hd o (filterVar v_1)) es_; " ^
10.171 - " e_2 = (hd o (filterVar v_2)) es_; " ^
10.172 - " (s_1::bool list) = " ^
10.173 - " (SubProblem (DiffApp_,[univariate,equation],[no_met])" ^
10.174 - " [bool_ e_1, real_ v_1]); " ^
10.175 - " (s_2::bool list) = " ^
10.176 - " (SubProblem (DiffApp_,[univariate,equation],[no_met])" ^
10.177 - " [bool_ e_2, real_ v_2])" ^
10.178 - "in Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] h_)"
10.179 -));
10.180 -store_met
10.181 -(prep_met (theory "DiffApp") "met_diffapp_funexp" [] e_metID
10.182 -(["DiffApp","make_fun_by_explicit"]:metID,
10.183 - [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
10.184 - ("#Find" ,["functionEq f_1_"])
10.185 - ],
10.186 - {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls=list_rls,prls=e_rls,
10.187 - crls = eval_rls, nrls=norm_Rational
10.188 - (*, asm_rls=[],asm_thm=[]*)},
10.189 - "Script Make_fun_by_explicit (f_::real) (v_::real) " ^
10.190 - " (eqs_::bool list) = " ^
10.191 - " (let h_ = (hd o (filterVar f_)) eqs_; " ^
10.192 - " e_1 = hd (dropWhile (ident h_) eqs_); " ^
10.193 - " vs_ = dropWhile (ident f_) (Vars h_); " ^
10.194 - " v_1 = hd (dropWhile (ident v_) vs_); " ^
10.195 - " (s_1::bool list)= " ^
10.196 - " (SubProblem(DiffApp_,[univariate,equation],[no_met])" ^
10.197 - " [bool_ e_1, real_ v_1]) " ^
10.198 - " in Substitute [(v_1 = (rhs o hd) s_1)] h_) "
10.199 - ));
10.200 -store_met
10.201 - (prep_met (theory "DiffApp") "met_diffapp_max_oninterval" [] e_metID
10.202 - (["DiffApp","max_on_interval_by_calculus"]:metID,
10.203 - [("#Given" ,["functionEq t_","boundVariable v_","interval itv_"(*,
10.204 - "errorBound err_"*)]),
10.205 - ("#Find" ,["maxArgument v_0_"])
10.206 - ],
10.207 - {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls = e_rls,prls=e_rls,
10.208 - crls = eval_rls, nrls=norm_Rational
10.209 - (*, asm_rls=[],asm_thm=[]*)},
10.210 - "empty_script"
10.211 - ));
10.212 -store_met
10.213 - (prep_met (theory "DiffApp") "met_diffapp_findvals" [] e_metID
10.214 - (["DiffApp","find_values"]:metID,
10.215 - [],
10.216 - {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls = e_rls,prls=e_rls,
10.217 - crls = eval_rls, nrls=norm_Rational(*,
10.218 - asm_rls=[],asm_thm=[]*)},
10.219 - "empty_script"));
10.220 -
10.221 -val list_rls = append_rls "list_rls" list_rls
10.222 - [Thm ("filterVar_Const", num_str filterVar_Const),
10.223 - Thm ("filterVar_Nil", num_str filterVar_Nil)
10.224 - ];
10.225 -ruleset' := overwritelthy thy (!ruleset',
10.226 - [("list_rls",list_rls)
10.227 - ]);
10.228 -
11.1 --- a/src/Tools/isac/Knowledge/DiffApp.thy Fri Aug 27 10:39:12 2010 +0200
11.2 +++ b/src/Tools/isac/Knowledge/DiffApp.thy Fri Aug 27 14:56:54 2010 +0200
11.3 @@ -1,30 +1,27 @@
11.4 (* application of differential calculus
11.5 - use_thy_only"../Knowledge/DiffApp";
11.6 - use_thy_only"DiffApp";
11.7 -
11.8 -
11.9 + Walther Neuper 2002
11.10 + (c) due to copyright terms
11.11 *)
11.12
11.13 -
11.14 -DiffApp = Diff +
11.15 +theory DiffApp imports Diff begin
11.16
11.17 consts
11.18
11.19 Maximum'_value
11.20 - :: "[bool list,real,bool list,real,real set,bool,\
11.21 - \ bool list] => bool list"
11.22 + :: "[bool list,real,bool list,real,real set,bool,
11.23 + bool list] => bool list"
11.24 ("((Script Maximum'_value (_ _ _ _ _ _ =))// (_))" 9)
11.25
11.26 Make'_fun'_by'_new'_variable
11.27 - :: "[real,real,bool list, \
11.28 - \ bool] => bool"
11.29 - ("((Script Make'_fun'_by'_new'_variable (_ _ _ =))// \
11.30 - \(_))" 9)
11.31 + :: "[real,real,bool list,
11.32 + bool] => bool"
11.33 + ("((Script Make'_fun'_by'_new'_variable (_ _ _ =))//
11.34 + (_))" 9)
11.35 Make'_fun'_by'_explicit
11.36 - :: "[real,real,bool list, \
11.37 - \ bool] => bool"
11.38 - ("((Script Make'_fun'_by'_explicit (_ _ _ =))// \
11.39 - \(_))" 9)
11.40 + :: "[real,real,bool list,
11.41 + bool] => bool"
11.42 + ("((Script Make'_fun'_by'_explicit (_ _ _ =))//
11.43 + (_))" 9)
11.44
11.45 dummy :: real
11.46
11.47 @@ -33,8 +30,223 @@
11.48
11.49 (*primrec*)rules
11.50 filterVar_Nil "filterVar v [] = []"
11.51 - filterVar_Const "filterVar v (x#xs) = \
11.52 - \(if (v mem (Vars x)) then x#(filterVar v xs) \
11.53 - \ else filterVar v xs) "
11.54 + filterVar_Const "filterVar v (x#xs) =
11.55 + (if (v mem (Vars x)) then x#(filterVar v xs)
11.56 + else filterVar v xs) "
11.57 +text {*WN.6.5.03: old decisions in this file partially are being changed
11.58 + in a quick-and-dirty way to make scripts run: Maximum_value,
11.59 + Make_fun_by_new_variable, Make_fun_by_explicit.
11.60 +found to be reconsidered:
11.61 +- descriptions (Descript.thy)
11.62 +- penv: really need term list; or just rerun the whole example with num/var
11.63 +- mk_arg, itms2args ... env in script different from penv ?
11.64 +- L = SubProblem eq ... show some vars on the worksheet ? (other means for
11.65 + referencing are labels (no on worksheet))
11.66 +
11.67 +WN.6.5.03 quick-and-dirty: mk_arg, itms2args just make most convenient env
11.68 + from penv as is.
11.69 +*}
11.70 +
11.71 +ML {*
11.72 +val eval_rls = prep_rls(
11.73 + Rls {id="eval_rls",preconds = [], rew_ord = ("termlessI",termlessI),
11.74 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
11.75 + rules = [Thm ("refl",num_str refl),
11.76 + Thm ("le_refl",num_str le_refl),
11.77 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
11.78 + Thm ("not_true",num_str not_true),
11.79 + Thm ("not_false",num_str not_false),
11.80 + Thm ("and_true",and_true),
11.81 + Thm ("and_false",and_false),
11.82 + Thm ("or_true",or_true),
11.83 + Thm ("or_false",or_false),
11.84 + Thm ("and_commute",num_str and_commute),
11.85 + Thm ("or_commute",num_str or_commute),
11.86 +
11.87 + Calc ("op <",eval_equ "#less_"),
11.88 + Calc ("op <=",eval_equ "#less_equal_"),
11.89 +
11.90 + Calc ("Atools.ident",eval_ident "#ident_"),
11.91 + Calc ("Atools.is'_const",eval_const "#is_const_"),
11.92 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
11.93 + Calc ("Tools.matches",eval_matches "")
11.94 + ],
11.95 + scr = Script ((term_of o the o (parse thy))
11.96 + "empty_script")
11.97 + }:rls);
11.98 +ruleset' := overwritelthy thy
11.99 + (!ruleset',
11.100 + [("eval_rls",Atools_erls)(*FIXXXME:del with rls.rls'*)
11.101 + ]);
11.102 +
11.103 +
11.104 +(** problem types **)
11.105 +
11.106 +store_pbt
11.107 + (prep_pbt (theory "DiffApp") "pbl_fun_max" [] e_pblID
11.108 + (["maximum_of","function"],
11.109 + [("#Given" ,["fixedValues fix_"]),
11.110 + ("#Find" ,["maximum m_","valuesFor vs_"]),
11.111 + ("#Relate",["relations rs_"])
11.112 + ],
11.113 + e_rls, NONE, []));
11.114 +
11.115 +store_pbt
11.116 + (prep_pbt (theory "DiffApp") "pbl_fun_make" [] e_pblID
11.117 + (["make","function"]:pblID,
11.118 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
11.119 + ("#Find" ,["functionEq f_1_"])
11.120 + ],
11.121 + e_rls, NONE, []));
11.122 +store_pbt
11.123 + (prep_pbt (theory "DiffApp") "pbl_fun_max_expl" [] e_pblID
11.124 + (["by_explicit","make","function"]:pblID,
11.125 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
11.126 + ("#Find" ,["functionEq f_1_"])
11.127 + ],
11.128 + e_rls, NONE, [["DiffApp","make_fun_by_explicit"]]));
11.129 +store_pbt
11.130 + (prep_pbt (theory "DiffApp") "pbl_fun_max_newvar" [] e_pblID
11.131 + (["by_new_variable","make","function"]:pblID,
11.132 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
11.133 + (*WN.12.5.03: precond for distinction still missing*)
11.134 + ("#Find" ,["functionEq f_1_"])
11.135 + ],
11.136 + e_rls, NONE, [["DiffApp","make_fun_by_new_variable"]]));
11.137 +
11.138 +store_pbt
11.139 + (prep_pbt (theory "DiffApp") "pbl_fun_max_interv" [] e_pblID
11.140 + (["on_interval","maximum_of","function"]:pblID,
11.141 + [("#Given" ,["functionEq t_","boundVariable v_","interval itv_"]),
11.142 + (*WN.12.5.03: precond for distinction still missing*)
11.143 + ("#Find" ,["maxArgument v_0_"])
11.144 + ],
11.145 + e_rls, NONE, []));
11.146 +
11.147 +store_pbt
11.148 + (prep_pbt (theory "DiffApp") "pbl_tool" [] e_pblID
11.149 + (["tool"]:pblID,
11.150 + [],
11.151 + e_rls, NONE, []));
11.152 +
11.153 +store_pbt
11.154 + (prep_pbt (theory "DiffApp") "pbl_tool_findvals" [] e_pblID
11.155 + (["find_values","tool"]:pblID,
11.156 + [("#Given" ,["maxArgument ma_","functionEq f_","boundVariable v_"]),
11.157 + ("#Find" ,["valuesFor vls_"]),
11.158 + ("#Relate",["additionalRels rs_"])
11.159 + ],
11.160 + e_rls, NONE, []));
11.161 +
11.162 +
11.163 +(** methods, scripts not yet implemented **)
11.164 +
11.165 +store_met
11.166 + (prep_met (theory "DiffApp") "met_diffapp" [] e_metID
11.167 + (["DiffApp"],
11.168 + [],
11.169 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
11.170 + crls = Atools_erls, nrls=norm_Rational
11.171 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
11.172 +store_met
11.173 + (prep_met (theory "DiffApp") "met_diffapp_max" [] e_metID
11.174 + (["DiffApp","max_by_calculus"]:metID,
11.175 + [("#Given" ,["fixedValues fix_","maximum m_","relations rs_",
11.176 + "boundVariable v_","interval itv_","errorBound err_"]),
11.177 + ("#Find" ,["valuesFor vs_"]),
11.178 + ("#Relate",[])
11.179 + ],
11.180 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls=list_rls,prls=e_rls,
11.181 + crls = eval_rls, nrls=norm_Rational
11.182 + (*, asm_rls=[],asm_thm=[]*)},
11.183 + "Script Maximum_value(fix_::bool list)(m_::real) (rs_::bool list) " ^
11.184 + " (v_::real) (itv_::real set) (err_::bool) = " ^
11.185 + " (let e_ = (hd o (filterVar m_)) rs_; " ^
11.186 + " t_ = (if 1 < length_ rs_ " ^
11.187 + " then (SubProblem (DiffApp_,[make,function],[no_met]) " ^
11.188 + " [real_ m_, real_ v_, bool_list_ rs_]) " ^
11.189 + " else (hd rs_)); " ^
11.190 + " (mx_::real) = " ^
11.191 + "SubProblem(DiffApp_,[on_interval,maximum_of,function], " ^
11.192 + " [DiffApp,max_on_interval_by_calculus]) " ^
11.193 + " [bool_ t_, real_ v_, real_set_ itv_] " ^
11.194 + " in ((SubProblem (DiffApp_,[find_values,tool],[Isac,find_values]) " ^
11.195 + " [real_ mx_, real_ (Rhs t_), real_ v_, real_ m_, " ^
11.196 + " bool_list_ (dropWhile (ident e_) rs_)])::bool list)) "
11.197 + ));
11.198 +store_met
11.199 + (prep_met (theory "DiffApp") "met_diffapp_funnew" [] e_metID
11.200 + (["DiffApp","make_fun_by_new_variable"]:metID,
11.201 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
11.202 + ("#Find" ,["functionEq f_1_"])
11.203 + ],
11.204 + {rew_ord'="tless_true",rls'=eval_rls,srls=list_rls,prls=e_rls,
11.205 + calc=[], crls = eval_rls, nrls=norm_Rational(*,asm_rls=[],asm_thm=[]*)},
11.206 + "Script Make_fun_by_new_variable (f_::real) (v_::real) " ^
11.207 + " (eqs_::bool list) = " ^
11.208 + "(let h_ = (hd o (filterVar f_)) eqs_; " ^
11.209 + " es_ = dropWhile (ident h_) eqs_; " ^
11.210 + " vs_ = dropWhile (ident f_) (Vars h_); " ^
11.211 + " v_1 = nth_ 1 vs_; " ^
11.212 + " v_2 = nth_ 2 vs_; " ^
11.213 + " e_1 = (hd o (filterVar v_1)) es_; " ^
11.214 + " e_2 = (hd o (filterVar v_2)) es_; " ^
11.215 + " (s_1::bool list) = " ^
11.216 + " (SubProblem (DiffApp_,[univariate,equation],[no_met])" ^
11.217 + " [bool_ e_1, real_ v_1]); " ^
11.218 + " (s_2::bool list) = " ^
11.219 + " (SubProblem (DiffApp_,[univariate,equation],[no_met])" ^
11.220 + " [bool_ e_2, real_ v_2])" ^
11.221 + "in Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] h_)"
11.222 +));
11.223 +store_met
11.224 +(prep_met (theory "DiffApp") "met_diffapp_funexp" [] e_metID
11.225 +(["DiffApp","make_fun_by_explicit"]:metID,
11.226 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
11.227 + ("#Find" ,["functionEq f_1_"])
11.228 + ],
11.229 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls=list_rls,prls=e_rls,
11.230 + crls = eval_rls, nrls=norm_Rational
11.231 + (*, asm_rls=[],asm_thm=[]*)},
11.232 + "Script Make_fun_by_explicit (f_::real) (v_::real) " ^
11.233 + " (eqs_::bool list) = " ^
11.234 + " (let h_ = (hd o (filterVar f_)) eqs_; " ^
11.235 + " e_1 = hd (dropWhile (ident h_) eqs_); " ^
11.236 + " vs_ = dropWhile (ident f_) (Vars h_); " ^
11.237 + " v_1 = hd (dropWhile (ident v_) vs_); " ^
11.238 + " (s_1::bool list)= " ^
11.239 + " (SubProblem(DiffApp_,[univariate,equation],[no_met])" ^
11.240 + " [bool_ e_1, real_ v_1]) " ^
11.241 + " in Substitute [(v_1 = (rhs o hd) s_1)] h_) "
11.242 + ));
11.243 +store_met
11.244 + (prep_met (theory "DiffApp") "met_diffapp_max_oninterval" [] e_metID
11.245 + (["DiffApp","max_on_interval_by_calculus"]:metID,
11.246 + [("#Given" ,["functionEq t_","boundVariable v_","interval itv_"(*,
11.247 + "errorBound err_"*)]),
11.248 + ("#Find" ,["maxArgument v_0_"])
11.249 + ],
11.250 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls = e_rls,prls=e_rls,
11.251 + crls = eval_rls, nrls=norm_Rational
11.252 + (*, asm_rls=[],asm_thm=[]*)},
11.253 + "empty_script"
11.254 + ));
11.255 +store_met
11.256 + (prep_met (theory "DiffApp") "met_diffapp_findvals" [] e_metID
11.257 + (["DiffApp","find_values"]:metID,
11.258 + [],
11.259 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls = e_rls,prls=e_rls,
11.260 + crls = eval_rls, nrls=norm_Rational(*,
11.261 + asm_rls=[],asm_thm=[]*)},
11.262 + "empty_script"));
11.263 +
11.264 +val list_rls = append_rls "list_rls" list_rls
11.265 + [Thm ("filterVar_Const", num_str filterVar_Const),
11.266 + Thm ("filterVar_Nil", num_str filterVar_Nil)
11.267 + ];
11.268 +ruleset' := overwritelthy thy (!ruleset',
11.269 + [("list_rls",list_rls)
11.270 + ]);
11.271 +*}
11.272
11.273 end
11.274 \ No newline at end of file
12.1 --- a/src/Tools/isac/Knowledge/EqSystem.ML Fri Aug 27 10:39:12 2010 +0200
12.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
12.3 @@ -1,669 +0,0 @@
12.4 -(* tools for systems of equations over the reals
12.5 - author: Walther Neuper 050905, 08:51
12.6 - (c) due to copyright terms
12.7 -
12.8 -use"Knowledge/EqSystem.ML";
12.9 -use"EqSystem.ML";
12.10 -
12.11 -remove_thy"EqSystem";
12.12 -use_thy"Knowledge/Isac";
12.13 -*)
12.14 -
12.15 -(** interface isabelle -- isac **)
12.16 -
12.17 -theory' := overwritel (!theory', [("EqSystem.thy",EqSystem.thy)]);
12.18 -
12.19 -(** eval functions **)
12.20 -
12.21 -(*certain variables of a given list occur _all_ in a term
12.22 - args: all: ..variables, which are under consideration (eg. the bound vars)
12.23 - vs: variables which must be in t,
12.24 - and none of the others in all must be in t
12.25 - t: the term under consideration
12.26 - *)
12.27 -fun occur_exactly_in vs all t =
12.28 - let fun occurs_in' a b = occurs_in b a
12.29 - in foldl and_ (true, map (occurs_in' t) vs)
12.30 - andalso not (foldl or_ (false, map (occurs_in' t)
12.31 - (subtract op = vs all)))
12.32 - end;
12.33 -
12.34 -(*("occur_exactly_in", ("EqSystem.occur'_exactly'_in",
12.35 - eval_occur_exactly_in "#eval_occur_exactly_in_"))*)
12.36 -fun eval_occur_exactly_in _ "EqSystem.occur'_exactly'_in"
12.37 - (p as (Const ("EqSystem.occur'_exactly'_in",_)
12.38 - $ vs $ all $ t)) _ =
12.39 - if occur_exactly_in (isalist2list vs) (isalist2list all) t
12.40 - then SOME ((term2str p) ^ " = True",
12.41 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
12.42 - else SOME ((term2str p) ^ " = False",
12.43 - Trueprop $ (mk_equality (p, HOLogic.false_const)))
12.44 - | eval_occur_exactly_in _ _ _ _ = NONE;
12.45 -
12.46 -calclist':=
12.47 -overwritel (!calclist',
12.48 - [("occur_exactly_in",
12.49 - ("EqSystem.occur'_exactly'_in",
12.50 - eval_occur_exactly_in "#eval_occur_exactly_in_"))
12.51 - ]);
12.52 -
12.53 -
12.54 -(** rewrite order 'ord_simplify_System' **)
12.55 -
12.56 -(* order wrt. several linear (i.e. without exponents) variables "c","c_2",..
12.57 - which leaves the monomials containing c, c_2,... at the end of an Integral
12.58 - and puts the c, c_2,... rightmost within a monomial.
12.59 -
12.60 - WN050906 this is a quick and dirty adaption of ord_make_polynomial_in,
12.61 - which was most adequate, because it uses size_of_term*)
12.62 -(**)
12.63 -local (*. for simplify_System .*)
12.64 -(**)
12.65 -open Term; (* for type order = EQUAL | LESS | GREATER *)
12.66 -
12.67 -fun pr_ord EQUAL = "EQUAL"
12.68 - | pr_ord LESS = "LESS"
12.69 - | pr_ord GREATER = "GREATER";
12.70 -
12.71 -fun dest_hd' (Const (a, T)) = (((a, 0), T), 0)
12.72 - | dest_hd' (Free (ccc, T)) =
12.73 - (case explode ccc of
12.74 - "c"::[] => ((("|||||||||||||||||||||", 0), T), 1)(*greatest string WN*)
12.75 - | "c"::"_"::_ => ((("|||||||||||||||||||||", 0), T), 1)
12.76 - | _ => (((ccc, 0), T), 1))
12.77 - | dest_hd' (Var v) = (v, 2)
12.78 - | dest_hd' (Bound i) = ((("", i), dummyT), 3)
12.79 - | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
12.80 -
12.81 -fun size_of_term' (Free (ccc, _)) =
12.82 - (case explode ccc of (*WN0510 hack for the bound variables*)
12.83 - "c"::[] => 1000
12.84 - | "c"::"_"::is => 1000 * ((str2int o implode) is)
12.85 - | _ => 1)
12.86 - | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
12.87 - | size_of_term' (f$t) = size_of_term' f + size_of_term' t
12.88 - | size_of_term' _ = 1;
12.89 -
12.90 -fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
12.91 - (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
12.92 - | term_ord' pr thy (t, u) =
12.93 - (if pr then
12.94 - let
12.95 - val (f, ts) = strip_comb t and (g, us) = strip_comb u;
12.96 - val _=writeln("t= f@ts= \""^
12.97 - ((Syntax.string_of_term (thy2ctxt thy)) f)^"\" @ \"["^
12.98 - (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
12.99 - val _=writeln("u= g@us= \""^
12.100 - ((Syntax.string_of_term (thy2ctxt thy)) g)^"\" @ \"["^
12.101 - (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
12.102 - val _=writeln("size_of_term(t,u)= ("^
12.103 - (string_of_int(size_of_term' t))^", "^
12.104 - (string_of_int(size_of_term' u))^")");
12.105 - val _=writeln("hd_ord(f,g) = "^((pr_ord o hd_ord)(f,g)));
12.106 - val _=writeln("terms_ord(ts,us) = "^
12.107 - ((pr_ord o terms_ord str false)(ts,us)));
12.108 - val _=writeln("-------");
12.109 - in () end
12.110 - else ();
12.111 - case int_ord (size_of_term' t, size_of_term' u) of
12.112 - EQUAL =>
12.113 - let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
12.114 - (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
12.115 - | ord => ord)
12.116 - end
12.117 - | ord => ord)
12.118 -and hd_ord (f, g) = (* ~ term.ML *)
12.119 - prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f,
12.120 - dest_hd' g)
12.121 -and terms_ord str pr (ts, us) =
12.122 - list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
12.123 -(**)
12.124 -in
12.125 -(**)
12.126 -(*WN0510 for preliminary use in eval_order_system, see case-study mat-eng.tex
12.127 -fun ord_simplify_System_rev (pr:bool) thy subst tu =
12.128 - (term_ord' pr thy (Library.swap tu) = LESS);*)
12.129 -
12.130 -(*for the rls's*)
12.131 -fun ord_simplify_System (pr:bool) thy subst tu =
12.132 - (term_ord' pr thy tu = LESS);
12.133 -(**)
12.134 -end;
12.135 -(**)
12.136 -rew_ord' := overwritel (!rew_ord',
12.137 -[("ord_simplify_System", ord_simplify_System false thy)
12.138 - ]);
12.139 -
12.140 -
12.141 -(** rulesets **)
12.142 -
12.143 -(*.adapted from 'order_add_mult_in' by just replacing the rew_ord.*)
12.144 -val order_add_mult_System =
12.145 - Rls{id = "order_add_mult_System", preconds = [],
12.146 - rew_ord = ("ord_simplify_System",
12.147 - ord_simplify_System false (theory "Integrate")),
12.148 - erls = e_rls,srls = Erls, calc = [],
12.149 - rules = [Thm ("real_mult_commute",num_str real_mult_commute),
12.150 - (* z * w = w * z *)
12.151 - Thm ("real_mult_left_commute",num_str real_mult_left_commute),
12.152 - (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
12.153 - Thm ("real_mult_assoc",num_str real_mult_assoc),
12.154 - (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
12.155 - Thm ("real_add_commute",num_str real_add_commute),
12.156 - (*z + w = w + z*)
12.157 - Thm ("real_add_left_commute",num_str real_add_left_commute),
12.158 - (*x + (y + z) = y + (x + z)*)
12.159 - Thm ("real_add_assoc",num_str real_add_assoc)
12.160 - (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
12.161 - ],
12.162 - scr = EmptyScr}:rls;
12.163 -
12.164 -(*.adapted from 'norm_Rational' by
12.165 - #1 using 'ord_simplify_System' in 'order_add_mult_System'
12.166 - #2 NOT using common_nominator_p .*)
12.167 -val norm_System_noadd_fractions =
12.168 - Rls {id = "norm_System_noadd_fractions", preconds = [],
12.169 - rew_ord = ("dummy_ord",dummy_ord),
12.170 - erls = norm_rat_erls, srls = Erls, calc = [],
12.171 - rules = [(*sequence given by operator precedence*)
12.172 - Rls_ discard_minus,
12.173 - Rls_ powers,
12.174 - Rls_ rat_mult_divide,
12.175 - Rls_ expand,
12.176 - Rls_ reduce_0_1_2,
12.177 - Rls_ (*order_add_mult #1*) order_add_mult_System,
12.178 - Rls_ collect_numerals,
12.179 - (*Rls_ add_fractions_p, #2*)
12.180 - Rls_ cancel_p
12.181 - ],
12.182 - scr = Script ((term_of o the o (parse thy))
12.183 - "empty_script")
12.184 - }:rls;
12.185 -(*.adapted from 'norm_Rational' by
12.186 - *1* using 'ord_simplify_System' in 'order_add_mult_System'.*)
12.187 -val norm_System =
12.188 - Rls {id = "norm_System", preconds = [],
12.189 - rew_ord = ("dummy_ord",dummy_ord),
12.190 - erls = norm_rat_erls, srls = Erls, calc = [],
12.191 - rules = [(*sequence given by operator precedence*)
12.192 - Rls_ discard_minus,
12.193 - Rls_ powers,
12.194 - Rls_ rat_mult_divide,
12.195 - Rls_ expand,
12.196 - Rls_ reduce_0_1_2,
12.197 - Rls_ (*order_add_mult *1*) order_add_mult_System,
12.198 - Rls_ collect_numerals,
12.199 - Rls_ add_fractions_p,
12.200 - Rls_ cancel_p
12.201 - ],
12.202 - scr = Script ((term_of o the o (parse thy))
12.203 - "empty_script")
12.204 - }:rls;
12.205 -
12.206 -(*.simplify an equational system BEFORE solving it such that parentheses are
12.207 - ( ((u0*v0)*w0) + ( ((u1*v1)*w1) * c + ... +((u4*v4)*w4) * c_4 ) )
12.208 -ATTENTION: works ONLY for bound variables c, c_1, c_2, c_3, c_4 :ATTENTION
12.209 - This is a copy from 'make_ratpoly_in' with respective reductions:
12.210 - *0* expand the term, ie. distribute * and / over +
12.211 - *1* ord_simplify_System instead of termlessI
12.212 - *2* no add_fractions_p (= common_nominator_p_rls !)
12.213 - *3* discard_parentheses only for (.*(.*.))
12.214 - analoguous to simplify_Integral .*)
12.215 -val simplify_System_parenthesized =
12.216 - Seq {id = "simplify_System_parenthesized", preconds = []:term list,
12.217 - rew_ord = ("dummy_ord", dummy_ord),
12.218 - erls = Atools_erls, srls = Erls, calc = [],
12.219 - rules = [Thm ("real_add_mult_distrib",num_str real_add_mult_distrib),
12.220 - (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
12.221 - Thm ("real_add_divide_distrib",num_str real_add_divide_distrib),
12.222 - (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
12.223 - (*^^^^^ *0* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
12.224 - Rls_ norm_Rational_noadd_fractions(**2**),
12.225 - Rls_ (*order_add_mult_in*) norm_System_noadd_fractions (**1**),
12.226 - Thm ("sym_real_mult_assoc", num_str (real_mult_assoc RS sym))
12.227 - (*Rls_ discard_parentheses *3**),
12.228 - Rls_ collect_bdv, (*from make_polynomial_in WN051031 welldone?*)
12.229 - Rls_ separate_bdv2,
12.230 - Calc ("HOL.divide" ,eval_cancel "#divide_")
12.231 - ],
12.232 - scr = EmptyScr}:rls;
12.233 -
12.234 -(*.simplify an equational system AFTER solving it;
12.235 - This is a copy of 'make_ratpoly_in' with the differences
12.236 - *1* ord_simplify_System instead of termlessI .*)
12.237 -(*TODO.WN051031 ^^^^^^^^^^ should be in EACH rls contained *)
12.238 -val simplify_System =
12.239 - Seq {id = "simplify_System", preconds = []:term list,
12.240 - rew_ord = ("dummy_ord", dummy_ord),
12.241 - erls = Atools_erls, srls = Erls, calc = [],
12.242 - rules = [Rls_ norm_Rational,
12.243 - Rls_ (*order_add_mult_in*) norm_System (**1**),
12.244 - Rls_ discard_parentheses,
12.245 - Rls_ collect_bdv, (*from make_polynomial_in WN051031 welldone?*)
12.246 - Rls_ separate_bdv2,
12.247 - Calc ("HOL.divide" ,eval_cancel "#divide_")
12.248 - ],
12.249 - scr = EmptyScr}:rls;
12.250 -(*
12.251 -val simplify_System =
12.252 - append_rls "simplify_System" simplify_System_parenthesized
12.253 - [Thm ("sym_real_add_assoc", num_str (real_add_assoc RS sym))];
12.254 -*)
12.255 -
12.256 -val isolate_bdvs =
12.257 - Rls {id="isolate_bdvs", preconds = [],
12.258 - rew_ord = ("e_rew_ord", e_rew_ord),
12.259 - erls = append_rls "erls_isolate_bdvs" e_rls
12.260 - [(Calc ("EqSystem.occur'_exactly'_in",
12.261 - eval_occur_exactly_in
12.262 - "#eval_occur_exactly_in_"))
12.263 - ],
12.264 - srls = Erls, calc = [],
12.265 - rules = [Thm ("commute_0_equality",
12.266 - num_str commute_0_equality),
12.267 - Thm ("separate_bdvs_add", num_str separate_bdvs_add),
12.268 - Thm ("separate_bdvs_mult", num_str separate_bdvs_mult)],
12.269 - scr = EmptyScr};
12.270 -val isolate_bdvs_4x4 =
12.271 - Rls {id="isolate_bdvs_4x4", preconds = [],
12.272 - rew_ord = ("e_rew_ord", e_rew_ord),
12.273 - erls = append_rls
12.274 - "erls_isolate_bdvs_4x4" e_rls
12.275 - [Calc ("EqSystem.occur'_exactly'_in",
12.276 - eval_occur_exactly_in "#eval_occur_exactly_in_"),
12.277 - Calc ("Atools.ident",eval_ident "#ident_"),
12.278 - Calc ("Atools.some'_occur'_in",
12.279 - eval_some_occur_in "#some_occur_in_"),
12.280 - Thm ("not_true",num_str not_true),
12.281 - Thm ("not_false",num_str not_false)
12.282 - ],
12.283 - srls = Erls, calc = [],
12.284 - rules = [Thm ("commute_0_equality",
12.285 - num_str commute_0_equality),
12.286 - Thm ("separate_bdvs0", num_str separate_bdvs0),
12.287 - Thm ("separate_bdvs_add1", num_str separate_bdvs_add1),
12.288 - Thm ("separate_bdvs_add1", num_str separate_bdvs_add2),
12.289 - Thm ("separate_bdvs_mult", num_str separate_bdvs_mult)],
12.290 - scr = EmptyScr};
12.291 -
12.292 -(*.order the equations in a system such, that a triangular system (if any)
12.293 - appears as [..c_4 = .., ..., ..., ..c_1 + ..c_2 + ..c_3 ..c_4 = ..].*)
12.294 -val order_system =
12.295 - Rls {id="order_system", preconds = [],
12.296 - rew_ord = ("ord_simplify_System",
12.297 - ord_simplify_System false thy),
12.298 - erls = Erls, srls = Erls, calc = [],
12.299 - rules = [Thm ("order_system_NxN", num_str order_system_NxN)
12.300 - ],
12.301 - scr = EmptyScr};
12.302 -
12.303 -val prls_triangular =
12.304 - Rls {id="prls_triangular", preconds = [],
12.305 - rew_ord = ("e_rew_ord", e_rew_ord),
12.306 - erls = Rls {id="erls_prls_triangular", preconds = [],
12.307 - rew_ord = ("e_rew_ord", e_rew_ord),
12.308 - erls = Erls, srls = Erls, calc = [],
12.309 - rules = [(*for precond nth_Cons_ ...*)
12.310 - Calc ("op <",eval_equ "#less_"),
12.311 - Calc ("op +", eval_binop "#add_")
12.312 - (*immediately repeated rewrite pushes
12.313 - '+' into precondition !*)
12.314 - ],
12.315 - scr = EmptyScr},
12.316 - srls = Erls, calc = [],
12.317 - rules = [Thm ("nth_Cons_",num_str nth_Cons_),
12.318 - Calc ("op +", eval_binop "#add_"),
12.319 - Thm ("nth_Nil_",num_str nth_Nil_),
12.320 - Thm ("tl_Cons",num_str tl_Cons),
12.321 - Thm ("tl_Nil",num_str tl_Nil),
12.322 - Calc ("EqSystem.occur'_exactly'_in",
12.323 - eval_occur_exactly_in
12.324 - "#eval_occur_exactly_in_")
12.325 - ],
12.326 - scr = EmptyScr};
12.327 -
12.328 -(*WN060914 quickly created for 4x4;
12.329 - more similarity to prls_triangular desirable*)
12.330 -val prls_triangular4 =
12.331 - Rls {id="prls_triangular4", preconds = [],
12.332 - rew_ord = ("e_rew_ord", e_rew_ord),
12.333 - erls = Rls {id="erls_prls_triangular4", preconds = [],
12.334 - rew_ord = ("e_rew_ord", e_rew_ord),
12.335 - erls = Erls, srls = Erls, calc = [],
12.336 - rules = [(*for precond nth_Cons_ ...*)
12.337 - Calc ("op <",eval_equ "#less_"),
12.338 - Calc ("op +", eval_binop "#add_")
12.339 - (*immediately repeated rewrite pushes
12.340 - '+' into precondition !*)
12.341 - ],
12.342 - scr = EmptyScr},
12.343 - srls = Erls, calc = [],
12.344 - rules = [Thm ("nth_Cons_",num_str nth_Cons_),
12.345 - Calc ("op +", eval_binop "#add_"),
12.346 - Thm ("nth_Nil_",num_str nth_Nil_),
12.347 - Thm ("tl_Cons",num_str tl_Cons),
12.348 - Thm ("tl_Nil",num_str tl_Nil),
12.349 - Calc ("EqSystem.occur'_exactly'_in",
12.350 - eval_occur_exactly_in
12.351 - "#eval_occur_exactly_in_")
12.352 - ],
12.353 - scr = EmptyScr};
12.354 -
12.355 -ruleset' :=
12.356 -overwritelthy thy
12.357 - (!ruleset',
12.358 -[("simplify_System_parenthesized", prep_rls simplify_System_parenthesized),
12.359 - ("simplify_System", prep_rls simplify_System),
12.360 - ("isolate_bdvs", prep_rls isolate_bdvs),
12.361 - ("isolate_bdvs_4x4", prep_rls isolate_bdvs_4x4),
12.362 - ("order_system", prep_rls order_system),
12.363 - ("order_add_mult_System", prep_rls order_add_mult_System),
12.364 - ("norm_System_noadd_fractions", prep_rls norm_System_noadd_fractions),
12.365 - ("norm_System", prep_rls norm_System)
12.366 - ]);
12.367 -
12.368 -
12.369 -(** problems **)
12.370 -
12.371 -store_pbt
12.372 - (prep_pbt EqSystem.thy "pbl_equsys" [] e_pblID
12.373 - (["system"],
12.374 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.375 - ("#Find" ,["solution ss___"](*___ is copy-named*))
12.376 - ],
12.377 - append_rls "e_rls" e_rls [(*for preds in where_*)],
12.378 - SOME "solveSystem es_ vs_",
12.379 - []));
12.380 -store_pbt
12.381 - (prep_pbt EqSystem.thy "pbl_equsys_lin" [] e_pblID
12.382 - (["linear", "system"],
12.383 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.384 - (*TODO.WN050929 check linearity*)
12.385 - ("#Find" ,["solution ss___"])
12.386 - ],
12.387 - append_rls "e_rls" e_rls [(*for preds in where_*)],
12.388 - SOME "solveSystem es_ vs_",
12.389 - []));
12.390 -store_pbt
12.391 - (prep_pbt EqSystem.thy "pbl_equsys_lin_2x2" [] e_pblID
12.392 - (["2x2", "linear", "system"],
12.393 - (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
12.394 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.395 - ("#Where" ,["length_ (es_:: bool list) = 2", "length_ vs_ = 2"]),
12.396 - ("#Find" ,["solution ss___"])
12.397 - ],
12.398 - append_rls "prls_2x2_linear_system" e_rls
12.399 - [Thm ("length_Cons_",num_str length_Cons_),
12.400 - Thm ("length_Nil_",num_str length_Nil_),
12.401 - Calc ("op +", eval_binop "#add_"),
12.402 - Calc ("op =",eval_equal "#equal_")
12.403 - ],
12.404 - SOME "solveSystem es_ vs_",
12.405 - []));
12.406 -store_pbt
12.407 - (prep_pbt EqSystem.thy "pbl_equsys_lin_2x2_tri" [] e_pblID
12.408 - (["triangular", "2x2", "linear", "system"],
12.409 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.410 - ("#Where" ,
12.411 - ["(tl vs_) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))",
12.412 - " vs_ from_ vs_ occur_exactly_in (nth_ 2 (es_::bool list))"]),
12.413 - ("#Find" ,["solution ss___"])
12.414 - ],
12.415 - prls_triangular,
12.416 - SOME "solveSystem es_ vs_",
12.417 - [["EqSystem","top_down_substitution","2x2"]]));
12.418 -store_pbt
12.419 - (prep_pbt EqSystem.thy "pbl_equsys_lin_2x2_norm" [] e_pblID
12.420 - (["normalize", "2x2", "linear", "system"],
12.421 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.422 - ("#Find" ,["solution ss___"])
12.423 - ],
12.424 - append_rls "e_rls" e_rls [(*for preds in where_*)],
12.425 - SOME "solveSystem es_ vs_",
12.426 - [["EqSystem","normalize","2x2"]]));
12.427 -store_pbt
12.428 - (prep_pbt EqSystem.thy "pbl_equsys_lin_3x3" [] e_pblID
12.429 - (["3x3", "linear", "system"],
12.430 - (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
12.431 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.432 - ("#Where" ,["length_ (es_:: bool list) = 3", "length_ vs_ = 3"]),
12.433 - ("#Find" ,["solution ss___"])
12.434 - ],
12.435 - append_rls "prls_3x3_linear_system" e_rls
12.436 - [Thm ("length_Cons_",num_str length_Cons_),
12.437 - Thm ("length_Nil_",num_str length_Nil_),
12.438 - Calc ("op +", eval_binop "#add_"),
12.439 - Calc ("op =",eval_equal "#equal_")
12.440 - ],
12.441 - SOME "solveSystem es_ vs_",
12.442 - []));
12.443 -store_pbt
12.444 - (prep_pbt EqSystem.thy "pbl_equsys_lin_4x4" [] e_pblID
12.445 - (["4x4", "linear", "system"],
12.446 - (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
12.447 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.448 - ("#Where" ,["length_ (es_:: bool list) = 4", "length_ vs_ = 4"]),
12.449 - ("#Find" ,["solution ss___"])
12.450 - ],
12.451 - append_rls "prls_4x4_linear_system" e_rls
12.452 - [Thm ("length_Cons_",num_str length_Cons_),
12.453 - Thm ("length_Nil_",num_str length_Nil_),
12.454 - Calc ("op +", eval_binop "#add_"),
12.455 - Calc ("op =",eval_equal "#equal_")
12.456 - ],
12.457 - SOME "solveSystem es_ vs_",
12.458 - []));
12.459 -store_pbt
12.460 - (prep_pbt EqSystem.thy "pbl_equsys_lin_4x4_tri" [] e_pblID
12.461 - (["triangular", "4x4", "linear", "system"],
12.462 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.463 - ("#Where" , (*accepts missing variables up to diagional form*)
12.464 - ["(nth_ 1 (vs_::real list)) occurs_in (nth_ 1 (es_::bool list))",
12.465 - "(nth_ 2 (vs_::real list)) occurs_in (nth_ 2 (es_::bool list))",
12.466 - "(nth_ 3 (vs_::real list)) occurs_in (nth_ 3 (es_::bool list))",
12.467 - "(nth_ 4 (vs_::real list)) occurs_in (nth_ 4 (es_::bool list))"
12.468 - ]),
12.469 - ("#Find" ,["solution ss___"])
12.470 - ],
12.471 - append_rls "prls_tri_4x4_lin_sys" prls_triangular
12.472 - [Calc ("Atools.occurs'_in",eval_occurs_in "")],
12.473 - SOME "solveSystem es_ vs_",
12.474 - [["EqSystem","top_down_substitution","4x4"]]));
12.475 -
12.476 -store_pbt
12.477 - (prep_pbt EqSystem.thy "pbl_equsys_lin_4x4_norm" [] e_pblID
12.478 - (["normalize", "4x4", "linear", "system"],
12.479 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.480 - (*length_ is checked 1 level above*)
12.481 - ("#Find" ,["solution ss___"])
12.482 - ],
12.483 - append_rls "e_rls" e_rls [(*for preds in where_*)],
12.484 - SOME "solveSystem es_ vs_",
12.485 - [["EqSystem","normalize","4x4"]]));
12.486 -
12.487 -
12.488 -(* show_ptyps();
12.489 - *)
12.490 -
12.491 -(** methods **)
12.492 -
12.493 -store_met
12.494 - (prep_met EqSystem.thy "met_eqsys" [] e_metID
12.495 - (["EqSystem"],
12.496 - [],
12.497 - {rew_ord'="tless_true", rls' = Erls, calc = [],
12.498 - srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
12.499 - "empty_script"
12.500 - ));
12.501 -store_met
12.502 - (prep_met EqSystem.thy "met_eqsys_topdown" [] e_metID
12.503 - (["EqSystem","top_down_substitution"],
12.504 - [],
12.505 - {rew_ord'="tless_true", rls' = Erls, calc = [],
12.506 - srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
12.507 - "empty_script"
12.508 - ));
12.509 -store_met
12.510 - (prep_met EqSystem.thy "met_eqsys_topdown_2x2" [] e_metID
12.511 - (["EqSystem","top_down_substitution","2x2"],
12.512 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.513 - ("#Where" ,
12.514 - ["(tl vs_) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))",
12.515 - " vs_ from_ vs_ occur_exactly_in (nth_ 2 (es_::bool list))"]),
12.516 - ("#Find" ,["solution ss___"])
12.517 - ],
12.518 - {rew_ord'="ord_simplify_System", rls' = Erls, calc = [],
12.519 - srls = append_rls "srls_top_down_2x2" e_rls
12.520 - [Thm ("hd_thm",num_str hd_thm),
12.521 - Thm ("tl_Cons",num_str tl_Cons),
12.522 - Thm ("tl_Nil",num_str tl_Nil)
12.523 - ],
12.524 - prls = prls_triangular, crls = Erls, nrls = Erls},
12.525 -"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
12.526 -" (let e1__ = Take (hd es_); " ^
12.527 -" e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.528 -" isolate_bdvs False)) @@ " ^
12.529 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.530 -" simplify_System False))) e1__; " ^
12.531 -" e2__ = Take (hd (tl es_)); " ^
12.532 -" e2__ = ((Substitute [e1__]) @@ " ^
12.533 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.534 -" simplify_System_parenthesized False)) @@ " ^
12.535 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.536 -" isolate_bdvs False)) @@ " ^
12.537 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.538 -" simplify_System False))) e2__; " ^
12.539 -" es__ = Take [e1__, e2__] " ^
12.540 -" in (Try (Rewrite_Set order_system False)) es__)"
12.541 -(*---------------------------------------------------------------------------
12.542 - this script does NOT separate the equations as abolve,
12.543 - but it does not yet work due to preliminary script-interpreter,
12.544 - see eqsystem.sml 'script [EqSystem,top_down_substitution,2x2] Vers.2'
12.545 -
12.546 -"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
12.547 -" (let es__ = Take es_; " ^
12.548 -" e1__ = hd es__; " ^
12.549 -" e2__ = hd (tl es__); " ^
12.550 -" es__ = [e1__, Substitute [e1__] e2__] " ^
12.551 -" in ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.552 -" simplify_System_parenthesized False)) @@ " ^
12.553 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))] " ^
12.554 -" isolate_bdvs False)) @@ " ^
12.555 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.556 -" simplify_System False))) es__)"
12.557 ----------------------------------------------------------------------------*)
12.558 - ));
12.559 -store_met
12.560 - (prep_met EqSystem.thy "met_eqsys_norm" [] e_metID
12.561 - (["EqSystem","normalize"],
12.562 - [],
12.563 - {rew_ord'="tless_true", rls' = Erls, calc = [],
12.564 - srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
12.565 - "empty_script"
12.566 - ));
12.567 -store_met
12.568 - (prep_met EqSystem.thy "met_eqsys_norm_2x2" [] e_metID
12.569 - (["EqSystem","normalize","2x2"],
12.570 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.571 - ("#Find" ,["solution ss___"])],
12.572 - {rew_ord'="tless_true", rls' = Erls, calc = [],
12.573 - srls = append_rls "srls_normalize_2x2" e_rls
12.574 - [Thm ("hd_thm",num_str hd_thm),
12.575 - Thm ("tl_Cons",num_str tl_Cons),
12.576 - Thm ("tl_Nil",num_str tl_Nil)
12.577 - ],
12.578 - prls = Erls, crls = Erls, nrls = Erls},
12.579 -"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
12.580 -" (let es__ = ((Try (Rewrite_Set norm_Rational False)) @@ " ^
12.581 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.582 -" simplify_System_parenthesized False)) @@ " ^
12.583 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.584 -" isolate_bdvs False)) @@ " ^
12.585 -" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
12.586 -" simplify_System_parenthesized False)) @@ " ^
12.587 -" (Try (Rewrite_Set order_system False))) es_ " ^
12.588 -" in (SubProblem (EqSystem_,[linear,system],[no_met]) " ^
12.589 -" [bool_list_ es__, real_list_ vs_]))"
12.590 - ));
12.591 -
12.592 -(*this is for nth_ only*)
12.593 -val srls = Rls {id="srls_normalize_4x4",
12.594 - preconds = [],
12.595 - rew_ord = ("termlessI",termlessI),
12.596 - erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
12.597 - [(*for asm in nth_Cons_ ...*)
12.598 - Calc ("op <",eval_equ "#less_"),
12.599 - (*2nd nth_Cons_ pushes n+-1 into asms*)
12.600 - Calc("op +", eval_binop "#add_")
12.601 - ],
12.602 - srls = Erls, calc = [],
12.603 - rules = [Thm ("nth_Cons_",num_str nth_Cons_),
12.604 - Calc("op +", eval_binop "#add_"),
12.605 - Thm ("nth_Nil_",num_str nth_Nil_)],
12.606 - scr = EmptyScr};
12.607 -store_met
12.608 - (prep_met EqSystem.thy "met_eqsys_norm_4x4" [] e_metID
12.609 - (["EqSystem","normalize","4x4"],
12.610 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.611 - ("#Find" ,["solution ss___"])],
12.612 - {rew_ord'="tless_true", rls' = Erls, calc = [],
12.613 - srls = append_rls "srls_normalize_4x4" srls
12.614 - [Thm ("hd_thm",num_str hd_thm),
12.615 - Thm ("tl_Cons",num_str tl_Cons),
12.616 - Thm ("tl_Nil",num_str tl_Nil)
12.617 - ],
12.618 - prls = Erls, crls = Erls, nrls = Erls},
12.619 -(*GOON met ["EqSystem","normalize","4x4"] @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
12.620 -"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
12.621 -" (let es__ = " ^
12.622 -" ((Try (Rewrite_Set norm_Rational False)) @@ " ^
12.623 -" (Repeat (Rewrite commute_0_equality False)) @@ " ^
12.624 -" (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), " ^
12.625 -" (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] " ^
12.626 -" simplify_System_parenthesized False)) @@ " ^
12.627 -" (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), " ^
12.628 -" (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] " ^
12.629 -" isolate_bdvs_4x4 False)) @@ " ^
12.630 -" (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), " ^
12.631 -" (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] " ^
12.632 -" simplify_System_parenthesized False)) @@ " ^
12.633 -" (Try (Rewrite_Set order_system False))) es_ " ^
12.634 -" in (SubProblem (EqSystem_,[linear,system],[no_met]) " ^
12.635 -" [bool_list_ es__, real_list_ vs_]))"
12.636 -));
12.637 -store_met
12.638 -(prep_met EqSystem.thy "met_eqsys_topdown_4x4" [] e_metID
12.639 - (["EqSystem","top_down_substitution","4x4"],
12.640 - [("#Given" ,["equalities es_", "solveForVars vs_"]),
12.641 - ("#Where" , (*accepts missing variables up to diagonal form*)
12.642 - ["(nth_ 1 (vs_::real list)) occurs_in (nth_ 1 (es_::bool list))",
12.643 - "(nth_ 2 (vs_::real list)) occurs_in (nth_ 2 (es_::bool list))",
12.644 - "(nth_ 3 (vs_::real list)) occurs_in (nth_ 3 (es_::bool list))",
12.645 - "(nth_ 4 (vs_::real list)) occurs_in (nth_ 4 (es_::bool list))"
12.646 - ]),
12.647 - ("#Find" ,["solution ss___"])
12.648 - ],
12.649 - {rew_ord'="ord_simplify_System", rls' = Erls, calc = [],
12.650 - srls = append_rls "srls_top_down_4x4" srls [],
12.651 - prls = append_rls "prls_tri_4x4_lin_sys" prls_triangular
12.652 - [Calc ("Atools.occurs'_in",eval_occurs_in "")],
12.653 - crls = Erls, nrls = Erls},
12.654 -(*FIXXXXME.WN060916: this script works ONLY for exp 7.79 @@@@@@@@@@@@@@@@@@@@*)
12.655 -"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
12.656 -" (let e1_ = nth_ 1 es_; " ^
12.657 -" e2_ = Take (nth_ 2 es_); " ^
12.658 -" e2_ = ((Substitute [e1_]) @@ " ^
12.659 -" (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_)," ^
12.660 -" (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]" ^
12.661 -" simplify_System_parenthesized False)) @@ " ^
12.662 -" (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_)," ^
12.663 -" (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]" ^
12.664 -" isolate_bdvs False)) @@ " ^
12.665 -" (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_)," ^
12.666 -" (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]" ^
12.667 -" norm_Rational False))) e2_ " ^
12.668 -" in [e1_, e2_, nth_ 3 es_, nth_ 4 es_])"
12.669 -));
12.670 -
12.671 -(* show_mets();
12.672 - *)
13.1 --- a/src/Tools/isac/Knowledge/EqSystem.thy Fri Aug 27 10:39:12 2010 +0200
13.2 +++ b/src/Tools/isac/Knowledge/EqSystem.thy Fri Aug 27 14:56:54 2010 +0200
13.3 @@ -2,17 +2,9 @@
13.4 author: Walther Neuper
13.5 050826,
13.6 (c) due to copyright terms
13.7 -
13.8 -remove_thy"EqSystem";
13.9 -use_thy"Knowledge/EqSystem";
13.10 -
13.11 -use_thy_only"Knowledge/EqSystem";
13.12 -
13.13 -remove_thy"Typefix";
13.14 -use_thy"Knowledge/Isac";
13.15 *)
13.16
13.17 -EqSystem = Rational + Root +
13.18 +theory EqSystem imports Rational Root begin
13.19
13.20 consts
13.21
13.22 @@ -27,11 +19,11 @@
13.23 solveSystem :: "[bool list, real list] => bool list"
13.24
13.25 (*Script-names*)
13.26 - SolveSystemScript :: "[bool list, real list, bool list] \
13.27 - \=> bool list"
13.28 + SolveSystemScript :: "[bool list, real list, bool list]
13.29 + => bool list"
13.30 ("((Script SolveSystemScript (_ _ =))// (_))" 9)
13.31
13.32 -rules
13.33 +axioms
13.34 (*stated as axioms, todo: prove as theorems
13.35 'bdv' is a constant handled on the meta-level
13.36 specifically as a 'bound variable' *)
13.37 @@ -41,32 +33,680 @@
13.38 (*WN0510 see simliar rules 'isolate_' 'separate_' (by RL)
13.39 [bdv_1,bdv_2,bdv_3,bdv_4] work also for 2 and 3 bdvs, ugly !*)
13.40 separate_bdvs_add
13.41 - "[| [] from_ [bdv_1,bdv_2,bdv_3,bdv_4] occur_exactly_in a |]\
13.42 - \ ==> (a + b = c) = (b = c + -1*a)"
13.43 + "[| [] from_ [bdv_1,bdv_2,bdv_3,bdv_4] occur_exactly_in a |]
13.44 + ==> (a + b = c) = (b = c + -1*a)"
13.45 separate_bdvs0
13.46 - "[| some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in b; Not (b=!=0) |]\
13.47 - \ ==> (a = b) = (a + -1*b = 0)"
13.48 + "[| some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in b; Not (b=!=0) |]
13.49 + ==> (a = b) = (a + -1*b = 0)"
13.50 separate_bdvs_add1
13.51 - "[| some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in c |]\
13.52 - \ ==> (a = b + c) = (a + -1*c = b)"
13.53 + "[| some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in c |]
13.54 + ==> (a = b + c) = (a + -1*c = b)"
13.55 separate_bdvs_add2
13.56 - "[| Not (some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in a) |]\
13.57 - \ ==> (a + b = c) = (b = -1*a + c)"
13.58 + "[| Not (some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in a) |]
13.59 + ==> (a + b = c) = (b = -1*a + c)"
13.60
13.61
13.62
13.63 separate_bdvs_mult
13.64 - "[| [] from_ [bdv_1,bdv_2,bdv_3,bdv_4] occur_exactly_in a; Not (a=!=0) |]\
13.65 - \ ==>(a * b = c) = (b = c / a)"
13.66 + "[| [] from_ [bdv_1,bdv_2,bdv_3,bdv_4] occur_exactly_in a; Not (a=!=0) |]
13.67 + ==>(a * b = c) = (b = c / a)"
13.68
13.69 (*requires rew_ord for termination, eg. ord_simplify_Integral;
13.70 works for lists of any length, interestingly !?!*)
13.71 order_system_NxN "[a,b] = [b,a]"
13.72
13.73 +ML {*
13.74 +(** eval functions **)
13.75 +
13.76 +(*certain variables of a given list occur _all_ in a term
13.77 + args: all: ..variables, which are under consideration (eg. the bound vars)
13.78 + vs: variables which must be in t,
13.79 + and none of the others in all must be in t
13.80 + t: the term under consideration
13.81 + *)
13.82 +fun occur_exactly_in vs all t =
13.83 + let fun occurs_in' a b = occurs_in b a
13.84 + in foldl and_ (true, map (occurs_in' t) vs)
13.85 + andalso not (foldl or_ (false, map (occurs_in' t)
13.86 + (subtract op = vs all)))
13.87 + end;
13.88 +
13.89 +(*("occur_exactly_in", ("EqSystem.occur'_exactly'_in",
13.90 + eval_occur_exactly_in "#eval_occur_exactly_in_"))*)
13.91 +fun eval_occur_exactly_in _ "EqSystem.occur'_exactly'_in"
13.92 + (p as (Const ("EqSystem.occur'_exactly'_in",_)
13.93 + $ vs $ all $ t)) _ =
13.94 + if occur_exactly_in (isalist2list vs) (isalist2list all) t
13.95 + then SOME ((term2str p) ^ " = True",
13.96 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
13.97 + else SOME ((term2str p) ^ " = False",
13.98 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
13.99 + | eval_occur_exactly_in _ _ _ _ = NONE;
13.100 +
13.101 +calclist':=
13.102 +overwritel (!calclist',
13.103 + [("occur_exactly_in",
13.104 + ("EqSystem.occur'_exactly'_in",
13.105 + eval_occur_exactly_in "#eval_occur_exactly_in_"))
13.106 + ]);
13.107 +
13.108 +
13.109 +(** rewrite order 'ord_simplify_System' **)
13.110 +
13.111 +(* order wrt. several linear (i.e. without exponents) variables "c","c_2",..
13.112 + which leaves the monomials containing c, c_2,... at the end of an Integral
13.113 + and puts the c, c_2,... rightmost within a monomial.
13.114 +
13.115 + WN050906 this is a quick and dirty adaption of ord_make_polynomial_in,
13.116 + which was most adequate, because it uses size_of_term*)
13.117 +(**)
13.118 +local (*. for simplify_System .*)
13.119 +(**)
13.120 +open Term; (* for type order = EQUAL | LESS | GREATER *)
13.121 +
13.122 +fun pr_ord EQUAL = "EQUAL"
13.123 + | pr_ord LESS = "LESS"
13.124 + | pr_ord GREATER = "GREATER";
13.125 +
13.126 +fun dest_hd' (Const (a, T)) = (((a, 0), T), 0)
13.127 + | dest_hd' (Free (ccc, T)) =
13.128 + (case explode ccc of
13.129 + "c"::[] => ((("|||||||||||||||||||||", 0), T), 1)(*greatest string WN*)
13.130 + | "c"::"_"::_ => ((("|||||||||||||||||||||", 0), T), 1)
13.131 + | _ => (((ccc, 0), T), 1))
13.132 + | dest_hd' (Var v) = (v, 2)
13.133 + | dest_hd' (Bound i) = ((("", i), dummyT), 3)
13.134 + | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
13.135 +
13.136 +fun size_of_term' (Free (ccc, _)) =
13.137 + (case explode ccc of (*WN0510 hack for the bound variables*)
13.138 + "c"::[] => 1000
13.139 + | "c"::"_"::is => 1000 * ((str2int o implode) is)
13.140 + | _ => 1)
13.141 + | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
13.142 + | size_of_term' (f$t) = size_of_term' f + size_of_term' t
13.143 + | size_of_term' _ = 1;
13.144 +
13.145 +fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
13.146 + (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
13.147 + | term_ord' pr thy (t, u) =
13.148 + (if pr then
13.149 + let
13.150 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
13.151 + val _=writeln("t= f@ts= \""^
13.152 + ((Syntax.string_of_term (thy2ctxt thy)) f)^"\" @ \"["^
13.153 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
13.154 + val _=writeln("u= g@us= \""^
13.155 + ((Syntax.string_of_term (thy2ctxt thy)) g)^"\" @ \"["^
13.156 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
13.157 + val _=writeln("size_of_term(t,u)= ("^
13.158 + (string_of_int(size_of_term' t))^", "^
13.159 + (string_of_int(size_of_term' u))^")");
13.160 + val _=writeln("hd_ord(f,g) = "^((pr_ord o hd_ord)(f,g)));
13.161 + val _=writeln("terms_ord(ts,us) = "^
13.162 + ((pr_ord o terms_ord str false)(ts,us)));
13.163 + val _=writeln("-------");
13.164 + in () end
13.165 + else ();
13.166 + case int_ord (size_of_term' t, size_of_term' u) of
13.167 + EQUAL =>
13.168 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
13.169 + (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
13.170 + | ord => ord)
13.171 + end
13.172 + | ord => ord)
13.173 +and hd_ord (f, g) = (* ~ term.ML *)
13.174 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f,
13.175 + dest_hd' g)
13.176 +and terms_ord str pr (ts, us) =
13.177 + list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
13.178 +(**)
13.179 +in
13.180 +(**)
13.181 +(*WN0510 for preliminary use in eval_order_system, see case-study mat-eng.tex
13.182 +fun ord_simplify_System_rev (pr:bool) thy subst tu =
13.183 + (term_ord' pr thy (Library.swap tu) = LESS);*)
13.184 +
13.185 +(*for the rls's*)
13.186 +fun ord_simplify_System (pr:bool) thy subst tu =
13.187 + (term_ord' pr thy tu = LESS);
13.188 +(**)
13.189 +end;
13.190 +(**)
13.191 +rew_ord' := overwritel (!rew_ord',
13.192 +[("ord_simplify_System", ord_simplify_System false thy)
13.193 + ]);
13.194 +
13.195 +
13.196 +(** rulesets **)
13.197 +
13.198 +(*.adapted from 'order_add_mult_in' by just replacing the rew_ord.*)
13.199 +val order_add_mult_System =
13.200 + Rls{id = "order_add_mult_System", preconds = [],
13.201 + rew_ord = ("ord_simplify_System",
13.202 + ord_simplify_System false (theory "Integrate")),
13.203 + erls = e_rls,srls = Erls, calc = [],
13.204 + rules = [Thm ("real_mult_commute",num_str real_mult_commute),
13.205 + (* z * w = w * z *)
13.206 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
13.207 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
13.208 + Thm ("real_mult_assoc",num_str real_mult_assoc),
13.209 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
13.210 + Thm ("real_add_commute",num_str real_add_commute),
13.211 + (*z + w = w + z*)
13.212 + Thm ("real_add_left_commute",num_str real_add_left_commute),
13.213 + (*x + (y + z) = y + (x + z)*)
13.214 + Thm ("real_add_assoc",num_str real_add_assoc)
13.215 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
13.216 + ],
13.217 + scr = EmptyScr}:rls;
13.218 +
13.219 +(*.adapted from 'norm_Rational' by
13.220 + #1 using 'ord_simplify_System' in 'order_add_mult_System'
13.221 + #2 NOT using common_nominator_p .*)
13.222 +val norm_System_noadd_fractions =
13.223 + Rls {id = "norm_System_noadd_fractions", preconds = [],
13.224 + rew_ord = ("dummy_ord",dummy_ord),
13.225 + erls = norm_rat_erls, srls = Erls, calc = [],
13.226 + rules = [(*sequence given by operator precedence*)
13.227 + Rls_ discard_minus,
13.228 + Rls_ powers,
13.229 + Rls_ rat_mult_divide,
13.230 + Rls_ expand,
13.231 + Rls_ reduce_0_1_2,
13.232 + Rls_ (*order_add_mult #1*) order_add_mult_System,
13.233 + Rls_ collect_numerals,
13.234 + (*Rls_ add_fractions_p, #2*)
13.235 + Rls_ cancel_p
13.236 + ],
13.237 + scr = Script ((term_of o the o (parse thy))
13.238 + "empty_script")
13.239 + }:rls;
13.240 +(*.adapted from 'norm_Rational' by
13.241 + *1* using 'ord_simplify_System' in 'order_add_mult_System'.*)
13.242 +val norm_System =
13.243 + Rls {id = "norm_System", preconds = [],
13.244 + rew_ord = ("dummy_ord",dummy_ord),
13.245 + erls = norm_rat_erls, srls = Erls, calc = [],
13.246 + rules = [(*sequence given by operator precedence*)
13.247 + Rls_ discard_minus,
13.248 + Rls_ powers,
13.249 + Rls_ rat_mult_divide,
13.250 + Rls_ expand,
13.251 + Rls_ reduce_0_1_2,
13.252 + Rls_ (*order_add_mult *1*) order_add_mult_System,
13.253 + Rls_ collect_numerals,
13.254 + Rls_ add_fractions_p,
13.255 + Rls_ cancel_p
13.256 + ],
13.257 + scr = Script ((term_of o the o (parse thy))
13.258 + "empty_script")
13.259 + }:rls;
13.260 +
13.261 +(*.simplify an equational system BEFORE solving it such that parentheses are
13.262 + ( ((u0*v0)*w0) + ( ((u1*v1)*w1) * c + ... +((u4*v4)*w4) * c_4 ) )
13.263 +ATTENTION: works ONLY for bound variables c, c_1, c_2, c_3, c_4 :ATTENTION
13.264 + This is a copy from 'make_ratpoly_in' with respective reductions:
13.265 + *0* expand the term, ie. distribute * and / over +
13.266 + *1* ord_simplify_System instead of termlessI
13.267 + *2* no add_fractions_p (= common_nominator_p_rls !)
13.268 + *3* discard_parentheses only for (.*(.*.))
13.269 + analoguous to simplify_Integral .*)
13.270 +val simplify_System_parenthesized =
13.271 + Seq {id = "simplify_System_parenthesized", preconds = []:term list,
13.272 + rew_ord = ("dummy_ord", dummy_ord),
13.273 + erls = Atools_erls, srls = Erls, calc = [],
13.274 + rules = [Thm ("real_add_mult_distrib",num_str real_add_mult_distrib),
13.275 + (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
13.276 + Thm ("real_add_divide_distrib",num_str real_add_divide_distrib),
13.277 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
13.278 + (*^^^^^ *0* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
13.279 + Rls_ norm_Rational_noadd_fractions(**2**),
13.280 + Rls_ (*order_add_mult_in*) norm_System_noadd_fractions (**1**),
13.281 + Thm ("sym_real_mult_assoc", num_str (real_mult_assoc RS sym))
13.282 + (*Rls_ discard_parentheses *3**),
13.283 + Rls_ collect_bdv, (*from make_polynomial_in WN051031 welldone?*)
13.284 + Rls_ separate_bdv2,
13.285 + Calc ("HOL.divide" ,eval_cancel "#divide_")
13.286 + ],
13.287 + scr = EmptyScr}:rls;
13.288 +
13.289 +(*.simplify an equational system AFTER solving it;
13.290 + This is a copy of 'make_ratpoly_in' with the differences
13.291 + *1* ord_simplify_System instead of termlessI .*)
13.292 +(*TODO.WN051031 ^^^^^^^^^^ should be in EACH rls contained *)
13.293 +val simplify_System =
13.294 + Seq {id = "simplify_System", preconds = []:term list,
13.295 + rew_ord = ("dummy_ord", dummy_ord),
13.296 + erls = Atools_erls, srls = Erls, calc = [],
13.297 + rules = [Rls_ norm_Rational,
13.298 + Rls_ (*order_add_mult_in*) norm_System (**1**),
13.299 + Rls_ discard_parentheses,
13.300 + Rls_ collect_bdv, (*from make_polynomial_in WN051031 welldone?*)
13.301 + Rls_ separate_bdv2,
13.302 + Calc ("HOL.divide" ,eval_cancel "#divide_")
13.303 + ],
13.304 + scr = EmptyScr}:rls;
13.305 (*
13.306 -remove_thy"EqSystem";
13.307 -use_thy_only"Knowledge/EqSystem";
13.308 -use_thy"Knowledge/EqSystem";
13.309 -use"Knowledge/EqSystem.ML";
13.310 - *)
13.311 +val simplify_System =
13.312 + append_rls "simplify_System" simplify_System_parenthesized
13.313 + [Thm ("sym_real_add_assoc", num_str (real_add_assoc RS sym))];
13.314 +*)
13.315 +
13.316 +val isolate_bdvs =
13.317 + Rls {id="isolate_bdvs", preconds = [],
13.318 + rew_ord = ("e_rew_ord", e_rew_ord),
13.319 + erls = append_rls "erls_isolate_bdvs" e_rls
13.320 + [(Calc ("EqSystem.occur'_exactly'_in",
13.321 + eval_occur_exactly_in
13.322 + "#eval_occur_exactly_in_"))
13.323 + ],
13.324 + srls = Erls, calc = [],
13.325 + rules = [Thm ("commute_0_equality",
13.326 + num_str commute_0_equality),
13.327 + Thm ("separate_bdvs_add", num_str separate_bdvs_add),
13.328 + Thm ("separate_bdvs_mult", num_str separate_bdvs_mult)],
13.329 + scr = EmptyScr};
13.330 +val isolate_bdvs_4x4 =
13.331 + Rls {id="isolate_bdvs_4x4", preconds = [],
13.332 + rew_ord = ("e_rew_ord", e_rew_ord),
13.333 + erls = append_rls
13.334 + "erls_isolate_bdvs_4x4" e_rls
13.335 + [Calc ("EqSystem.occur'_exactly'_in",
13.336 + eval_occur_exactly_in "#eval_occur_exactly_in_"),
13.337 + Calc ("Atools.ident",eval_ident "#ident_"),
13.338 + Calc ("Atools.some'_occur'_in",
13.339 + eval_some_occur_in "#some_occur_in_"),
13.340 + Thm ("not_true",num_str not_true),
13.341 + Thm ("not_false",num_str not_false)
13.342 + ],
13.343 + srls = Erls, calc = [],
13.344 + rules = [Thm ("commute_0_equality",
13.345 + num_str commute_0_equality),
13.346 + Thm ("separate_bdvs0", num_str separate_bdvs0),
13.347 + Thm ("separate_bdvs_add1", num_str separate_bdvs_add1),
13.348 + Thm ("separate_bdvs_add1", num_str separate_bdvs_add2),
13.349 + Thm ("separate_bdvs_mult", num_str separate_bdvs_mult)],
13.350 + scr = EmptyScr};
13.351 +
13.352 +(*.order the equations in a system such, that a triangular system (if any)
13.353 + appears as [..c_4 = .., ..., ..., ..c_1 + ..c_2 + ..c_3 ..c_4 = ..].*)
13.354 +val order_system =
13.355 + Rls {id="order_system", preconds = [],
13.356 + rew_ord = ("ord_simplify_System",
13.357 + ord_simplify_System false thy),
13.358 + erls = Erls, srls = Erls, calc = [],
13.359 + rules = [Thm ("order_system_NxN", num_str order_system_NxN)
13.360 + ],
13.361 + scr = EmptyScr};
13.362 +
13.363 +val prls_triangular =
13.364 + Rls {id="prls_triangular", preconds = [],
13.365 + rew_ord = ("e_rew_ord", e_rew_ord),
13.366 + erls = Rls {id="erls_prls_triangular", preconds = [],
13.367 + rew_ord = ("e_rew_ord", e_rew_ord),
13.368 + erls = Erls, srls = Erls, calc = [],
13.369 + rules = [(*for precond nth_Cons_ ...*)
13.370 + Calc ("op <",eval_equ "#less_"),
13.371 + Calc ("op +", eval_binop "#add_")
13.372 + (*immediately repeated rewrite pushes
13.373 + '+' into precondition !*)
13.374 + ],
13.375 + scr = EmptyScr},
13.376 + srls = Erls, calc = [],
13.377 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
13.378 + Calc ("op +", eval_binop "#add_"),
13.379 + Thm ("nth_Nil_",num_str nth_Nil_),
13.380 + Thm ("tl_Cons",num_str tl_Cons),
13.381 + Thm ("tl_Nil",num_str tl_Nil),
13.382 + Calc ("EqSystem.occur'_exactly'_in",
13.383 + eval_occur_exactly_in
13.384 + "#eval_occur_exactly_in_")
13.385 + ],
13.386 + scr = EmptyScr};
13.387 +
13.388 +(*WN060914 quickly created for 4x4;
13.389 + more similarity to prls_triangular desirable*)
13.390 +val prls_triangular4 =
13.391 + Rls {id="prls_triangular4", preconds = [],
13.392 + rew_ord = ("e_rew_ord", e_rew_ord),
13.393 + erls = Rls {id="erls_prls_triangular4", preconds = [],
13.394 + rew_ord = ("e_rew_ord", e_rew_ord),
13.395 + erls = Erls, srls = Erls, calc = [],
13.396 + rules = [(*for precond nth_Cons_ ...*)
13.397 + Calc ("op <",eval_equ "#less_"),
13.398 + Calc ("op +", eval_binop "#add_")
13.399 + (*immediately repeated rewrite pushes
13.400 + '+' into precondition !*)
13.401 + ],
13.402 + scr = EmptyScr},
13.403 + srls = Erls, calc = [],
13.404 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
13.405 + Calc ("op +", eval_binop "#add_"),
13.406 + Thm ("nth_Nil_",num_str nth_Nil_),
13.407 + Thm ("tl_Cons",num_str tl_Cons),
13.408 + Thm ("tl_Nil",num_str tl_Nil),
13.409 + Calc ("EqSystem.occur'_exactly'_in",
13.410 + eval_occur_exactly_in
13.411 + "#eval_occur_exactly_in_")
13.412 + ],
13.413 + scr = EmptyScr};
13.414 +
13.415 +ruleset' :=
13.416 +overwritelthy thy
13.417 + (!ruleset',
13.418 +[("simplify_System_parenthesized", prep_rls simplify_System_parenthesized),
13.419 + ("simplify_System", prep_rls simplify_System),
13.420 + ("isolate_bdvs", prep_rls isolate_bdvs),
13.421 + ("isolate_bdvs_4x4", prep_rls isolate_bdvs_4x4),
13.422 + ("order_system", prep_rls order_system),
13.423 + ("order_add_mult_System", prep_rls order_add_mult_System),
13.424 + ("norm_System_noadd_fractions", prep_rls norm_System_noadd_fractions),
13.425 + ("norm_System", prep_rls norm_System)
13.426 + ]);
13.427 +
13.428 +
13.429 +(** problems **)
13.430 +
13.431 +store_pbt
13.432 + (prep_pbt (theory "EqSystem") "pbl_equsys" [] e_pblID
13.433 + (["system"],
13.434 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.435 + ("#Find" ,["solution ss___"](*___ is copy-named*))
13.436 + ],
13.437 + append_rls "e_rls" e_rls [(*for preds in where_*)],
13.438 + SOME "solveSystem es_ vs_",
13.439 + []));
13.440 +store_pbt
13.441 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin" [] e_pblID
13.442 + (["linear", "system"],
13.443 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.444 + (*TODO.WN050929 check linearity*)
13.445 + ("#Find" ,["solution ss___"])
13.446 + ],
13.447 + append_rls "e_rls" e_rls [(*for preds in where_*)],
13.448 + SOME "solveSystem es_ vs_",
13.449 + []));
13.450 +store_pbt
13.451 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_2x2" [] e_pblID
13.452 + (["2x2", "linear", "system"],
13.453 + (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
13.454 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.455 + ("#Where" ,["length_ (es_:: bool list) = 2", "length_ vs_ = 2"]),
13.456 + ("#Find" ,["solution ss___"])
13.457 + ],
13.458 + append_rls "prls_2x2_linear_system" e_rls
13.459 + [Thm ("length_Cons_",num_str length_Cons_),
13.460 + Thm ("length_Nil_",num_str length_Nil_),
13.461 + Calc ("op +", eval_binop "#add_"),
13.462 + Calc ("op =",eval_equal "#equal_")
13.463 + ],
13.464 + SOME "solveSystem es_ vs_",
13.465 + []));
13.466 +store_pbt
13.467 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_2x2_tri" [] e_pblID
13.468 + (["triangular", "2x2", "linear", "system"],
13.469 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.470 + ("#Where" ,
13.471 + ["(tl vs_) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))",
13.472 + " vs_ from_ vs_ occur_exactly_in (nth_ 2 (es_::bool list))"]),
13.473 + ("#Find" ,["solution ss___"])
13.474 + ],
13.475 + prls_triangular,
13.476 + SOME "solveSystem es_ vs_",
13.477 + [["EqSystem","top_down_substitution","2x2"]]));
13.478 +store_pbt
13.479 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_2x2_norm" [] e_pblID
13.480 + (["normalize", "2x2", "linear", "system"],
13.481 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.482 + ("#Find" ,["solution ss___"])
13.483 + ],
13.484 + append_rls "e_rls" e_rls [(*for preds in where_*)],
13.485 + SOME "solveSystem es_ vs_",
13.486 + [["EqSystem","normalize","2x2"]]));
13.487 +store_pbt
13.488 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_3x3" [] e_pblID
13.489 + (["3x3", "linear", "system"],
13.490 + (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
13.491 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.492 + ("#Where" ,["length_ (es_:: bool list) = 3", "length_ vs_ = 3"]),
13.493 + ("#Find" ,["solution ss___"])
13.494 + ],
13.495 + append_rls "prls_3x3_linear_system" e_rls
13.496 + [Thm ("length_Cons_",num_str length_Cons_),
13.497 + Thm ("length_Nil_",num_str length_Nil_),
13.498 + Calc ("op +", eval_binop "#add_"),
13.499 + Calc ("op =",eval_equal "#equal_")
13.500 + ],
13.501 + SOME "solveSystem es_ vs_",
13.502 + []));
13.503 +store_pbt
13.504 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_4x4" [] e_pblID
13.505 + (["4x4", "linear", "system"],
13.506 + (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
13.507 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.508 + ("#Where" ,["length_ (es_:: bool list) = 4", "length_ vs_ = 4"]),
13.509 + ("#Find" ,["solution ss___"])
13.510 + ],
13.511 + append_rls "prls_4x4_linear_system" e_rls
13.512 + [Thm ("length_Cons_",num_str length_Cons_),
13.513 + Thm ("length_Nil_",num_str length_Nil_),
13.514 + Calc ("op +", eval_binop "#add_"),
13.515 + Calc ("op =",eval_equal "#equal_")
13.516 + ],
13.517 + SOME "solveSystem es_ vs_",
13.518 + []));
13.519 +store_pbt
13.520 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_4x4_tri" [] e_pblID
13.521 + (["triangular", "4x4", "linear", "system"],
13.522 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.523 + ("#Where" , (*accepts missing variables up to diagional form*)
13.524 + ["(nth_ 1 (vs_::real list)) occurs_in (nth_ 1 (es_::bool list))",
13.525 + "(nth_ 2 (vs_::real list)) occurs_in (nth_ 2 (es_::bool list))",
13.526 + "(nth_ 3 (vs_::real list)) occurs_in (nth_ 3 (es_::bool list))",
13.527 + "(nth_ 4 (vs_::real list)) occurs_in (nth_ 4 (es_::bool list))"
13.528 + ]),
13.529 + ("#Find" ,["solution ss___"])
13.530 + ],
13.531 + append_rls "prls_tri_4x4_lin_sys" prls_triangular
13.532 + [Calc ("Atools.occurs'_in",eval_occurs_in "")],
13.533 + SOME "solveSystem es_ vs_",
13.534 + [["EqSystem","top_down_substitution","4x4"]]));
13.535 +
13.536 +store_pbt
13.537 + (prep_pbt (theory "EqSystem") "pbl_equsys_lin_4x4_norm" [] e_pblID
13.538 + (["normalize", "4x4", "linear", "system"],
13.539 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.540 + (*length_ is checked 1 level above*)
13.541 + ("#Find" ,["solution ss___"])
13.542 + ],
13.543 + append_rls "e_rls" e_rls [(*for preds in where_*)],
13.544 + SOME "solveSystem es_ vs_",
13.545 + [["EqSystem","normalize","4x4"]]));
13.546 +
13.547 +
13.548 +(* show_ptyps();
13.549 + *)
13.550 +
13.551 +(** methods **)
13.552 +
13.553 +store_met
13.554 + (prep_met (theory "EqSystem") "met_eqsys" [] e_metID
13.555 + (["EqSystem"],
13.556 + [],
13.557 + {rew_ord'="tless_true", rls' = Erls, calc = [],
13.558 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
13.559 + "empty_script"
13.560 + ));
13.561 +store_met
13.562 + (prep_met (theory "EqSystem") "met_eqsys_topdown" [] e_metID
13.563 + (["EqSystem","top_down_substitution"],
13.564 + [],
13.565 + {rew_ord'="tless_true", rls' = Erls, calc = [],
13.566 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
13.567 + "empty_script"
13.568 + ));
13.569 +store_met
13.570 + (prep_met (theory "EqSystem") "met_eqsys_topdown_2x2" [] e_metID
13.571 + (["EqSystem","top_down_substitution","2x2"],
13.572 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.573 + ("#Where" ,
13.574 + ["(tl vs_) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))",
13.575 + " vs_ from_ vs_ occur_exactly_in (nth_ 2 (es_::bool list))"]),
13.576 + ("#Find" ,["solution ss___"])
13.577 + ],
13.578 + {rew_ord'="ord_simplify_System", rls' = Erls, calc = [],
13.579 + srls = append_rls "srls_top_down_2x2" e_rls
13.580 + [Thm ("hd_thm",num_str hd_thm),
13.581 + Thm ("tl_Cons",num_str tl_Cons),
13.582 + Thm ("tl_Nil",num_str tl_Nil)
13.583 + ],
13.584 + prls = prls_triangular, crls = Erls, nrls = Erls},
13.585 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
13.586 +" (let e1__ = Take (hd es_); " ^
13.587 +" e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.588 +" isolate_bdvs False)) @@ " ^
13.589 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.590 +" simplify_System False))) e1__; " ^
13.591 +" e2__ = Take (hd (tl es_)); " ^
13.592 +" e2__ = ((Substitute [e1__]) @@ " ^
13.593 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.594 +" simplify_System_parenthesized False)) @@ " ^
13.595 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.596 +" isolate_bdvs False)) @@ " ^
13.597 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.598 +" simplify_System False))) e2__; " ^
13.599 +" es__ = Take [e1__, e2__] " ^
13.600 +" in (Try (Rewrite_Set order_system False)) es__)"
13.601 +(*---------------------------------------------------------------------------
13.602 + this script does NOT separate the equations as abolve,
13.603 + but it does not yet work due to preliminary script-interpreter,
13.604 + see eqsystem.sml 'script [EqSystem,top_down_substitution,2x2] Vers.2'
13.605 +
13.606 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
13.607 +" (let es__ = Take es_; " ^
13.608 +" e1__ = hd es__; " ^
13.609 +" e2__ = hd (tl es__); " ^
13.610 +" es__ = [e1__, Substitute [e1__] e2__] " ^
13.611 +" in ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.612 +" simplify_System_parenthesized False)) @@ " ^
13.613 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))] " ^
13.614 +" isolate_bdvs False)) @@ " ^
13.615 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.616 +" simplify_System False))) es__)"
13.617 +---------------------------------------------------------------------------*)
13.618 + ));
13.619 +store_met
13.620 + (prep_met (theory "EqSystem") "met_eqsys_norm" [] e_metID
13.621 + (["EqSystem","normalize"],
13.622 + [],
13.623 + {rew_ord'="tless_true", rls' = Erls, calc = [],
13.624 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
13.625 + "empty_script"
13.626 + ));
13.627 +store_met
13.628 + (prep_met (theory "EqSystem") "met_eqsys_norm_2x2" [] e_metID
13.629 + (["EqSystem","normalize","2x2"],
13.630 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.631 + ("#Find" ,["solution ss___"])],
13.632 + {rew_ord'="tless_true", rls' = Erls, calc = [],
13.633 + srls = append_rls "srls_normalize_2x2" e_rls
13.634 + [Thm ("hd_thm",num_str hd_thm),
13.635 + Thm ("tl_Cons",num_str tl_Cons),
13.636 + Thm ("tl_Nil",num_str tl_Nil)
13.637 + ],
13.638 + prls = Erls, crls = Erls, nrls = Erls},
13.639 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
13.640 +" (let es__ = ((Try (Rewrite_Set norm_Rational False)) @@ " ^
13.641 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.642 +" simplify_System_parenthesized False)) @@ " ^
13.643 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.644 +" isolate_bdvs False)) @@ " ^
13.645 +" (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]" ^
13.646 +" simplify_System_parenthesized False)) @@ " ^
13.647 +" (Try (Rewrite_Set order_system False))) es_ " ^
13.648 +" in (SubProblem (EqSystem_,[linear,system],[no_met]) " ^
13.649 +" [bool_list_ es__, real_list_ vs_]))"
13.650 + ));
13.651 +
13.652 +(*this is for nth_ only*)
13.653 +val srls = Rls {id="srls_normalize_4x4",
13.654 + preconds = [],
13.655 + rew_ord = ("termlessI",termlessI),
13.656 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
13.657 + [(*for asm in nth_Cons_ ...*)
13.658 + Calc ("op <",eval_equ "#less_"),
13.659 + (*2nd nth_Cons_ pushes n+-1 into asms*)
13.660 + Calc("op +", eval_binop "#add_")
13.661 + ],
13.662 + srls = Erls, calc = [],
13.663 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
13.664 + Calc("op +", eval_binop "#add_"),
13.665 + Thm ("nth_Nil_",num_str nth_Nil_)],
13.666 + scr = EmptyScr};
13.667 +store_met
13.668 + (prep_met (theory "EqSystem") "met_eqsys_norm_4x4" [] e_metID
13.669 + (["EqSystem","normalize","4x4"],
13.670 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.671 + ("#Find" ,["solution ss___"])],
13.672 + {rew_ord'="tless_true", rls' = Erls, calc = [],
13.673 + srls = append_rls "srls_normalize_4x4" srls
13.674 + [Thm ("hd_thm",num_str hd_thm),
13.675 + Thm ("tl_Cons",num_str tl_Cons),
13.676 + Thm ("tl_Nil",num_str tl_Nil)
13.677 + ],
13.678 + prls = Erls, crls = Erls, nrls = Erls},
13.679 +(*GOON met ["EqSystem","normalize","4x4"] @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
13.680 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
13.681 +" (let es__ = " ^
13.682 +" ((Try (Rewrite_Set norm_Rational False)) @@ " ^
13.683 +" (Repeat (Rewrite commute_0_equality False)) @@ " ^
13.684 +" (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), " ^
13.685 +" (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] " ^
13.686 +" simplify_System_parenthesized False)) @@ " ^
13.687 +" (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), " ^
13.688 +" (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] " ^
13.689 +" isolate_bdvs_4x4 False)) @@ " ^
13.690 +" (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), " ^
13.691 +" (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] " ^
13.692 +" simplify_System_parenthesized False)) @@ " ^
13.693 +" (Try (Rewrite_Set order_system False))) es_ " ^
13.694 +" in (SubProblem (EqSystem_,[linear,system],[no_met]) " ^
13.695 +" [bool_list_ es__, real_list_ vs_]))"
13.696 +));
13.697 +store_met
13.698 +(prep_met (theory "EqSystem") "met_eqsys_topdown_4x4" [] e_metID
13.699 + (["EqSystem","top_down_substitution","4x4"],
13.700 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
13.701 + ("#Where" , (*accepts missing variables up to diagonal form*)
13.702 + ["(nth_ 1 (vs_::real list)) occurs_in (nth_ 1 (es_::bool list))",
13.703 + "(nth_ 2 (vs_::real list)) occurs_in (nth_ 2 (es_::bool list))",
13.704 + "(nth_ 3 (vs_::real list)) occurs_in (nth_ 3 (es_::bool list))",
13.705 + "(nth_ 4 (vs_::real list)) occurs_in (nth_ 4 (es_::bool list))"
13.706 + ]),
13.707 + ("#Find" ,["solution ss___"])
13.708 + ],
13.709 + {rew_ord'="ord_simplify_System", rls' = Erls, calc = [],
13.710 + srls = append_rls "srls_top_down_4x4" srls [],
13.711 + prls = append_rls "prls_tri_4x4_lin_sys" prls_triangular
13.712 + [Calc ("Atools.occurs'_in",eval_occurs_in "")],
13.713 + crls = Erls, nrls = Erls},
13.714 +(*FIXXXXME.WN060916: this script works ONLY for exp 7.79 @@@@@@@@@@@@@@@@@@@@*)
13.715 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = " ^
13.716 +" (let e1_ = nth_ 1 es_; " ^
13.717 +" e2_ = Take (nth_ 2 es_); " ^
13.718 +" e2_ = ((Substitute [e1_]) @@ " ^
13.719 +" (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_)," ^
13.720 +" (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]" ^
13.721 +" simplify_System_parenthesized False)) @@ " ^
13.722 +" (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_)," ^
13.723 +" (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]" ^
13.724 +" isolate_bdvs False)) @@ " ^
13.725 +" (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_)," ^
13.726 +" (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]" ^
13.727 +" norm_Rational False))) e2_ " ^
13.728 +" in [e1_, e2_, nth_ 3 es_, nth_ 4 es_])"
13.729 +));
13.730 +*}
13.731 +
13.732 end
13.733 \ No newline at end of file
14.1 --- a/src/Tools/isac/Knowledge/InsSort.ML Fri Aug 27 10:39:12 2010 +0200
14.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
14.3 @@ -1,77 +0,0 @@
14.4 -(* 6.8.02 change to Isabelle2002 caused error -- thy excluded !
14.5 -
14.6 -Proving equations for primrec function(s) "InsSort.foldr" ...
14.7 -GC #1.17.30.54.345.21479: (10 ms)
14.8 -*** Definition of InsSort.ins :: "['a::ord list, 'a::ord] => 'a::ord list"
14.9 -*** imposes additional sort constraints on the declared type of the constant
14.10 -*** The error(s) above occurred in definition "InsSort.ins.ins_list_def"
14.11 -*)
14.12 -
14.13 -(* tools for insertion sort
14.14 - use"Knowledge/InsSort.ML";
14.15 -*)
14.16 -
14.17 -(** interface isabelle -- isac **)
14.18 -
14.19 -theory' := (!theory') @ [("InsSort.thy",InsSort.thy)];
14.20 -
14.21 -(** rule set **)
14.22 -
14.23 -val ins_sort = prep_rls(
14.24 - Rls{preconds = [], rew_ord = ("tless_true",tless_true),
14.25 - rules = [Thm ("foldr_base",(*num_str*) foldr_base),
14.26 - Thm ("foldr_rec",foldr_rec),
14.27 - Thm ("ins_base",ins_base),
14.28 - Thm ("ins_rec",ins_rec),
14.29 - Thm ("sort_def",sort_def),
14.30 -
14.31 - Calc ("op <",eval_equ "#less_"),
14.32 - Thm ("if_True", if_True),
14.33 - Thm ("if_False", if_False)
14.34 - ],
14.35 - scr = Script ((term_of o the o (parse thy))
14.36 - "empty_script")
14.37 - }:rls);
14.38 -
14.39 -(** problem type **)
14.40 -
14.41 -store_pbt
14.42 - (prep_pbt InsSort.thy
14.43 - (["functional"]:pblID,
14.44 - [("#Given" ,["unsorted u_"]),
14.45 - ("#Find" ,["sorted s_"])
14.46 - ],
14.47 - []));
14.48 -
14.49 -store_pbt
14.50 - (prep_pbt InsSort.thy
14.51 - (["inssort","functional"]:pblID,
14.52 - [("#Given" ,["unsorted u_"]),
14.53 - ("#Find" ,["sorted s_"])
14.54 - ],
14.55 - []));
14.56 -
14.57 -(** method,
14.58 - todo: implementation needs extra object-level lists **)
14.59 -
14.60 -store_met
14.61 - (prep_met Diff.thy
14.62 - (["InsSort"],
14.63 - [],
14.64 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
14.65 - crls = Atools_rls, nrls=norm_Rational
14.66 - (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
14.67 -store_met
14.68 - (prep_met InsSort.thy (*test-version for [#1,#3,#2] only: see *.sml*)
14.69 - (["InsSort""sort"]:metID,
14.70 - [("#Given" ,["unsorted u_"]),
14.71 - ("#Find" ,["sorted s_"])
14.72 - ],
14.73 - {rew_ord'="tless_true",rls'=eval_rls,calc = [], srls = e_rls, prls=e_rls,
14.74 - crls = eval_rls, nrls=norm_Rational(*,asm_rls=[],asm_thm=[]*)},
14.75 - "Script Sort (u_::'a list) = (Rewrite_Set ins_sort False) u_"
14.76 - ));
14.77 -
14.78 -ruleset' := overwritelthy thy (!ruleset',
14.79 - [(*("ins_sort",ins_sort) overwrites a Isa fun!!*)
14.80 - ]:(string * rls) list);
15.1 --- a/src/Tools/isac/Knowledge/InsSort.thy Fri Aug 27 10:39:12 2010 +0200
15.2 +++ b/src/Tools/isac/Knowledge/InsSort.thy Fri Aug 27 14:56:54 2010 +0200
15.3 @@ -11,11 +11,9 @@
15.4 WN.7.5.03: -"- started with someList :: 'a list => unl, fun dest_list
15.5 WN.8.5.03: error (@@@) remained with outcommenting foldr ?!?
15.6
15.7 - use_thy_only"Knowledge/InsSort";
15.8 -
15.9 *)
15.10
15.11 -InsSort = Script +
15.12 +theory InsSort imports "../ProgLang/Script" begin
15.13
15.14 consts
15.15
15.16 @@ -38,14 +36,14 @@
15.17 sorted :: 'a list => unl
15.18
15.19 (*subproblem and script-name*)
15.20 - Ins'_sort :: "['a list, \
15.21 - \ 'a list] => 'a list"
15.22 - ("((Script Ins'_sort (_ =))// \
15.23 - \ (_))" 9)
15.24 - Sort :: "['a list, \
15.25 - \ 'a list] => 'a list"
15.26 - ("((Script Sort (_ =))// \
15.27 - \ (_))" 9)
15.28 + Ins'_sort :: "['a list,
15.29 + 'a list] => 'a list"
15.30 + ("((Script Ins'_sort (_ =))//
15.31 + (_))" 9)
15.32 + Sort :: "['a list,
15.33 + 'a list] => 'a list"
15.34 + ("((Script Sort (_ =))//
15.35 + (_))" 9)
15.36
15.37 (*primrec
15.38 foldr_base "foldr f [] a = a"
15.39 @@ -60,4 +58,49 @@
15.40
15.41 sort_def "sort ls = foldr ins ls []"
15.42
15.43 +ML {*
15.44 +(** problem type **)
15.45 +
15.46 +store_pbt
15.47 + (prep_pbt (theory "InsSort")
15.48 + (["functional"]:pblID,
15.49 + [("#Given" ,["unsorted u_"]),
15.50 + ("#Find" ,["sorted s_"])
15.51 + ],
15.52 + []));
15.53 +
15.54 +store_pbt
15.55 + (prep_pbt (theory "InsSort")
15.56 + (["inssort","functional"]:pblID,
15.57 + [("#Given" ,["unsorted u_"]),
15.58 + ("#Find" ,["sorted s_"])
15.59 + ],
15.60 + []));
15.61 +
15.62 +(** method,
15.63 + todo: implementation needs extra object-level lists **)
15.64 +
15.65 +store_met
15.66 + (prep_met (theory "Diff")
15.67 + (["InsSort"],
15.68 + [],
15.69 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
15.70 + crls = Atools_rls, nrls=norm_Rational
15.71 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
15.72 +store_met
15.73 + (prep_met (theory "InsSort") (*test-version for [#1,#3,#2] only: see *.sml*)
15.74 + (["InsSort""sort"]:metID,
15.75 + [("#Given" ,["unsorted u_"]),
15.76 + ("#Find" ,["sorted s_"])
15.77 + ],
15.78 + {rew_ord'="tless_true",rls'=eval_rls,calc = [], srls = e_rls, prls=e_rls,
15.79 + crls = eval_rls, nrls=norm_Rational(*,asm_rls=[],asm_thm=[]*)},
15.80 + "Script Sort (u_::'a list) = (Rewrite_Set ins_sort False) u_"
15.81 + ));
15.82 +
15.83 +ruleset' := overwritelthy thy (!ruleset',
15.84 + [(*("ins_sort",ins_sort) overwrites a Isa fun!!*)
15.85 + ]:(string * rls) list);
15.86 +*}
15.87 +
15.88 end
16.1 --- a/src/Tools/isac/Knowledge/Integrate.ML Fri Aug 27 10:39:12 2010 +0200
16.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
16.3 @@ -1,352 +0,0 @@
16.4 -(* tools for integration over the reals
16.5 - author: Walther Neuper 050905, 08:51
16.6 - (c) due to copyright terms
16.7 -
16.8 -use"Knowledge/Integrate.ML";
16.9 -use"Integrate.ML";
16.10 -
16.11 -remove_thy"Integrate";
16.12 -use_thy"Knowledge/Isac";
16.13 -*)
16.14 -
16.15 -(** interface isabelle -- isac **)
16.16 -
16.17 -theory' := overwritel (!theory', [("Integrate.thy",Integrate.thy)]);
16.18 -
16.19 -(** eval functions **)
16.20 -
16.21 -val c = Free ("c", HOLogic.realT);
16.22 -(*.create a new unique variable 'c..' in a term; for use by Calc in a rls;
16.23 - an alternative to do this would be '(Try (Calculate new_c_) (new_c es__))'
16.24 - in the script; this will be possible if currying doesnt take the value
16.25 - from a variable, but the value '(new_c es__)' itself.*)
16.26 -fun new_c term =
16.27 - let fun selc var =
16.28 - case (explode o id_of) var of
16.29 - "c"::[] => true
16.30 - | "c"::"_"::is => (case (int_of_str o implode) is of
16.31 - SOME _ => true
16.32 - | NONE => false)
16.33 - | _ => false;
16.34 - fun get_coeff c = case (explode o id_of) c of
16.35 - "c"::"_"::is => (the o int_of_str o implode) is
16.36 - | _ => 0;
16.37 - val cs = filter selc (vars term);
16.38 - in
16.39 - case cs of
16.40 - [] => c
16.41 - | [c] => Free ("c_2", HOLogic.realT)
16.42 - | cs =>
16.43 - let val max_coeff = maxl (map get_coeff cs)
16.44 - in Free ("c_"^string_of_int (max_coeff + 1), HOLogic.realT) end
16.45 - end;
16.46 -
16.47 -(*WN080222
16.48 -(*("new_c", ("Integrate.new'_c", eval_new_c "#new_c_"))*)
16.49 -fun eval_new_c _ _ (p as (Const ("Integrate.new'_c",_) $ t)) _ =
16.50 - SOME ((term2str p) ^ " = " ^ term2str (new_c p),
16.51 - Trueprop $ (mk_equality (p, new_c p)))
16.52 - | eval_new_c _ _ _ _ = NONE;
16.53 -*)
16.54 -
16.55 -(*WN080222:*)
16.56 -(*("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "#add_new_c_"))
16.57 - add a new c to a term or a fun-equation;
16.58 - this is _not in_ the term, because only applied to _whole_ term*)
16.59 -fun eval_add_new_c (_:string) "Integrate.add'_new'_c" p (_:theory) =
16.60 - let val p' = case p of
16.61 - Const ("op =", T) $ lh $ rh =>
16.62 - Const ("op =", T) $ lh $ mk_add rh (new_c rh)
16.63 - | p => mk_add p (new_c p)
16.64 - in SOME ((term2str p) ^ " = " ^ term2str p',
16.65 - Trueprop $ (mk_equality (p, p')))
16.66 - end
16.67 - | eval_add_new_c _ _ _ _ = NONE;
16.68 -
16.69 -
16.70 -(*("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_x_"))*)
16.71 -fun eval_is_f_x _ _(p as (Const ("Integrate.is'_f'_x", _)
16.72 - $ arg)) _ =
16.73 - if is_f_x arg
16.74 - then SOME ((term2str p) ^ " = True",
16.75 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
16.76 - else SOME ((term2str p) ^ " = False",
16.77 - Trueprop $ (mk_equality (p, HOLogic.false_const)))
16.78 - | eval_is_f_x _ _ _ _ = NONE;
16.79 -
16.80 -calclist':= overwritel (!calclist',
16.81 - [(*("new_c", ("Integrate.new'_c", eval_new_c "new_c_")),*)
16.82 - ("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "add_new_c_")),
16.83 - ("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_idextifier_"))
16.84 - ]);
16.85 -
16.86 -
16.87 -(** rulesets **)
16.88 -
16.89 -(*.rulesets for integration.*)
16.90 -val integration_rules =
16.91 - Rls {id="integration_rules", preconds = [],
16.92 - rew_ord = ("termlessI",termlessI),
16.93 - erls = Rls {id="conditions_in_integration_rules",
16.94 - preconds = [],
16.95 - rew_ord = ("termlessI",termlessI),
16.96 - erls = Erls,
16.97 - srls = Erls, calc = [],
16.98 - rules = [(*for rewriting conditions in Thm's*)
16.99 - Calc ("Atools.occurs'_in",
16.100 - eval_occurs_in "#occurs_in_"),
16.101 - Thm ("not_true",num_str not_true),
16.102 - Thm ("not_false",not_false)
16.103 - ],
16.104 - scr = EmptyScr},
16.105 - srls = Erls, calc = [],
16.106 - rules = [
16.107 - Thm ("integral_const",num_str integral_const),
16.108 - Thm ("integral_var",num_str integral_var),
16.109 - Thm ("integral_add",num_str integral_add),
16.110 - Thm ("integral_mult",num_str integral_mult),
16.111 - Thm ("integral_pow",num_str integral_pow),
16.112 - Calc ("op +", eval_binop "#add_")(*for n+1*)
16.113 - ],
16.114 - scr = EmptyScr};
16.115 -val add_new_c =
16.116 - Seq {id="add_new_c", preconds = [],
16.117 - rew_ord = ("termlessI",termlessI),
16.118 - erls = Rls {id="conditions_in_add_new_c",
16.119 - preconds = [],
16.120 - rew_ord = ("termlessI",termlessI),
16.121 - erls = Erls,
16.122 - srls = Erls, calc = [],
16.123 - rules = [Calc ("Tools.matches", eval_matches""),
16.124 - Calc ("Integrate.is'_f'_x",
16.125 - eval_is_f_x "is_f_x_"),
16.126 - Thm ("not_true",num_str not_true),
16.127 - Thm ("not_false",num_str not_false)
16.128 - ],
16.129 - scr = EmptyScr},
16.130 - srls = Erls, calc = [],
16.131 - rules = [ (*Thm ("call_for_new_c", num_str call_for_new_c),*)
16.132 - Cal1 ("Integrate.add'_new'_c", eval_add_new_c "new_c_")
16.133 - ],
16.134 - scr = EmptyScr};
16.135 -
16.136 -(*.rulesets for simplifying Integrals.*)
16.137 -
16.138 -(*.for simplify_Integral adapted from 'norm_Rational_rls'.*)
16.139 -val norm_Rational_rls_noadd_fractions =
16.140 -Rls {id = "norm_Rational_rls_noadd_fractions", preconds = [],
16.141 - rew_ord = ("dummy_ord",dummy_ord),
16.142 - erls = norm_rat_erls, srls = Erls, calc = [],
16.143 - rules = [(*Rls_ common_nominator_p_rls,!!!*)
16.144 - Rls_ (*rat_mult_div_pow original corrected WN051028*)
16.145 - (Rls {id = "rat_mult_div_pow", preconds = [],
16.146 - rew_ord = ("dummy_ord",dummy_ord),
16.147 - erls = (*FIXME.WN051028 e_rls,*)
16.148 - append_rls "e_rls-is_polyexp" e_rls
16.149 - [Calc ("Poly.is'_polyexp",
16.150 - eval_is_polyexp "")],
16.151 - srls = Erls, calc = [],
16.152 - rules = [Thm ("rat_mult",num_str rat_mult),
16.153 - (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
16.154 - Thm ("rat_mult_poly_l",num_str rat_mult_poly_l),
16.155 - (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
16.156 - Thm ("rat_mult_poly_r",num_str rat_mult_poly_r),
16.157 - (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
16.158 -
16.159 - Thm ("real_divide_divide1_mg", real_divide_divide1_mg),
16.160 - (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
16.161 - Thm ("real_divide_divide1_eq", real_divide_divide1_eq),
16.162 - (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
16.163 - Thm ("real_divide_divide2_eq", real_divide_divide2_eq),
16.164 - (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
16.165 - Calc ("HOL.divide" ,eval_cancel "#divide_"),
16.166 -
16.167 - Thm ("rat_power", num_str rat_power)
16.168 - (*"(?a / ?b) ^^^ ?n = ?a ^^^ ?n / ?b ^^^ ?n"*)
16.169 - ],
16.170 - scr = Script ((term_of o the o (parse thy)) "empty_script")
16.171 - }),
16.172 - Rls_ make_rat_poly_with_parentheses,
16.173 - Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
16.174 - Rls_ rat_reduce_1
16.175 - ],
16.176 - scr = Script ((term_of o the o (parse thy)) "empty_script")
16.177 - }:rls;
16.178 -
16.179 -(*.for simplify_Integral adapted from 'norm_Rational'.*)
16.180 -val norm_Rational_noadd_fractions =
16.181 - Seq {id = "norm_Rational_noadd_fractions", preconds = [],
16.182 - rew_ord = ("dummy_ord",dummy_ord),
16.183 - erls = norm_rat_erls, srls = Erls, calc = [],
16.184 - rules = [Rls_ discard_minus_,
16.185 - Rls_ rat_mult_poly,(* removes double fractions like a/b/c *)
16.186 - Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
16.187 - Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
16.188 - Rls_ norm_Rational_rls_noadd_fractions,(* the main rls (#) *)
16.189 - Rls_ discard_parentheses_ (* mult only *)
16.190 - ],
16.191 - scr = Script ((term_of o the o (parse thy)) "empty_script")
16.192 - }:rls;
16.193 -
16.194 -(*.simplify terms before and after Integration such that
16.195 - ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
16.196 - common denominator as done by norm_Rational or make_ratpoly_in.
16.197 - This is a copy from 'make_ratpoly_in' with respective reduction of rules and
16.198 - *1* expand the term, ie. distribute * and / over +
16.199 -.*)
16.200 -val separate_bdv2 =
16.201 - append_rls "separate_bdv2"
16.202 - collect_bdv
16.203 - [Thm ("separate_bdv", num_str separate_bdv),
16.204 - (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
16.205 - Thm ("separate_bdv_n", num_str separate_bdv_n),
16.206 - Thm ("separate_1_bdv", num_str separate_1_bdv),
16.207 - (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
16.208 - Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)(*,
16.209 - (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
16.210 - *****Thm ("real_add_divide_distrib",
16.211 - *****num_str real_add_divide_distrib)
16.212 - (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)----------*)
16.213 - ];
16.214 -val simplify_Integral =
16.215 - Seq {id = "simplify_Integral", preconds = []:term list,
16.216 - rew_ord = ("dummy_ord", dummy_ord),
16.217 - erls = Atools_erls, srls = Erls,
16.218 - calc = [], (*asm_thm = [],*)
16.219 - rules = [Thm ("real_add_mult_distrib",num_str real_add_mult_distrib),
16.220 - (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
16.221 - Thm ("real_add_divide_distrib",num_str real_add_divide_distrib),
16.222 - (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
16.223 - (*^^^^^ *1* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
16.224 - Rls_ norm_Rational_noadd_fractions,
16.225 - Rls_ order_add_mult_in,
16.226 - Rls_ discard_parentheses,
16.227 - (*Rls_ collect_bdv, from make_polynomial_in*)
16.228 - Rls_ separate_bdv2,
16.229 - Calc ("HOL.divide" ,eval_cancel "#divide_")
16.230 - ],
16.231 - scr = EmptyScr}:rls;
16.232 -
16.233 -
16.234 -(*simplify terms before and after Integration such that
16.235 - ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
16.236 - common denominator as done by norm_Rational or make_ratpoly_in.
16.237 - This is a copy from 'make_polynomial_in' with insertions from
16.238 - 'make_ratpoly_in'
16.239 -THIS IS KEPT FOR COMPARISON ............................................
16.240 -* val simplify_Integral = prep_rls(
16.241 -* Seq {id = "", preconds = []:term list,
16.242 -* rew_ord = ("dummy_ord", dummy_ord),
16.243 -* erls = Atools_erls, srls = Erls,
16.244 -* calc = [], (*asm_thm = [],*)
16.245 -* rules = [Rls_ expand_poly,
16.246 -* Rls_ order_add_mult_in,
16.247 -* Rls_ simplify_power,
16.248 -* Rls_ collect_numerals,
16.249 -* Rls_ reduce_012,
16.250 -* Thm ("realpow_oneI",num_str realpow_oneI),
16.251 -* Rls_ discard_parentheses,
16.252 -* Rls_ collect_bdv,
16.253 -* (*below inserted from 'make_ratpoly_in'*)
16.254 -* Rls_ (append_rls "separate_bdv"
16.255 -* collect_bdv
16.256 -* [Thm ("separate_bdv", num_str separate_bdv),
16.257 -* (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
16.258 -* Thm ("separate_bdv_n", num_str separate_bdv_n),
16.259 -* Thm ("separate_1_bdv", num_str separate_1_bdv),
16.260 -* (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
16.261 -* Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)(*,
16.262 -* (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
16.263 -* Thm ("real_add_divide_distrib",
16.264 -* num_str real_add_divide_distrib)
16.265 -* (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)*)
16.266 -* ]),
16.267 -* Calc ("HOL.divide" ,eval_cancel "#divide_")
16.268 -* ],
16.269 -* scr = EmptyScr
16.270 -* }:rls);
16.271 -.......................................................................*)
16.272 -
16.273 -val integration =
16.274 - Seq {id="integration", preconds = [],
16.275 - rew_ord = ("termlessI",termlessI),
16.276 - erls = Rls {id="conditions_in_integration",
16.277 - preconds = [],
16.278 - rew_ord = ("termlessI",termlessI),
16.279 - erls = Erls,
16.280 - srls = Erls, calc = [],
16.281 - rules = [],
16.282 - scr = EmptyScr},
16.283 - srls = Erls, calc = [],
16.284 - rules = [ Rls_ integration_rules,
16.285 - Rls_ add_new_c,
16.286 - Rls_ simplify_Integral
16.287 - ],
16.288 - scr = EmptyScr};
16.289 -ruleset' :=
16.290 -overwritelthy thy (!ruleset',
16.291 - [("integration_rules", prep_rls integration_rules),
16.292 - ("add_new_c", prep_rls add_new_c),
16.293 - ("simplify_Integral", prep_rls simplify_Integral),
16.294 - ("integration", prep_rls integration),
16.295 - ("separate_bdv2", separate_bdv2),
16.296 - ("norm_Rational_noadd_fractions", norm_Rational_noadd_fractions),
16.297 - ("norm_Rational_rls_noadd_fractions",
16.298 - norm_Rational_rls_noadd_fractions)
16.299 - ]);
16.300 -
16.301 -(** problems **)
16.302 -
16.303 -store_pbt
16.304 - (prep_pbt (theory "Integrate") "pbl_fun_integ" [] e_pblID
16.305 - (["integrate","function"],
16.306 - [("#Given" ,["functionTerm f_", "integrateBy v_"]),
16.307 - ("#Find" ,["antiDerivative F_"])
16.308 - ],
16.309 - append_rls "e_rls" e_rls [(*for preds in where_*)],
16.310 - SOME "Integrate (f_, v_)",
16.311 - [["diff","integration"]]));
16.312 -
16.313 -(*here "named" is used differently from Differentiation"*)
16.314 -store_pbt
16.315 - (prep_pbt (theory "Integrate") "pbl_fun_integ_nam" [] e_pblID
16.316 - (["named","integrate","function"],
16.317 - [("#Given" ,["functionTerm f_", "integrateBy v_"]),
16.318 - ("#Find" ,["antiDerivativeName F_"])
16.319 - ],
16.320 - append_rls "e_rls" e_rls [(*for preds in where_*)],
16.321 - SOME "Integrate (f_, v_)",
16.322 - [["diff","integration","named"]]));
16.323 -
16.324 -(** methods **)
16.325 -
16.326 -store_met
16.327 - (prep_met (theory "Integrate") "met_diffint" [] e_metID
16.328 - (["diff","integration"],
16.329 - [("#Given" ,["functionTerm f_", "integrateBy v_"]),
16.330 - ("#Find" ,["antiDerivative F_"])
16.331 - ],
16.332 - {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
16.333 - srls = e_rls,
16.334 - prls=e_rls,
16.335 - crls = Atools_erls, nrls = e_rls},
16.336 -"Script IntegrationScript (f_::real) (v_::real) = " ^
16.337 -" (let t_ = Take (Integral f_ D v_) " ^
16.338 -" in (Rewrite_Set_Inst [(bdv,v_)] integration False) (t_::real))"
16.339 -));
16.340 -
16.341 -store_met
16.342 - (prep_met (theory "Integrate") "met_diffint_named" [] e_metID
16.343 - (["diff","integration","named"],
16.344 - [("#Given" ,["functionTerm f_", "integrateBy v_"]),
16.345 - ("#Find" ,["antiDerivativeName F_"])
16.346 - ],
16.347 - {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
16.348 - srls = e_rls,
16.349 - prls=e_rls,
16.350 - crls = Atools_erls, nrls = e_rls},
16.351 -"Script NamedIntegrationScript (f_::real) (v_::real) (F_::real=>real) = " ^
16.352 -" (let t_ = Take (F_ v_ = Integral f_ D v_) " ^
16.353 -" in ((Try (Rewrite_Set_Inst [(bdv,v_)] simplify_Integral False)) @@ " ^
16.354 -" (Rewrite_Set_Inst [(bdv,v_)] integration False)) t_) "
16.355 - ));
17.1 --- a/src/Tools/isac/Knowledge/Integrate.thy Fri Aug 27 10:39:12 2010 +0200
17.2 +++ b/src/Tools/isac/Knowledge/Integrate.thy Fri Aug 27 14:56:54 2010 +0200
17.3 @@ -2,16 +2,9 @@
17.4 author: Walther Neuper
17.5 050814, 08:51
17.6 (c) due to copyright terms
17.7 -
17.8 -remove_thy"Integrate";
17.9 -use_thy"Knowledge/Integrate";
17.10 -use_thy_only"Knowledge/Integrate";
17.11 -
17.12 -remove_thy"Typefix";
17.13 -use_thy"Knowledge/Isac";
17.14 *)
17.15
17.16 -Integrate = Diff +
17.17 +theory Integrate imports Diff begin
17.18
17.19 consts
17.20
17.21 @@ -33,7 +26,7 @@
17.22 NamedIntegrationScript :: "[real,real, real=>real, bool] => bool"
17.23 ("((Script NamedIntegrationScript (_ _ _=))// (_))" 9)
17.24
17.25 -rules
17.26 +axioms
17.27 (*stated as axioms, todo: prove as theorems
17.28 'bdv' is a constant handled on the meta-level
17.29 specifically as a 'bound variable' *)
17.30 @@ -41,14 +34,354 @@
17.31 integral_const "Not (bdv occurs_in u) ==> Integral u D bdv = u * bdv"
17.32 integral_var "Integral bdv D bdv = bdv ^^^ 2 / 2"
17.33
17.34 - integral_add "Integral (u + v) D bdv = \
17.35 - \(Integral u D bdv) + (Integral v D bdv)"
17.36 - integral_mult "[| Not (bdv occurs_in u); bdv occurs_in v |] ==> \
17.37 - \Integral (u * v) D bdv = u * (Integral v D bdv)"
17.38 + integral_add "Integral (u + v) D bdv =
17.39 + (Integral u D bdv) + (Integral v D bdv)"
17.40 + integral_mult "[| Not (bdv occurs_in u); bdv occurs_in v |] ==>
17.41 + Integral (u * v) D bdv = u * (Integral v D bdv)"
17.42 (*WN080222: this goes into sub-terms, too ...
17.43 - call_for_new_c "[| Not (matches (u + new_c v) a); Not (a is_f_x) |] ==> \
17.44 - \a = a + new_c a"
17.45 + call_for_new_c "[| Not (matches (u + new_c v) a); Not (a is_f_x) |] ==>
17.46 + a = a + new_c a"
17.47 *)
17.48 integral_pow "Integral bdv ^^^ n D bdv = bdv ^^^ (n+1) / (n + 1)"
17.49
17.50 +ML {*
17.51 +(** eval functions **)
17.52 +
17.53 +val c = Free ("c", HOLogic.realT);
17.54 +(*.create a new unique variable 'c..' in a term; for use by Calc in a rls;
17.55 + an alternative to do this would be '(Try (Calculate new_c_) (new_c es__))'
17.56 + in the script; this will be possible if currying doesnt take the value
17.57 + from a variable, but the value '(new_c es__)' itself.*)
17.58 +fun new_c term =
17.59 + let fun selc var =
17.60 + case (explode o id_of) var of
17.61 + "c"::[] => true
17.62 + | "c"::"_"::is => (case (int_of_str o implode) is of
17.63 + SOME _ => true
17.64 + | NONE => false)
17.65 + | _ => false;
17.66 + fun get_coeff c = case (explode o id_of) c of
17.67 + "c"::"_"::is => (the o int_of_str o implode) is
17.68 + | _ => 0;
17.69 + val cs = filter selc (vars term);
17.70 + in
17.71 + case cs of
17.72 + [] => c
17.73 + | [c] => Free ("c_2", HOLogic.realT)
17.74 + | cs =>
17.75 + let val max_coeff = maxl (map get_coeff cs)
17.76 + in Free ("c_"^string_of_int (max_coeff + 1), HOLogic.realT) end
17.77 + end;
17.78 +
17.79 +(*WN080222
17.80 +(*("new_c", ("Integrate.new'_c", eval_new_c "#new_c_"))*)
17.81 +fun eval_new_c _ _ (p as (Const ("Integrate.new'_c",_) $ t)) _ =
17.82 + SOME ((term2str p) ^ " = " ^ term2str (new_c p),
17.83 + Trueprop $ (mk_equality (p, new_c p)))
17.84 + | eval_new_c _ _ _ _ = NONE;
17.85 +*)
17.86 +
17.87 +(*WN080222:*)
17.88 +(*("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "#add_new_c_"))
17.89 + add a new c to a term or a fun-equation;
17.90 + this is _not in_ the term, because only applied to _whole_ term*)
17.91 +fun eval_add_new_c (_:string) "Integrate.add'_new'_c" p (_:theory) =
17.92 + let val p' = case p of
17.93 + Const ("op =", T) $ lh $ rh =>
17.94 + Const ("op =", T) $ lh $ mk_add rh (new_c rh)
17.95 + | p => mk_add p (new_c p)
17.96 + in SOME ((term2str p) ^ " = " ^ term2str p',
17.97 + Trueprop $ (mk_equality (p, p')))
17.98 + end
17.99 + | eval_add_new_c _ _ _ _ = NONE;
17.100 +
17.101 +
17.102 +(*("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_x_"))*)
17.103 +fun eval_is_f_x _ _(p as (Const ("Integrate.is'_f'_x", _)
17.104 + $ arg)) _ =
17.105 + if is_f_x arg
17.106 + then SOME ((term2str p) ^ " = True",
17.107 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
17.108 + else SOME ((term2str p) ^ " = False",
17.109 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
17.110 + | eval_is_f_x _ _ _ _ = NONE;
17.111 +
17.112 +calclist':= overwritel (!calclist',
17.113 + [(*("new_c", ("Integrate.new'_c", eval_new_c "new_c_")),*)
17.114 + ("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "add_new_c_")),
17.115 + ("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_idextifier_"))
17.116 + ]);
17.117 +
17.118 +
17.119 +(** rulesets **)
17.120 +
17.121 +(*.rulesets for integration.*)
17.122 +val integration_rules =
17.123 + Rls {id="integration_rules", preconds = [],
17.124 + rew_ord = ("termlessI",termlessI),
17.125 + erls = Rls {id="conditions_in_integration_rules",
17.126 + preconds = [],
17.127 + rew_ord = ("termlessI",termlessI),
17.128 + erls = Erls,
17.129 + srls = Erls, calc = [],
17.130 + rules = [(*for rewriting conditions in Thm's*)
17.131 + Calc ("Atools.occurs'_in",
17.132 + eval_occurs_in "#occurs_in_"),
17.133 + Thm ("not_true",num_str not_true),
17.134 + Thm ("not_false",not_false)
17.135 + ],
17.136 + scr = EmptyScr},
17.137 + srls = Erls, calc = [],
17.138 + rules = [
17.139 + Thm ("integral_const",num_str integral_const),
17.140 + Thm ("integral_var",num_str integral_var),
17.141 + Thm ("integral_add",num_str integral_add),
17.142 + Thm ("integral_mult",num_str integral_mult),
17.143 + Thm ("integral_pow",num_str integral_pow),
17.144 + Calc ("op +", eval_binop "#add_")(*for n+1*)
17.145 + ],
17.146 + scr = EmptyScr};
17.147 +val add_new_c =
17.148 + Seq {id="add_new_c", preconds = [],
17.149 + rew_ord = ("termlessI",termlessI),
17.150 + erls = Rls {id="conditions_in_add_new_c",
17.151 + preconds = [],
17.152 + rew_ord = ("termlessI",termlessI),
17.153 + erls = Erls,
17.154 + srls = Erls, calc = [],
17.155 + rules = [Calc ("Tools.matches", eval_matches""),
17.156 + Calc ("Integrate.is'_f'_x",
17.157 + eval_is_f_x "is_f_x_"),
17.158 + Thm ("not_true",num_str not_true),
17.159 + Thm ("not_false",num_str not_false)
17.160 + ],
17.161 + scr = EmptyScr},
17.162 + srls = Erls, calc = [],
17.163 + rules = [ (*Thm ("call_for_new_c", num_str call_for_new_c),*)
17.164 + Cal1 ("Integrate.add'_new'_c", eval_add_new_c "new_c_")
17.165 + ],
17.166 + scr = EmptyScr};
17.167 +
17.168 +(*.rulesets for simplifying Integrals.*)
17.169 +
17.170 +(*.for simplify_Integral adapted from 'norm_Rational_rls'.*)
17.171 +val norm_Rational_rls_noadd_fractions =
17.172 +Rls {id = "norm_Rational_rls_noadd_fractions", preconds = [],
17.173 + rew_ord = ("dummy_ord",dummy_ord),
17.174 + erls = norm_rat_erls, srls = Erls, calc = [],
17.175 + rules = [(*Rls_ common_nominator_p_rls,!!!*)
17.176 + Rls_ (*rat_mult_div_pow original corrected WN051028*)
17.177 + (Rls {id = "rat_mult_div_pow", preconds = [],
17.178 + rew_ord = ("dummy_ord",dummy_ord),
17.179 + erls = (*FIXME.WN051028 e_rls,*)
17.180 + append_rls "e_rls-is_polyexp" e_rls
17.181 + [Calc ("Poly.is'_polyexp",
17.182 + eval_is_polyexp "")],
17.183 + srls = Erls, calc = [],
17.184 + rules = [Thm ("rat_mult",num_str rat_mult),
17.185 + (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
17.186 + Thm ("rat_mult_poly_l",num_str rat_mult_poly_l),
17.187 + (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
17.188 + Thm ("rat_mult_poly_r",num_str rat_mult_poly_r),
17.189 + (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
17.190 +
17.191 + Thm ("real_divide_divide1_mg", real_divide_divide1_mg),
17.192 + (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
17.193 + Thm ("real_divide_divide1_eq", real_divide_divide1_eq),
17.194 + (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
17.195 + Thm ("real_divide_divide2_eq", real_divide_divide2_eq),
17.196 + (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
17.197 + Calc ("HOL.divide" ,eval_cancel "#divide_"),
17.198 +
17.199 + Thm ("rat_power", num_str rat_power)
17.200 + (*"(?a / ?b) ^^^ ?n = ?a ^^^ ?n / ?b ^^^ ?n"*)
17.201 + ],
17.202 + scr = Script ((term_of o the o (parse thy)) "empty_script")
17.203 + }),
17.204 + Rls_ make_rat_poly_with_parentheses,
17.205 + Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
17.206 + Rls_ rat_reduce_1
17.207 + ],
17.208 + scr = Script ((term_of o the o (parse thy)) "empty_script")
17.209 + }:rls;
17.210 +
17.211 +(*.for simplify_Integral adapted from 'norm_Rational'.*)
17.212 +val norm_Rational_noadd_fractions =
17.213 + Seq {id = "norm_Rational_noadd_fractions", preconds = [],
17.214 + rew_ord = ("dummy_ord",dummy_ord),
17.215 + erls = norm_rat_erls, srls = Erls, calc = [],
17.216 + rules = [Rls_ discard_minus_,
17.217 + Rls_ rat_mult_poly,(* removes double fractions like a/b/c *)
17.218 + Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
17.219 + Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
17.220 + Rls_ norm_Rational_rls_noadd_fractions,(* the main rls (#) *)
17.221 + Rls_ discard_parentheses_ (* mult only *)
17.222 + ],
17.223 + scr = Script ((term_of o the o (parse thy)) "empty_script")
17.224 + }:rls;
17.225 +
17.226 +(*.simplify terms before and after Integration such that
17.227 + ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
17.228 + common denominator as done by norm_Rational or make_ratpoly_in.
17.229 + This is a copy from 'make_ratpoly_in' with respective reduction of rules and
17.230 + *1* expand the term, ie. distribute * and / over +
17.231 +.*)
17.232 +val separate_bdv2 =
17.233 + append_rls "separate_bdv2"
17.234 + collect_bdv
17.235 + [Thm ("separate_bdv", num_str separate_bdv),
17.236 + (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
17.237 + Thm ("separate_bdv_n", num_str separate_bdv_n),
17.238 + Thm ("separate_1_bdv", num_str separate_1_bdv),
17.239 + (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
17.240 + Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)(*,
17.241 + (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
17.242 + *****Thm ("real_add_divide_distrib",
17.243 + *****num_str real_add_divide_distrib)
17.244 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)----------*)
17.245 + ];
17.246 +val simplify_Integral =
17.247 + Seq {id = "simplify_Integral", preconds = []:term list,
17.248 + rew_ord = ("dummy_ord", dummy_ord),
17.249 + erls = Atools_erls, srls = Erls,
17.250 + calc = [], (*asm_thm = [],*)
17.251 + rules = [Thm ("real_add_mult_distrib",num_str real_add_mult_distrib),
17.252 + (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
17.253 + Thm ("real_add_divide_distrib",num_str real_add_divide_distrib),
17.254 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
17.255 + (*^^^^^ *1* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
17.256 + Rls_ norm_Rational_noadd_fractions,
17.257 + Rls_ order_add_mult_in,
17.258 + Rls_ discard_parentheses,
17.259 + (*Rls_ collect_bdv, from make_polynomial_in*)
17.260 + Rls_ separate_bdv2,
17.261 + Calc ("HOL.divide" ,eval_cancel "#divide_")
17.262 + ],
17.263 + scr = EmptyScr}:rls;
17.264 +
17.265 +
17.266 +(*simplify terms before and after Integration such that
17.267 + ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
17.268 + common denominator as done by norm_Rational or make_ratpoly_in.
17.269 + This is a copy from 'make_polynomial_in' with insertions from
17.270 + 'make_ratpoly_in'
17.271 +THIS IS KEPT FOR COMPARISON ............................................
17.272 +* val simplify_Integral = prep_rls(
17.273 +* Seq {id = "", preconds = []:term list,
17.274 +* rew_ord = ("dummy_ord", dummy_ord),
17.275 +* erls = Atools_erls, srls = Erls,
17.276 +* calc = [], (*asm_thm = [],*)
17.277 +* rules = [Rls_ expand_poly,
17.278 +* Rls_ order_add_mult_in,
17.279 +* Rls_ simplify_power,
17.280 +* Rls_ collect_numerals,
17.281 +* Rls_ reduce_012,
17.282 +* Thm ("realpow_oneI",num_str realpow_oneI),
17.283 +* Rls_ discard_parentheses,
17.284 +* Rls_ collect_bdv,
17.285 +* (*below inserted from 'make_ratpoly_in'*)
17.286 +* Rls_ (append_rls "separate_bdv"
17.287 +* collect_bdv
17.288 +* [Thm ("separate_bdv", num_str separate_bdv),
17.289 +* (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
17.290 +* Thm ("separate_bdv_n", num_str separate_bdv_n),
17.291 +* Thm ("separate_1_bdv", num_str separate_1_bdv),
17.292 +* (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
17.293 +* Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)(*,
17.294 +* (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
17.295 +* Thm ("real_add_divide_distrib",
17.296 +* num_str real_add_divide_distrib)
17.297 +* (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)*)
17.298 +* ]),
17.299 +* Calc ("HOL.divide" ,eval_cancel "#divide_")
17.300 +* ],
17.301 +* scr = EmptyScr
17.302 +* }:rls);
17.303 +.......................................................................*)
17.304 +
17.305 +val integration =
17.306 + Seq {id="integration", preconds = [],
17.307 + rew_ord = ("termlessI",termlessI),
17.308 + erls = Rls {id="conditions_in_integration",
17.309 + preconds = [],
17.310 + rew_ord = ("termlessI",termlessI),
17.311 + erls = Erls,
17.312 + srls = Erls, calc = [],
17.313 + rules = [],
17.314 + scr = EmptyScr},
17.315 + srls = Erls, calc = [],
17.316 + rules = [ Rls_ integration_rules,
17.317 + Rls_ add_new_c,
17.318 + Rls_ simplify_Integral
17.319 + ],
17.320 + scr = EmptyScr};
17.321 +ruleset' :=
17.322 +overwritelthy thy (!ruleset',
17.323 + [("integration_rules", prep_rls integration_rules),
17.324 + ("add_new_c", prep_rls add_new_c),
17.325 + ("simplify_Integral", prep_rls simplify_Integral),
17.326 + ("integration", prep_rls integration),
17.327 + ("separate_bdv2", separate_bdv2),
17.328 + ("norm_Rational_noadd_fractions", norm_Rational_noadd_fractions),
17.329 + ("norm_Rational_rls_noadd_fractions",
17.330 + norm_Rational_rls_noadd_fractions)
17.331 + ]);
17.332 +
17.333 +(** problems **)
17.334 +
17.335 +store_pbt
17.336 + (prep_pbt (theory "Integrate") "pbl_fun_integ" [] e_pblID
17.337 + (["integrate","function"],
17.338 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
17.339 + ("#Find" ,["antiDerivative F_"])
17.340 + ],
17.341 + append_rls "e_rls" e_rls [(*for preds in where_*)],
17.342 + SOME "Integrate (f_, v_)",
17.343 + [["diff","integration"]]));
17.344 +
17.345 +(*here "named" is used differently from Differentiation"*)
17.346 +store_pbt
17.347 + (prep_pbt (theory "Integrate") "pbl_fun_integ_nam" [] e_pblID
17.348 + (["named","integrate","function"],
17.349 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
17.350 + ("#Find" ,["antiDerivativeName F_"])
17.351 + ],
17.352 + append_rls "e_rls" e_rls [(*for preds in where_*)],
17.353 + SOME "Integrate (f_, v_)",
17.354 + [["diff","integration","named"]]));
17.355 +
17.356 +(** methods **)
17.357 +
17.358 +store_met
17.359 + (prep_met (theory "Integrate") "met_diffint" [] e_metID
17.360 + (["diff","integration"],
17.361 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
17.362 + ("#Find" ,["antiDerivative F_"])
17.363 + ],
17.364 + {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
17.365 + srls = e_rls,
17.366 + prls=e_rls,
17.367 + crls = Atools_erls, nrls = e_rls},
17.368 +"Script IntegrationScript (f_::real) (v_::real) = " ^
17.369 +" (let t_ = Take (Integral f_ D v_) " ^
17.370 +" in (Rewrite_Set_Inst [(bdv,v_)] integration False) (t_::real))"
17.371 +));
17.372 +
17.373 +store_met
17.374 + (prep_met (theory "Integrate") "met_diffint_named" [] e_metID
17.375 + (["diff","integration","named"],
17.376 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
17.377 + ("#Find" ,["antiDerivativeName F_"])
17.378 + ],
17.379 + {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
17.380 + srls = e_rls,
17.381 + prls=e_rls,
17.382 + crls = Atools_erls, nrls = e_rls},
17.383 +"Script NamedIntegrationScript (f_::real) (v_::real) (F_::real=>real) = " ^
17.384 +" (let t_ = Take (F_ v_ = Integral f_ D v_) " ^
17.385 +" in ((Try (Rewrite_Set_Inst [(bdv,v_)] simplify_Integral False)) @@ " ^
17.386 +" (Rewrite_Set_Inst [(bdv,v_)] integration False)) t_) "
17.387 + ));
17.388 +*}
17.389 +
17.390 end
17.391 \ No newline at end of file
18.1 --- a/src/Tools/isac/Knowledge/Isac.ML Fri Aug 27 10:39:12 2010 +0200
18.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
18.3 @@ -1,38 +0,0 @@
18.4 -(* collect all knowledge defined in theories so far
18.5 - author: Walther Neuper 0003
18.6 - (c) isac-team
18.7 -
18.8 -use"Knowledge/Isac.ML";
18.9 -use"Isac.ML";
18.10 - *)
18.11 -
18.12 -
18.13 -theory' := overwritel (!theory', [("Isac.thy",Isac.thy)]);
18.14 -
18.15 -
18.16 -(**.set up a list for getting guh + theID for a thm (defined in isabelle).**)
18.17 -
18.18 -(*.get all theorems used by isac and defined in isabelle.*)
18.19 -local
18.20 - val isacrlsthms = ((gen_distinct eq_thmI) o (map rep_thm_G') o flat o
18.21 - (map (thms_of_rls o #2 o #2))) (!ruleset');
18.22 - val isacthms = (flat o (map (PureThy.all_thms_of o #2)))
18.23 - (*WN100827 TODOOOOO*)(!theory');
18.24 -in
18.25 - val rlsthmsNOTisac = gen_diff eq_thmI (isacrlsthms, isacthms);
18.26 -end;
18.27 -
18.28 -(*.set up the list using 'val first_isac_thy' (see ListC.ML).*)
18.29 -isab_thm_thy := make_isab rlsthmsNOTisac
18.30 - ((#ancestors o rep_theory) first_isac_thy);
18.31 -
18.32 -
18.33 -(*.create the hierarchy of theory elements from IsacKnowledge
18.34 - including thms from Isabelle used in rls;
18.35 - elements store_*d in any *.ML are not overwritten.*)
18.36 -
18.37 -thehier := the_hier (!thehier) (collect_thydata ());
18.38 -writeln("----------------------------------\n" ^
18.39 - "*** insert: not found ... IS OK : \n" ^
18.40 - "comes from fill_parents \n" ^
18.41 - "----------------------------------\n");
19.1 --- a/src/Tools/isac/Knowledge/Isac.thy Fri Aug 27 10:39:12 2010 +0200
19.2 +++ b/src/Tools/isac/Knowledge/Isac.thy Fri Aug 27 14:56:54 2010 +0200
19.3 @@ -2,12 +2,10 @@
19.4 WN.11.00
19.5 *)
19.6
19.7 -Isac = PolyMinus + PolyEq + Vect + DiffApp + Biegelinie + AlgEin
19.8 - + (*InsSort +*) Test +
19.9 +theory Isac imports PolyMinus PolyEq Vect DiffApp Biegelinie AlgEin
19.10 + (*InsSort +*) Test begin
19.11
19.12 -end
19.13 -
19.14 -(* dependencies alternative to those defined by R.Lang during his thesis:
19.15 +text {* dependencies alternative to those defined by R.Lang during his thesis:
19.16
19.17 Poly Root
19.18 |\__________ |
19.19 @@ -18,4 +16,35 @@
19.20 \ / \ /
19.21 \ / \ /
19.22 RatPolyEq RatRootEq etc.
19.23 -*)
19.24 +*}
19.25 +
19.26 +ML {*
19.27 +(**.set up a list for getting guh + theID for a thm (defined in isabelle).**)
19.28 +
19.29 +(*.get all theorems used by isac and defined in isabelle.*)
19.30 +local
19.31 + val isacrlsthms = ((gen_distinct eq_thmI) o (map rep_thm_G') o flat o
19.32 + (map (thms_of_rls o #2 o #2))) (!ruleset');
19.33 + val isacthms = (flat o (map (PureThy.all_thms_of o #2)))
19.34 + (*WN100827 TODOOOOO*)(!theory');
19.35 +in
19.36 + val rlsthmsNOTisac = gen_diff eq_thmI (isacrlsthms, isacthms);
19.37 +end;
19.38 +
19.39 +(*.set up the list using 'val first_isac_thy' (see ListC.ML).*)
19.40 +isab_thm_thy := make_isab rlsthmsNOTisac
19.41 + ((#ancestors o rep_theory) first_isac_thy);
19.42 +
19.43 +
19.44 +(*.create the hierarchy of theory elements from IsacKnowledge
19.45 + including thms from Isabelle used in rls;
19.46 + elements store_*d in any *.ML are not overwritten.*)
19.47 +
19.48 +thehier := the_hier (!thehier) (collect_thydata ());
19.49 +writeln("----------------------------------\n" ^
19.50 + "*** insert: not found ... IS OK : \n" ^
19.51 + "comes from fill_parents \n" ^
19.52 + "----------------------------------\n");
19.53 +*}
19.54 +
19.55 +end
20.1 --- a/src/Tools/isac/Knowledge/LogExp.ML Fri Aug 27 10:39:12 2010 +0200
20.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
20.3 @@ -1,39 +0,0 @@
20.4 -(* all outcommented in order to demonstrate authoring:
20.5 - WN071203
20.6 -*)
20.7 -
20.8 -(** interface isabelle -- isac **)
20.9 -theory' := overwritel (!theory', [("LogExp.thy",LogExp.thy)]);
20.10 -
20.11 -(*--------------------------------------------------*)
20.12 -
20.13 -(** problems **)
20.14 -store_pbt
20.15 - (prep_pbt (theory "LogExp") "pbl_test_equ_univ_log" [] e_pblID
20.16 - (["logarithmic","univariate","equation"],
20.17 - [("#Given",["equality e_","solveFor v_"]),
20.18 - ("#Where",["matches ((?a log ?v_) = ?b) e_"]),
20.19 - ("#Find" ,["solutions v_i_"]),
20.20 - ("#With" ,["||(lhs (Subst (v_i_,v_) e_) - " ^
20.21 - " (rhs (Subst (v_i_,v_) e_) || < eps)"])
20.22 - ],
20.23 - PolyEq_prls, SOME "solve (e_::bool, v_)",
20.24 - [["Equation","solve_log"]]));
20.25 -
20.26 -(** methods **)
20.27 -store_met
20.28 - (prep_met (theory "LogExp") "met_equ_log" [] e_metID
20.29 - (["Equation","solve_log"],
20.30 - [("#Given" ,["equality e_","solveFor v_"]),
20.31 - ("#Where" ,["matches ((?a log ?v_) = ?b) e_"]),
20.32 - ("#Find" ,["solutions v_i_"])
20.33 - ],
20.34 - {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
20.35 - calc=[],crls=PolyEq_crls, nrls=norm_Rational},
20.36 - "Script Solve_log (e_::bool) (v_::real) = " ^
20.37 - "(let e_ = ((Rewrite equality_power False) @@ " ^
20.38 - " (Rewrite exp_invers_log False) @@ " ^
20.39 - " (Rewrite_Set norm_Poly False)) e_ " ^
20.40 - " in [e_])"
20.41 - ));
20.42 -(*--------------------------------------------------*)
21.1 --- a/src/Tools/isac/Knowledge/LogExp.thy Fri Aug 27 10:39:12 2010 +0200
21.2 +++ b/src/Tools/isac/Knowledge/LogExp.thy Fri Aug 27 14:56:54 2010 +0200
21.3 @@ -1,10 +1,8 @@
21.4 (* all outcommented in order to demonstrate authoring:
21.5 WN071203
21.6 -remove_thy"LogExp";
21.7 -use_thy_only"Knowledge/LogExp";
21.8 -use_thy_only"Knowledge/Isac";
21.9 *)
21.10 -LogExp = PolyEq +
21.11 +
21.12 +theory LogExp imports PolyEq begin
21.13
21.14 consts
21.15
21.16 @@ -15,8 +13,8 @@
21.17 alog :: "[real, real] => real" ("_ log _" 90)
21.18
21.19 (*Script-names*)
21.20 - Solve'_log :: "[bool,real, bool list] \
21.21 - \=> bool list"
21.22 + Solve'_log :: "[bool,real, bool list]
21.23 + => bool list"
21.24 ("((Script Solve'_log (_ _=))//(_))" 9)
21.25
21.26 rules
21.27 @@ -25,6 +23,37 @@
21.28 (* this is what students ^^^^^^^... are told to do *)
21.29 equality_power "((a log b) = c) = (a^^^(a log b) = a^^^c)"
21.30 exp_invers_log "a^^^(a log b) = b"
21.31 -(*---------------------------------------------------*)
21.32 +
21.33 +ML {*
21.34 +(** problems **)
21.35 +store_pbt
21.36 + (prep_pbt (theory "LogExp") "pbl_test_equ_univ_log" [] e_pblID
21.37 + (["logarithmic","univariate","equation"],
21.38 + [("#Given",["equality e_","solveFor v_"]),
21.39 + ("#Where",["matches ((?a log ?v_) = ?b) e_"]),
21.40 + ("#Find" ,["solutions v_i_"]),
21.41 + ("#With" ,["||(lhs (Subst (v_i_,v_) e_) - " ^
21.42 + " (rhs (Subst (v_i_,v_) e_) || < eps)"])
21.43 + ],
21.44 + PolyEq_prls, SOME "solve (e_::bool, v_)",
21.45 + [["Equation","solve_log"]]));
21.46 +
21.47 +(** methods **)
21.48 +store_met
21.49 + (prep_met (theory "LogExp") "met_equ_log" [] e_metID
21.50 + (["Equation","solve_log"],
21.51 + [("#Given" ,["equality e_","solveFor v_"]),
21.52 + ("#Where" ,["matches ((?a log ?v_) = ?b) e_"]),
21.53 + ("#Find" ,["solutions v_i_"])
21.54 + ],
21.55 + {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
21.56 + calc=[],crls=PolyEq_crls, nrls=norm_Rational},
21.57 + "Script Solve_log (e_::bool) (v_::real) = " ^
21.58 + "(let e_ = ((Rewrite equality_power False) @@ " ^
21.59 + " (Rewrite exp_invers_log False) @@ " ^
21.60 + " (Rewrite_Set norm_Poly False)) e_ " ^
21.61 + " in [e_])"
21.62 + ));
21.63 +*}
21.64
21.65 end
21.66 \ No newline at end of file
22.1 --- a/src/Tools/isac/Knowledge/PolyEq.ML Fri Aug 27 10:39:12 2010 +0200
22.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
22.3 @@ -1,1108 +0,0 @@
22.4 -(*. (c) by Richard Lang, 2003 .*)
22.5 -(* collecting all knowledge for PolynomialEquations
22.6 - created by: rlang
22.7 - date: 02.07
22.8 - changed by: rlang
22.9 - last change by: rlang
22.10 - date: 02.11.26
22.11 -*)
22.12 -
22.13 -(* use"Knowledge/PolyEq.ML";
22.14 - use"PolyEq.ML";
22.15 -
22.16 - use"ROOT.ML";
22.17 - cd"IsacKnowledge";
22.18 -
22.19 - remove_thy"PolyEq";
22.20 - use_thy"Knowledge/Isac";
22.21 - *)
22.22 -"******* PolyEq.ML begin *******";
22.23 -
22.24 -theory' := overwritel (!theory', [("PolyEq.thy",PolyEq.thy)]);
22.25 -(*-------------------------functions---------------------*)
22.26 -
22.27 -(*-------------------------rulse-------------------------*)
22.28 -val PolyEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
22.29 - append_rls "PolyEq_prls" e_rls
22.30 - [Calc ("Atools.ident",eval_ident "#ident_"),
22.31 - Calc ("Tools.matches",eval_matches ""),
22.32 - Calc ("Tools.lhs" ,eval_lhs ""),
22.33 - Calc ("Tools.rhs" ,eval_rhs ""),
22.34 - Calc ("Poly.is'_expanded'_in",eval_is_expanded_in ""),
22.35 - Calc ("Poly.is'_poly'_in",eval_is_poly_in ""),
22.36 - Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),
22.37 - Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
22.38 - (*Calc ("Atools.occurs'_in",eval_occurs_in ""), *)
22.39 - (*Calc ("Atools.is'_const",eval_const "#is_const_"),*)
22.40 - Calc ("op =",eval_equal "#equal_"),
22.41 - Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
22.42 - Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
22.43 - Thm ("not_true",num_str not_true),
22.44 - Thm ("not_false",num_str not_false),
22.45 - Thm ("and_true",num_str and_true),
22.46 - Thm ("and_false",num_str and_false),
22.47 - Thm ("or_true",num_str or_true),
22.48 - Thm ("or_false",num_str or_false)
22.49 - ];
22.50 -
22.51 -val PolyEq_erls =
22.52 - merge_rls "PolyEq_erls" LinEq_erls
22.53 - (append_rls "ops_preds" calculate_Rational
22.54 - [Calc ("op =",eval_equal "#equal_"),
22.55 - Thm ("plus_leq", num_str plus_leq),
22.56 - Thm ("minus_leq", num_str minus_leq),
22.57 - Thm ("rat_leq1", num_str rat_leq1),
22.58 - Thm ("rat_leq2", num_str rat_leq2),
22.59 - Thm ("rat_leq3", num_str rat_leq3)
22.60 - ]);
22.61 -
22.62 -val PolyEq_crls =
22.63 - merge_rls "PolyEq_crls" LinEq_crls
22.64 - (append_rls "ops_preds" calculate_Rational
22.65 - [Calc ("op =",eval_equal "#equal_"),
22.66 - Thm ("plus_leq", num_str plus_leq),
22.67 - Thm ("minus_leq", num_str minus_leq),
22.68 - Thm ("rat_leq1", num_str rat_leq1),
22.69 - Thm ("rat_leq2", num_str rat_leq2),
22.70 - Thm ("rat_leq3", num_str rat_leq3)
22.71 - ]);
22.72 -
22.73 -val cancel_leading_coeff = prep_rls(
22.74 - Rls {id = "cancel_leading_coeff", preconds = [],
22.75 - rew_ord = ("e_rew_ord",e_rew_ord),
22.76 - erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
22.77 - rules = [Thm ("cancel_leading_coeff1",num_str cancel_leading_coeff1),
22.78 - Thm ("cancel_leading_coeff2",num_str cancel_leading_coeff2),
22.79 - Thm ("cancel_leading_coeff3",num_str cancel_leading_coeff3),
22.80 - Thm ("cancel_leading_coeff4",num_str cancel_leading_coeff4),
22.81 - Thm ("cancel_leading_coeff5",num_str cancel_leading_coeff5),
22.82 - Thm ("cancel_leading_coeff6",num_str cancel_leading_coeff6),
22.83 - Thm ("cancel_leading_coeff7",num_str cancel_leading_coeff7),
22.84 - Thm ("cancel_leading_coeff8",num_str cancel_leading_coeff8),
22.85 - Thm ("cancel_leading_coeff9",num_str cancel_leading_coeff9),
22.86 - Thm ("cancel_leading_coeff10",num_str cancel_leading_coeff10),
22.87 - Thm ("cancel_leading_coeff11",num_str cancel_leading_coeff11),
22.88 - Thm ("cancel_leading_coeff12",num_str cancel_leading_coeff12),
22.89 - Thm ("cancel_leading_coeff13",num_str cancel_leading_coeff13)
22.90 - ],
22.91 - scr = Script ((term_of o the o (parse thy))
22.92 - "empty_script")
22.93 - }:rls);
22.94 -
22.95 -val complete_square = prep_rls(
22.96 - Rls {id = "complete_square", preconds = [],
22.97 - rew_ord = ("e_rew_ord",e_rew_ord),
22.98 - erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
22.99 - rules = [Thm ("complete_square1",num_str complete_square1),
22.100 - Thm ("complete_square2",num_str complete_square2),
22.101 - Thm ("complete_square3",num_str complete_square3),
22.102 - Thm ("complete_square4",num_str complete_square4),
22.103 - Thm ("complete_square5",num_str complete_square5)
22.104 - ],
22.105 - scr = Script ((term_of o the o (parse thy))
22.106 - "empty_script")
22.107 - }:rls);
22.108 -
22.109 -val polyeq_simplify = prep_rls(
22.110 - Rls {id = "polyeq_simplify", preconds = [],
22.111 - rew_ord = ("termlessI",termlessI),
22.112 - erls = PolyEq_erls,
22.113 - srls = Erls,
22.114 - calc = [],
22.115 - (*asm_thm = [],*)
22.116 - rules = [Thm ("real_assoc_1",num_str real_assoc_1),
22.117 - Thm ("real_assoc_2",num_str real_assoc_2),
22.118 - Thm ("real_diff_minus",num_str real_diff_minus),
22.119 - Thm ("real_unari_minus",num_str real_unari_minus),
22.120 - Thm ("realpow_multI",num_str realpow_multI),
22.121 - Calc ("op +",eval_binop "#add_"),
22.122 - Calc ("op -",eval_binop "#sub_"),
22.123 - Calc ("op *",eval_binop "#mult_"),
22.124 - Calc ("HOL.divide", eval_cancel "#divide_"),
22.125 - Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
22.126 - Calc ("Atools.pow" ,eval_binop "#power_"),
22.127 - Rls_ reduce_012
22.128 - ],
22.129 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.130 - }:rls);
22.131 -
22.132 -ruleset' := overwritelthy thy (!ruleset',
22.133 - [("cancel_leading_coeff",cancel_leading_coeff),
22.134 - ("complete_square",complete_square),
22.135 - ("PolyEq_erls",PolyEq_erls),(*FIXXXME:del with rls.rls'*)
22.136 - ("polyeq_simplify",polyeq_simplify)]);
22.137 -
22.138 -
22.139 -(* ------------- polySolve ------------------ *)
22.140 -(* -- d0 -- *)
22.141 -(*isolate the bound variable in an d0 equation; 'bdv' is a meta-constant*)
22.142 -val d0_polyeq_simplify = prep_rls(
22.143 - Rls {id = "d0_polyeq_simplify", preconds = [],
22.144 - rew_ord = ("e_rew_ord",e_rew_ord),
22.145 - erls = PolyEq_erls,
22.146 - srls = Erls,
22.147 - calc = [],
22.148 - (*asm_thm = [],*)
22.149 - rules = [Thm("d0_true",num_str d0_true),
22.150 - Thm("d0_false",num_str d0_false)
22.151 - ],
22.152 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.153 - }:rls);
22.154 -
22.155 -(* -- d1 -- *)
22.156 -(*isolate the bound variable in an d1 equation; 'bdv' is a meta-constant*)
22.157 -val d1_polyeq_simplify = prep_rls(
22.158 - Rls {id = "d1_polyeq_simplify", preconds = [],
22.159 - rew_ord = ("e_rew_ord",e_rew_ord),
22.160 - erls = PolyEq_erls,
22.161 - srls = Erls,
22.162 - calc = [],
22.163 - (*asm_thm = [("d1_isolate_div","")],*)
22.164 - rules = [
22.165 - Thm("d1_isolate_add1",num_str d1_isolate_add1),
22.166 - (* a+bx=0 -> bx=-a *)
22.167 - Thm("d1_isolate_add2",num_str d1_isolate_add2),
22.168 - (* a+ x=0 -> x=-a *)
22.169 - Thm("d1_isolate_div",num_str d1_isolate_div)
22.170 - (* bx=c -> x=c/b *)
22.171 - ],
22.172 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.173 - }:rls);
22.174 -
22.175 -(* -- d2 -- *)
22.176 -(* isolate the bound variable in an d2 equation with bdv only;
22.177 - 'bdv' is a meta-constant*)
22.178 -val d2_polyeq_bdv_only_simplify = prep_rls(
22.179 - Rls {id = "d2_polyeq_bdv_only_simplify", preconds = [],
22.180 - rew_ord = ("e_rew_ord",e_rew_ord),
22.181 - erls = PolyEq_erls,
22.182 - srls = Erls,
22.183 - calc = [],
22.184 - (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
22.185 - ("d2_isolate_div","")],*)
22.186 - rules = [Thm("d2_prescind1",num_str d2_prescind1),
22.187 - (* ax+bx^2=0 -> x(a+bx)=0 *)
22.188 - Thm("d2_prescind2",num_str d2_prescind2),
22.189 - (* ax+ x^2=0 -> x(a+ x)=0 *)
22.190 - Thm("d2_prescind3",num_str d2_prescind3),
22.191 - (* x+bx^2=0 -> x(1+bx)=0 *)
22.192 - Thm("d2_prescind4",num_str d2_prescind4),
22.193 - (* x+ x^2=0 -> x(1+ x)=0 *)
22.194 - Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1),
22.195 - (* x^2=c -> x=+-sqrt(c)*)
22.196 - Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),
22.197 - (* [0<c] x^2=c -> [] *)
22.198 - Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
22.199 - (* x^2=0 -> x=0 *)
22.200 - Thm("d2_reduce_equation1",num_str d2_reduce_equation1),
22.201 - (* x(a+bx)=0 -> x=0 | a+bx=0*)
22.202 - Thm("d2_reduce_equation2",num_str d2_reduce_equation2),
22.203 - (* x(a+ x)=0 -> x=0 | a+ x=0*)
22.204 - Thm("d2_isolate_div",num_str d2_isolate_div)
22.205 - (* bx^2=c -> x^2=c/b*)
22.206 - ],
22.207 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.208 - }:rls);
22.209 -
22.210 -(* isolate the bound variable in an d2 equation with sqrt only;
22.211 - 'bdv' is a meta-constant*)
22.212 -val d2_polyeq_sq_only_simplify = prep_rls(
22.213 - Rls {id = "d2_polyeq_sq_only_simplify", preconds = [],
22.214 - rew_ord = ("e_rew_ord",e_rew_ord),
22.215 - erls = PolyEq_erls,
22.216 - srls = Erls,
22.217 - calc = [],
22.218 - (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
22.219 - ("d2_isolate_div","")],*)
22.220 - rules = [Thm("d2_isolate_add1",num_str d2_isolate_add1),
22.221 - (* a+ bx^2=0 -> bx^2=(-1)a*)
22.222 - Thm("d2_isolate_add2",num_str d2_isolate_add2),
22.223 - (* a+ x^2=0 -> x^2=(-1)a*)
22.224 - Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
22.225 - (* x^2=0 -> x=0 *)
22.226 - Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1),
22.227 - (* x^2=c -> x=+-sqrt(c)*)
22.228 - Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),
22.229 - (* [c<0] x^2=c -> x=[] *)
22.230 - Thm("d2_isolate_div",num_str d2_isolate_div)
22.231 - (* bx^2=c -> x^2=c/b*)
22.232 - ],
22.233 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.234 - }:rls);
22.235 -
22.236 -(* isolate the bound variable in an d2 equation with pqFormula;
22.237 - 'bdv' is a meta-constant*)
22.238 -val d2_polyeq_pqFormula_simplify = prep_rls(
22.239 - Rls {id = "d2_polyeq_pqFormula_simplify", preconds = [],
22.240 - rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
22.241 - srls = Erls, calc = [],
22.242 - rules = [Thm("d2_pqformula1",num_str d2_pqformula1),
22.243 - (* q+px+ x^2=0 *)
22.244 - Thm("d2_pqformula1_neg",num_str d2_pqformula1_neg),
22.245 - (* q+px+ x^2=0 *)
22.246 - Thm("d2_pqformula2",num_str d2_pqformula2),
22.247 - (* q+px+1x^2=0 *)
22.248 - Thm("d2_pqformula2_neg",num_str d2_pqformula2_neg),
22.249 - (* q+px+1x^2=0 *)
22.250 - Thm("d2_pqformula3",num_str d2_pqformula3),
22.251 - (* q+ x+ x^2=0 *)
22.252 - Thm("d2_pqformula3_neg",num_str d2_pqformula3_neg),
22.253 - (* q+ x+ x^2=0 *)
22.254 - Thm("d2_pqformula4",num_str d2_pqformula4),
22.255 - (* q+ x+1x^2=0 *)
22.256 - Thm("d2_pqformula4_neg",num_str d2_pqformula4_neg),
22.257 - (* q+ x+1x^2=0 *)
22.258 - Thm("d2_pqformula5",num_str d2_pqformula5),
22.259 - (* qx+ x^2=0 *)
22.260 - Thm("d2_pqformula6",num_str d2_pqformula6),
22.261 - (* qx+1x^2=0 *)
22.262 - Thm("d2_pqformula7",num_str d2_pqformula7),
22.263 - (* x+ x^2=0 *)
22.264 - Thm("d2_pqformula8",num_str d2_pqformula8),
22.265 - (* x+1x^2=0 *)
22.266 - Thm("d2_pqformula9",num_str d2_pqformula9),
22.267 - (* q +1x^2=0 *)
22.268 - Thm("d2_pqformula9_neg",num_str d2_pqformula9_neg),
22.269 - (* q +1x^2=0 *)
22.270 - Thm("d2_pqformula10",num_str d2_pqformula10),
22.271 - (* q + x^2=0 *)
22.272 - Thm("d2_pqformula10_neg",num_str d2_pqformula10_neg),
22.273 - (* q + x^2=0 *)
22.274 - Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
22.275 - (* x^2=0 *)
22.276 - Thm("d2_sqrt_equation3",num_str d2_sqrt_equation3)
22.277 - (* 1x^2=0 *)
22.278 - ],
22.279 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.280 - }:rls);
22.281 -
22.282 -(* isolate the bound variable in an d2 equation with abcFormula;
22.283 - 'bdv' is a meta-constant*)
22.284 -val d2_polyeq_abcFormula_simplify = prep_rls(
22.285 - Rls {id = "d2_polyeq_abcFormula_simplify", preconds = [],
22.286 - rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
22.287 - srls = Erls, calc = [],
22.288 - rules = [Thm("d2_abcformula1",num_str d2_abcformula1),
22.289 - (*c+bx+cx^2=0 *)
22.290 - Thm("d2_abcformula1_neg",num_str d2_abcformula1_neg),
22.291 - (*c+bx+cx^2=0 *)
22.292 - Thm("d2_abcformula2",num_str d2_abcformula2),
22.293 - (*c+ x+cx^2=0 *)
22.294 - Thm("d2_abcformula2_neg",num_str d2_abcformula2_neg),
22.295 - (*c+ x+cx^2=0 *)
22.296 - Thm("d2_abcformula3",num_str d2_abcformula3),
22.297 - (*c+bx+ x^2=0 *)
22.298 - Thm("d2_abcformula3_neg",num_str d2_abcformula3_neg),
22.299 - (*c+bx+ x^2=0 *)
22.300 - Thm("d2_abcformula4",num_str d2_abcformula4),
22.301 - (*c+ x+ x^2=0 *)
22.302 - Thm("d2_abcformula4_neg",num_str d2_abcformula4_neg),
22.303 - (*c+ x+ x^2=0 *)
22.304 - Thm("d2_abcformula5",num_str d2_abcformula5),
22.305 - (*c+ cx^2=0 *)
22.306 - Thm("d2_abcformula5_neg",num_str d2_abcformula5_neg),
22.307 - (*c+ cx^2=0 *)
22.308 - Thm("d2_abcformula6",num_str d2_abcformula6),
22.309 - (*c+ x^2=0 *)
22.310 - Thm("d2_abcformula6_neg",num_str d2_abcformula6_neg),
22.311 - (*c+ x^2=0 *)
22.312 - Thm("d2_abcformula7",num_str d2_abcformula7),
22.313 - (* bx+ax^2=0 *)
22.314 - Thm("d2_abcformula8",num_str d2_abcformula8),
22.315 - (* bx+ x^2=0 *)
22.316 - Thm("d2_abcformula9",num_str d2_abcformula9),
22.317 - (* x+ax^2=0 *)
22.318 - Thm("d2_abcformula10",num_str d2_abcformula10),
22.319 - (* x+ x^2=0 *)
22.320 - Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
22.321 - (* x^2=0 *)
22.322 - Thm("d2_sqrt_equation3",num_str d2_sqrt_equation3)
22.323 - (* bx^2=0 *)
22.324 - ],
22.325 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.326 - }:rls);
22.327 -
22.328 -(* isolate the bound variable in an d2 equation;
22.329 - 'bdv' is a meta-constant*)
22.330 -val d2_polyeq_simplify = prep_rls(
22.331 - Rls {id = "d2_polyeq_simplify", preconds = [],
22.332 - rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
22.333 - srls = Erls, calc = [],
22.334 - rules = [Thm("d2_pqformula1",num_str d2_pqformula1),
22.335 - (* p+qx+ x^2=0 *)
22.336 - Thm("d2_pqformula1_neg",num_str d2_pqformula1_neg),
22.337 - (* p+qx+ x^2=0 *)
22.338 - Thm("d2_pqformula2",num_str d2_pqformula2),
22.339 - (* p+qx+1x^2=0 *)
22.340 - Thm("d2_pqformula2_neg",num_str d2_pqformula2_neg),
22.341 - (* p+qx+1x^2=0 *)
22.342 - Thm("d2_pqformula3",num_str d2_pqformula3),
22.343 - (* p+ x+ x^2=0 *)
22.344 - Thm("d2_pqformula3_neg",num_str d2_pqformula3_neg),
22.345 - (* p+ x+ x^2=0 *)
22.346 - Thm("d2_pqformula4",num_str d2_pqformula4),
22.347 - (* p+ x+1x^2=0 *)
22.348 - Thm("d2_pqformula4_neg",num_str d2_pqformula4_neg),
22.349 - (* p+ x+1x^2=0 *)
22.350 - Thm("d2_abcformula1",num_str d2_abcformula1),
22.351 - (* c+bx+cx^2=0 *)
22.352 - Thm("d2_abcformula1_neg",num_str d2_abcformula1_neg),
22.353 - (* c+bx+cx^2=0 *)
22.354 - Thm("d2_abcformula2",num_str d2_abcformula2),
22.355 - (* c+ x+cx^2=0 *)
22.356 - Thm("d2_abcformula2_neg",num_str d2_abcformula2_neg),
22.357 - (* c+ x+cx^2=0 *)
22.358 - Thm("d2_prescind1",num_str d2_prescind1),
22.359 - (* ax+bx^2=0 -> x(a+bx)=0 *)
22.360 - Thm("d2_prescind2",num_str d2_prescind2),
22.361 - (* ax+ x^2=0 -> x(a+ x)=0 *)
22.362 - Thm("d2_prescind3",num_str d2_prescind3),
22.363 - (* x+bx^2=0 -> x(1+bx)=0 *)
22.364 - Thm("d2_prescind4",num_str d2_prescind4),
22.365 - (* x+ x^2=0 -> x(1+ x)=0 *)
22.366 - Thm("d2_isolate_add1",num_str d2_isolate_add1),
22.367 - (* a+ bx^2=0 -> bx^2=(-1)a*)
22.368 - Thm("d2_isolate_add2",num_str d2_isolate_add2),
22.369 - (* a+ x^2=0 -> x^2=(-1)a*)
22.370 - Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1),
22.371 - (* x^2=c -> x=+-sqrt(c)*)
22.372 - Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),
22.373 - (* [c<0] x^2=c -> x=[]*)
22.374 - Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
22.375 - (* x^2=0 -> x=0 *)
22.376 - Thm("d2_reduce_equation1",num_str d2_reduce_equation1),
22.377 - (* x(a+bx)=0 -> x=0 | a+bx=0*)
22.378 - Thm("d2_reduce_equation2",num_str d2_reduce_equation2),
22.379 - (* x(a+ x)=0 -> x=0 | a+ x=0*)
22.380 - Thm("d2_isolate_div",num_str d2_isolate_div)
22.381 - (* bx^2=c -> x^2=c/b*)
22.382 - ],
22.383 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.384 - }:rls);
22.385 -
22.386 -(* -- d3 -- *)
22.387 -(* isolate the bound variable in an d3 equation; 'bdv' is a meta-constant *)
22.388 -val d3_polyeq_simplify = prep_rls(
22.389 - Rls {id = "d3_polyeq_simplify", preconds = [],
22.390 - rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
22.391 - srls = Erls, calc = [],
22.392 - rules =
22.393 - [Thm("d3_reduce_equation1",num_str d3_reduce_equation1),
22.394 - (*a*bdv + b*bdv^^^2 + c*bdv^^^3=0) =
22.395 - (bdv=0 | (a + b*bdv + c*bdv^^^2=0)*)
22.396 - Thm("d3_reduce_equation2",num_str d3_reduce_equation2),
22.397 - (* bdv + b*bdv^^^2 + c*bdv^^^3=0) =
22.398 - (bdv=0 | (1 + b*bdv + c*bdv^^^2=0)*)
22.399 - Thm("d3_reduce_equation3",num_str d3_reduce_equation3),
22.400 - (*a*bdv + bdv^^^2 + c*bdv^^^3=0) =
22.401 - (bdv=0 | (a + bdv + c*bdv^^^2=0)*)
22.402 - Thm("d3_reduce_equation4",num_str d3_reduce_equation4),
22.403 - (* bdv + bdv^^^2 + c*bdv^^^3=0) =
22.404 - (bdv=0 | (1 + bdv + c*bdv^^^2=0)*)
22.405 - Thm("d3_reduce_equation5",num_str d3_reduce_equation5),
22.406 - (*a*bdv + b*bdv^^^2 + bdv^^^3=0) =
22.407 - (bdv=0 | (a + b*bdv + bdv^^^2=0)*)
22.408 - Thm("d3_reduce_equation6",num_str d3_reduce_equation6),
22.409 - (* bdv + b*bdv^^^2 + bdv^^^3=0) =
22.410 - (bdv=0 | (1 + b*bdv + bdv^^^2=0)*)
22.411 - Thm("d3_reduce_equation7",num_str d3_reduce_equation7),
22.412 - (*a*bdv + bdv^^^2 + bdv^^^3=0) =
22.413 - (bdv=0 | (1 + bdv + bdv^^^2=0)*)
22.414 - Thm("d3_reduce_equation8",num_str d3_reduce_equation8),
22.415 - (* bdv + bdv^^^2 + bdv^^^3=0) =
22.416 - (bdv=0 | (1 + bdv + bdv^^^2=0)*)
22.417 - Thm("d3_reduce_equation9",num_str d3_reduce_equation9),
22.418 - (*a*bdv + c*bdv^^^3=0) =
22.419 - (bdv=0 | (a + c*bdv^^^2=0)*)
22.420 - Thm("d3_reduce_equation10",num_str d3_reduce_equation10),
22.421 - (* bdv + c*bdv^^^3=0) =
22.422 - (bdv=0 | (1 + c*bdv^^^2=0)*)
22.423 - Thm("d3_reduce_equation11",num_str d3_reduce_equation11),
22.424 - (*a*bdv + bdv^^^3=0) =
22.425 - (bdv=0 | (a + bdv^^^2=0)*)
22.426 - Thm("d3_reduce_equation12",num_str d3_reduce_equation12),
22.427 - (* bdv + bdv^^^3=0) =
22.428 - (bdv=0 | (1 + bdv^^^2=0)*)
22.429 - Thm("d3_reduce_equation13",num_str d3_reduce_equation13),
22.430 - (* b*bdv^^^2 + c*bdv^^^3=0) =
22.431 - (bdv=0 | ( b*bdv + c*bdv^^^2=0)*)
22.432 - Thm("d3_reduce_equation14",num_str d3_reduce_equation14),
22.433 - (* bdv^^^2 + c*bdv^^^3=0) =
22.434 - (bdv=0 | ( bdv + c*bdv^^^2=0)*)
22.435 - Thm("d3_reduce_equation15",num_str d3_reduce_equation15),
22.436 - (* b*bdv^^^2 + bdv^^^3=0) =
22.437 - (bdv=0 | ( b*bdv + bdv^^^2=0)*)
22.438 - Thm("d3_reduce_equation16",num_str d3_reduce_equation16),
22.439 - (* bdv^^^2 + bdv^^^3=0) =
22.440 - (bdv=0 | ( bdv + bdv^^^2=0)*)
22.441 - Thm("d3_isolate_add1",num_str d3_isolate_add1),
22.442 - (*[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^3=0) =
22.443 - (bdv=0 | (b*bdv^^^3=a)*)
22.444 - Thm("d3_isolate_add2",num_str d3_isolate_add2),
22.445 - (*[|Not(bdv occurs_in a)|] ==> (a + bdv^^^3=0) =
22.446 - (bdv=0 | ( bdv^^^3=a)*)
22.447 - Thm("d3_isolate_div",num_str d3_isolate_div),
22.448 - (*[|Not(b=0)|] ==> (b*bdv^^^3=c) = (bdv^^^3=c/b*)
22.449 - Thm("d3_root_equation2",num_str d3_root_equation2),
22.450 - (*(bdv^^^3=0) = (bdv=0) *)
22.451 - Thm("d3_root_equation1",num_str d3_root_equation1)
22.452 - (*bdv^^^3=c) = (bdv = nroot 3 c*)
22.453 - ],
22.454 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.455 - }:rls);
22.456 -
22.457 -(* -- d4 -- *)
22.458 -(*isolate the bound variable in an d4 equation; 'bdv' is a meta-constant*)
22.459 -val d4_polyeq_simplify = prep_rls(
22.460 - Rls {id = "d4_polyeq_simplify", preconds = [],
22.461 - rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
22.462 - srls = Erls, calc = [],
22.463 - rules =
22.464 - [Thm("d4_sub_u1",num_str d4_sub_u1)
22.465 - (* ax^4+bx^2+c=0 -> x=+-sqrt(ax^2+bx^+c) *)
22.466 - ],
22.467 - scr = Script ((term_of o the o (parse thy)) "empty_script")
22.468 - }:rls);
22.469 -
22.470 -ruleset' :=
22.471 -overwritelthy thy
22.472 - (!ruleset',
22.473 - [("d0_polyeq_simplify", d0_polyeq_simplify),
22.474 - ("d1_polyeq_simplify", d1_polyeq_simplify),
22.475 - ("d2_polyeq_simplify", d2_polyeq_simplify),
22.476 - ("d2_polyeq_bdv_only_simplify", d2_polyeq_bdv_only_simplify),
22.477 - ("d2_polyeq_sq_only_simplify", d2_polyeq_sq_only_simplify),
22.478 - ("d2_polyeq_pqFormula_simplify", d2_polyeq_pqFormula_simplify),
22.479 - ("d2_polyeq_abcFormula_simplify",
22.480 - d2_polyeq_abcFormula_simplify),
22.481 - ("d3_polyeq_simplify", d3_polyeq_simplify),
22.482 - ("d4_polyeq_simplify", d4_polyeq_simplify)
22.483 - ]);
22.484 -
22.485 -(*------------------------problems------------------------*)
22.486 -(*
22.487 -(get_pbt ["degree_2","polynomial","univariate","equation"]);
22.488 -show_ptyps();
22.489 -*)
22.490 -
22.491 -(*-------------------------poly-----------------------*)
22.492 -store_pbt
22.493 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly" [] e_pblID
22.494 - (["polynomial","univariate","equation"],
22.495 - [("#Given" ,["equality e_","solveFor v_"]),
22.496 - ("#Where" ,["~((e_::bool) is_ratequation_in (v_::real))",
22.497 - "~((lhs e_) is_rootTerm_in (v_::real))",
22.498 - "~((rhs e_) is_rootTerm_in (v_::real))"]),
22.499 - ("#Find" ,["solutions v_i_"])
22.500 - ],
22.501 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.502 - []));
22.503 -(*--- d0 ---*)
22.504 -store_pbt
22.505 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg0" [] e_pblID
22.506 - (["degree_0","polynomial","univariate","equation"],
22.507 - [("#Given" ,["equality e_","solveFor v_"]),
22.508 - ("#Where" ,["matches (?a = 0) e_",
22.509 - "(lhs e_) is_poly_in v_",
22.510 - "((lhs e_) has_degree_in v_ ) = 0"
22.511 - ]),
22.512 - ("#Find" ,["solutions v_i_"])
22.513 - ],
22.514 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.515 - [["PolyEq","solve_d0_polyeq_equation"]]));
22.516 -
22.517 -(*--- d1 ---*)
22.518 -store_pbt
22.519 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg1" [] e_pblID
22.520 - (["degree_1","polynomial","univariate","equation"],
22.521 - [("#Given" ,["equality e_","solveFor v_"]),
22.522 - ("#Where" ,["matches (?a = 0) e_",
22.523 - "(lhs e_) is_poly_in v_",
22.524 - "((lhs e_) has_degree_in v_ ) = 1"
22.525 - ]),
22.526 - ("#Find" ,["solutions v_i_"])
22.527 - ],
22.528 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.529 - [["PolyEq","solve_d1_polyeq_equation"]]));
22.530 -
22.531 -(*--- d2 ---*)
22.532 -store_pbt
22.533 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2" [] e_pblID
22.534 - (["degree_2","polynomial","univariate","equation"],
22.535 - [("#Given" ,["equality e_","solveFor v_"]),
22.536 - ("#Where" ,["matches (?a = 0) e_",
22.537 - "(lhs e_) is_poly_in v_ ",
22.538 - "((lhs e_) has_degree_in v_ ) = 2"]),
22.539 - ("#Find" ,["solutions v_i_"])
22.540 - ],
22.541 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.542 - [["PolyEq","solve_d2_polyeq_equation"]]));
22.543 -
22.544 - store_pbt
22.545 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_sqonly" [] e_pblID
22.546 - (["sq_only","degree_2","polynomial","univariate","equation"],
22.547 - [("#Given" ,["equality e_","solveFor v_"]),
22.548 - ("#Where" ,["matches ( ?a + ?v_^^^2 = 0) e_ | " ^
22.549 - "matches ( ?a + ?b*?v_^^^2 = 0) e_ | " ^
22.550 - "matches ( ?v_^^^2 = 0) e_ | " ^
22.551 - "matches ( ?b*?v_^^^2 = 0) e_" ,
22.552 - "Not (matches (?a + ?v_ + ?v_^^^2 = 0) e_) &" ^
22.553 - "Not (matches (?a + ?b*?v_ + ?v_^^^2 = 0) e_) &" ^
22.554 - "Not (matches (?a + ?v_ + ?c*?v_^^^2 = 0) e_) &" ^
22.555 - "Not (matches (?a + ?b*?v_ + ?c*?v_^^^2 = 0) e_) &" ^
22.556 - "Not (matches ( ?v_ + ?v_^^^2 = 0) e_) &" ^
22.557 - "Not (matches ( ?b*?v_ + ?v_^^^2 = 0) e_) &" ^
22.558 - "Not (matches ( ?v_ + ?c*?v_^^^2 = 0) e_) &" ^
22.559 - "Not (matches ( ?b*?v_ + ?c*?v_^^^2 = 0) e_)"]),
22.560 - ("#Find" ,["solutions v_i_"])
22.561 - ],
22.562 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.563 - [["PolyEq","solve_d2_polyeq_sqonly_equation"]]));
22.564 -
22.565 -store_pbt
22.566 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_bdvonly" [] e_pblID
22.567 - (["bdv_only","degree_2","polynomial","univariate","equation"],
22.568 - [("#Given" ,["equality e_","solveFor v_"]),
22.569 - ("#Where" ,["matches (?a*?v_ + ?v_^^^2 = 0) e_ | " ^
22.570 - "matches ( ?v_ + ?v_^^^2 = 0) e_ | " ^
22.571 - "matches ( ?v_ + ?b*?v_^^^2 = 0) e_ | " ^
22.572 - "matches (?a*?v_ + ?b*?v_^^^2 = 0) e_ | " ^
22.573 - "matches ( ?v_^^^2 = 0) e_ | " ^
22.574 - "matches ( ?b*?v_^^^2 = 0) e_ "]),
22.575 - ("#Find" ,["solutions v_i_"])
22.576 - ],
22.577 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.578 - [["PolyEq","solve_d2_polyeq_bdvonly_equation"]]));
22.579 -
22.580 -store_pbt
22.581 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_pq" [] e_pblID
22.582 - (["pqFormula","degree_2","polynomial","univariate","equation"],
22.583 - [("#Given" ,["equality e_","solveFor v_"]),
22.584 - ("#Where" ,["matches (?a + 1*?v_^^^2 = 0) e_ | " ^
22.585 - "matches (?a + ?v_^^^2 = 0) e_"]),
22.586 - ("#Find" ,["solutions v_i_"])
22.587 - ],
22.588 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.589 - [["PolyEq","solve_d2_polyeq_pq_equation"]]));
22.590 -
22.591 -store_pbt
22.592 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_abc" [] e_pblID
22.593 - (["abcFormula","degree_2","polynomial","univariate","equation"],
22.594 - [("#Given" ,["equality e_","solveFor v_"]),
22.595 - ("#Where" ,["matches (?a + ?v_^^^2 = 0) e_ | " ^
22.596 - "matches (?a + ?b*?v_^^^2 = 0) e_"]),
22.597 - ("#Find" ,["solutions v_i_"])
22.598 - ],
22.599 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.600 - [["PolyEq","solve_d2_polyeq_abc_equation"]]));
22.601 -
22.602 -(*--- d3 ---*)
22.603 -store_pbt
22.604 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg3" [] e_pblID
22.605 - (["degree_3","polynomial","univariate","equation"],
22.606 - [("#Given" ,["equality e_","solveFor v_"]),
22.607 - ("#Where" ,["matches (?a = 0) e_",
22.608 - "(lhs e_) is_poly_in v_ ",
22.609 - "((lhs e_) has_degree_in v_) = 3"]),
22.610 - ("#Find" ,["solutions v_i_"])
22.611 - ],
22.612 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.613 - [["PolyEq","solve_d3_polyeq_equation"]]));
22.614 -
22.615 -(*--- d4 ---*)
22.616 -store_pbt
22.617 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg4" [] e_pblID
22.618 - (["degree_4","polynomial","univariate","equation"],
22.619 - [("#Given" ,["equality e_","solveFor v_"]),
22.620 - ("#Where" ,["matches (?a = 0) e_",
22.621 - "(lhs e_) is_poly_in v_ ",
22.622 - "((lhs e_) has_degree_in v_) = 4"]),
22.623 - ("#Find" ,["solutions v_i_"])
22.624 - ],
22.625 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.626 - [(*["PolyEq","solve_d4_polyeq_equation"]*)]));
22.627 -
22.628 -(*--- normalize ---*)
22.629 -store_pbt
22.630 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_norm" [] e_pblID
22.631 - (["normalize","polynomial","univariate","equation"],
22.632 - [("#Given" ,["equality e_","solveFor v_"]),
22.633 - ("#Where" ,["(Not((matches (?a = 0 ) e_ ))) |" ^
22.634 - "(Not(((lhs e_) is_poly_in v_)))"]),
22.635 - ("#Find" ,["solutions v_i_"])
22.636 - ],
22.637 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.638 - [["PolyEq","normalize_poly"]]));
22.639 -(*-------------------------expanded-----------------------*)
22.640 -store_pbt
22.641 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_expand" [] e_pblID
22.642 - (["expanded","univariate","equation"],
22.643 - [("#Given" ,["equality e_","solveFor v_"]),
22.644 - ("#Where" ,["matches (?a = 0) e_",
22.645 - "(lhs e_) is_expanded_in v_ "]),
22.646 - ("#Find" ,["solutions v_i_"])
22.647 - ],
22.648 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.649 - []));
22.650 -
22.651 -(*--- d2 ---*)
22.652 -store_pbt
22.653 - (prep_pbt (theory "PolyEq") "pbl_equ_univ_expand_deg2" [] e_pblID
22.654 - (["degree_2","expanded","univariate","equation"],
22.655 - [("#Given" ,["equality e_","solveFor v_"]),
22.656 - ("#Where" ,["((lhs e_) has_degree_in v_) = 2"]),
22.657 - ("#Find" ,["solutions v_i_"])
22.658 - ],
22.659 - PolyEq_prls, SOME "solve (e_::bool, v_)",
22.660 - [["PolyEq","complete_square"]]));
22.661 -
22.662 -
22.663 -"-------------------------methods-----------------------";
22.664 -store_met
22.665 - (prep_met (theory "PolyEq") "met_polyeq" [] e_metID
22.666 - (["PolyEq"],
22.667 - [],
22.668 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
22.669 - crls=PolyEq_crls, nrls=norm_Rational}, "empty_script"));
22.670 -
22.671 -store_met
22.672 - (prep_met (theory "PolyEq") "met_polyeq_norm" [] e_metID
22.673 - (["PolyEq","normalize_poly"],
22.674 - [("#Given" ,["equality e_","solveFor v_"]),
22.675 - ("#Where" ,["(Not((matches (?a = 0 ) e_ ))) |" ^
22.676 - "(Not(((lhs e_) is_poly_in v_)))"]),
22.677 - ("#Find" ,["solutions v_i_"])
22.678 - ],
22.679 - {rew_ord'="termlessI",
22.680 - rls'=PolyEq_erls,
22.681 - srls=e_rls,
22.682 - prls=PolyEq_prls,
22.683 - calc=[],
22.684 - crls=PolyEq_crls, nrls=norm_Rational
22.685 - "Script Normalize_poly (e_::bool) (v_::real) = " ^
22.686 - "(let e_ =((Try (Rewrite all_left False)) @@ " ^
22.687 - " (Try (Repeat (Rewrite makex1_x False))) @@ " ^
22.688 - " (Try (Repeat (Rewrite_Set expand_binoms False))) @@ " ^
22.689 - " (Try (Repeat (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.690 - " make_ratpoly_in False))) @@ " ^
22.691 - " (Try (Repeat (Rewrite_Set polyeq_simplify False)))) e_ " ^
22.692 - " in (SubProblem (PolyEq_,[polynomial,univariate,equation], " ^
22.693 - " [no_met]) [bool_ e_, real_ v_]))"
22.694 - ));
22.695 -
22.696 -store_met
22.697 - (prep_met (theory "PolyEq") "met_polyeq_d0" [] e_metID
22.698 - (["PolyEq","solve_d0_polyeq_equation"],
22.699 - [("#Given" ,["equality e_","solveFor v_"]),
22.700 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.701 - "((lhs e_) has_degree_in v_) = 0"]),
22.702 - ("#Find" ,["solutions v_i_"])
22.703 - ],
22.704 - {rew_ord'="termlessI",
22.705 - rls'=PolyEq_erls,
22.706 - srls=e_rls,
22.707 - prls=PolyEq_prls,
22.708 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.709 - crls=PolyEq_crls, nrls=norm_Rational},
22.710 - "Script Solve_d0_polyeq_equation (e_::bool) (v_::real) = " ^
22.711 - "(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.712 - " d0_polyeq_simplify False))) e_ " ^
22.713 - " in ((Or_to_List e_)::bool list))"
22.714 - ));
22.715 -
22.716 -store_met
22.717 - (prep_met (theory "PolyEq") "met_polyeq_d1" [] e_metID
22.718 - (["PolyEq","solve_d1_polyeq_equation"],
22.719 - [("#Given" ,["equality e_","solveFor v_"]),
22.720 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.721 - "((lhs e_) has_degree_in v_) = 1"]),
22.722 - ("#Find" ,["solutions v_i_"])
22.723 - ],
22.724 - {rew_ord'="termlessI",
22.725 - rls'=PolyEq_erls,
22.726 - srls=e_rls,
22.727 - prls=PolyEq_prls,
22.728 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.729 - crls=PolyEq_crls, nrls=norm_Rational(*,
22.730 - (* asm_rls=["d1_polyeq_simplify"],*)
22.731 - asm_rls=[],
22.732 - asm_thm=[("d1_isolate_div","")]*)},
22.733 - "Script Solve_d1_polyeq_equation (e_::bool) (v_::real) = " ^
22.734 - "(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.735 - " d1_polyeq_simplify True)) @@ " ^
22.736 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.737 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
22.738 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.739 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.740 - ));
22.741 -
22.742 -store_met
22.743 - (prep_met (theory "PolyEq") "met_polyeq_d22" [] e_metID
22.744 - (["PolyEq","solve_d2_polyeq_equation"],
22.745 - [("#Given" ,["equality e_","solveFor v_"]),
22.746 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.747 - "((lhs e_) has_degree_in v_) = 2"]),
22.748 - ("#Find" ,["solutions v_i_"])
22.749 - ],
22.750 - {rew_ord'="termlessI",
22.751 - rls'=PolyEq_erls,
22.752 - srls=e_rls,
22.753 - prls=PolyEq_prls,
22.754 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.755 - crls=PolyEq_crls, nrls=norm_Rational},
22.756 - "Script Solve_d2_polyeq_equation (e_::bool) (v_::real) = " ^
22.757 - " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.758 - " d2_polyeq_simplify True)) @@ " ^
22.759 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.760 - " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.761 - " d1_polyeq_simplify True)) @@ " ^
22.762 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.763 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
22.764 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.765 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.766 - ));
22.767 -
22.768 -store_met
22.769 - (prep_met (theory "PolyEq") "met_polyeq_d2_bdvonly" [] e_metID
22.770 - (["PolyEq","solve_d2_polyeq_bdvonly_equation"],
22.771 - [("#Given" ,["equality e_","solveFor v_"]),
22.772 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.773 - "((lhs e_) has_degree_in v_) = 2"]),
22.774 - ("#Find" ,["solutions v_i_"])
22.775 - ],
22.776 - {rew_ord'="termlessI",
22.777 - rls'=PolyEq_erls,
22.778 - srls=e_rls,
22.779 - prls=PolyEq_prls,
22.780 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.781 - crls=PolyEq_crls, nrls=norm_Rational},
22.782 - "Script Solve_d2_polyeq_bdvonly_equation (e_::bool) (v_::real) =" ^
22.783 - " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.784 - " d2_polyeq_bdv_only_simplify True)) @@ " ^
22.785 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.786 - " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.787 - " d1_polyeq_simplify True)) @@ " ^
22.788 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.789 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
22.790 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.791 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.792 - ));
22.793 -
22.794 -store_met
22.795 - (prep_met (theory "PolyEq") "met_polyeq_d2_sqonly" [] e_metID
22.796 - (["PolyEq","solve_d2_polyeq_sqonly_equation"],
22.797 - [("#Given" ,["equality e_","solveFor v_"]),
22.798 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.799 - "((lhs e_) has_degree_in v_) = 2"]),
22.800 - ("#Find" ,["solutions v_i_"])
22.801 - ],
22.802 - {rew_ord'="termlessI",
22.803 - rls'=PolyEq_erls,
22.804 - srls=e_rls,
22.805 - prls=PolyEq_prls,
22.806 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.807 - crls=PolyEq_crls, nrls=norm_Rational},
22.808 - "Script Solve_d2_polyeq_sqonly_equation (e_::bool) (v_::real) =" ^
22.809 - " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.810 - " d2_polyeq_sq_only_simplify True)) @@ " ^
22.811 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.812 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_; " ^
22.813 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.814 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.815 - ));
22.816 -
22.817 -store_met
22.818 - (prep_met (theory "PolyEq") "met_polyeq_d2_pq" [] e_metID
22.819 - (["PolyEq","solve_d2_polyeq_pq_equation"],
22.820 - [("#Given" ,["equality e_","solveFor v_"]),
22.821 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.822 - "((lhs e_) has_degree_in v_) = 2"]),
22.823 - ("#Find" ,["solutions v_i_"])
22.824 - ],
22.825 - {rew_ord'="termlessI",
22.826 - rls'=PolyEq_erls,
22.827 - srls=e_rls,
22.828 - prls=PolyEq_prls,
22.829 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.830 - crls=PolyEq_crls, nrls=norm_Rational},
22.831 - "Script Solve_d2_polyeq_pq_equation (e_::bool) (v_::real) = " ^
22.832 - " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.833 - " d2_polyeq_pqFormula_simplify True)) @@ " ^
22.834 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.835 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
22.836 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.837 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.838 - ));
22.839 -
22.840 -store_met
22.841 - (prep_met (theory "PolyEq") "met_polyeq_d2_abc" [] e_metID
22.842 - (["PolyEq","solve_d2_polyeq_abc_equation"],
22.843 - [("#Given" ,["equality e_","solveFor v_"]),
22.844 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.845 - "((lhs e_) has_degree_in v_) = 2"]),
22.846 - ("#Find" ,["solutions v_i_"])
22.847 - ],
22.848 - {rew_ord'="termlessI",
22.849 - rls'=PolyEq_erls,
22.850 - srls=e_rls,
22.851 - prls=PolyEq_prls,
22.852 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.853 - crls=PolyEq_crls, nrls=norm_Rational},
22.854 - "Script Solve_d2_polyeq_abc_equation (e_::bool) (v_::real) = " ^
22.855 - " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.856 - " d2_polyeq_abcFormula_simplify True)) @@ " ^
22.857 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.858 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
22.859 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.860 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.861 - ));
22.862 -
22.863 -store_met
22.864 - (prep_met (theory "PolyEq") "met_polyeq_d3" [] e_metID
22.865 - (["PolyEq","solve_d3_polyeq_equation"],
22.866 - [("#Given" ,["equality e_","solveFor v_"]),
22.867 - ("#Where" ,["(lhs e_) is_poly_in v_ ",
22.868 - "((lhs e_) has_degree_in v_) = 3"]),
22.869 - ("#Find" ,["solutions v_i_"])
22.870 - ],
22.871 - {rew_ord'="termlessI",
22.872 - rls'=PolyEq_erls,
22.873 - srls=e_rls,
22.874 - prls=PolyEq_prls,
22.875 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.876 - crls=PolyEq_crls, nrls=norm_Rational},
22.877 - "Script Solve_d3_polyeq_equation (e_::bool) (v_::real) = " ^
22.878 - " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.879 - " d3_polyeq_simplify True)) @@ " ^
22.880 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.881 - " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.882 - " d2_polyeq_simplify True)) @@ " ^
22.883 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.884 - " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
22.885 - " d1_polyeq_simplify True)) @@ " ^
22.886 - " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
22.887 - " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
22.888 - " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
22.889 - " in Check_elementwise L_ {(v_::real). Assumptions} )"
22.890 - ));
22.891 -
22.892 - (*.solves all expanded (ie. normalized) terms of degree 2.*)
22.893 - (*Oct.02 restriction: 'eval_true 0 =< discriminant' ony for integer values
22.894 - by 'PolyEq_erls'; restricted until Float.thy is implemented*)
22.895 -store_met
22.896 - (prep_met (theory "PolyEq") "met_polyeq_complsq" [] e_metID
22.897 - (["PolyEq","complete_square"],
22.898 - [("#Given" ,["equality e_","solveFor v_"]),
22.899 - ("#Where" ,["matches (?a = 0) e_",
22.900 - "((lhs e_) has_degree_in v_) = 2"]),
22.901 - ("#Find" ,["solutions v_i_"])
22.902 - ],
22.903 - {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
22.904 - calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
22.905 - crls=PolyEq_crls, nrls=norm_Rational},
22.906 - "Script Complete_square (e_::bool) (v_::real) = " ^
22.907 - "(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_)] cancel_leading_coeff True))" ^
22.908 - " @@ (Try (Rewrite_Set_Inst [(bdv,v_)] complete_square True)) " ^
22.909 - " @@ (Try (Rewrite square_explicit1 False)) " ^
22.910 - " @@ (Try (Rewrite square_explicit2 False)) " ^
22.911 - " @@ (Rewrite root_plus_minus True) " ^
22.912 - " @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit1 False))) " ^
22.913 - " @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit2 False))) " ^
22.914 - " @@ (Try (Repeat " ^
22.915 - " (Rewrite_Inst [(bdv,v_)] bdv_explicit3 False))) " ^
22.916 - " @@ (Try (Rewrite_Set calculate_RootRat False)) " ^
22.917 - " @@ (Try (Repeat (Calculate sqrt_)))) e_ " ^
22.918 - " in ((Or_to_List e_)::bool list))"
22.919 - ));
22.920 -
22.921 -
22.922 -(* termorder hacked by MG *)
22.923 -local (*. for make_polynomial_in .*)
22.924 -
22.925 -open Term; (* for type order = EQUAL | LESS | GREATER *)
22.926 -
22.927 -fun pr_ord EQUAL = "EQUAL"
22.928 - | pr_ord LESS = "LESS"
22.929 - | pr_ord GREATER = "GREATER";
22.930 -
22.931 -fun dest_hd' x (Const (a, T)) = (((a, 0), T), 0)
22.932 - | dest_hd' x (t as Free (a, T)) =
22.933 - if x = t then ((("|||||||||||||", 0), T), 0) (*WN*)
22.934 - else (((a, 0), T), 1)
22.935 - | dest_hd' x (Var v) = (v, 2)
22.936 - | dest_hd' x (Bound i) = ((("", i), dummyT), 3)
22.937 - | dest_hd' x (Abs (_, T, _)) = ((("", 0), T), 4);
22.938 -
22.939 -fun size_of_term' x (Const ("Atools.pow",_) $ Free (var,_) $ Free (pot,_)) =
22.940 - (case x of (*WN*)
22.941 - (Free (xstr,_)) =>
22.942 - (if xstr = var then 1000*(the (int_of_str pot)) else 3)
22.943 - | _ => raise error ("size_of_term' called with subst = "^
22.944 - (term2str x)))
22.945 - | size_of_term' x (Free (subst,_)) =
22.946 - (case x of
22.947 - (Free (xstr,_)) => (if xstr = subst then 1000 else 1)
22.948 - | _ => raise error ("size_of_term' called with subst = "^
22.949 - (term2str x)))
22.950 - | size_of_term' x (Abs (_,_,body)) = 1 + size_of_term' x body
22.951 - | size_of_term' x (f$t) = size_of_term' x f + size_of_term' x t
22.952 - | size_of_term' x _ = 1;
22.953 -
22.954 -
22.955 -fun term_ord' x pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
22.956 - (case term_ord' x pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
22.957 - | term_ord' x pr thy (t, u) =
22.958 - (if pr then
22.959 - let
22.960 - val (f, ts) = strip_comb t and (g, us) = strip_comb u;
22.961 - val _=writeln("t= f@ts= \""^
22.962 - ((Syntax.string_of_term (thy2ctxt thy)) f)^"\" @ \"["^
22.963 - (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
22.964 - val _=writeln("u= g@us= \""^
22.965 - ((Syntax.string_of_term (thy2ctxt thy)) g)^"\" @ \"["^
22.966 - (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
22.967 - val _=writeln("size_of_term(t,u)= ("^
22.968 - (string_of_int(size_of_term' x t))^", "^
22.969 - (string_of_int(size_of_term' x u))^")");
22.970 - val _=writeln("hd_ord(f,g) = "^((pr_ord o (hd_ord x))(f,g)));
22.971 - val _=writeln("terms_ord(ts,us) = "^
22.972 - ((pr_ord o (terms_ord x) str false)(ts,us)));
22.973 - val _=writeln("-------");
22.974 - in () end
22.975 - else ();
22.976 - case int_ord (size_of_term' x t, size_of_term' x u) of
22.977 - EQUAL =>
22.978 - let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
22.979 - (case hd_ord x (f, g) of EQUAL => (terms_ord x str pr) (ts, us)
22.980 - | ord => ord)
22.981 - end
22.982 - | ord => ord)
22.983 -and hd_ord x (f, g) = (* ~ term.ML *)
22.984 - prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' x f,
22.985 - dest_hd' x g)
22.986 -and terms_ord x str pr (ts, us) =
22.987 - list_ord (term_ord' x pr (assoc_thy "Isac.thy"))(ts, us);
22.988 -in
22.989 -
22.990 -fun ord_make_polynomial_in (pr:bool) thy subst tu =
22.991 - let
22.992 - (* val _=writeln("*** subs variable is: "^(subst2str subst)); *)
22.993 - in
22.994 - case subst of
22.995 - (_,x)::_ => (term_ord' x pr thy tu = LESS)
22.996 - | _ => raise error ("ord_make_polynomial_in called with subst = "^
22.997 - (subst2str subst))
22.998 - end;
22.999 -end;
22.1000 -
22.1001 -val order_add_mult_in = prep_rls(
22.1002 - Rls{id = "order_add_mult_in", preconds = [],
22.1003 - rew_ord = ("ord_make_polynomial_in",
22.1004 - ord_make_polynomial_in false Poly.thy),
22.1005 - erls = e_rls,srls = Erls,
22.1006 - calc = [],
22.1007 - (*asm_thm = [],*)
22.1008 - rules = [Thm ("real_mult_commute",num_str real_mult_commute),
22.1009 - (* z * w = w * z *)
22.1010 - Thm ("real_mult_left_commute",num_str real_mult_left_commute),
22.1011 - (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
22.1012 - Thm ("real_mult_assoc",num_str real_mult_assoc),
22.1013 - (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
22.1014 - Thm ("real_add_commute",num_str real_add_commute),
22.1015 - (*z + w = w + z*)
22.1016 - Thm ("real_add_left_commute",num_str real_add_left_commute),
22.1017 - (*x + (y + z) = y + (x + z)*)
22.1018 - Thm ("real_add_assoc",num_str real_add_assoc)
22.1019 - (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
22.1020 - ], scr = EmptyScr}:rls);
22.1021 -
22.1022 -val collect_bdv = prep_rls(
22.1023 - Rls{id = "collect_bdv", preconds = [],
22.1024 - rew_ord = ("dummy_ord", dummy_ord),
22.1025 - erls = e_rls,srls = Erls,
22.1026 - calc = [],
22.1027 - (*asm_thm = [],*)
22.1028 - rules = [Thm ("bdv_collect_1",num_str bdv_collect_1),
22.1029 - Thm ("bdv_collect_2",num_str bdv_collect_2),
22.1030 - Thm ("bdv_collect_3",num_str bdv_collect_3),
22.1031 -
22.1032 - Thm ("bdv_collect_assoc1_1",num_str bdv_collect_assoc1_1),
22.1033 - Thm ("bdv_collect_assoc1_2",num_str bdv_collect_assoc1_2),
22.1034 - Thm ("bdv_collect_assoc1_3",num_str bdv_collect_assoc1_3),
22.1035 -
22.1036 - Thm ("bdv_collect_assoc2_1",num_str bdv_collect_assoc2_1),
22.1037 - Thm ("bdv_collect_assoc2_2",num_str bdv_collect_assoc2_2),
22.1038 - Thm ("bdv_collect_assoc2_3",num_str bdv_collect_assoc2_3),
22.1039 -
22.1040 -
22.1041 - Thm ("bdv_n_collect_1",num_str bdv_n_collect_1),
22.1042 - Thm ("bdv_n_collect_2",num_str bdv_n_collect_2),
22.1043 - Thm ("bdv_n_collect_3",num_str bdv_n_collect_3),
22.1044 -
22.1045 - Thm ("bdv_n_collect_assoc1_1",num_str bdv_n_collect_assoc1_1),
22.1046 - Thm ("bdv_n_collect_assoc1_2",num_str bdv_n_collect_assoc1_2),
22.1047 - Thm ("bdv_n_collect_assoc1_3",num_str bdv_n_collect_assoc1_3),
22.1048 -
22.1049 - Thm ("bdv_n_collect_assoc2_1",num_str bdv_n_collect_assoc2_1),
22.1050 - Thm ("bdv_n_collect_assoc2_2",num_str bdv_n_collect_assoc2_2),
22.1051 - Thm ("bdv_n_collect_assoc2_3",num_str bdv_n_collect_assoc2_3)
22.1052 - ], scr = EmptyScr}:rls);
22.1053 -
22.1054 -(*.transforms an arbitrary term without roots to a polynomial [4]
22.1055 - according to knowledge/Poly.sml.*)
22.1056 -val make_polynomial_in = prep_rls(
22.1057 - Seq {id = "make_polynomial_in", preconds = []:term list,
22.1058 - rew_ord = ("dummy_ord", dummy_ord),
22.1059 - erls = Atools_erls, srls = Erls,
22.1060 - calc = [], (*asm_thm = [],*)
22.1061 - rules = [Rls_ expand_poly,
22.1062 - Rls_ order_add_mult_in,
22.1063 - Rls_ simplify_power,
22.1064 - Rls_ collect_numerals,
22.1065 - Rls_ reduce_012,
22.1066 - Thm ("realpow_oneI",num_str realpow_oneI),
22.1067 - Rls_ discard_parentheses,
22.1068 - Rls_ collect_bdv
22.1069 - ],
22.1070 - scr = EmptyScr
22.1071 - }:rls);
22.1072 -
22.1073 -val separate_bdvs =
22.1074 - append_rls "separate_bdvs"
22.1075 - collect_bdv
22.1076 - [Thm ("separate_bdv", num_str separate_bdv),
22.1077 - (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
22.1078 - Thm ("separate_bdv_n", num_str separate_bdv_n),
22.1079 - Thm ("separate_1_bdv", num_str separate_1_bdv),
22.1080 - (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
22.1081 - Thm ("separate_1_bdv_n", num_str separate_1_bdv_n),
22.1082 - (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
22.1083 - Thm ("real_add_divide_distrib",
22.1084 - num_str real_add_divide_distrib)
22.1085 - (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"
22.1086 - WN051031 DOES NOT BELONG TO HERE*)
22.1087 - ];
22.1088 -val make_ratpoly_in = prep_rls(
22.1089 - Seq {id = "make_ratpoly_in", preconds = []:term list,
22.1090 - rew_ord = ("dummy_ord", dummy_ord),
22.1091 - erls = Atools_erls, srls = Erls,
22.1092 - calc = [], (*asm_thm = [],*)
22.1093 - rules = [Rls_ norm_Rational,
22.1094 - Rls_ order_add_mult_in,
22.1095 - Rls_ discard_parentheses,
22.1096 - Rls_ separate_bdvs,
22.1097 - (* Rls_ rearrange_assoc, WN060916 why does cancel_p not work?*)
22.1098 - Rls_ cancel_p
22.1099 - (*Calc ("HOL.divide" ,eval_cancel "#divide_") too weak!*)
22.1100 - ],
22.1101 - scr = EmptyScr}:rls);
22.1102 -
22.1103 -
22.1104 -ruleset' := overwritelthy thy (!ruleset',
22.1105 - [("order_add_mult_in", order_add_mult_in),
22.1106 - ("collect_bdv", collect_bdv),
22.1107 - ("make_polynomial_in", make_polynomial_in),
22.1108 - ("make_ratpoly_in", make_ratpoly_in),
22.1109 - ("separate_bdvs", separate_bdvs)
22.1110 - ]);
22.1111 -
23.1 --- a/src/Tools/isac/Knowledge/PolyEq.thy Fri Aug 27 10:39:12 2010 +0200
23.2 +++ b/src/Tools/isac/Knowledge/PolyEq.thy Fri Aug 27 14:56:54 2010 +0200
23.3 @@ -1,4 +1,3 @@
23.4 -(*.(c) by Richard Lang, 2003 .*)
23.5 (* theory collecting all knowledge
23.6 (predicates 'is_rootEq_in', 'is_sqrt_in', 'is_ratEq_in')
23.7 for PolynomialEquations.
23.8 @@ -8,131 +7,121 @@
23.9 changed by: rlang
23.10 last change by: rlang
23.11 date: 03.06.03
23.12 + (c) by Richard Lang, 2003
23.13 *)
23.14
23.15 -(* remove_thy"PolyEq";
23.16 - use_thy"Knowledge/Isac";
23.17 - use_thy"Knowledge/PolyEq";
23.18 -
23.19 - remove_thy"PolyEq";
23.20 - use_thy"Isac";
23.21 +theory PolyEq imports LinEq RootRatEq begin
23.22
23.23 - use"ROOT.ML";
23.24 - cd"knowledge";
23.25 - *)
23.26 -
23.27 -PolyEq = LinEq + RootRatEq +
23.28 -(*-------------------- consts ------------------------------------------------*)
23.29 consts
23.30
23.31 (*---------scripts--------------------------*)
23.32 Complete'_square
23.33 - :: "[bool,real, \
23.34 - \ bool list] => bool list"
23.35 - ("((Script Complete'_square (_ _ =))// \
23.36 - \ (_))" 9)
23.37 + :: "[bool,real,
23.38 + bool list] => bool list"
23.39 + ("((Script Complete'_square (_ _ =))//
23.40 + (_))" 9)
23.41 (*----- poly ----- *)
23.42 Normalize'_poly
23.43 - :: "[bool,real, \
23.44 - \ bool list] => bool list"
23.45 - ("((Script Normalize'_poly (_ _=))// \
23.46 - \ (_))" 9)
23.47 + :: "[bool,real,
23.48 + bool list] => bool list"
23.49 + ("((Script Normalize'_poly (_ _=))//
23.50 + (_))" 9)
23.51 Solve'_d0'_polyeq'_equation
23.52 - :: "[bool,real, \
23.53 - \ bool list] => bool list"
23.54 - ("((Script Solve'_d0'_polyeq'_equation (_ _ =))// \
23.55 - \ (_))" 9)
23.56 + :: "[bool,real,
23.57 + bool list] => bool list"
23.58 + ("((Script Solve'_d0'_polyeq'_equation (_ _ =))//
23.59 + (_))" 9)
23.60 Solve'_d1'_polyeq'_equation
23.61 - :: "[bool,real, \
23.62 - \ bool list] => bool list"
23.63 - ("((Script Solve'_d1'_polyeq'_equation (_ _ =))// \
23.64 - \ (_))" 9)
23.65 + :: "[bool,real,
23.66 + bool list] => bool list"
23.67 + ("((Script Solve'_d1'_polyeq'_equation (_ _ =))//
23.68 + (_))" 9)
23.69 Solve'_d2'_polyeq'_equation
23.70 - :: "[bool,real, \
23.71 - \ bool list] => bool list"
23.72 - ("((Script Solve'_d2'_polyeq'_equation (_ _ =))// \
23.73 - \ (_))" 9)
23.74 + :: "[bool,real,
23.75 + bool list] => bool list"
23.76 + ("((Script Solve'_d2'_polyeq'_equation (_ _ =))//
23.77 + (_))" 9)
23.78 Solve'_d2'_polyeq'_sqonly'_equation
23.79 - :: "[bool,real, \
23.80 - \ bool list] => bool list"
23.81 - ("((Script Solve'_d2'_polyeq'_sqonly'_equation (_ _ =))// \
23.82 - \ (_))" 9)
23.83 + :: "[bool,real,
23.84 + bool list] => bool list"
23.85 + ("((Script Solve'_d2'_polyeq'_sqonly'_equation (_ _ =))//
23.86 + (_))" 9)
23.87 Solve'_d2'_polyeq'_bdvonly'_equation
23.88 - :: "[bool,real, \
23.89 - \ bool list] => bool list"
23.90 - ("((Script Solve'_d2'_polyeq'_bdvonly'_equation (_ _ =))// \
23.91 - \ (_))" 9)
23.92 + :: "[bool,real,
23.93 + bool list] => bool list"
23.94 + ("((Script Solve'_d2'_polyeq'_bdvonly'_equation (_ _ =))//
23.95 + (_))" 9)
23.96 Solve'_d2'_polyeq'_pq'_equation
23.97 - :: "[bool,real, \
23.98 - \ bool list] => bool list"
23.99 - ("((Script Solve'_d2'_polyeq'_pq'_equation (_ _ =))// \
23.100 - \ (_))" 9)
23.101 + :: "[bool,real,
23.102 + bool list] => bool list"
23.103 + ("((Script Solve'_d2'_polyeq'_pq'_equation (_ _ =))//
23.104 + (_))" 9)
23.105 Solve'_d2'_polyeq'_abc'_equation
23.106 - :: "[bool,real, \
23.107 - \ bool list] => bool list"
23.108 - ("((Script Solve'_d2'_polyeq'_abc'_equation (_ _ =))// \
23.109 - \ (_))" 9)
23.110 + :: "[bool,real,
23.111 + bool list] => bool list"
23.112 + ("((Script Solve'_d2'_polyeq'_abc'_equation (_ _ =))//
23.113 + (_))" 9)
23.114 Solve'_d3'_polyeq'_equation
23.115 - :: "[bool,real, \
23.116 - \ bool list] => bool list"
23.117 - ("((Script Solve'_d3'_polyeq'_equation (_ _ =))// \
23.118 - \ (_))" 9)
23.119 + :: "[bool,real,
23.120 + bool list] => bool list"
23.121 + ("((Script Solve'_d3'_polyeq'_equation (_ _ =))//
23.122 + (_))" 9)
23.123 Solve'_d4'_polyeq'_equation
23.124 - :: "[bool,real, \
23.125 - \ bool list] => bool list"
23.126 - ("((Script Solve'_d4'_polyeq'_equation (_ _ =))// \
23.127 - \ (_))" 9)
23.128 + :: "[bool,real,
23.129 + bool list] => bool list"
23.130 + ("((Script Solve'_d4'_polyeq'_equation (_ _ =))//
23.131 + (_))" 9)
23.132 Biquadrat'_poly
23.133 - :: "[bool,real, \
23.134 - \ bool list] => bool list"
23.135 - ("((Script Biquadrat'_poly (_ _=))// \
23.136 - \ (_))" 9)
23.137 + :: "[bool,real,
23.138 + bool list] => bool list"
23.139 + ("((Script Biquadrat'_poly (_ _=))//
23.140 + (_))" 9)
23.141
23.142 (*-------------------- rules -------------------------------------------------*)
23.143 -rules
23.144 +axioms
23.145
23.146 - cancel_leading_coeff1 "Not (c =!= 0) ==> (a + b*bdv + c*bdv^^^2 = 0) = \
23.147 - \ (a/c + b/c*bdv + bdv^^^2 = 0)"
23.148 - cancel_leading_coeff2 "Not (c =!= 0) ==> (a - b*bdv + c*bdv^^^2 = 0) = \
23.149 - \ (a/c - b/c*bdv + bdv^^^2 = 0)"
23.150 - cancel_leading_coeff3 "Not (c =!= 0) ==> (a + b*bdv - c*bdv^^^2 = 0) = \
23.151 - \ (a/c + b/c*bdv - bdv^^^2 = 0)"
23.152 + cancel_leading_coeff1 "Not (c =!= 0) ==> (a + b*bdv + c*bdv^^^2 = 0) =
23.153 + (a/c + b/c*bdv + bdv^^^2 = 0)"
23.154 + cancel_leading_coeff2 "Not (c =!= 0) ==> (a - b*bdv + c*bdv^^^2 = 0) =
23.155 + (a/c - b/c*bdv + bdv^^^2 = 0)"
23.156 + cancel_leading_coeff3 "Not (c =!= 0) ==> (a + b*bdv - c*bdv^^^2 = 0) =
23.157 + (a/c + b/c*bdv - bdv^^^2 = 0)"
23.158
23.159 - cancel_leading_coeff4 "Not (c =!= 0) ==> (a + bdv + c*bdv^^^2 = 0) = \
23.160 - \ (a/c + 1/c*bdv + bdv^^^2 = 0)"
23.161 - cancel_leading_coeff5 "Not (c =!= 0) ==> (a - bdv + c*bdv^^^2 = 0) = \
23.162 - \ (a/c - 1/c*bdv + bdv^^^2 = 0)"
23.163 - cancel_leading_coeff6 "Not (c =!= 0) ==> (a + bdv - c*bdv^^^2 = 0) = \
23.164 - \ (a/c + 1/c*bdv - bdv^^^2 = 0)"
23.165 + cancel_leading_coeff4 "Not (c =!= 0) ==> (a + bdv + c*bdv^^^2 = 0) =
23.166 + (a/c + 1/c*bdv + bdv^^^2 = 0)"
23.167 + cancel_leading_coeff5 "Not (c =!= 0) ==> (a - bdv + c*bdv^^^2 = 0) =
23.168 + (a/c - 1/c*bdv + bdv^^^2 = 0)"
23.169 + cancel_leading_coeff6 "Not (c =!= 0) ==> (a + bdv - c*bdv^^^2 = 0) =
23.170 + (a/c + 1/c*bdv - bdv^^^2 = 0)"
23.171
23.172 - cancel_leading_coeff7 "Not (c =!= 0) ==> ( b*bdv + c*bdv^^^2 = 0) = \
23.173 - \ ( b/c*bdv + bdv^^^2 = 0)"
23.174 - cancel_leading_coeff8 "Not (c =!= 0) ==> ( b*bdv - c*bdv^^^2 = 0) = \
23.175 - \ ( b/c*bdv - bdv^^^2 = 0)"
23.176 + cancel_leading_coeff7 "Not (c =!= 0) ==> ( b*bdv + c*bdv^^^2 = 0) =
23.177 + ( b/c*bdv + bdv^^^2 = 0)"
23.178 + cancel_leading_coeff8 "Not (c =!= 0) ==> ( b*bdv - c*bdv^^^2 = 0) =
23.179 + ( b/c*bdv - bdv^^^2 = 0)"
23.180
23.181 - cancel_leading_coeff9 "Not (c =!= 0) ==> ( bdv + c*bdv^^^2 = 0) = \
23.182 - \ ( 1/c*bdv + bdv^^^2 = 0)"
23.183 - cancel_leading_coeff10"Not (c =!= 0) ==> ( bdv - c*bdv^^^2 = 0) = \
23.184 - \ ( 1/c*bdv - bdv^^^2 = 0)"
23.185 + cancel_leading_coeff9 "Not (c =!= 0) ==> ( bdv + c*bdv^^^2 = 0) =
23.186 + ( 1/c*bdv + bdv^^^2 = 0)"
23.187 + cancel_leading_coeff10"Not (c =!= 0) ==> ( bdv - c*bdv^^^2 = 0) =
23.188 + ( 1/c*bdv - bdv^^^2 = 0)"
23.189
23.190 - cancel_leading_coeff11"Not (c =!= 0) ==> (a + b*bdv^^^2 = 0) = \
23.191 - \ (a/b + bdv^^^2 = 0)"
23.192 - cancel_leading_coeff12"Not (c =!= 0) ==> (a - b*bdv^^^2 = 0) = \
23.193 - \ (a/b - bdv^^^2 = 0)"
23.194 - cancel_leading_coeff13"Not (c =!= 0) ==> ( b*bdv^^^2 = 0) = \
23.195 - \ ( bdv^^^2 = 0/b)"
23.196 + cancel_leading_coeff11"Not (c =!= 0) ==> (a + b*bdv^^^2 = 0) =
23.197 + (a/b + bdv^^^2 = 0)"
23.198 + cancel_leading_coeff12"Not (c =!= 0) ==> (a - b*bdv^^^2 = 0) =
23.199 + (a/b - bdv^^^2 = 0)"
23.200 + cancel_leading_coeff13"Not (c =!= 0) ==> ( b*bdv^^^2 = 0) =
23.201 + ( bdv^^^2 = 0/b)"
23.202
23.203 - complete_square1 "(q + p*bdv + bdv^^^2 = 0) = \
23.204 - \(q + (p/2 + bdv)^^^2 = (p/2)^^^2)"
23.205 - complete_square2 "( p*bdv + bdv^^^2 = 0) = \
23.206 - \( (p/2 + bdv)^^^2 = (p/2)^^^2)"
23.207 - complete_square3 "( bdv + bdv^^^2 = 0) = \
23.208 - \( (1/2 + bdv)^^^2 = (1/2)^^^2)"
23.209 + complete_square1 "(q + p*bdv + bdv^^^2 = 0) =
23.210 + (q + (p/2 + bdv)^^^2 = (p/2)^^^2)"
23.211 + complete_square2 "( p*bdv + bdv^^^2 = 0) =
23.212 + ( (p/2 + bdv)^^^2 = (p/2)^^^2)"
23.213 + complete_square3 "( bdv + bdv^^^2 = 0) =
23.214 + ( (1/2 + bdv)^^^2 = (1/2)^^^2)"
23.215
23.216 - complete_square4 "(q - p*bdv + bdv^^^2 = 0) = \
23.217 - \(q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
23.218 - complete_square5 "(q + p*bdv - bdv^^^2 = 0) = \
23.219 - \(q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
23.220 + complete_square4 "(q - p*bdv + bdv^^^2 = 0) =
23.221 + (q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
23.222 + complete_square5 "(q + p*bdv - bdv^^^2 = 0) =
23.223 + (q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
23.224
23.225 square_explicit1 "(a + b^^^2 = c) = ( b^^^2 = c - a)"
23.226 square_explicit2 "(a - b^^^2 = c) = (-(b^^^2) = c - a)"
23.227 @@ -146,20 +135,14 @@
23.228
23.229 (*-- normalize --*)
23.230 (*WN0509 compare LinEq.all_left "[|Not(b=!=0)|] ==> (a=b) = (a+(-1)*b=0)"*)
23.231 - all_left
23.232 - "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"
23.233 - makex1_x
23.234 - "a^^^1 = a"
23.235 - real_assoc_1
23.236 - "a+(b+c) = a+b+c"
23.237 - real_assoc_2
23.238 - "a*(b*c) = a*b*c"
23.239 + all_left "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"
23.240 + makex1_x "a^^^1 = a"
23.241 + real_assoc_1 "a+(b+c) = a+b+c"
23.242 + real_assoc_2 "a*(b*c) = a*b*c"
23.243
23.244 (* ---- degree 0 ----*)
23.245 - d0_true
23.246 - "(0=0) = True"
23.247 - d0_false
23.248 - "[|Not(bdv occurs_in a);Not(a=0)|] ==> (a=0) = False"
23.249 + d0_true "(0=0) = True"
23.250 + d0_false "[|Not(bdv occurs_in a);Not(a=0)|] ==> (a=0) = False"
23.251 (* ---- degree 1 ----*)
23.252 d1_isolate_add1
23.253 "[|Not(bdv occurs_in a)|] ==> (a + b*bdv = 0) = (b*bdv = (-1)*a)"
23.254 @@ -174,76 +157,56 @@
23.255 "[|Not(bdv occurs_in a)|] ==> (a + bdv^^^2=0) = ( bdv^^^2= (-1)*a)"
23.256 d2_isolate_div
23.257 "[|Not(b=0);Not(bdv occurs_in c)|] ==> (b*bdv^^^2=c) = (bdv^^^2=c/b)"
23.258 - d2_prescind1
23.259 - "(a*bdv + b*bdv^^^2 = 0) = (bdv*(a +b*bdv)=0)"
23.260 - d2_prescind2
23.261 - "(a*bdv + bdv^^^2 = 0) = (bdv*(a + bdv)=0)"
23.262 - d2_prescind3
23.263 - "( bdv + b*bdv^^^2 = 0) = (bdv*(1+b*bdv)=0)"
23.264 - d2_prescind4
23.265 - "( bdv + bdv^^^2 = 0) = (bdv*(1+ bdv)=0)"
23.266 +
23.267 + d2_prescind1 "(a*bdv + b*bdv^^^2 = 0) = (bdv*(a +b*bdv)=0)"
23.268 + d2_prescind2 "(a*bdv + bdv^^^2 = 0) = (bdv*(a + bdv)=0)"
23.269 + d2_prescind3 "( bdv + b*bdv^^^2 = 0) = (bdv*(1+b*bdv)=0)"
23.270 + d2_prescind4 "( bdv + bdv^^^2 = 0) = (bdv*(1+ bdv)=0)"
23.271 (* eliminate degree 2 *)
23.272 (* thm for neg arguments in sqroot have postfix _neg *)
23.273 - d2_sqrt_equation1
23.274 - "[|(0<=c);Not(bdv occurs_in c)|] ==> (bdv^^^2=c) = ((bdv=sqrt c) | (bdv=(-1)*sqrt c ))"
23.275 + d2_sqrt_equation1 "[|(0<=c);Not(bdv occurs_in c)|] ==>
23.276 + (bdv^^^2=c) = ((bdv=sqrt c) | (bdv=(-1)*sqrt c ))"
23.277 d2_sqrt_equation1_neg
23.278 "[|(c<0);Not(bdv occurs_in c)|] ==> (bdv^^^2=c) = False"
23.279 - d2_sqrt_equation2
23.280 - "(bdv^^^2=0) = (bdv=0)"
23.281 - d2_sqrt_equation3
23.282 - "(b*bdv^^^2=0) = (bdv=0)"
23.283 - d2_reduce_equation1
23.284 - "(bdv*(a +b*bdv)=0) = ((bdv=0)|(a+b*bdv=0))"
23.285 - d2_reduce_equation2
23.286 - "(bdv*(a + bdv)=0) = ((bdv=0)|(a+ bdv=0))"
23.287 - d2_pqformula1
23.288 - "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+ bdv^^^2=0) =
23.289 - ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2)
23.290 - | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
23.291 - d2_pqformula1_neg
23.292 - "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+ bdv^^^2=0) = False"
23.293 - d2_pqformula2
23.294 - "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+1*bdv^^^2=0) =
23.295 - ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2)
23.296 - | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
23.297 - d2_pqformula2_neg
23.298 - "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+1*bdv^^^2=0) = False"
23.299 - d2_pqformula3
23.300 - "[|0<=1 - 4*q|] ==> (q+ bdv+ bdv^^^2=0) =
23.301 - ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2)
23.302 - | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
23.303 - d2_pqformula3_neg
23.304 - "[|1 - 4*q<0|] ==> (q+ bdv+ bdv^^^2=0) = False"
23.305 - d2_pqformula4
23.306 - "[|0<=1 - 4*q|] ==> (q+ bdv+1*bdv^^^2=0) =
23.307 - ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2)
23.308 - | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
23.309 - d2_pqformula4_neg
23.310 - "[|1 - 4*q<0|] ==> (q+ bdv+1*bdv^^^2=0) = False"
23.311 - d2_pqformula5
23.312 - "[|0<=p^^^2 - 0|] ==> ( p*bdv+ bdv^^^2=0) =
23.313 - ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2)
23.314 - | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
23.315 + d2_sqrt_equation2 "(bdv^^^2=0) = (bdv=0)"
23.316 + d2_sqrt_equation3 "(b*bdv^^^2=0) = (bdv=0)"
23.317 + d2_reduce_equation1 "(bdv*(a +b*bdv)=0) = ((bdv=0)|(a+b*bdv=0))"
23.318 + d2_reduce_equation2 "(bdv*(a + bdv)=0) = ((bdv=0)|(a+ bdv=0))"
23.319 + d2_pqformula1 "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+ bdv^^^2=0) =
23.320 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2)
23.321 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
23.322 + d2_pqformula1_neg "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+ bdv^^^2=0) = False"
23.323 + d2_pqformula2 "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+1*bdv^^^2=0) =
23.324 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2)
23.325 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
23.326 + d2_pqformula2_neg "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+1*bdv^^^2=0) = False"
23.327 + d2_pqformula3 "[|0<=1 - 4*q|] ==> (q+ bdv+ bdv^^^2=0) =
23.328 + ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2)
23.329 + | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
23.330 + d2_pqformula3_neg "[|1 - 4*q<0|] ==> (q+ bdv+ bdv^^^2=0) = False"
23.331 + d2_pqformula4 "[|0<=1 - 4*q|] ==> (q+ bdv+1*bdv^^^2=0) =
23.332 + ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2)
23.333 + | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
23.334 + d2_pqformula4_neg "[|1 - 4*q<0|] ==> (q+ bdv+1*bdv^^^2=0) = False"
23.335 + d2_pqformula5 "[|0<=p^^^2 - 0|] ==> ( p*bdv+ bdv^^^2=0) =
23.336 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2)
23.337 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
23.338 (* d2_pqformula5_neg not need p^2 never less zero in R *)
23.339 - d2_pqformula6
23.340 - "[|0<=p^^^2 - 0|] ==> ( p*bdv+1*bdv^^^2=0) =
23.341 - ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2)
23.342 - | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
23.343 + d2_pqformula6 "[|0<=p^^^2 - 0|] ==> ( p*bdv+1*bdv^^^2=0) =
23.344 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2)
23.345 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
23.346 (* d2_pqformula6_neg not need p^2 never less zero in R *)
23.347 - d2_pqformula7
23.348 - "[|0<=1 - 0|] ==> ( bdv+ bdv^^^2=0) =
23.349 - ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2)
23.350 - | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
23.351 + d2_pqformula7 "[|0<=1 - 0|] ==> ( bdv+ bdv^^^2=0) =
23.352 + ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2)
23.353 + | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
23.354 (* d2_pqformula7_neg not need, because 1<0 ==> False*)
23.355 - d2_pqformula8
23.356 - "[|0<=1 - 0|] ==> ( bdv+1*bdv^^^2=0) =
23.357 - ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2)
23.358 - | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
23.359 + d2_pqformula8 "[|0<=1 - 0|] ==> ( bdv+1*bdv^^^2=0) =
23.360 + ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2)
23.361 + | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
23.362 (* d2_pqformula8_neg not need, because 1<0 ==> False*)
23.363 - d2_pqformula9
23.364 - "[|Not(bdv occurs_in q); 0<= (-1)*4*q|] ==> (q+ 1*bdv^^^2=0) =
23.365 - ((bdv= 0 + sqrt(0 - 4*q)/2)
23.366 - | (bdv= 0 - sqrt(0 - 4*q)/2))"
23.367 + d2_pqformula9 "[|Not(bdv occurs_in q); 0<= (-1)*4*q|] ==>
23.368 + (q+ 1*bdv^^^2=0) = ((bdv= 0 + sqrt(0 - 4*q)/2)
23.369 + | (bdv= 0 - sqrt(0 - 4*q)/2))"
23.370 d2_pqformula9_neg
23.371 "[|Not(bdv occurs_in q); (-1)*4*q<0|] ==> (q+ 1*bdv^^^2=0) = False"
23.372 d2_pqformula10
23.373 @@ -398,6 +361,1093 @@
23.374 separate_1_bdv "bdv / b = (1 / b) * bdv"
23.375 separate_1_bdv_n "bdv ^^^ n / b = (1 / b) * bdv ^^^ n"
23.376
23.377 +ML {*
23.378 +(*-------------------------rulse-------------------------*)
23.379 +val PolyEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
23.380 + append_rls "PolyEq_prls" e_rls
23.381 + [Calc ("Atools.ident",eval_ident "#ident_"),
23.382 + Calc ("Tools.matches",eval_matches ""),
23.383 + Calc ("Tools.lhs" ,eval_lhs ""),
23.384 + Calc ("Tools.rhs" ,eval_rhs ""),
23.385 + Calc ("Poly.is'_expanded'_in",eval_is_expanded_in ""),
23.386 + Calc ("Poly.is'_poly'_in",eval_is_poly_in ""),
23.387 + Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),
23.388 + Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
23.389 + (*Calc ("Atools.occurs'_in",eval_occurs_in ""), *)
23.390 + (*Calc ("Atools.is'_const",eval_const "#is_const_"),*)
23.391 + Calc ("op =",eval_equal "#equal_"),
23.392 + Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
23.393 + Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
23.394 + Thm ("not_true",num_str not_true),
23.395 + Thm ("not_false",num_str not_false),
23.396 + Thm ("and_true",num_str and_true),
23.397 + Thm ("and_false",num_str and_false),
23.398 + Thm ("or_true",num_str or_true),
23.399 + Thm ("or_false",num_str or_false)
23.400 + ];
23.401 +
23.402 +val PolyEq_erls =
23.403 + merge_rls "PolyEq_erls" LinEq_erls
23.404 + (append_rls "ops_preds" calculate_Rational
23.405 + [Calc ("op =",eval_equal "#equal_"),
23.406 + Thm ("plus_leq", num_str plus_leq),
23.407 + Thm ("minus_leq", num_str minus_leq),
23.408 + Thm ("rat_leq1", num_str rat_leq1),
23.409 + Thm ("rat_leq2", num_str rat_leq2),
23.410 + Thm ("rat_leq3", num_str rat_leq3)
23.411 + ]);
23.412 +
23.413 +val PolyEq_crls =
23.414 + merge_rls "PolyEq_crls" LinEq_crls
23.415 + (append_rls "ops_preds" calculate_Rational
23.416 + [Calc ("op =",eval_equal "#equal_"),
23.417 + Thm ("plus_leq", num_str plus_leq),
23.418 + Thm ("minus_leq", num_str minus_leq),
23.419 + Thm ("rat_leq1", num_str rat_leq1),
23.420 + Thm ("rat_leq2", num_str rat_leq2),
23.421 + Thm ("rat_leq3", num_str rat_leq3)
23.422 + ]);
23.423 +
23.424 +val cancel_leading_coeff = prep_rls(
23.425 + Rls {id = "cancel_leading_coeff", preconds = [],
23.426 + rew_ord = ("e_rew_ord",e_rew_ord),
23.427 + erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
23.428 + rules = [Thm ("cancel_leading_coeff1",num_str cancel_leading_coeff1),
23.429 + Thm ("cancel_leading_coeff2",num_str cancel_leading_coeff2),
23.430 + Thm ("cancel_leading_coeff3",num_str cancel_leading_coeff3),
23.431 + Thm ("cancel_leading_coeff4",num_str cancel_leading_coeff4),
23.432 + Thm ("cancel_leading_coeff5",num_str cancel_leading_coeff5),
23.433 + Thm ("cancel_leading_coeff6",num_str cancel_leading_coeff6),
23.434 + Thm ("cancel_leading_coeff7",num_str cancel_leading_coeff7),
23.435 + Thm ("cancel_leading_coeff8",num_str cancel_leading_coeff8),
23.436 + Thm ("cancel_leading_coeff9",num_str cancel_leading_coeff9),
23.437 + Thm ("cancel_leading_coeff10",num_str cancel_leading_coeff10),
23.438 + Thm ("cancel_leading_coeff11",num_str cancel_leading_coeff11),
23.439 + Thm ("cancel_leading_coeff12",num_str cancel_leading_coeff12),
23.440 + Thm ("cancel_leading_coeff13",num_str cancel_leading_coeff13)
23.441 + ],
23.442 + scr = Script ((term_of o the o (parse thy))
23.443 + "empty_script")
23.444 + }:rls);
23.445 +
23.446 +val complete_square = prep_rls(
23.447 + Rls {id = "complete_square", preconds = [],
23.448 + rew_ord = ("e_rew_ord",e_rew_ord),
23.449 + erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
23.450 + rules = [Thm ("complete_square1",num_str complete_square1),
23.451 + Thm ("complete_square2",num_str complete_square2),
23.452 + Thm ("complete_square3",num_str complete_square3),
23.453 + Thm ("complete_square4",num_str complete_square4),
23.454 + Thm ("complete_square5",num_str complete_square5)
23.455 + ],
23.456 + scr = Script ((term_of o the o (parse thy))
23.457 + "empty_script")
23.458 + }:rls);
23.459 +
23.460 +val polyeq_simplify = prep_rls(
23.461 + Rls {id = "polyeq_simplify", preconds = [],
23.462 + rew_ord = ("termlessI",termlessI),
23.463 + erls = PolyEq_erls,
23.464 + srls = Erls,
23.465 + calc = [],
23.466 + (*asm_thm = [],*)
23.467 + rules = [Thm ("real_assoc_1",num_str real_assoc_1),
23.468 + Thm ("real_assoc_2",num_str real_assoc_2),
23.469 + Thm ("real_diff_minus",num_str real_diff_minus),
23.470 + Thm ("real_unari_minus",num_str real_unari_minus),
23.471 + Thm ("realpow_multI",num_str realpow_multI),
23.472 + Calc ("op +",eval_binop "#add_"),
23.473 + Calc ("op -",eval_binop "#sub_"),
23.474 + Calc ("op *",eval_binop "#mult_"),
23.475 + Calc ("HOL.divide", eval_cancel "#divide_"),
23.476 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
23.477 + Calc ("Atools.pow" ,eval_binop "#power_"),
23.478 + Rls_ reduce_012
23.479 + ],
23.480 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.481 + }:rls);
23.482 +
23.483 +ruleset' := overwritelthy thy (!ruleset',
23.484 + [("cancel_leading_coeff",cancel_leading_coeff),
23.485 + ("complete_square",complete_square),
23.486 + ("PolyEq_erls",PolyEq_erls),(*FIXXXME:del with rls.rls'*)
23.487 + ("polyeq_simplify",polyeq_simplify)]);
23.488 +
23.489 +
23.490 +(* ------------- polySolve ------------------ *)
23.491 +(* -- d0 -- *)
23.492 +(*isolate the bound variable in an d0 equation; 'bdv' is a meta-constant*)
23.493 +val d0_polyeq_simplify = prep_rls(
23.494 + Rls {id = "d0_polyeq_simplify", preconds = [],
23.495 + rew_ord = ("e_rew_ord",e_rew_ord),
23.496 + erls = PolyEq_erls,
23.497 + srls = Erls,
23.498 + calc = [],
23.499 + (*asm_thm = [],*)
23.500 + rules = [Thm("d0_true",num_str d0_true),
23.501 + Thm("d0_false",num_str d0_false)
23.502 + ],
23.503 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.504 + }:rls);
23.505 +
23.506 +(* -- d1 -- *)
23.507 +(*isolate the bound variable in an d1 equation; 'bdv' is a meta-constant*)
23.508 +val d1_polyeq_simplify = prep_rls(
23.509 + Rls {id = "d1_polyeq_simplify", preconds = [],
23.510 + rew_ord = ("e_rew_ord",e_rew_ord),
23.511 + erls = PolyEq_erls,
23.512 + srls = Erls,
23.513 + calc = [],
23.514 + (*asm_thm = [("d1_isolate_div","")],*)
23.515 + rules = [
23.516 + Thm("d1_isolate_add1",num_str d1_isolate_add1),
23.517 + (* a+bx=0 -> bx=-a *)
23.518 + Thm("d1_isolate_add2",num_str d1_isolate_add2),
23.519 + (* a+ x=0 -> x=-a *)
23.520 + Thm("d1_isolate_div",num_str d1_isolate_div)
23.521 + (* bx=c -> x=c/b *)
23.522 + ],
23.523 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.524 + }:rls);
23.525 +
23.526 +(* -- d2 -- *)
23.527 +(* isolate the bound variable in an d2 equation with bdv only;
23.528 + 'bdv' is a meta-constant*)
23.529 +val d2_polyeq_bdv_only_simplify = prep_rls(
23.530 + Rls {id = "d2_polyeq_bdv_only_simplify", preconds = [],
23.531 + rew_ord = ("e_rew_ord",e_rew_ord),
23.532 + erls = PolyEq_erls,
23.533 + srls = Erls,
23.534 + calc = [],
23.535 + (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
23.536 + ("d2_isolate_div","")],*)
23.537 + rules = [Thm("d2_prescind1",num_str d2_prescind1),
23.538 + (* ax+bx^2=0 -> x(a+bx)=0 *)
23.539 + Thm("d2_prescind2",num_str d2_prescind2),
23.540 + (* ax+ x^2=0 -> x(a+ x)=0 *)
23.541 + Thm("d2_prescind3",num_str d2_prescind3),
23.542 + (* x+bx^2=0 -> x(1+bx)=0 *)
23.543 + Thm("d2_prescind4",num_str d2_prescind4),
23.544 + (* x+ x^2=0 -> x(1+ x)=0 *)
23.545 + Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1),
23.546 + (* x^2=c -> x=+-sqrt(c)*)
23.547 + Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),
23.548 + (* [0<c] x^2=c -> [] *)
23.549 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
23.550 + (* x^2=0 -> x=0 *)
23.551 + Thm("d2_reduce_equation1",num_str d2_reduce_equation1),
23.552 + (* x(a+bx)=0 -> x=0 | a+bx=0*)
23.553 + Thm("d2_reduce_equation2",num_str d2_reduce_equation2),
23.554 + (* x(a+ x)=0 -> x=0 | a+ x=0*)
23.555 + Thm("d2_isolate_div",num_str d2_isolate_div)
23.556 + (* bx^2=c -> x^2=c/b*)
23.557 + ],
23.558 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.559 + }:rls);
23.560 +
23.561 +(* isolate the bound variable in an d2 equation with sqrt only;
23.562 + 'bdv' is a meta-constant*)
23.563 +val d2_polyeq_sq_only_simplify = prep_rls(
23.564 + Rls {id = "d2_polyeq_sq_only_simplify", preconds = [],
23.565 + rew_ord = ("e_rew_ord",e_rew_ord),
23.566 + erls = PolyEq_erls,
23.567 + srls = Erls,
23.568 + calc = [],
23.569 + (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
23.570 + ("d2_isolate_div","")],*)
23.571 + rules = [Thm("d2_isolate_add1",num_str d2_isolate_add1),
23.572 + (* a+ bx^2=0 -> bx^2=(-1)a*)
23.573 + Thm("d2_isolate_add2",num_str d2_isolate_add2),
23.574 + (* a+ x^2=0 -> x^2=(-1)a*)
23.575 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
23.576 + (* x^2=0 -> x=0 *)
23.577 + Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1),
23.578 + (* x^2=c -> x=+-sqrt(c)*)
23.579 + Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),
23.580 + (* [c<0] x^2=c -> x=[] *)
23.581 + Thm("d2_isolate_div",num_str d2_isolate_div)
23.582 + (* bx^2=c -> x^2=c/b*)
23.583 + ],
23.584 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.585 + }:rls);
23.586 +
23.587 +(* isolate the bound variable in an d2 equation with pqFormula;
23.588 + 'bdv' is a meta-constant*)
23.589 +val d2_polyeq_pqFormula_simplify = prep_rls(
23.590 + Rls {id = "d2_polyeq_pqFormula_simplify", preconds = [],
23.591 + rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
23.592 + srls = Erls, calc = [],
23.593 + rules = [Thm("d2_pqformula1",num_str d2_pqformula1),
23.594 + (* q+px+ x^2=0 *)
23.595 + Thm("d2_pqformula1_neg",num_str d2_pqformula1_neg),
23.596 + (* q+px+ x^2=0 *)
23.597 + Thm("d2_pqformula2",num_str d2_pqformula2),
23.598 + (* q+px+1x^2=0 *)
23.599 + Thm("d2_pqformula2_neg",num_str d2_pqformula2_neg),
23.600 + (* q+px+1x^2=0 *)
23.601 + Thm("d2_pqformula3",num_str d2_pqformula3),
23.602 + (* q+ x+ x^2=0 *)
23.603 + Thm("d2_pqformula3_neg",num_str d2_pqformula3_neg),
23.604 + (* q+ x+ x^2=0 *)
23.605 + Thm("d2_pqformula4",num_str d2_pqformula4),
23.606 + (* q+ x+1x^2=0 *)
23.607 + Thm("d2_pqformula4_neg",num_str d2_pqformula4_neg),
23.608 + (* q+ x+1x^2=0 *)
23.609 + Thm("d2_pqformula5",num_str d2_pqformula5),
23.610 + (* qx+ x^2=0 *)
23.611 + Thm("d2_pqformula6",num_str d2_pqformula6),
23.612 + (* qx+1x^2=0 *)
23.613 + Thm("d2_pqformula7",num_str d2_pqformula7),
23.614 + (* x+ x^2=0 *)
23.615 + Thm("d2_pqformula8",num_str d2_pqformula8),
23.616 + (* x+1x^2=0 *)
23.617 + Thm("d2_pqformula9",num_str d2_pqformula9),
23.618 + (* q +1x^2=0 *)
23.619 + Thm("d2_pqformula9_neg",num_str d2_pqformula9_neg),
23.620 + (* q +1x^2=0 *)
23.621 + Thm("d2_pqformula10",num_str d2_pqformula10),
23.622 + (* q + x^2=0 *)
23.623 + Thm("d2_pqformula10_neg",num_str d2_pqformula10_neg),
23.624 + (* q + x^2=0 *)
23.625 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
23.626 + (* x^2=0 *)
23.627 + Thm("d2_sqrt_equation3",num_str d2_sqrt_equation3)
23.628 + (* 1x^2=0 *)
23.629 + ],
23.630 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.631 + }:rls);
23.632 +
23.633 +(* isolate the bound variable in an d2 equation with abcFormula;
23.634 + 'bdv' is a meta-constant*)
23.635 +val d2_polyeq_abcFormula_simplify = prep_rls(
23.636 + Rls {id = "d2_polyeq_abcFormula_simplify", preconds = [],
23.637 + rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
23.638 + srls = Erls, calc = [],
23.639 + rules = [Thm("d2_abcformula1",num_str d2_abcformula1),
23.640 + (*c+bx+cx^2=0 *)
23.641 + Thm("d2_abcformula1_neg",num_str d2_abcformula1_neg),
23.642 + (*c+bx+cx^2=0 *)
23.643 + Thm("d2_abcformula2",num_str d2_abcformula2),
23.644 + (*c+ x+cx^2=0 *)
23.645 + Thm("d2_abcformula2_neg",num_str d2_abcformula2_neg),
23.646 + (*c+ x+cx^2=0 *)
23.647 + Thm("d2_abcformula3",num_str d2_abcformula3),
23.648 + (*c+bx+ x^2=0 *)
23.649 + Thm("d2_abcformula3_neg",num_str d2_abcformula3_neg),
23.650 + (*c+bx+ x^2=0 *)
23.651 + Thm("d2_abcformula4",num_str d2_abcformula4),
23.652 + (*c+ x+ x^2=0 *)
23.653 + Thm("d2_abcformula4_neg",num_str d2_abcformula4_neg),
23.654 + (*c+ x+ x^2=0 *)
23.655 + Thm("d2_abcformula5",num_str d2_abcformula5),
23.656 + (*c+ cx^2=0 *)
23.657 + Thm("d2_abcformula5_neg",num_str d2_abcformula5_neg),
23.658 + (*c+ cx^2=0 *)
23.659 + Thm("d2_abcformula6",num_str d2_abcformula6),
23.660 + (*c+ x^2=0 *)
23.661 + Thm("d2_abcformula6_neg",num_str d2_abcformula6_neg),
23.662 + (*c+ x^2=0 *)
23.663 + Thm("d2_abcformula7",num_str d2_abcformula7),
23.664 + (* bx+ax^2=0 *)
23.665 + Thm("d2_abcformula8",num_str d2_abcformula8),
23.666 + (* bx+ x^2=0 *)
23.667 + Thm("d2_abcformula9",num_str d2_abcformula9),
23.668 + (* x+ax^2=0 *)
23.669 + Thm("d2_abcformula10",num_str d2_abcformula10),
23.670 + (* x+ x^2=0 *)
23.671 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
23.672 + (* x^2=0 *)
23.673 + Thm("d2_sqrt_equation3",num_str d2_sqrt_equation3)
23.674 + (* bx^2=0 *)
23.675 + ],
23.676 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.677 + }:rls);
23.678 +
23.679 +(* isolate the bound variable in an d2 equation;
23.680 + 'bdv' is a meta-constant*)
23.681 +val d2_polyeq_simplify = prep_rls(
23.682 + Rls {id = "d2_polyeq_simplify", preconds = [],
23.683 + rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
23.684 + srls = Erls, calc = [],
23.685 + rules = [Thm("d2_pqformula1",num_str d2_pqformula1),
23.686 + (* p+qx+ x^2=0 *)
23.687 + Thm("d2_pqformula1_neg",num_str d2_pqformula1_neg),
23.688 + (* p+qx+ x^2=0 *)
23.689 + Thm("d2_pqformula2",num_str d2_pqformula2),
23.690 + (* p+qx+1x^2=0 *)
23.691 + Thm("d2_pqformula2_neg",num_str d2_pqformula2_neg),
23.692 + (* p+qx+1x^2=0 *)
23.693 + Thm("d2_pqformula3",num_str d2_pqformula3),
23.694 + (* p+ x+ x^2=0 *)
23.695 + Thm("d2_pqformula3_neg",num_str d2_pqformula3_neg),
23.696 + (* p+ x+ x^2=0 *)
23.697 + Thm("d2_pqformula4",num_str d2_pqformula4),
23.698 + (* p+ x+1x^2=0 *)
23.699 + Thm("d2_pqformula4_neg",num_str d2_pqformula4_neg),
23.700 + (* p+ x+1x^2=0 *)
23.701 + Thm("d2_abcformula1",num_str d2_abcformula1),
23.702 + (* c+bx+cx^2=0 *)
23.703 + Thm("d2_abcformula1_neg",num_str d2_abcformula1_neg),
23.704 + (* c+bx+cx^2=0 *)
23.705 + Thm("d2_abcformula2",num_str d2_abcformula2),
23.706 + (* c+ x+cx^2=0 *)
23.707 + Thm("d2_abcformula2_neg",num_str d2_abcformula2_neg),
23.708 + (* c+ x+cx^2=0 *)
23.709 + Thm("d2_prescind1",num_str d2_prescind1),
23.710 + (* ax+bx^2=0 -> x(a+bx)=0 *)
23.711 + Thm("d2_prescind2",num_str d2_prescind2),
23.712 + (* ax+ x^2=0 -> x(a+ x)=0 *)
23.713 + Thm("d2_prescind3",num_str d2_prescind3),
23.714 + (* x+bx^2=0 -> x(1+bx)=0 *)
23.715 + Thm("d2_prescind4",num_str d2_prescind4),
23.716 + (* x+ x^2=0 -> x(1+ x)=0 *)
23.717 + Thm("d2_isolate_add1",num_str d2_isolate_add1),
23.718 + (* a+ bx^2=0 -> bx^2=(-1)a*)
23.719 + Thm("d2_isolate_add2",num_str d2_isolate_add2),
23.720 + (* a+ x^2=0 -> x^2=(-1)a*)
23.721 + Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1),
23.722 + (* x^2=c -> x=+-sqrt(c)*)
23.723 + Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),
23.724 + (* [c<0] x^2=c -> x=[]*)
23.725 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2),
23.726 + (* x^2=0 -> x=0 *)
23.727 + Thm("d2_reduce_equation1",num_str d2_reduce_equation1),
23.728 + (* x(a+bx)=0 -> x=0 | a+bx=0*)
23.729 + Thm("d2_reduce_equation2",num_str d2_reduce_equation2),
23.730 + (* x(a+ x)=0 -> x=0 | a+ x=0*)
23.731 + Thm("d2_isolate_div",num_str d2_isolate_div)
23.732 + (* bx^2=c -> x^2=c/b*)
23.733 + ],
23.734 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.735 + }:rls);
23.736 +
23.737 +(* -- d3 -- *)
23.738 +(* isolate the bound variable in an d3 equation; 'bdv' is a meta-constant *)
23.739 +val d3_polyeq_simplify = prep_rls(
23.740 + Rls {id = "d3_polyeq_simplify", preconds = [],
23.741 + rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
23.742 + srls = Erls, calc = [],
23.743 + rules =
23.744 + [Thm("d3_reduce_equation1",num_str d3_reduce_equation1),
23.745 + (*a*bdv + b*bdv^^^2 + c*bdv^^^3=0) =
23.746 + (bdv=0 | (a + b*bdv + c*bdv^^^2=0)*)
23.747 + Thm("d3_reduce_equation2",num_str d3_reduce_equation2),
23.748 + (* bdv + b*bdv^^^2 + c*bdv^^^3=0) =
23.749 + (bdv=0 | (1 + b*bdv + c*bdv^^^2=0)*)
23.750 + Thm("d3_reduce_equation3",num_str d3_reduce_equation3),
23.751 + (*a*bdv + bdv^^^2 + c*bdv^^^3=0) =
23.752 + (bdv=0 | (a + bdv + c*bdv^^^2=0)*)
23.753 + Thm("d3_reduce_equation4",num_str d3_reduce_equation4),
23.754 + (* bdv + bdv^^^2 + c*bdv^^^3=0) =
23.755 + (bdv=0 | (1 + bdv + c*bdv^^^2=0)*)
23.756 + Thm("d3_reduce_equation5",num_str d3_reduce_equation5),
23.757 + (*a*bdv + b*bdv^^^2 + bdv^^^3=0) =
23.758 + (bdv=0 | (a + b*bdv + bdv^^^2=0)*)
23.759 + Thm("d3_reduce_equation6",num_str d3_reduce_equation6),
23.760 + (* bdv + b*bdv^^^2 + bdv^^^3=0) =
23.761 + (bdv=0 | (1 + b*bdv + bdv^^^2=0)*)
23.762 + Thm("d3_reduce_equation7",num_str d3_reduce_equation7),
23.763 + (*a*bdv + bdv^^^2 + bdv^^^3=0) =
23.764 + (bdv=0 | (1 + bdv + bdv^^^2=0)*)
23.765 + Thm("d3_reduce_equation8",num_str d3_reduce_equation8),
23.766 + (* bdv + bdv^^^2 + bdv^^^3=0) =
23.767 + (bdv=0 | (1 + bdv + bdv^^^2=0)*)
23.768 + Thm("d3_reduce_equation9",num_str d3_reduce_equation9),
23.769 + (*a*bdv + c*bdv^^^3=0) =
23.770 + (bdv=0 | (a + c*bdv^^^2=0)*)
23.771 + Thm("d3_reduce_equation10",num_str d3_reduce_equation10),
23.772 + (* bdv + c*bdv^^^3=0) =
23.773 + (bdv=0 | (1 + c*bdv^^^2=0)*)
23.774 + Thm("d3_reduce_equation11",num_str d3_reduce_equation11),
23.775 + (*a*bdv + bdv^^^3=0) =
23.776 + (bdv=0 | (a + bdv^^^2=0)*)
23.777 + Thm("d3_reduce_equation12",num_str d3_reduce_equation12),
23.778 + (* bdv + bdv^^^3=0) =
23.779 + (bdv=0 | (1 + bdv^^^2=0)*)
23.780 + Thm("d3_reduce_equation13",num_str d3_reduce_equation13),
23.781 + (* b*bdv^^^2 + c*bdv^^^3=0) =
23.782 + (bdv=0 | ( b*bdv + c*bdv^^^2=0)*)
23.783 + Thm("d3_reduce_equation14",num_str d3_reduce_equation14),
23.784 + (* bdv^^^2 + c*bdv^^^3=0) =
23.785 + (bdv=0 | ( bdv + c*bdv^^^2=0)*)
23.786 + Thm("d3_reduce_equation15",num_str d3_reduce_equation15),
23.787 + (* b*bdv^^^2 + bdv^^^3=0) =
23.788 + (bdv=0 | ( b*bdv + bdv^^^2=0)*)
23.789 + Thm("d3_reduce_equation16",num_str d3_reduce_equation16),
23.790 + (* bdv^^^2 + bdv^^^3=0) =
23.791 + (bdv=0 | ( bdv + bdv^^^2=0)*)
23.792 + Thm("d3_isolate_add1",num_str d3_isolate_add1),
23.793 + (*[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^3=0) =
23.794 + (bdv=0 | (b*bdv^^^3=a)*)
23.795 + Thm("d3_isolate_add2",num_str d3_isolate_add2),
23.796 + (*[|Not(bdv occurs_in a)|] ==> (a + bdv^^^3=0) =
23.797 + (bdv=0 | ( bdv^^^3=a)*)
23.798 + Thm("d3_isolate_div",num_str d3_isolate_div),
23.799 + (*[|Not(b=0)|] ==> (b*bdv^^^3=c) = (bdv^^^3=c/b*)
23.800 + Thm("d3_root_equation2",num_str d3_root_equation2),
23.801 + (*(bdv^^^3=0) = (bdv=0) *)
23.802 + Thm("d3_root_equation1",num_str d3_root_equation1)
23.803 + (*bdv^^^3=c) = (bdv = nroot 3 c*)
23.804 + ],
23.805 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.806 + }:rls);
23.807 +
23.808 +(* -- d4 -- *)
23.809 +(*isolate the bound variable in an d4 equation; 'bdv' is a meta-constant*)
23.810 +val d4_polyeq_simplify = prep_rls(
23.811 + Rls {id = "d4_polyeq_simplify", preconds = [],
23.812 + rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
23.813 + srls = Erls, calc = [],
23.814 + rules =
23.815 + [Thm("d4_sub_u1",num_str d4_sub_u1)
23.816 + (* ax^4+bx^2+c=0 -> x=+-sqrt(ax^2+bx^+c) *)
23.817 + ],
23.818 + scr = Script ((term_of o the o (parse thy)) "empty_script")
23.819 + }:rls);
23.820 +
23.821 +ruleset' :=
23.822 +overwritelthy thy
23.823 + (!ruleset',
23.824 + [("d0_polyeq_simplify", d0_polyeq_simplify),
23.825 + ("d1_polyeq_simplify", d1_polyeq_simplify),
23.826 + ("d2_polyeq_simplify", d2_polyeq_simplify),
23.827 + ("d2_polyeq_bdv_only_simplify", d2_polyeq_bdv_only_simplify),
23.828 + ("d2_polyeq_sq_only_simplify", d2_polyeq_sq_only_simplify),
23.829 + ("d2_polyeq_pqFormula_simplify", d2_polyeq_pqFormula_simplify),
23.830 + ("d2_polyeq_abcFormula_simplify",
23.831 + d2_polyeq_abcFormula_simplify),
23.832 + ("d3_polyeq_simplify", d3_polyeq_simplify),
23.833 + ("d4_polyeq_simplify", d4_polyeq_simplify)
23.834 + ]);
23.835 +
23.836 +(*------------------------problems------------------------*)
23.837 +(*
23.838 +(get_pbt ["degree_2","polynomial","univariate","equation"]);
23.839 +show_ptyps();
23.840 +*)
23.841 +
23.842 +(*-------------------------poly-----------------------*)
23.843 +store_pbt
23.844 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly" [] e_pblID
23.845 + (["polynomial","univariate","equation"],
23.846 + [("#Given" ,["equality e_","solveFor v_"]),
23.847 + ("#Where" ,["~((e_::bool) is_ratequation_in (v_::real))",
23.848 + "~((lhs e_) is_rootTerm_in (v_::real))",
23.849 + "~((rhs e_) is_rootTerm_in (v_::real))"]),
23.850 + ("#Find" ,["solutions v_i_"])
23.851 + ],
23.852 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.853 + []));
23.854 +(*--- d0 ---*)
23.855 +store_pbt
23.856 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg0" [] e_pblID
23.857 + (["degree_0","polynomial","univariate","equation"],
23.858 + [("#Given" ,["equality e_","solveFor v_"]),
23.859 + ("#Where" ,["matches (?a = 0) e_",
23.860 + "(lhs e_) is_poly_in v_",
23.861 + "((lhs e_) has_degree_in v_ ) = 0"
23.862 + ]),
23.863 + ("#Find" ,["solutions v_i_"])
23.864 + ],
23.865 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.866 + [["PolyEq","solve_d0_polyeq_equation"]]));
23.867 +
23.868 +(*--- d1 ---*)
23.869 +store_pbt
23.870 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg1" [] e_pblID
23.871 + (["degree_1","polynomial","univariate","equation"],
23.872 + [("#Given" ,["equality e_","solveFor v_"]),
23.873 + ("#Where" ,["matches (?a = 0) e_",
23.874 + "(lhs e_) is_poly_in v_",
23.875 + "((lhs e_) has_degree_in v_ ) = 1"
23.876 + ]),
23.877 + ("#Find" ,["solutions v_i_"])
23.878 + ],
23.879 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.880 + [["PolyEq","solve_d1_polyeq_equation"]]));
23.881 +
23.882 +(*--- d2 ---*)
23.883 +store_pbt
23.884 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2" [] e_pblID
23.885 + (["degree_2","polynomial","univariate","equation"],
23.886 + [("#Given" ,["equality e_","solveFor v_"]),
23.887 + ("#Where" ,["matches (?a = 0) e_",
23.888 + "(lhs e_) is_poly_in v_ ",
23.889 + "((lhs e_) has_degree_in v_ ) = 2"]),
23.890 + ("#Find" ,["solutions v_i_"])
23.891 + ],
23.892 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.893 + [["PolyEq","solve_d2_polyeq_equation"]]));
23.894 +
23.895 + store_pbt
23.896 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_sqonly" [] e_pblID
23.897 + (["sq_only","degree_2","polynomial","univariate","equation"],
23.898 + [("#Given" ,["equality e_","solveFor v_"]),
23.899 + ("#Where" ,["matches ( ?a + ?v_^^^2 = 0) e_ | " ^
23.900 + "matches ( ?a + ?b*?v_^^^2 = 0) e_ | " ^
23.901 + "matches ( ?v_^^^2 = 0) e_ | " ^
23.902 + "matches ( ?b*?v_^^^2 = 0) e_" ,
23.903 + "Not (matches (?a + ?v_ + ?v_^^^2 = 0) e_) &" ^
23.904 + "Not (matches (?a + ?b*?v_ + ?v_^^^2 = 0) e_) &" ^
23.905 + "Not (matches (?a + ?v_ + ?c*?v_^^^2 = 0) e_) &" ^
23.906 + "Not (matches (?a + ?b*?v_ + ?c*?v_^^^2 = 0) e_) &" ^
23.907 + "Not (matches ( ?v_ + ?v_^^^2 = 0) e_) &" ^
23.908 + "Not (matches ( ?b*?v_ + ?v_^^^2 = 0) e_) &" ^
23.909 + "Not (matches ( ?v_ + ?c*?v_^^^2 = 0) e_) &" ^
23.910 + "Not (matches ( ?b*?v_ + ?c*?v_^^^2 = 0) e_)"]),
23.911 + ("#Find" ,["solutions v_i_"])
23.912 + ],
23.913 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.914 + [["PolyEq","solve_d2_polyeq_sqonly_equation"]]));
23.915 +
23.916 +store_pbt
23.917 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_bdvonly" [] e_pblID
23.918 + (["bdv_only","degree_2","polynomial","univariate","equation"],
23.919 + [("#Given" ,["equality e_","solveFor v_"]),
23.920 + ("#Where" ,["matches (?a*?v_ + ?v_^^^2 = 0) e_ | " ^
23.921 + "matches ( ?v_ + ?v_^^^2 = 0) e_ | " ^
23.922 + "matches ( ?v_ + ?b*?v_^^^2 = 0) e_ | " ^
23.923 + "matches (?a*?v_ + ?b*?v_^^^2 = 0) e_ | " ^
23.924 + "matches ( ?v_^^^2 = 0) e_ | " ^
23.925 + "matches ( ?b*?v_^^^2 = 0) e_ "]),
23.926 + ("#Find" ,["solutions v_i_"])
23.927 + ],
23.928 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.929 + [["PolyEq","solve_d2_polyeq_bdvonly_equation"]]));
23.930 +
23.931 +store_pbt
23.932 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_pq" [] e_pblID
23.933 + (["pqFormula","degree_2","polynomial","univariate","equation"],
23.934 + [("#Given" ,["equality e_","solveFor v_"]),
23.935 + ("#Where" ,["matches (?a + 1*?v_^^^2 = 0) e_ | " ^
23.936 + "matches (?a + ?v_^^^2 = 0) e_"]),
23.937 + ("#Find" ,["solutions v_i_"])
23.938 + ],
23.939 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.940 + [["PolyEq","solve_d2_polyeq_pq_equation"]]));
23.941 +
23.942 +store_pbt
23.943 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg2_abc" [] e_pblID
23.944 + (["abcFormula","degree_2","polynomial","univariate","equation"],
23.945 + [("#Given" ,["equality e_","solveFor v_"]),
23.946 + ("#Where" ,["matches (?a + ?v_^^^2 = 0) e_ | " ^
23.947 + "matches (?a + ?b*?v_^^^2 = 0) e_"]),
23.948 + ("#Find" ,["solutions v_i_"])
23.949 + ],
23.950 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.951 + [["PolyEq","solve_d2_polyeq_abc_equation"]]));
23.952 +
23.953 +(*--- d3 ---*)
23.954 +store_pbt
23.955 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg3" [] e_pblID
23.956 + (["degree_3","polynomial","univariate","equation"],
23.957 + [("#Given" ,["equality e_","solveFor v_"]),
23.958 + ("#Where" ,["matches (?a = 0) e_",
23.959 + "(lhs e_) is_poly_in v_ ",
23.960 + "((lhs e_) has_degree_in v_) = 3"]),
23.961 + ("#Find" ,["solutions v_i_"])
23.962 + ],
23.963 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.964 + [["PolyEq","solve_d3_polyeq_equation"]]));
23.965 +
23.966 +(*--- d4 ---*)
23.967 +store_pbt
23.968 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_deg4" [] e_pblID
23.969 + (["degree_4","polynomial","univariate","equation"],
23.970 + [("#Given" ,["equality e_","solveFor v_"]),
23.971 + ("#Where" ,["matches (?a = 0) e_",
23.972 + "(lhs e_) is_poly_in v_ ",
23.973 + "((lhs e_) has_degree_in v_) = 4"]),
23.974 + ("#Find" ,["solutions v_i_"])
23.975 + ],
23.976 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.977 + [(*["PolyEq","solve_d4_polyeq_equation"]*)]));
23.978 +
23.979 +(*--- normalize ---*)
23.980 +store_pbt
23.981 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_poly_norm" [] e_pblID
23.982 + (["normalize","polynomial","univariate","equation"],
23.983 + [("#Given" ,["equality e_","solveFor v_"]),
23.984 + ("#Where" ,["(Not((matches (?a = 0 ) e_ ))) |" ^
23.985 + "(Not(((lhs e_) is_poly_in v_)))"]),
23.986 + ("#Find" ,["solutions v_i_"])
23.987 + ],
23.988 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.989 + [["PolyEq","normalize_poly"]]));
23.990 +(*-------------------------expanded-----------------------*)
23.991 +store_pbt
23.992 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_expand" [] e_pblID
23.993 + (["expanded","univariate","equation"],
23.994 + [("#Given" ,["equality e_","solveFor v_"]),
23.995 + ("#Where" ,["matches (?a = 0) e_",
23.996 + "(lhs e_) is_expanded_in v_ "]),
23.997 + ("#Find" ,["solutions v_i_"])
23.998 + ],
23.999 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.1000 + []));
23.1001 +
23.1002 +(*--- d2 ---*)
23.1003 +store_pbt
23.1004 + (prep_pbt (theory "PolyEq") "pbl_equ_univ_expand_deg2" [] e_pblID
23.1005 + (["degree_2","expanded","univariate","equation"],
23.1006 + [("#Given" ,["equality e_","solveFor v_"]),
23.1007 + ("#Where" ,["((lhs e_) has_degree_in v_) = 2"]),
23.1008 + ("#Find" ,["solutions v_i_"])
23.1009 + ],
23.1010 + PolyEq_prls, SOME "solve (e_::bool, v_)",
23.1011 + [["PolyEq","complete_square"]]));
23.1012 +
23.1013 +
23.1014 +"-------------------------methods-----------------------";
23.1015 +store_met
23.1016 + (prep_met (theory "PolyEq") "met_polyeq" [] e_metID
23.1017 + (["PolyEq"],
23.1018 + [],
23.1019 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
23.1020 + crls=PolyEq_crls, nrls=norm_Rational}, "empty_script"));
23.1021 +
23.1022 +store_met
23.1023 + (prep_met (theory "PolyEq") "met_polyeq_norm" [] e_metID
23.1024 + (["PolyEq","normalize_poly"],
23.1025 + [("#Given" ,["equality e_","solveFor v_"]),
23.1026 + ("#Where" ,["(Not((matches (?a = 0 ) e_ ))) |" ^
23.1027 + "(Not(((lhs e_) is_poly_in v_)))"]),
23.1028 + ("#Find" ,["solutions v_i_"])
23.1029 + ],
23.1030 + {rew_ord'="termlessI",
23.1031 + rls'=PolyEq_erls,
23.1032 + srls=e_rls,
23.1033 + prls=PolyEq_prls,
23.1034 + calc=[],
23.1035 + crls=PolyEq_crls, nrls=norm_Rational
23.1036 + "Script Normalize_poly (e_::bool) (v_::real) = " ^
23.1037 + "(let e_ =((Try (Rewrite all_left False)) @@ " ^
23.1038 + " (Try (Repeat (Rewrite makex1_x False))) @@ " ^
23.1039 + " (Try (Repeat (Rewrite_Set expand_binoms False))) @@ " ^
23.1040 + " (Try (Repeat (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1041 + " make_ratpoly_in False))) @@ " ^
23.1042 + " (Try (Repeat (Rewrite_Set polyeq_simplify False)))) e_ " ^
23.1043 + " in (SubProblem (PolyEq_,[polynomial,univariate,equation], " ^
23.1044 + " [no_met]) [bool_ e_, real_ v_]))"
23.1045 + ));
23.1046 +
23.1047 +store_met
23.1048 + (prep_met (theory "PolyEq") "met_polyeq_d0" [] e_metID
23.1049 + (["PolyEq","solve_d0_polyeq_equation"],
23.1050 + [("#Given" ,["equality e_","solveFor v_"]),
23.1051 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1052 + "((lhs e_) has_degree_in v_) = 0"]),
23.1053 + ("#Find" ,["solutions v_i_"])
23.1054 + ],
23.1055 + {rew_ord'="termlessI",
23.1056 + rls'=PolyEq_erls,
23.1057 + srls=e_rls,
23.1058 + prls=PolyEq_prls,
23.1059 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1060 + crls=PolyEq_crls, nrls=norm_Rational},
23.1061 + "Script Solve_d0_polyeq_equation (e_::bool) (v_::real) = " ^
23.1062 + "(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1063 + " d0_polyeq_simplify False))) e_ " ^
23.1064 + " in ((Or_to_List e_)::bool list))"
23.1065 + ));
23.1066 +
23.1067 +store_met
23.1068 + (prep_met (theory "PolyEq") "met_polyeq_d1" [] e_metID
23.1069 + (["PolyEq","solve_d1_polyeq_equation"],
23.1070 + [("#Given" ,["equality e_","solveFor v_"]),
23.1071 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1072 + "((lhs e_) has_degree_in v_) = 1"]),
23.1073 + ("#Find" ,["solutions v_i_"])
23.1074 + ],
23.1075 + {rew_ord'="termlessI",
23.1076 + rls'=PolyEq_erls,
23.1077 + srls=e_rls,
23.1078 + prls=PolyEq_prls,
23.1079 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1080 + crls=PolyEq_crls, nrls=norm_Rational(*,
23.1081 + (* asm_rls=["d1_polyeq_simplify"],*)
23.1082 + asm_rls=[],
23.1083 + asm_thm=[("d1_isolate_div","")]*)},
23.1084 + "Script Solve_d1_polyeq_equation (e_::bool) (v_::real) = " ^
23.1085 + "(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1086 + " d1_polyeq_simplify True)) @@ " ^
23.1087 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1088 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
23.1089 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1090 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1091 + ));
23.1092 +
23.1093 +store_met
23.1094 + (prep_met (theory "PolyEq") "met_polyeq_d22" [] e_metID
23.1095 + (["PolyEq","solve_d2_polyeq_equation"],
23.1096 + [("#Given" ,["equality e_","solveFor v_"]),
23.1097 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1098 + "((lhs e_) has_degree_in v_) = 2"]),
23.1099 + ("#Find" ,["solutions v_i_"])
23.1100 + ],
23.1101 + {rew_ord'="termlessI",
23.1102 + rls'=PolyEq_erls,
23.1103 + srls=e_rls,
23.1104 + prls=PolyEq_prls,
23.1105 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1106 + crls=PolyEq_crls, nrls=norm_Rational},
23.1107 + "Script Solve_d2_polyeq_equation (e_::bool) (v_::real) = " ^
23.1108 + " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1109 + " d2_polyeq_simplify True)) @@ " ^
23.1110 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1111 + " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1112 + " d1_polyeq_simplify True)) @@ " ^
23.1113 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1114 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
23.1115 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1116 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1117 + ));
23.1118 +
23.1119 +store_met
23.1120 + (prep_met (theory "PolyEq") "met_polyeq_d2_bdvonly" [] e_metID
23.1121 + (["PolyEq","solve_d2_polyeq_bdvonly_equation"],
23.1122 + [("#Given" ,["equality e_","solveFor v_"]),
23.1123 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1124 + "((lhs e_) has_degree_in v_) = 2"]),
23.1125 + ("#Find" ,["solutions v_i_"])
23.1126 + ],
23.1127 + {rew_ord'="termlessI",
23.1128 + rls'=PolyEq_erls,
23.1129 + srls=e_rls,
23.1130 + prls=PolyEq_prls,
23.1131 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1132 + crls=PolyEq_crls, nrls=norm_Rational},
23.1133 + "Script Solve_d2_polyeq_bdvonly_equation (e_::bool) (v_::real) =" ^
23.1134 + " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1135 + " d2_polyeq_bdv_only_simplify True)) @@ " ^
23.1136 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1137 + " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1138 + " d1_polyeq_simplify True)) @@ " ^
23.1139 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1140 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
23.1141 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1142 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1143 + ));
23.1144 +
23.1145 +store_met
23.1146 + (prep_met (theory "PolyEq") "met_polyeq_d2_sqonly" [] e_metID
23.1147 + (["PolyEq","solve_d2_polyeq_sqonly_equation"],
23.1148 + [("#Given" ,["equality e_","solveFor v_"]),
23.1149 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1150 + "((lhs e_) has_degree_in v_) = 2"]),
23.1151 + ("#Find" ,["solutions v_i_"])
23.1152 + ],
23.1153 + {rew_ord'="termlessI",
23.1154 + rls'=PolyEq_erls,
23.1155 + srls=e_rls,
23.1156 + prls=PolyEq_prls,
23.1157 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1158 + crls=PolyEq_crls, nrls=norm_Rational},
23.1159 + "Script Solve_d2_polyeq_sqonly_equation (e_::bool) (v_::real) =" ^
23.1160 + " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1161 + " d2_polyeq_sq_only_simplify True)) @@ " ^
23.1162 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1163 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_; " ^
23.1164 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1165 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1166 + ));
23.1167 +
23.1168 +store_met
23.1169 + (prep_met (theory "PolyEq") "met_polyeq_d2_pq" [] e_metID
23.1170 + (["PolyEq","solve_d2_polyeq_pq_equation"],
23.1171 + [("#Given" ,["equality e_","solveFor v_"]),
23.1172 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1173 + "((lhs e_) has_degree_in v_) = 2"]),
23.1174 + ("#Find" ,["solutions v_i_"])
23.1175 + ],
23.1176 + {rew_ord'="termlessI",
23.1177 + rls'=PolyEq_erls,
23.1178 + srls=e_rls,
23.1179 + prls=PolyEq_prls,
23.1180 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1181 + crls=PolyEq_crls, nrls=norm_Rational},
23.1182 + "Script Solve_d2_polyeq_pq_equation (e_::bool) (v_::real) = " ^
23.1183 + " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1184 + " d2_polyeq_pqFormula_simplify True)) @@ " ^
23.1185 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1186 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
23.1187 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1188 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1189 + ));
23.1190 +
23.1191 +store_met
23.1192 + (prep_met (theory "PolyEq") "met_polyeq_d2_abc" [] e_metID
23.1193 + (["PolyEq","solve_d2_polyeq_abc_equation"],
23.1194 + [("#Given" ,["equality e_","solveFor v_"]),
23.1195 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1196 + "((lhs e_) has_degree_in v_) = 2"]),
23.1197 + ("#Find" ,["solutions v_i_"])
23.1198 + ],
23.1199 + {rew_ord'="termlessI",
23.1200 + rls'=PolyEq_erls,
23.1201 + srls=e_rls,
23.1202 + prls=PolyEq_prls,
23.1203 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1204 + crls=PolyEq_crls, nrls=norm_Rational},
23.1205 + "Script Solve_d2_polyeq_abc_equation (e_::bool) (v_::real) = " ^
23.1206 + " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1207 + " d2_polyeq_abcFormula_simplify True)) @@ " ^
23.1208 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1209 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
23.1210 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1211 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1212 + ));
23.1213 +
23.1214 +store_met
23.1215 + (prep_met (theory "PolyEq") "met_polyeq_d3" [] e_metID
23.1216 + (["PolyEq","solve_d3_polyeq_equation"],
23.1217 + [("#Given" ,["equality e_","solveFor v_"]),
23.1218 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
23.1219 + "((lhs e_) has_degree_in v_) = 3"]),
23.1220 + ("#Find" ,["solutions v_i_"])
23.1221 + ],
23.1222 + {rew_ord'="termlessI",
23.1223 + rls'=PolyEq_erls,
23.1224 + srls=e_rls,
23.1225 + prls=PolyEq_prls,
23.1226 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1227 + crls=PolyEq_crls, nrls=norm_Rational},
23.1228 + "Script Solve_d3_polyeq_equation (e_::bool) (v_::real) = " ^
23.1229 + " (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1230 + " d3_polyeq_simplify True)) @@ " ^
23.1231 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1232 + " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1233 + " d2_polyeq_simplify True)) @@ " ^
23.1234 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1235 + " (Try (Rewrite_Set_Inst [(bdv,v_::real)] " ^
23.1236 + " d1_polyeq_simplify True)) @@ " ^
23.1237 + " (Try (Rewrite_Set polyeq_simplify False)) @@ " ^
23.1238 + " (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
23.1239 + " (L_::bool list) = ((Or_to_List e_)::bool list) " ^
23.1240 + " in Check_elementwise L_ {(v_::real). Assumptions} )"
23.1241 + ));
23.1242 +
23.1243 + (*.solves all expanded (ie. normalized) terms of degree 2.*)
23.1244 + (*Oct.02 restriction: 'eval_true 0 =< discriminant' ony for integer values
23.1245 + by 'PolyEq_erls'; restricted until Float.thy is implemented*)
23.1246 +store_met
23.1247 + (prep_met (theory "PolyEq") "met_polyeq_complsq" [] e_metID
23.1248 + (["PolyEq","complete_square"],
23.1249 + [("#Given" ,["equality e_","solveFor v_"]),
23.1250 + ("#Where" ,["matches (?a = 0) e_",
23.1251 + "((lhs e_) has_degree_in v_) = 2"]),
23.1252 + ("#Find" ,["solutions v_i_"])
23.1253 + ],
23.1254 + {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
23.1255 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
23.1256 + crls=PolyEq_crls, nrls=norm_Rational},
23.1257 + "Script Complete_square (e_::bool) (v_::real) = " ^
23.1258 + "(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_)] cancel_leading_coeff True))" ^
23.1259 + " @@ (Try (Rewrite_Set_Inst [(bdv,v_)] complete_square True)) " ^
23.1260 + " @@ (Try (Rewrite square_explicit1 False)) " ^
23.1261 + " @@ (Try (Rewrite square_explicit2 False)) " ^
23.1262 + " @@ (Rewrite root_plus_minus True) " ^
23.1263 + " @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit1 False))) " ^
23.1264 + " @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit2 False))) " ^
23.1265 + " @@ (Try (Repeat " ^
23.1266 + " (Rewrite_Inst [(bdv,v_)] bdv_explicit3 False))) " ^
23.1267 + " @@ (Try (Rewrite_Set calculate_RootRat False)) " ^
23.1268 + " @@ (Try (Repeat (Calculate sqrt_)))) e_ " ^
23.1269 + " in ((Or_to_List e_)::bool list))"
23.1270 + ));
23.1271 +
23.1272 +
23.1273 +(* termorder hacked by MG *)
23.1274 +local (*. for make_polynomial_in .*)
23.1275 +
23.1276 +open Term; (* for type order = EQUAL | LESS | GREATER *)
23.1277 +
23.1278 +fun pr_ord EQUAL = "EQUAL"
23.1279 + | pr_ord LESS = "LESS"
23.1280 + | pr_ord GREATER = "GREATER";
23.1281 +
23.1282 +fun dest_hd' x (Const (a, T)) = (((a, 0), T), 0)
23.1283 + | dest_hd' x (t as Free (a, T)) =
23.1284 + if x = t then ((("|||||||||||||", 0), T), 0) (*WN*)
23.1285 + else (((a, 0), T), 1)
23.1286 + | dest_hd' x (Var v) = (v, 2)
23.1287 + | dest_hd' x (Bound i) = ((("", i), dummyT), 3)
23.1288 + | dest_hd' x (Abs (_, T, _)) = ((("", 0), T), 4);
23.1289 +
23.1290 +fun size_of_term' x (Const ("Atools.pow",_) $ Free (var,_) $ Free (pot,_)) =
23.1291 + (case x of (*WN*)
23.1292 + (Free (xstr,_)) =>
23.1293 + (if xstr = var then 1000*(the (int_of_str pot)) else 3)
23.1294 + | _ => raise error ("size_of_term' called with subst = "^
23.1295 + (term2str x)))
23.1296 + | size_of_term' x (Free (subst,_)) =
23.1297 + (case x of
23.1298 + (Free (xstr,_)) => (if xstr = subst then 1000 else 1)
23.1299 + | _ => raise error ("size_of_term' called with subst = "^
23.1300 + (term2str x)))
23.1301 + | size_of_term' x (Abs (_,_,body)) = 1 + size_of_term' x body
23.1302 + | size_of_term' x (f$t) = size_of_term' x f + size_of_term' x t
23.1303 + | size_of_term' x _ = 1;
23.1304 +
23.1305 +
23.1306 +fun term_ord' x pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
23.1307 + (case term_ord' x pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
23.1308 + | term_ord' x pr thy (t, u) =
23.1309 + (if pr then
23.1310 + let
23.1311 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
23.1312 + val _=writeln("t= f@ts= \""^
23.1313 + ((Syntax.string_of_term (thy2ctxt thy)) f)^"\" @ \"["^
23.1314 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
23.1315 + val _=writeln("u= g@us= \""^
23.1316 + ((Syntax.string_of_term (thy2ctxt thy)) g)^"\" @ \"["^
23.1317 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
23.1318 + val _=writeln("size_of_term(t,u)= ("^
23.1319 + (string_of_int(size_of_term' x t))^", "^
23.1320 + (string_of_int(size_of_term' x u))^")");
23.1321 + val _=writeln("hd_ord(f,g) = "^((pr_ord o (hd_ord x))(f,g)));
23.1322 + val _=writeln("terms_ord(ts,us) = "^
23.1323 + ((pr_ord o (terms_ord x) str false)(ts,us)));
23.1324 + val _=writeln("-------");
23.1325 + in () end
23.1326 + else ();
23.1327 + case int_ord (size_of_term' x t, size_of_term' x u) of
23.1328 + EQUAL =>
23.1329 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
23.1330 + (case hd_ord x (f, g) of EQUAL => (terms_ord x str pr) (ts, us)
23.1331 + | ord => ord)
23.1332 + end
23.1333 + | ord => ord)
23.1334 +and hd_ord x (f, g) = (* ~ term.ML *)
23.1335 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' x f,
23.1336 + dest_hd' x g)
23.1337 +and terms_ord x str pr (ts, us) =
23.1338 + list_ord (term_ord' x pr (assoc_thy "Isac.thy"))(ts, us);
23.1339 +in
23.1340 +
23.1341 +fun ord_make_polynomial_in (pr:bool) thy subst tu =
23.1342 + let
23.1343 + (* val _=writeln("*** subs variable is: "^(subst2str subst)); *)
23.1344 + in
23.1345 + case subst of
23.1346 + (_,x)::_ => (term_ord' x pr thy tu = LESS)
23.1347 + | _ => raise error ("ord_make_polynomial_in called with subst = "^
23.1348 + (subst2str subst))
23.1349 + end;
23.1350 +end;
23.1351 +
23.1352 +val order_add_mult_in = prep_rls(
23.1353 + Rls{id = "order_add_mult_in", preconds = [],
23.1354 + rew_ord = ("ord_make_polynomial_in",
23.1355 + ord_make_polynomial_in false Poly.thy),
23.1356 + erls = e_rls,srls = Erls,
23.1357 + calc = [],
23.1358 + (*asm_thm = [],*)
23.1359 + rules = [Thm ("real_mult_commute",num_str real_mult_commute),
23.1360 + (* z * w = w * z *)
23.1361 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
23.1362 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
23.1363 + Thm ("real_mult_assoc",num_str real_mult_assoc),
23.1364 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
23.1365 + Thm ("real_add_commute",num_str real_add_commute),
23.1366 + (*z + w = w + z*)
23.1367 + Thm ("real_add_left_commute",num_str real_add_left_commute),
23.1368 + (*x + (y + z) = y + (x + z)*)
23.1369 + Thm ("real_add_assoc",num_str real_add_assoc)
23.1370 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
23.1371 + ], scr = EmptyScr}:rls);
23.1372 +
23.1373 +val collect_bdv = prep_rls(
23.1374 + Rls{id = "collect_bdv", preconds = [],
23.1375 + rew_ord = ("dummy_ord", dummy_ord),
23.1376 + erls = e_rls,srls = Erls,
23.1377 + calc = [],
23.1378 + (*asm_thm = [],*)
23.1379 + rules = [Thm ("bdv_collect_1",num_str bdv_collect_1),
23.1380 + Thm ("bdv_collect_2",num_str bdv_collect_2),
23.1381 + Thm ("bdv_collect_3",num_str bdv_collect_3),
23.1382 +
23.1383 + Thm ("bdv_collect_assoc1_1",num_str bdv_collect_assoc1_1),
23.1384 + Thm ("bdv_collect_assoc1_2",num_str bdv_collect_assoc1_2),
23.1385 + Thm ("bdv_collect_assoc1_3",num_str bdv_collect_assoc1_3),
23.1386 +
23.1387 + Thm ("bdv_collect_assoc2_1",num_str bdv_collect_assoc2_1),
23.1388 + Thm ("bdv_collect_assoc2_2",num_str bdv_collect_assoc2_2),
23.1389 + Thm ("bdv_collect_assoc2_3",num_str bdv_collect_assoc2_3),
23.1390 +
23.1391 +
23.1392 + Thm ("bdv_n_collect_1",num_str bdv_n_collect_1),
23.1393 + Thm ("bdv_n_collect_2",num_str bdv_n_collect_2),
23.1394 + Thm ("bdv_n_collect_3",num_str bdv_n_collect_3),
23.1395 +
23.1396 + Thm ("bdv_n_collect_assoc1_1",num_str bdv_n_collect_assoc1_1),
23.1397 + Thm ("bdv_n_collect_assoc1_2",num_str bdv_n_collect_assoc1_2),
23.1398 + Thm ("bdv_n_collect_assoc1_3",num_str bdv_n_collect_assoc1_3),
23.1399 +
23.1400 + Thm ("bdv_n_collect_assoc2_1",num_str bdv_n_collect_assoc2_1),
23.1401 + Thm ("bdv_n_collect_assoc2_2",num_str bdv_n_collect_assoc2_2),
23.1402 + Thm ("bdv_n_collect_assoc2_3",num_str bdv_n_collect_assoc2_3)
23.1403 + ], scr = EmptyScr}:rls);
23.1404 +
23.1405 +(*.transforms an arbitrary term without roots to a polynomial [4]
23.1406 + according to knowledge/Poly.sml.*)
23.1407 +val make_polynomial_in = prep_rls(
23.1408 + Seq {id = "make_polynomial_in", preconds = []:term list,
23.1409 + rew_ord = ("dummy_ord", dummy_ord),
23.1410 + erls = Atools_erls, srls = Erls,
23.1411 + calc = [], (*asm_thm = [],*)
23.1412 + rules = [Rls_ expand_poly,
23.1413 + Rls_ order_add_mult_in,
23.1414 + Rls_ simplify_power,
23.1415 + Rls_ collect_numerals,
23.1416 + Rls_ reduce_012,
23.1417 + Thm ("realpow_oneI",num_str realpow_oneI),
23.1418 + Rls_ discard_parentheses,
23.1419 + Rls_ collect_bdv
23.1420 + ],
23.1421 + scr = EmptyScr
23.1422 + }:rls);
23.1423 +
23.1424 +val separate_bdvs =
23.1425 + append_rls "separate_bdvs"
23.1426 + collect_bdv
23.1427 + [Thm ("separate_bdv", num_str separate_bdv),
23.1428 + (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
23.1429 + Thm ("separate_bdv_n", num_str separate_bdv_n),
23.1430 + Thm ("separate_1_bdv", num_str separate_1_bdv),
23.1431 + (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
23.1432 + Thm ("separate_1_bdv_n", num_str separate_1_bdv_n),
23.1433 + (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
23.1434 + Thm ("real_add_divide_distrib",
23.1435 + num_str real_add_divide_distrib)
23.1436 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"
23.1437 + WN051031 DOES NOT BELONG TO HERE*)
23.1438 + ];
23.1439 +val make_ratpoly_in = prep_rls(
23.1440 + Seq {id = "make_ratpoly_in", preconds = []:term list,
23.1441 + rew_ord = ("dummy_ord", dummy_ord),
23.1442 + erls = Atools_erls, srls = Erls,
23.1443 + calc = [], (*asm_thm = [],*)
23.1444 + rules = [Rls_ norm_Rational,
23.1445 + Rls_ order_add_mult_in,
23.1446 + Rls_ discard_parentheses,
23.1447 + Rls_ separate_bdvs,
23.1448 + (* Rls_ rearrange_assoc, WN060916 why does cancel_p not work?*)
23.1449 + Rls_ cancel_p
23.1450 + (*Calc ("HOL.divide" ,eval_cancel "#divide_") too weak!*)
23.1451 + ],
23.1452 + scr = EmptyScr}:rls);
23.1453 +
23.1454 +
23.1455 +ruleset' := overwritelthy thy (!ruleset',
23.1456 + [("order_add_mult_in", order_add_mult_in),
23.1457 + ("collect_bdv", collect_bdv),
23.1458 + ("make_polynomial_in", make_polynomial_in),
23.1459 + ("make_ratpoly_in", make_ratpoly_in),
23.1460 + ("separate_bdvs", separate_bdvs)
23.1461 + ]);
23.1462 +*}
23.1463 +
23.1464 end
23.1465
23.1466
24.1 --- a/src/Tools/isac/Knowledge/RatEq.ML Fri Aug 27 10:39:12 2010 +0200
24.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
24.3 @@ -1,194 +0,0 @@
24.4 -(*.(c) by Richard Lang, 2003 .*)
24.5 -(* collecting all knowledge for RationalEquations
24.6 - created by: rlang
24.7 - date: 02.09
24.8 - changed by: rlang
24.9 - last change by: rlang
24.10 - date: 02.11.29
24.11 -*)
24.12 -
24.13 -(* use"Knowledge/RatEq.ML";
24.14 - use"RatEq.ML";
24.15 - remove_thy"RatEq";
24.16 - use_thy"Isac";
24.17 -
24.18 - use"ROOT.ML";
24.19 - cd"IsacKnowledge";
24.20 - *)
24.21 -"******* RatEq.ML begin *******";
24.22 -
24.23 -theory' := overwritel (!theory', [("RatEq.thy",RatEq.thy)]);
24.24 -
24.25 -(*-------------------------functions-----------------------*)
24.26 -(* is_rateqation_in becomes true, if a bdv is in the denominator of a fraction*)
24.27 -fun is_rateqation_in t v =
24.28 - let
24.29 - fun coeff_in c v = member op = (vars c) v;
24.30 - fun finddivide (_ $ _ $ _ $ _) v = raise error("is_rateqation_in:")
24.31 - (* at the moment there is no term like this, but ....*)
24.32 - | finddivide (t as (Const ("HOL.divide",_) $ _ $ b)) v = coeff_in b v
24.33 - | finddivide (_ $ t1 $ t2) v = (finddivide t1 v)
24.34 - orelse (finddivide t2 v)
24.35 - | finddivide (_ $ t1) v = (finddivide t1 v)
24.36 - | finddivide _ _ = false;
24.37 - in
24.38 - finddivide t v
24.39 - end;
24.40 -
24.41 -fun eval_is_ratequation_in _ _
24.42 - (p as (Const ("RatEq.is'_ratequation'_in",_) $ t $ v)) _ =
24.43 - if is_rateqation_in t v then
24.44 - SOME ((term2str p) ^ " = True",
24.45 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
24.46 - else SOME ((term2str p) ^ " = True",
24.47 - Trueprop $ (mk_equality (p, HOLogic.false_const)))
24.48 - | eval_is_ratequation_in _ _ _ _ = ((*writeln"### nichts matcht";*) NONE);
24.49 -
24.50 -(*-------------------------rulse-----------------------*)
24.51 -val RatEq_prls = (*15.10.02:just the following order due to subterm evaluation*)
24.52 - append_rls "RatEq_prls" e_rls
24.53 - [Calc ("Atools.ident",eval_ident "#ident_"),
24.54 - Calc ("Tools.matches",eval_matches ""),
24.55 - Calc ("Tools.lhs" ,eval_lhs ""),
24.56 - Calc ("Tools.rhs" ,eval_rhs ""),
24.57 - Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
24.58 - Calc ("op =",eval_equal "#equal_"),
24.59 - Thm ("not_true",num_str not_true),
24.60 - Thm ("not_false",num_str not_false),
24.61 - Thm ("and_true",num_str and_true),
24.62 - Thm ("and_false",num_str and_false),
24.63 - Thm ("or_true",num_str or_true),
24.64 - Thm ("or_false",num_str or_false)
24.65 - ];
24.66 -
24.67 -
24.68 -(*rls = merge_rls erls Poly_erls *)
24.69 -val rateq_erls =
24.70 - remove_rls "rateq_erls" (*WN: ein Hack*)
24.71 - (merge_rls "is_ratequation_in" calculate_Rational
24.72 - (append_rls "is_ratequation_in"
24.73 - Poly_erls
24.74 - [(*Calc ("HOL.divide", eval_cancel "#divide_"),*)
24.75 - Calc ("RatEq.is'_ratequation'_in",
24.76 - eval_is_ratequation_in "")
24.77 -
24.78 - ]))
24.79 - [Thm ("and_commute",num_str and_commute), (*WN: ein Hack*)
24.80 - Thm ("or_commute",num_str or_commute) (*WN: ein Hack*)
24.81 - ];
24.82 -ruleset' := overwritelthy thy (!ruleset',
24.83 - [("rateq_erls",rateq_erls)(*FIXXXME:del with rls.rls'*)
24.84 - ]);
24.85 -
24.86 -
24.87 -val RatEq_crls =
24.88 - remove_rls "RatEq_crls" (*WN: ein Hack*)
24.89 - (merge_rls "is_ratequation_in" calculate_Rational
24.90 - (append_rls "is_ratequation_in"
24.91 - Poly_erls
24.92 - [(*Calc ("HOL.divide", eval_cancel "#divide_"),*)
24.93 - Calc ("RatEq.is'_ratequation'_in",
24.94 - eval_is_ratequation_in "")
24.95 - ]))
24.96 - [Thm ("and_commute",num_str and_commute), (*WN: ein Hack*)
24.97 - Thm ("or_commute",num_str or_commute) (*WN: ein Hack*)
24.98 - ];
24.99 -
24.100 -val RatEq_eliminate = prep_rls(
24.101 - Rls {id = "RatEq_eliminate", preconds = [],
24.102 - rew_ord = ("termlessI", termlessI), erls = rateq_erls, srls = Erls,
24.103 - calc = [],
24.104 - rules = [
24.105 - Thm("rat_mult_denominator_both",num_str rat_mult_denominator_both),
24.106 - (* a/b=c/d -> ad=cb *)
24.107 - Thm("rat_mult_denominator_left",num_str rat_mult_denominator_left),
24.108 - (* a =c/d -> ad=c *)
24.109 - Thm("rat_mult_denominator_right",num_str rat_mult_denominator_right)
24.110 - (* a/b=c -> a=cb *)
24.111 - ],
24.112 - scr = Script ((term_of o the o (parse thy)) "empty_script")
24.113 - }:rls);
24.114 -ruleset' := overwritelthy thy (!ruleset',
24.115 - [("RatEq_eliminate",RatEq_eliminate)
24.116 - ]);
24.117 -
24.118 -val RatEq_simplify = prep_rls(
24.119 - Rls {id = "RatEq_simplify", preconds = [], rew_ord = ("termlessI", termlessI),
24.120 - erls = rateq_erls, srls = Erls, calc = [],
24.121 - rules = [
24.122 - Thm("real_rat_mult_1",num_str real_rat_mult_1),
24.123 - (*a*(b/c) = (a*b)/c*)
24.124 - Thm("real_rat_mult_2",num_str real_rat_mult_2),
24.125 - (*(a/b)*(c/d) = (a*c)/(b*d)*)
24.126 - Thm("real_rat_mult_3",num_str real_rat_mult_3),
24.127 - (* (a/b)*c = (a*c)/b*)
24.128 - Thm("real_rat_pow",num_str real_rat_pow),
24.129 - (*(a/b)^^^2 = a^^^2/b^^^2*)
24.130 - Thm("real_diff_minus",num_str real_diff_minus),
24.131 - (* a - b = a + (-1) * b *)
24.132 - Thm("rat_double_rat_1",num_str rat_double_rat_1),
24.133 - (* (a / (c/d) = (a*d) / c) *)
24.134 - Thm("rat_double_rat_2",num_str rat_double_rat_2),
24.135 - (* ((a/b) / (c/d) = (a*d) / (b*c)) *)
24.136 - Thm("rat_double_rat_3",num_str rat_double_rat_3)
24.137 - (* ((a/b) / c = a / (b*c) ) *)
24.138 - ],
24.139 - scr = Script ((term_of o the o (parse thy)) "empty_script")
24.140 - }:rls);
24.141 -ruleset' := overwritelthy thy (!ruleset',
24.142 - [("RatEq_simplify",RatEq_simplify)
24.143 - ]);
24.144 -
24.145 -(*-------------------------Problem-----------------------*)
24.146 -(*
24.147 -(get_pbt ["rational","univariate","equation"]);
24.148 -show_ptyps();
24.149 -*)
24.150 -store_pbt
24.151 - (prep_pbt (theory "RatEq") "pbl_equ_univ_rat" [] e_pblID
24.152 - (["rational","univariate","equation"],
24.153 - [("#Given" ,["equality e_","solveFor v_"]),
24.154 - ("#Where" ,["(e_::bool) is_ratequation_in (v_::real)"]),
24.155 - ("#Find" ,["solutions v_i_"])
24.156 - ],
24.157 -
24.158 - RatEq_prls, SOME "solve (e_::bool, v_)",
24.159 - [["RatEq","solve_rat_equation"]]));
24.160 -
24.161 -
24.162 -(*-------------------------methods-----------------------*)
24.163 -store_met
24.164 - (prep_met (theory "RatEq") "met_rateq" [] e_metID
24.165 - (["RatEq"],
24.166 - [],
24.167 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
24.168 - crls=RatEq_crls, nrls=norm_Rational
24.169 - (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
24.170 -store_met
24.171 - (prep_met (theory "RatEq") "met_rat_eq" [] e_metID
24.172 - (["RatEq","solve_rat_equation"],
24.173 - [("#Given" ,["equality e_","solveFor v_"]),
24.174 - ("#Where" ,["(e_::bool) is_ratequation_in (v_::real)"]),
24.175 - ("#Find" ,["solutions v_i_"])
24.176 - ],
24.177 - {rew_ord'="termlessI",
24.178 - rls'=rateq_erls,
24.179 - srls=e_rls,
24.180 - prls=RatEq_prls,
24.181 - calc=[],
24.182 - crls=RatEq_crls, nrls=norm_Rational},
24.183 - "Script Solve_rat_equation (e_::bool) (v_::real) = " ^
24.184 - "(let e_ = ((Repeat(Try (Rewrite_Set RatEq_simplify True))) @@ " ^
24.185 - " (Repeat(Try (Rewrite_Set norm_Rational False))) @@ " ^
24.186 - " (Repeat(Try (Rewrite_Set common_nominator_p False))) @@ " ^
24.187 - " (Repeat(Try (Rewrite_Set RatEq_eliminate True)))) e_;" ^
24.188 - " (L_::bool list) = (SubProblem (RatEq_,[univariate,equation], " ^
24.189 - " [no_met]) [bool_ e_, real_ v_]) " ^
24.190 - " in Check_elementwise L_ {(v_::real). Assumptions})"
24.191 - ));
24.192 -
24.193 -calclist':= overwritel (!calclist',
24.194 - [("is_ratequation_in", ("RatEq.is_ratequation_in",
24.195 - eval_is_ratequation_in ""))
24.196 - ]);
24.197 -"******* RatEq.ML end *******";
25.1 --- a/src/Tools/isac/Knowledge/RatEq.thy Fri Aug 27 10:39:12 2010 +0200
25.2 +++ b/src/Tools/isac/Knowledge/RatEq.thy Fri Aug 27 14:56:54 2010 +0200
25.3 @@ -7,34 +7,20 @@
25.4 date: 02.11.28
25.5 *)
25.6
25.7 -(*
25.8 - RL.020812
25.9 - use_thy"knowledge/RatEq";
25.10 - use_thy"RatEq";
25.11 - use_thy_only"RatEq";
25.12 +theory RatEq imports Rational begin
25.13
25.14 - remove_thy"RatEq";
25.15 - use_thy"Isac";
25.16 -
25.17 - use"ROOT.ML";
25.18 - cd"knowledge";
25.19 - *)
25.20 -RatEq = Rational +
25.21 -
25.22 -(*-------------------- consts------------------------------------------------*)
25.23 consts
25.24
25.25 is'_ratequation'_in :: "[bool, real] => bool" ("_ is'_ratequation'_in _")
25.26
25.27 (*----------------------scripts-----------------------*)
25.28 Solve'_rat'_equation
25.29 - :: "[bool,real, \
25.30 - \ bool list] => bool list"
25.31 - ("((Script Solve'_rat'_equation (_ _ =))// \
25.32 - \ (_))" 9)
25.33 + :: "[bool,real,
25.34 + bool list] => bool list"
25.35 + ("((Script Solve'_rat'_equation (_ _ =))//
25.36 + (_))" 9)
25.37
25.38 -(*-------------------- rules------------------------------------------------*)
25.39 -rules
25.40 +axioms
25.41 (* FIXME also in Poly.thy def. --> FIXED*)
25.42 (*real_diff_minus
25.43 "a - b = a + (-1) * b"*)
25.44 @@ -54,7 +40,6 @@
25.45 rat_double_rat_3
25.46 "[|Not(b=0);Not(c=0)|] ==> ((a/b) / c = a / (b*c))"
25.47
25.48 -
25.49 (* equation to same denominator *)
25.50 rat_mult_denominator_both
25.51 "[|Not(b=0); Not(d=0)|] ==> ((a::real) / b = c / d) = (a*d = c*b)"
25.52 @@ -63,5 +48,179 @@
25.53 rat_mult_denominator_right
25.54 "[|Not(b=0)|] ==> ((a::real) / b = c) = (a = c*b)"
25.55
25.56 +ML {*
25.57 +(*-------------------------functions-----------------------*)
25.58 +(* is_rateqation_in becomes true, if a bdv is in the denominator of a fraction*)
25.59 +fun is_rateqation_in t v =
25.60 + let
25.61 + fun coeff_in c v = member op = (vars c) v;
25.62 + fun finddivide (_ $ _ $ _ $ _) v = raise error("is_rateqation_in:")
25.63 + (* at the moment there is no term like this, but ....*)
25.64 + | finddivide (t as (Const ("HOL.divide",_) $ _ $ b)) v = coeff_in b v
25.65 + | finddivide (_ $ t1 $ t2) v = (finddivide t1 v)
25.66 + orelse (finddivide t2 v)
25.67 + | finddivide (_ $ t1) v = (finddivide t1 v)
25.68 + | finddivide _ _ = false;
25.69 + in
25.70 + finddivide t v
25.71 + end;
25.72 +
25.73 +fun eval_is_ratequation_in _ _
25.74 + (p as (Const ("RatEq.is'_ratequation'_in",_) $ t $ v)) _ =
25.75 + if is_rateqation_in t v then
25.76 + SOME ((term2str p) ^ " = True",
25.77 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
25.78 + else SOME ((term2str p) ^ " = True",
25.79 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
25.80 + | eval_is_ratequation_in _ _ _ _ = ((*writeln"### nichts matcht";*) NONE);
25.81 +
25.82 +(*-------------------------rulse-----------------------*)
25.83 +val RatEq_prls = (*15.10.02:just the following order due to subterm evaluation*)
25.84 + append_rls "RatEq_prls" e_rls
25.85 + [Calc ("Atools.ident",eval_ident "#ident_"),
25.86 + Calc ("Tools.matches",eval_matches ""),
25.87 + Calc ("Tools.lhs" ,eval_lhs ""),
25.88 + Calc ("Tools.rhs" ,eval_rhs ""),
25.89 + Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
25.90 + Calc ("op =",eval_equal "#equal_"),
25.91 + Thm ("not_true",num_str not_true),
25.92 + Thm ("not_false",num_str not_false),
25.93 + Thm ("and_true",num_str and_true),
25.94 + Thm ("and_false",num_str and_false),
25.95 + Thm ("or_true",num_str or_true),
25.96 + Thm ("or_false",num_str or_false)
25.97 + ];
25.98 +
25.99 +
25.100 +(*rls = merge_rls erls Poly_erls *)
25.101 +val rateq_erls =
25.102 + remove_rls "rateq_erls" (*WN: ein Hack*)
25.103 + (merge_rls "is_ratequation_in" calculate_Rational
25.104 + (append_rls "is_ratequation_in"
25.105 + Poly_erls
25.106 + [(*Calc ("HOL.divide", eval_cancel "#divide_"),*)
25.107 + Calc ("RatEq.is'_ratequation'_in",
25.108 + eval_is_ratequation_in "")
25.109 +
25.110 + ]))
25.111 + [Thm ("and_commute",num_str and_commute), (*WN: ein Hack*)
25.112 + Thm ("or_commute",num_str or_commute) (*WN: ein Hack*)
25.113 + ];
25.114 +ruleset' := overwritelthy thy (!ruleset',
25.115 + [("rateq_erls",rateq_erls)(*FIXXXME:del with rls.rls'*)
25.116 + ]);
25.117 +
25.118 +
25.119 +val RatEq_crls =
25.120 + remove_rls "RatEq_crls" (*WN: ein Hack*)
25.121 + (merge_rls "is_ratequation_in" calculate_Rational
25.122 + (append_rls "is_ratequation_in"
25.123 + Poly_erls
25.124 + [(*Calc ("HOL.divide", eval_cancel "#divide_"),*)
25.125 + Calc ("RatEq.is'_ratequation'_in",
25.126 + eval_is_ratequation_in "")
25.127 + ]))
25.128 + [Thm ("and_commute",num_str and_commute), (*WN: ein Hack*)
25.129 + Thm ("or_commute",num_str or_commute) (*WN: ein Hack*)
25.130 + ];
25.131 +
25.132 +val RatEq_eliminate = prep_rls(
25.133 + Rls {id = "RatEq_eliminate", preconds = [],
25.134 + rew_ord = ("termlessI", termlessI), erls = rateq_erls, srls = Erls,
25.135 + calc = [],
25.136 + rules = [
25.137 + Thm("rat_mult_denominator_both",num_str rat_mult_denominator_both),
25.138 + (* a/b=c/d -> ad=cb *)
25.139 + Thm("rat_mult_denominator_left",num_str rat_mult_denominator_left),
25.140 + (* a =c/d -> ad=c *)
25.141 + Thm("rat_mult_denominator_right",num_str rat_mult_denominator_right)
25.142 + (* a/b=c -> a=cb *)
25.143 + ],
25.144 + scr = Script ((term_of o the o (parse thy)) "empty_script")
25.145 + }:rls);
25.146 +ruleset' := overwritelthy thy (!ruleset',
25.147 + [("RatEq_eliminate",RatEq_eliminate)
25.148 + ]);
25.149 +
25.150 +val RatEq_simplify = prep_rls(
25.151 + Rls {id = "RatEq_simplify", preconds = [], rew_ord = ("termlessI", termlessI),
25.152 + erls = rateq_erls, srls = Erls, calc = [],
25.153 + rules = [
25.154 + Thm("real_rat_mult_1",num_str real_rat_mult_1),
25.155 + (*a*(b/c) = (a*b)/c*)
25.156 + Thm("real_rat_mult_2",num_str real_rat_mult_2),
25.157 + (*(a/b)*(c/d) = (a*c)/(b*d)*)
25.158 + Thm("real_rat_mult_3",num_str real_rat_mult_3),
25.159 + (* (a/b)*c = (a*c)/b*)
25.160 + Thm("real_rat_pow",num_str real_rat_pow),
25.161 + (*(a/b)^^^2 = a^^^2/b^^^2*)
25.162 + Thm("real_diff_minus",num_str real_diff_minus),
25.163 + (* a - b = a + (-1) * b *)
25.164 + Thm("rat_double_rat_1",num_str rat_double_rat_1),
25.165 + (* (a / (c/d) = (a*d) / c) *)
25.166 + Thm("rat_double_rat_2",num_str rat_double_rat_2),
25.167 + (* ((a/b) / (c/d) = (a*d) / (b*c)) *)
25.168 + Thm("rat_double_rat_3",num_str rat_double_rat_3)
25.169 + (* ((a/b) / c = a / (b*c) ) *)
25.170 + ],
25.171 + scr = Script ((term_of o the o (parse thy)) "empty_script")
25.172 + }:rls);
25.173 +ruleset' := overwritelthy thy (!ruleset',
25.174 + [("RatEq_simplify",RatEq_simplify)
25.175 + ]);
25.176 +
25.177 +(*-------------------------Problem-----------------------*)
25.178 +(*
25.179 +(get_pbt ["rational","univariate","equation"]);
25.180 +show_ptyps();
25.181 +*)
25.182 +store_pbt
25.183 + (prep_pbt (theory "RatEq") "pbl_equ_univ_rat" [] e_pblID
25.184 + (["rational","univariate","equation"],
25.185 + [("#Given" ,["equality e_","solveFor v_"]),
25.186 + ("#Where" ,["(e_::bool) is_ratequation_in (v_::real)"]),
25.187 + ("#Find" ,["solutions v_i_"])
25.188 + ],
25.189 +
25.190 + RatEq_prls, SOME "solve (e_::bool, v_)",
25.191 + [["RatEq","solve_rat_equation"]]));
25.192 +
25.193 +
25.194 +(*-------------------------methods-----------------------*)
25.195 +store_met
25.196 + (prep_met (theory "RatEq") "met_rateq" [] e_metID
25.197 + (["RatEq"],
25.198 + [],
25.199 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
25.200 + crls=RatEq_crls, nrls=norm_Rational
25.201 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
25.202 +store_met
25.203 + (prep_met (theory "RatEq") "met_rat_eq" [] e_metID
25.204 + (["RatEq","solve_rat_equation"],
25.205 + [("#Given" ,["equality e_","solveFor v_"]),
25.206 + ("#Where" ,["(e_::bool) is_ratequation_in (v_::real)"]),
25.207 + ("#Find" ,["solutions v_i_"])
25.208 + ],
25.209 + {rew_ord'="termlessI",
25.210 + rls'=rateq_erls,
25.211 + srls=e_rls,
25.212 + prls=RatEq_prls,
25.213 + calc=[],
25.214 + crls=RatEq_crls, nrls=norm_Rational},
25.215 + "Script Solve_rat_equation (e_::bool) (v_::real) = " ^
25.216 + "(let e_ = ((Repeat(Try (Rewrite_Set RatEq_simplify True))) @@ " ^
25.217 + " (Repeat(Try (Rewrite_Set norm_Rational False))) @@ " ^
25.218 + " (Repeat(Try (Rewrite_Set common_nominator_p False))) @@ " ^
25.219 + " (Repeat(Try (Rewrite_Set RatEq_eliminate True)))) e_;" ^
25.220 + " (L_::bool list) = (SubProblem (RatEq_,[univariate,equation], " ^
25.221 + " [no_met]) [bool_ e_, real_ v_]) " ^
25.222 + " in Check_elementwise L_ {(v_::real). Assumptions})"
25.223 + ));
25.224 +
25.225 +calclist':= overwritel (!calclist',
25.226 + [("is_ratequation_in", ("RatEq.is_ratequation_in",
25.227 + eval_is_ratequation_in ""))
25.228 + ]);
25.229 +*}
25.230
25.231 end
26.1 --- a/src/Tools/isac/Knowledge/RootRat.ML Fri Aug 27 10:39:12 2010 +0200
26.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
26.3 @@ -1,49 +0,0 @@
26.4 -(*.(c) by Richard Lang, 2003 .*)
26.5 -(* collecting all knowledge for Root and Rational
26.6 - created by: rlang
26.7 - date: 02.10
26.8 - changed by: rlang
26.9 - last change by: rlang
26.10 - date: 02.10.21
26.11 -*)
26.12 -(* use"knowledge/RootRat.ML";
26.13 - use"RootRat.ML";
26.14 -
26.15 - use"ROOT.ML";
26.16 - cd"knowledge";
26.17 -
26.18 - remove_thy"RootRat";
26.19 - use_thy"Isac";
26.20 - *)
26.21 -
26.22 -"******* RootRat.ML begin *******";
26.23 -theory' := overwritel (!theory', [("RootRat.thy",RootRat.thy)]);
26.24 -
26.25 -(*-------------------------functions---------------------*)
26.26 -
26.27 -(*-------------------------rulse-------------------------*)
26.28 -val rootrat_erls =
26.29 - merge_rls "rootrat_erls" Root_erls
26.30 - (merge_rls "" rational_erls
26.31 - (append_rls "" e_rls
26.32 - []));
26.33 -
26.34 -ruleset' := overwritelthy thy (!ruleset',
26.35 - [("rootrat_erls",rootrat_erls) (*FIXXXME:del with rls.rls'*)]);
26.36 -
26.37 -(*.calculate numeral groundterms.*)
26.38 -val calculate_RootRat =
26.39 - append_rls "calculate_RootRat" calculate_Rational
26.40 - [Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
26.41 - (* w*(z1.0 + z2.0) = w * z1.0 + w * z2.0 *)
26.42 - Thm ("real_mult_1",num_str real_mult_1),
26.43 - (* 1 * z = z *)
26.44 - Thm ("sym_real_mult_minus1",num_str (real_mult_minus1 RS sym)),
26.45 - (* "- z1 = -1 * z1" *)
26.46 - Calc ("Root.sqrt",eval_sqrt "#sqrt_")
26.47 - ];
26.48 -ruleset' := overwritelthy thy (!ruleset',
26.49 - [("calculate_RootRat",calculate_RootRat)]);
26.50 -
26.51 -
26.52 -"******* RootRat.ML end *******";
27.1 --- a/src/Tools/isac/Knowledge/RootRat.thy Fri Aug 27 10:39:12 2010 +0200
27.2 +++ b/src/Tools/isac/Knowledge/RootRat.thy Fri Aug 27 14:56:54 2010 +0200
27.3 @@ -1,16 +1,38 @@
27.4 -(*.(c) by Richard Lang, 2003 .*)
27.5 (* collecting all knowledge for Root and Rational
27.6 created by: rlang
27.7 date: 02.10
27.8 changed by: rlang
27.9 last change by: rlang
27.10 date: 02.10.20
27.11 + (c) by Richard Lang, 2003
27.12 *)
27.13
27.14 -RootRat = Root + Rational +
27.15 -(*-------------------- consts------------------------------------------------*)
27.16 +theory RootRat imports Root Rational begin
27.17
27.18 +ML {*
27.19 +(*-------------------------rules-------------------------*)
27.20 +val rootrat_erls =
27.21 + merge_rls "rootrat_erls" Root_erls
27.22 + (merge_rls "" rational_erls
27.23 + (append_rls "" e_rls
27.24 + []));
27.25
27.26 -(*-------------------- rules------------------------------------------------*)
27.27 +ruleset' := overwritelthy thy (!ruleset',
27.28 + [("rootrat_erls",rootrat_erls) (*FIXXXME:del with rls.rls'*)]);
27.29 +
27.30 +(*.calculate numeral groundterms.*)
27.31 +val calculate_RootRat =
27.32 + append_rls "calculate_RootRat" calculate_Rational
27.33 + [Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
27.34 + (* w*(z1.0 + z2.0) = w * z1.0 + w * z2.0 *)
27.35 + Thm ("real_mult_1",num_str real_mult_1),
27.36 + (* 1 * z = z *)
27.37 + Thm ("sym_real_mult_minus1",num_str (real_mult_minus1 RS sym)),
27.38 + (* "- z1 = -1 * z1" *)
27.39 + Calc ("Root.sqrt",eval_sqrt "#sqrt_")
27.40 + ];
27.41 +ruleset' := overwritelthy thy (!ruleset',
27.42 + [("calculate_RootRat",calculate_RootRat)]);
27.43 +*}
27.44
27.45 end
28.1 --- a/src/Tools/isac/Knowledge/RootRatEq.ML Fri Aug 27 10:39:12 2010 +0200
28.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
28.3 @@ -1,167 +0,0 @@
28.4 -(*.(c) by Richard Lang, 2003 .*)
28.5 -(* collecting all knowledge for Root and Rational Equations
28.6 - created by: rlang
28.7 - date: 02.10
28.8 - changed by: rlang
28.9 - last change by: rlang
28.10 - date: 02.11.04
28.11 -*)
28.12 -
28.13 -(* use"knowledge/RootRatEq.ML";
28.14 - use"RootRatEq.ML";
28.15 -
28.16 - use"ROOT.ML";
28.17 - cd"knowledge";
28.18 -
28.19 - remove_thy"RootRatEq";
28.20 - use_thy"Isac";
28.21 - *)
28.22 -
28.23 -"******* RootRatEq.ML begin *******";
28.24 -theory' := overwritel (!theory', [("RootRatEq.thy",RootRatEq.thy)]);
28.25 -
28.26 -(*-------------------------functions---------------------*)
28.27 -(* true if denominator contains (sq)root in + or - term
28.28 - 1/(sqrt(x+3)*(x+4)) -> false; 1/(sqrt(x)+2) -> true
28.29 - if false then (term)^2 contains no (sq)root *)
28.30 -fun is_rootRatAddTerm_in t v =
28.31 - let
28.32 - fun coeff_in c v = member op = (vars c) v;
28.33 - fun rootadd (t as (Const ("op +",_) $ t2 $ t3)) v =
28.34 - (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
28.35 - | rootadd (t as (Const ("op -",_) $ t2 $ t3)) v =
28.36 - (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
28.37 - | rootadd _ _ = false;
28.38 - fun findrootrat (_ $ _ $ _ $ _) v = raise error("is_rootRatAddTerm_in:")
28.39 - (* at the moment there is no term like this, but ....*)
28.40 - | findrootrat (t as (Const ("HOL.divide",_) $ _ $ t3)) v =
28.41 - if (is_rootTerm_in t3 v) then rootadd t3 v else false
28.42 - | findrootrat (_ $ t1 $ t2) v =
28.43 - (findrootrat t1 v) orelse (findrootrat t2 v)
28.44 - | findrootrat (_ $ t1) v = (findrootrat t1 v)
28.45 - | findrootrat _ _ = false;
28.46 - in
28.47 - findrootrat t v
28.48 - end;
28.49 -
28.50 -fun eval_is_rootRatAddTerm_in _ _
28.51 - (p as (Const ("RootRatEq.is'_rootRatAddTerm'_in",_) $ t $ v)) _ =
28.52 - if is_rootRatAddTerm_in t v then
28.53 - SOME ((term2str p) ^ " = True",
28.54 - Trueprop $ (mk_equality (p, HOLogic.true_const)))
28.55 - else SOME ((term2str p) ^ " = True",
28.56 - Trueprop $ (mk_equality (p, HOLogic.false_const)))
28.57 - | eval_is_rootRatAddTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) NONE);
28.58 -
28.59 -(*-------------------------rulse-------------------------*)
28.60 -val RootRatEq_prls =
28.61 - append_rls "RootRatEq_prls" e_rls
28.62 - [Calc ("Atools.ident",eval_ident "#ident_"),
28.63 - Calc ("Tools.matches",eval_matches ""),
28.64 - Calc ("Tools.lhs" ,eval_lhs ""),
28.65 - Calc ("Tools.rhs" ,eval_rhs ""),
28.66 - Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
28.67 - Calc ("RootRatEq.is'_rootRatAddTerm'_in",
28.68 - eval_is_rootRatAddTerm_in ""),
28.69 - Calc ("op =",eval_equal "#equal_"),
28.70 - Thm ("not_true",num_str not_true),
28.71 - Thm ("not_false",num_str not_false),
28.72 - Thm ("and_true",num_str and_true),
28.73 - Thm ("and_false",num_str and_false),
28.74 - Thm ("or_true",num_str or_true),
28.75 - Thm ("or_false",num_str or_false)
28.76 - ];
28.77 -
28.78 -val RooRatEq_erls =
28.79 - merge_rls "RooRatEq_erls" rootrat_erls
28.80 - (merge_rls "" RootEq_erls
28.81 - (merge_rls "" rateq_erls
28.82 - (append_rls "" e_rls
28.83 - [])));
28.84 -
28.85 -val RootRatEq_crls =
28.86 - merge_rls "RootRatEq_crls" rootrat_erls
28.87 - (merge_rls "" RootEq_erls
28.88 - (merge_rls "" rateq_erls
28.89 - (append_rls "" e_rls
28.90 - [])));
28.91 -
28.92 -ruleset' := overwritelthy thy (!ruleset',
28.93 - [("RooRatEq_erls",RooRatEq_erls) (*FIXXXME:del with rls.rls'*)]);
28.94 -
28.95 -(* Solves a rootrat Equation *)
28.96 - val rootrat_solve = prep_rls(
28.97 - Rls {id = "rootrat_solve", preconds = [],
28.98 - rew_ord = ("termlessI",termlessI),
28.99 - erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
28.100 - rules = [Thm("rootrat_equation_left_1", num_str rootrat_equation_left_1),
28.101 - (* [|c is_rootTerm_in bdv|] ==>
28.102 - ( (a + b/c = d) = ( b = (d - a) * c )) *)
28.103 - Thm("rootrat_equation_left_2",num_str rootrat_equation_left_2),
28.104 - (* [|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c )) *)
28.105 - Thm("rootrat_equation_right_1",num_str rootrat_equation_right_1),
28.106 - (* [|f is_rootTerm_in bdv|] ==>
28.107 - ( (a = d + e/f) = ( (a - d) * f = e )) *)
28.108 - Thm("rootrat_equation_right_2",num_str rootrat_equation_right_2)
28.109 - (* [|f is_rootTerm_in bdv|] ==> ( (a = e/f) = ( a * f = e ))*)
28.110 - ],
28.111 - scr = Script ((term_of o the o (parse thy)) "empty_script")
28.112 - }:rls);
28.113 -ruleset' := overwritelthy thy (!ruleset',
28.114 - [("rootrat_solve",rootrat_solve)
28.115 - ]);
28.116 -
28.117 -(*-----------------------probleme------------------------*)
28.118 -(*
28.119 -(get_pbt ["rat","root","univariate","equation"]);
28.120 -show_ptyps();
28.121 -*)
28.122 -store_pbt
28.123 - (prep_pbt RootRatEq.thy "pbl_equ_univ_root_sq_rat" [] e_pblID
28.124 - (["rat","sq","root","univariate","equation"],
28.125 - [("#Given" ,["equality e_","solveFor v_"]),
28.126 - ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) )| " ^
28.127 - "( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
28.128 - ("#Find" ,["solutions v_i_"])
28.129 - ],
28.130 - RootRatEq_prls, SOME "solve (e_::bool, v_)",
28.131 - [["RootRatEq","elim_rootrat_equation"]]));
28.132 -
28.133 -(*-------------------------Methode-----------------------*)
28.134 -store_met
28.135 - (prep_met LinEq.thy "met_rootrateq" [] e_metID
28.136 - (["RootRatEq"],
28.137 - [],
28.138 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
28.139 - crls=Atools_erls, nrls=norm_Rational}, "empty_script"));
28.140 -(*-- left 20.10.02 --*)
28.141 -store_met
28.142 - (prep_met RootRatEq.thy "met_rootrateq_elim" [] e_metID
28.143 - (["RootRatEq","elim_rootrat_equation"],
28.144 - [("#Given" ,["equality e_","solveFor v_"]),
28.145 - ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) ) | " ^
28.146 - "( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
28.147 - ("#Find" ,["solutions v_i_"])
28.148 - ],
28.149 - {rew_ord'="termlessI",
28.150 - rls'=RooRatEq_erls,
28.151 - srls=e_rls,
28.152 - prls=RootRatEq_prls,
28.153 - calc=[],
28.154 - crls=RootRatEq_crls, nrls=norm_Rational(*,
28.155 - asm_rls=[],
28.156 - asm_thm=[]*)},
28.157 - "Script Elim_rootrat_equation (e_::bool) (v_::real) = " ^
28.158 - "(let e_ = ((Try (Rewrite_Set expand_rootbinoms False)) @@ " ^
28.159 - " (Try (Rewrite_Set rooteq_simplify False)) @@ " ^
28.160 - " (Try (Rewrite_Set make_rooteq False)) @@ " ^
28.161 - " (Try (Rewrite_Set rooteq_simplify False)) @@ " ^
28.162 - " (Try (Rewrite_Set_Inst [(bdv,v_)] " ^
28.163 - " rootrat_solve False))) e_ " ^
28.164 - " in (SubProblem (RootEq_,[univariate,equation], " ^
28.165 - " [no_met]) [bool_ e_, real_ v_]))"
28.166 - ));
28.167 -calclist':= overwritel (!calclist',
28.168 - [("is_rootRatAddTerm_in", ("RootRatEq.is_rootRatAddTerm_in",
28.169 - eval_is_rootRatAddTerm_in""))
28.170 - ]);
29.1 --- a/src/Tools/isac/Knowledge/RootRatEq.thy Fri Aug 27 10:39:12 2010 +0200
29.2 +++ b/src/Tools/isac/Knowledge/RootRatEq.thy Fri Aug 27 14:56:54 2010 +0200
29.3 @@ -1,38 +1,28 @@
29.4 -(*.c) by Richard Lang, 2003 .*)
29.5 (* collecting all knowledge for Root and Rational Equations
29.6 created by: rlang
29.7 date: 02.10
29.8 changed by: rlang
29.9 last change by: rlang
29.10 date: 02.11.04
29.11 + (c) by Richard Lang, 2003
29.12 *)
29.13
29.14 -(* use"knowledge/RootRatEq.ML";
29.15 - use"RootRatEq.ML";
29.16 +theory RootRatEq imports RootEq RatEq RootRat begin
29.17
29.18 - use"ROOT.ML";
29.19 - cd"knowledge";
29.20 -
29.21 - remove_thy"RootRatEq";
29.22 - use_thy"Isac";
29.23 - *)
29.24 -
29.25 -RootRatEq = RootEq + RatEq + RootRat +
29.26 -
29.27 -(*-------------------- consts-----------------------------------------------*)
29.28 consts
29.29
29.30 - is'_rootRatAddTerm'_in :: [real, real] => bool ("_ is'_rootRatAddTerm'_in _") (*RL DA*)
29.31 + is'_rootRatAddTerm'_in :: "[real, real] => bool"
29.32 + ("_ is'_rootRatAddTerm'_in _") (*RL DA*)
29.33
29.34 (*---------scripts--------------------------*)
29.35 Elim'_rootrat'_equation
29.36 - :: "[bool,real, \
29.37 - \ bool list] => bool list"
29.38 - ("((Script Elim'_rootrat'_equation (_ _ =))// \
29.39 - \ (_))" 9)
29.40 + :: "[bool,real,
29.41 + bool list] => bool list"
29.42 + ("((Script Elim'_rootrat'_equation (_ _ =))//
29.43 + (_))" 9)
29.44 (*-------------------- rules------------------------------------------------*)
29.45 -rules
29.46
29.47 +axioms
29.48 (* eliminate ratRootTerm *)
29.49 rootrat_equation_left_1
29.50 "[|c is_rootTerm_in bdv|] ==> ( (a + b/c = d) = ( b = (d - a) * c ))"
29.51 @@ -43,6 +33,152 @@
29.52 rootrat_equation_right_1
29.53 "[|f is_rootTerm_in bdv|] ==> ( (a = e/f) = ( a * f = e ))"
29.54
29.55 +ML {*
29.56 +(*-------------------------functions---------------------*)
29.57 +(* true if denominator contains (sq)root in + or - term
29.58 + 1/(sqrt(x+3)*(x+4)) -> false; 1/(sqrt(x)+2) -> true
29.59 + if false then (term)^2 contains no (sq)root *)
29.60 +fun is_rootRatAddTerm_in t v =
29.61 + let
29.62 + fun coeff_in c v = member op = (vars c) v;
29.63 + fun rootadd (t as (Const ("op +",_) $ t2 $ t3)) v =
29.64 + (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
29.65 + | rootadd (t as (Const ("op -",_) $ t2 $ t3)) v =
29.66 + (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
29.67 + | rootadd _ _ = false;
29.68 + fun findrootrat (_ $ _ $ _ $ _) v = raise error("is_rootRatAddTerm_in:")
29.69 + (* at the moment there is no term like this, but ....*)
29.70 + | findrootrat (t as (Const ("HOL.divide",_) $ _ $ t3)) v =
29.71 + if (is_rootTerm_in t3 v) then rootadd t3 v else false
29.72 + | findrootrat (_ $ t1 $ t2) v =
29.73 + (findrootrat t1 v) orelse (findrootrat t2 v)
29.74 + | findrootrat (_ $ t1) v = (findrootrat t1 v)
29.75 + | findrootrat _ _ = false;
29.76 + in
29.77 + findrootrat t v
29.78 + end;
29.79
29.80 +fun eval_is_rootRatAddTerm_in _ _
29.81 + (p as (Const ("RootRatEq.is'_rootRatAddTerm'_in",_) $ t $ v)) _ =
29.82 + if is_rootRatAddTerm_in t v then
29.83 + SOME ((term2str p) ^ " = True",
29.84 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
29.85 + else SOME ((term2str p) ^ " = True",
29.86 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
29.87 + | eval_is_rootRatAddTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) NONE);
29.88 +
29.89 +(*-------------------------rulse-------------------------*)
29.90 +val RootRatEq_prls =
29.91 + append_rls "RootRatEq_prls" e_rls
29.92 + [Calc ("Atools.ident",eval_ident "#ident_"),
29.93 + Calc ("Tools.matches",eval_matches ""),
29.94 + Calc ("Tools.lhs" ,eval_lhs ""),
29.95 + Calc ("Tools.rhs" ,eval_rhs ""),
29.96 + Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
29.97 + Calc ("RootRatEq.is'_rootRatAddTerm'_in",
29.98 + eval_is_rootRatAddTerm_in ""),
29.99 + Calc ("op =",eval_equal "#equal_"),
29.100 + Thm ("not_true",num_str not_true),
29.101 + Thm ("not_false",num_str not_false),
29.102 + Thm ("and_true",num_str and_true),
29.103 + Thm ("and_false",num_str and_false),
29.104 + Thm ("or_true",num_str or_true),
29.105 + Thm ("or_false",num_str or_false)
29.106 + ];
29.107 +
29.108 +val RooRatEq_erls =
29.109 + merge_rls "RooRatEq_erls" rootrat_erls
29.110 + (merge_rls "" RootEq_erls
29.111 + (merge_rls "" rateq_erls
29.112 + (append_rls "" e_rls
29.113 + [])));
29.114 +
29.115 +val RootRatEq_crls =
29.116 + merge_rls "RootRatEq_crls" rootrat_erls
29.117 + (merge_rls "" RootEq_erls
29.118 + (merge_rls "" rateq_erls
29.119 + (append_rls "" e_rls
29.120 + [])));
29.121 +
29.122 +ruleset' := overwritelthy thy (!ruleset',
29.123 + [("RooRatEq_erls",RooRatEq_erls) (*FIXXXME:del with rls.rls'*)]);
29.124 +
29.125 +(* Solves a rootrat Equation *)
29.126 + val rootrat_solve = prep_rls(
29.127 + Rls {id = "rootrat_solve", preconds = [],
29.128 + rew_ord = ("termlessI",termlessI),
29.129 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
29.130 + rules = [Thm("rootrat_equation_left_1", num_str rootrat_equation_left_1),
29.131 + (* [|c is_rootTerm_in bdv|] ==>
29.132 + ( (a + b/c = d) = ( b = (d - a) * c )) *)
29.133 + Thm("rootrat_equation_left_2",num_str rootrat_equation_left_2),
29.134 + (* [|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c )) *)
29.135 + Thm("rootrat_equation_right_1",num_str rootrat_equation_right_1),
29.136 + (* [|f is_rootTerm_in bdv|] ==>
29.137 + ( (a = d + e/f) = ( (a - d) * f = e )) *)
29.138 + Thm("rootrat_equation_right_2",num_str rootrat_equation_right_2)
29.139 + (* [|f is_rootTerm_in bdv|] ==> ( (a = e/f) = ( a * f = e ))*)
29.140 + ],
29.141 + scr = Script ((term_of o the o (parse thy)) "empty_script")
29.142 + }:rls);
29.143 +ruleset' := overwritelthy thy (!ruleset',
29.144 + [("rootrat_solve",rootrat_solve)
29.145 + ]);
29.146 +
29.147 +(*-----------------------probleme------------------------*)
29.148 +(*
29.149 +(get_pbt ["rat","root","univariate","equation"]);
29.150 +show_ptyps();
29.151 +*)
29.152 +store_pbt
29.153 + (prep_pbt (theory "RootRatEq") "pbl_equ_univ_root_sq_rat" [] e_pblID
29.154 + (["rat","sq","root","univariate","equation"],
29.155 + [("#Given" ,["equality e_","solveFor v_"]),
29.156 + ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) )| " ^
29.157 + "( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
29.158 + ("#Find" ,["solutions v_i_"])
29.159 + ],
29.160 + RootRatEq_prls, SOME "solve (e_::bool, v_)",
29.161 + [["RootRatEq","elim_rootrat_equation"]]));
29.162 +
29.163 +(*-------------------------Methode-----------------------*)
29.164 +store_met
29.165 + (prep_met (theory "LinEq") "met_rootrateq" [] e_metID
29.166 + (["RootRatEq"],
29.167 + [],
29.168 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
29.169 + crls=Atools_erls, nrls=norm_Rational}, "empty_script"));
29.170 +(*-- left 20.10.02 --*)
29.171 +store_met
29.172 + (prep_met (theory "RootRatEq") "met_rootrateq_elim" [] e_metID
29.173 + (["RootRatEq","elim_rootrat_equation"],
29.174 + [("#Given" ,["equality e_","solveFor v_"]),
29.175 + ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) ) | " ^
29.176 + "( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
29.177 + ("#Find" ,["solutions v_i_"])
29.178 + ],
29.179 + {rew_ord'="termlessI",
29.180 + rls'=RooRatEq_erls,
29.181 + srls=e_rls,
29.182 + prls=RootRatEq_prls,
29.183 + calc=[],
29.184 + crls=RootRatEq_crls, nrls=norm_Rational(*,
29.185 + asm_rls=[],
29.186 + asm_thm=[]*)},
29.187 + "Script Elim_rootrat_equation (e_::bool) (v_::real) = " ^
29.188 + "(let e_ = ((Try (Rewrite_Set expand_rootbinoms False)) @@ " ^
29.189 + " (Try (Rewrite_Set rooteq_simplify False)) @@ " ^
29.190 + " (Try (Rewrite_Set make_rooteq False)) @@ " ^
29.191 + " (Try (Rewrite_Set rooteq_simplify False)) @@ " ^
29.192 + " (Try (Rewrite_Set_Inst [(bdv,v_)] " ^
29.193 + " rootrat_solve False))) e_ " ^
29.194 + " in (SubProblem (RootEq_,[univariate,equation], " ^
29.195 + " [no_met]) [bool_ e_, real_ v_]))"
29.196 + ));
29.197 +calclist':= overwritel (!calclist',
29.198 + [("is_rootRatAddTerm_in", ("RootRatEq.is_rootRatAddTerm_in",
29.199 + eval_is_rootRatAddTerm_in""))
29.200 + ]);
29.201 +*}
29.202
29.203 end
30.1 --- a/src/Tools/isac/Knowledge/Test.ML Fri Aug 27 10:39:12 2010 +0200
30.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
30.3 @@ -1,1301 +0,0 @@
30.4 -(* SML functions for rational arithmetic
30.5 - WN.22.10.99
30.6 - use"../knowledge/Test.ML";
30.7 - use"Knowledge/Test.ML";
30.8 - use"Test.ML";
30.9 - *)
30.10 -
30.11 -
30.12 -(** interface isabelle -- isac **)
30.13 -
30.14 -theory' := overwritel (!theory', [("Test.thy",Test.thy)]);
30.15 -
30.16 -(** evaluation of numerals and predicates **)
30.17 -
30.18 -(*does a term contain a root ?*)
30.19 -fun eval_root_free (thmid:string) _ (t as (Const(op0,t0) $ arg)) thy =
30.20 - if strip_thy op0 <> "is'_root'_free"
30.21 - then raise error ("eval_root_free: wrong "^op0)
30.22 - else if const_in (strip_thy op0) arg
30.23 - then SOME (mk_thmid thmid ""
30.24 - ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
30.25 - Trueprop $ (mk_equality (t, false_as_term)))
30.26 - else SOME (mk_thmid thmid ""
30.27 - ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
30.28 - Trueprop $ (mk_equality (t, true_as_term)))
30.29 - | eval_root_free _ _ _ _ = NONE;
30.30 -
30.31 -(*does a term contain a root ?*)
30.32 -fun eval_contains_root (thmid:string) _
30.33 - (t as (Const("Test.contains'_root",t0) $ arg)) thy =
30.34 - if member op = (ids_of arg) "sqrt"
30.35 - then SOME (mk_thmid thmid ""
30.36 - ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
30.37 - Trueprop $ (mk_equality (t, true_as_term)))
30.38 - else SOME (mk_thmid thmid ""
30.39 - ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
30.40 - Trueprop $ (mk_equality (t, false_as_term)))
30.41 - | eval_contains_root _ _ _ _ = NONE;
30.42 -
30.43 -calclist':= overwritel (!calclist',
30.44 - [("is_root_free", ("Test.is'_root'_free",
30.45 - eval_root_free"#is_root_free_")),
30.46 - ("contains_root", ("Test.contains'_root",
30.47 - eval_contains_root"#contains_root_"))
30.48 - ]);
30.49 -
30.50 -(** term order **)
30.51 -fun term_order (_:subst) tu = (term_ordI [] tu = LESS);
30.52 -
30.53 -(** rule sets **)
30.54 -
30.55 -val testerls =
30.56 - Rls {id = "testerls", preconds = [], rew_ord = ("termlessI",termlessI),
30.57 - erls = e_rls, srls = Erls,
30.58 - calc = [],
30.59 - rules = [Thm ("refl",num_str refl),
30.60 - Thm ("le_refl",num_str le_refl),
30.61 - Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
30.62 - Thm ("not_true",num_str not_true),
30.63 - Thm ("not_false",num_str not_false),
30.64 - Thm ("and_true",and_true),
30.65 - Thm ("and_false",and_false),
30.66 - Thm ("or_true",or_true),
30.67 - Thm ("or_false",or_false),
30.68 - Thm ("and_commute",num_str and_commute),
30.69 - Thm ("or_commute",num_str or_commute),
30.70 -
30.71 - Calc ("Atools.is'_const",eval_const "#is_const_"),
30.72 - Calc ("Tools.matches",eval_matches ""),
30.73 -
30.74 - Calc ("op +",eval_binop "#add_"),
30.75 - Calc ("op *",eval_binop "#mult_"),
30.76 - Calc ("Atools.pow" ,eval_binop "#power_"),
30.77 -
30.78 - Calc ("op <",eval_equ "#less_"),
30.79 - Calc ("op <=",eval_equ "#less_equal_"),
30.80 -
30.81 - Calc ("Atools.ident",eval_ident "#ident_")],
30.82 - scr = Script ((term_of o the o (parse thy))
30.83 - "empty_script")
30.84 - }:rls;
30.85 -
30.86 -(*.for evaluation of conditions in rewrite rules.*)
30.87 -(*FIXXXXXXME 10.8.02: handle like _simplify*)
30.88 -val tval_rls =
30.89 - Rls{id = "tval_rls", preconds = [],
30.90 - rew_ord = ("sqrt_right",sqrt_right false (theory "Pure")),
30.91 - erls=testerls,srls = e_rls,
30.92 - calc=[],
30.93 - rules = [Thm ("refl",num_str refl),
30.94 - Thm ("le_refl",num_str le_refl),
30.95 - Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
30.96 - Thm ("not_true",num_str not_true),
30.97 - Thm ("not_false",num_str not_false),
30.98 - Thm ("and_true",and_true),
30.99 - Thm ("and_false",and_false),
30.100 - Thm ("or_true",or_true),
30.101 - Thm ("or_false",or_false),
30.102 - Thm ("and_commute",num_str and_commute),
30.103 - Thm ("or_commute",num_str or_commute),
30.104 -
30.105 - Thm ("real_diff_minus",num_str real_diff_minus),
30.106 -
30.107 - Thm ("root_ge0",num_str root_ge0),
30.108 - Thm ("root_add_ge0",num_str root_add_ge0),
30.109 - Thm ("root_ge0_1",num_str root_ge0_1),
30.110 - Thm ("root_ge0_2",num_str root_ge0_2),
30.111 -
30.112 - Calc ("Atools.is'_const",eval_const "#is_const_"),
30.113 - Calc ("Test.is'_root'_free",eval_root_free "#is_root_free_"),
30.114 - Calc ("Tools.matches",eval_matches ""),
30.115 - Calc ("Test.contains'_root",
30.116 - eval_contains_root"#contains_root_"),
30.117 -
30.118 - Calc ("op +",eval_binop "#add_"),
30.119 - Calc ("op *",eval_binop "#mult_"),
30.120 - Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
30.121 - Calc ("Atools.pow" ,eval_binop "#power_"),
30.122 -
30.123 - Calc ("op <",eval_equ "#less_"),
30.124 - Calc ("op <=",eval_equ "#less_equal_"),
30.125 -
30.126 - Calc ("Atools.ident",eval_ident "#ident_")],
30.127 - scr = Script ((term_of o the o (parse thy))
30.128 - "empty_script")
30.129 - }:rls;
30.130 -
30.131 -
30.132 -ruleset' := overwritelthy thy (!ruleset',
30.133 - [("testerls", prep_rls testerls)
30.134 - ]);
30.135 -
30.136 -
30.137 -(*make () dissappear*)
30.138 -val rearrange_assoc =
30.139 - Rls{id = "rearrange_assoc", preconds = [],
30.140 - rew_ord = ("e_rew_ord",e_rew_ord),
30.141 - erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
30.142 - rules =
30.143 - [Thm ("sym_radd_assoc",num_str (radd_assoc RS sym)),
30.144 - Thm ("sym_rmult_assoc",num_str (rmult_assoc RS sym))],
30.145 - scr = Script ((term_of o the o (parse thy))
30.146 - "empty_script")
30.147 - }:rls;
30.148 -
30.149 -val ac_plus_times =
30.150 - Rls{id = "ac_plus_times", preconds = [], rew_ord = ("term_order",term_order),
30.151 - erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
30.152 - rules =
30.153 - [Thm ("radd_commute",radd_commute),
30.154 - Thm ("radd_left_commute",radd_left_commute),
30.155 - Thm ("radd_assoc",radd_assoc),
30.156 - Thm ("rmult_commute",rmult_commute),
30.157 - Thm ("rmult_left_commute",rmult_left_commute),
30.158 - Thm ("rmult_assoc",rmult_assoc)],
30.159 - scr = Script ((term_of o the o (parse thy))
30.160 - "empty_script")
30.161 - }:rls;
30.162 -
30.163 -(*todo: replace by Rewrite("rnorm_equation_add",num_str rnorm_equation_add)*)
30.164 -val norm_equation =
30.165 - Rls{id = "norm_equation", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
30.166 - erls = tval_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
30.167 - rules = [Thm ("rnorm_equation_add",num_str rnorm_equation_add)
30.168 - ],
30.169 - scr = Script ((term_of o the o (parse thy))
30.170 - "empty_script")
30.171 - }:rls;
30.172 -
30.173 -(** rule sets **)
30.174 -
30.175 -val STest_simplify = (* vv--- not changed to real by parse*)
30.176 - "Script STest_simplify (t_::'z) = " ^
30.177 - "(Repeat" ^
30.178 - " ((Try (Repeat (Rewrite real_diff_minus False))) @@ " ^
30.179 - " (Try (Repeat (Rewrite radd_mult_distrib2 False))) @@ " ^
30.180 - " (Try (Repeat (Rewrite rdistr_right_assoc False))) @@ " ^
30.181 - " (Try (Repeat (Rewrite rdistr_right_assoc_p False))) @@" ^
30.182 - " (Try (Repeat (Rewrite rdistr_div_right False))) @@ " ^
30.183 - " (Try (Repeat (Rewrite rbinom_power_2 False))) @@ " ^
30.184 -
30.185 - " (Try (Repeat (Rewrite radd_commute False))) @@ " ^
30.186 - " (Try (Repeat (Rewrite radd_left_commute False))) @@ " ^
30.187 - " (Try (Repeat (Rewrite radd_assoc False))) @@ " ^
30.188 - " (Try (Repeat (Rewrite rmult_commute False))) @@ " ^
30.189 - " (Try (Repeat (Rewrite rmult_left_commute False))) @@ " ^
30.190 - " (Try (Repeat (Rewrite rmult_assoc False))) @@ " ^
30.191 -
30.192 - " (Try (Repeat (Rewrite radd_real_const_eq False))) @@ " ^
30.193 - " (Try (Repeat (Rewrite radd_real_const False))) @@ " ^
30.194 - " (Try (Repeat (Calculate plus))) @@ " ^
30.195 - " (Try (Repeat (Calculate times))) @@ " ^
30.196 - " (Try (Repeat (Calculate divide_))) @@" ^
30.197 - " (Try (Repeat (Calculate power_))) @@ " ^
30.198 -
30.199 - " (Try (Repeat (Rewrite rcollect_right False))) @@ " ^
30.200 - " (Try (Repeat (Rewrite rcollect_one_left False))) @@ " ^
30.201 - " (Try (Repeat (Rewrite rcollect_one_left_assoc False))) @@ " ^
30.202 - " (Try (Repeat (Rewrite rcollect_one_left_assoc_p False))) @@ " ^
30.203 -
30.204 - " (Try (Repeat (Rewrite rshift_nominator False))) @@ " ^
30.205 - " (Try (Repeat (Rewrite rcancel_den False))) @@ " ^
30.206 - " (Try (Repeat (Rewrite rroot_square_inv False))) @@ " ^
30.207 - " (Try (Repeat (Rewrite rroot_times_root False))) @@ " ^
30.208 - " (Try (Repeat (Rewrite rroot_times_root_assoc_p False))) @@ " ^
30.209 - " (Try (Repeat (Rewrite rsqare False))) @@ " ^
30.210 - " (Try (Repeat (Rewrite power_1 False))) @@ " ^
30.211 - " (Try (Repeat (Rewrite rtwo_of_the_same False))) @@ " ^
30.212 - " (Try (Repeat (Rewrite rtwo_of_the_same_assoc_p False))) @@ " ^
30.213 -
30.214 - " (Try (Repeat (Rewrite rmult_1 False))) @@ " ^
30.215 - " (Try (Repeat (Rewrite rmult_1_right False))) @@ " ^
30.216 - " (Try (Repeat (Rewrite rmult_0 False))) @@ " ^
30.217 - " (Try (Repeat (Rewrite rmult_0_right False))) @@ " ^
30.218 - " (Try (Repeat (Rewrite radd_0 False))) @@ " ^
30.219 - " (Try (Repeat (Rewrite radd_0_right False)))) " ^
30.220 - " t_)";
30.221 -
30.222 -
30.223 -(* expects * distributed over + *)
30.224 -val Test_simplify =
30.225 - Rls{id = "Test_simplify", preconds = [],
30.226 - rew_ord = ("sqrt_right",sqrt_right false (theory "Pure")),
30.227 - erls = tval_rls, srls = e_rls,
30.228 - calc=[(*since 040209 filled by prep_rls*)],
30.229 - (*asm_thm = [],*)
30.230 - rules = [
30.231 - Thm ("real_diff_minus",num_str real_diff_minus),
30.232 - Thm ("radd_mult_distrib2",num_str radd_mult_distrib2),
30.233 - Thm ("rdistr_right_assoc",num_str rdistr_right_assoc),
30.234 - Thm ("rdistr_right_assoc_p",num_str rdistr_right_assoc_p),
30.235 - Thm ("rdistr_div_right",num_str rdistr_div_right),
30.236 - Thm ("rbinom_power_2",num_str rbinom_power_2),
30.237 -
30.238 - Thm ("radd_commute",num_str radd_commute),
30.239 - Thm ("radd_left_commute",num_str radd_left_commute),
30.240 - Thm ("radd_assoc",num_str radd_assoc),
30.241 - Thm ("rmult_commute",num_str rmult_commute),
30.242 - Thm ("rmult_left_commute",num_str rmult_left_commute),
30.243 - Thm ("rmult_assoc",num_str rmult_assoc),
30.244 -
30.245 - Thm ("radd_real_const_eq",num_str radd_real_const_eq),
30.246 - Thm ("radd_real_const",num_str radd_real_const),
30.247 - (* these 2 rules are invers to distr_div_right wrt. termination.
30.248 - thus they MUST be done IMMEDIATELY before calc *)
30.249 - Calc ("op +", eval_binop "#add_"),
30.250 - Calc ("op *", eval_binop "#mult_"),
30.251 - Calc ("HOL.divide", eval_cancel "#divide_"),
30.252 - Calc ("Atools.pow", eval_binop "#power_"),
30.253 -
30.254 - Thm ("rcollect_right",num_str rcollect_right),
30.255 - Thm ("rcollect_one_left",num_str rcollect_one_left),
30.256 - Thm ("rcollect_one_left_assoc",num_str rcollect_one_left_assoc),
30.257 - Thm ("rcollect_one_left_assoc_p",num_str rcollect_one_left_assoc_p),
30.258 -
30.259 - Thm ("rshift_nominator",num_str rshift_nominator),
30.260 - Thm ("rcancel_den",num_str rcancel_den),
30.261 - Thm ("rroot_square_inv",num_str rroot_square_inv),
30.262 - Thm ("rroot_times_root",num_str rroot_times_root),
30.263 - Thm ("rroot_times_root_assoc_p",num_str rroot_times_root_assoc_p),
30.264 - Thm ("rsqare",num_str rsqare),
30.265 - Thm ("power_1",num_str power_1),
30.266 - Thm ("rtwo_of_the_same",num_str rtwo_of_the_same),
30.267 - Thm ("rtwo_of_the_same_assoc_p",num_str rtwo_of_the_same_assoc_p),
30.268 -
30.269 - Thm ("rmult_1",num_str rmult_1),
30.270 - Thm ("rmult_1_right",num_str rmult_1_right),
30.271 - Thm ("rmult_0",num_str rmult_0),
30.272 - Thm ("rmult_0_right",num_str rmult_0_right),
30.273 - Thm ("radd_0",num_str radd_0),
30.274 - Thm ("radd_0_right",num_str radd_0_right)
30.275 - ],
30.276 - scr = Script ((term_of o the o (parse thy)) "empty_script")
30.277 - (*since 040209 filled by prep_rls: STest_simplify*)
30.278 - }:rls;
30.279 -
30.280 -
30.281 -
30.282 -
30.283 -
30.284 -(** rule sets **)
30.285 -
30.286 -
30.287 -
30.288 -(*isolate the root in a root-equation*)
30.289 -val isolate_root =
30.290 - Rls{id = "isolate_root", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
30.291 - erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
30.292 - rules = [Thm ("rroot_to_lhs",num_str rroot_to_lhs),
30.293 - Thm ("rroot_to_lhs_mult",num_str rroot_to_lhs_mult),
30.294 - Thm ("rroot_to_lhs_add_mult",num_str rroot_to_lhs_add_mult),
30.295 - Thm ("risolate_root_add",num_str risolate_root_add),
30.296 - Thm ("risolate_root_mult",num_str risolate_root_mult),
30.297 - Thm ("risolate_root_div",num_str risolate_root_div) ],
30.298 - scr = Script ((term_of o the o (parse thy))
30.299 - "empty_script")
30.300 - }:rls;
30.301 -
30.302 -(*isolate the bound variable in an equation; 'bdv' is a meta-constant*)
30.303 -val isolate_bdv =
30.304 - Rls{id = "isolate_bdv", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
30.305 - erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
30.306 - rules =
30.307 - [Thm ("risolate_bdv_add",num_str risolate_bdv_add),
30.308 - Thm ("risolate_bdv_mult_add",num_str risolate_bdv_mult_add),
30.309 - Thm ("risolate_bdv_mult",num_str risolate_bdv_mult),
30.310 - Thm ("mult_square",num_str mult_square),
30.311 - Thm ("constant_square",num_str constant_square),
30.312 - Thm ("constant_mult_square",num_str constant_mult_square)
30.313 - ],
30.314 - scr = Script ((term_of o the o (parse thy))
30.315 - "empty_script")
30.316 - }:rls;
30.317 -
30.318 -
30.319 -
30.320 -
30.321 -(* association list for calculate_, calculate
30.322 - "op +" etc. not usable in scripts *)
30.323 -val calclist =
30.324 - [
30.325 - (*as Tools.ML*)
30.326 - ("Vars" ,("Tools.Vars" ,eval_var "#Vars_")),
30.327 - ("matches",("Tools.matches",eval_matches "#matches_")),
30.328 - ("lhs" ,("Tools.lhs" ,eval_lhs "")),
30.329 - (*aus Atools.ML*)
30.330 - ("PLUS" ,("op +" ,eval_binop "#add_")),
30.331 - ("TIMES" ,("op *" ,eval_binop "#mult_")),
30.332 - ("DIVIDE" ,("HOL.divide" ,eval_cancel "#divide_")),
30.333 - ("POWER" ,("Atools.pow" ,eval_binop "#power_")),
30.334 - ("is_const",("Atools.is'_const",eval_const "#is_const_")),
30.335 - ("le" ,("op <" ,eval_equ "#less_")),
30.336 - ("leq" ,("op <=" ,eval_equ "#less_equal_")),
30.337 - ("ident" ,("Atools.ident",eval_ident "#ident_")),
30.338 - (*von hier (ehem.SqRoot*)
30.339 - ("sqrt" ,("Root.sqrt" ,eval_sqrt "#sqrt_")),
30.340 - ("Test.is_root_free",("is'_root'_free", eval_root_free"#is_root_free_")),
30.341 - ("Test.contains_root",("contains'_root",
30.342 - eval_contains_root"#contains_root_"))
30.343 - ];
30.344 -
30.345 -ruleset' := overwritelthy thy (!ruleset',
30.346 - [("Test_simplify", prep_rls Test_simplify),
30.347 - ("tval_rls", prep_rls tval_rls),
30.348 - ("isolate_root", prep_rls isolate_root),
30.349 - ("isolate_bdv", prep_rls isolate_bdv),
30.350 - ("matches",
30.351 - prep_rls (append_rls "matches" testerls
30.352 - [Calc ("Tools.matches",eval_matches "#matches_")]))
30.353 - ]);
30.354 -
30.355 -(** problem types **)
30.356 -store_pbt
30.357 - (prep_pbt (theory "Test") "pbl_test" [] e_pblID
30.358 - (["test"],
30.359 - [],
30.360 - e_rls, NONE, []));
30.361 -store_pbt
30.362 - (prep_pbt (theory "Test") "pbl_test_equ" [] e_pblID
30.363 - (["equation","test"],
30.364 - [("#Given" ,["equality e_","solveFor v_"]),
30.365 - ("#Where" ,["matches (?a = ?b) e_"]),
30.366 - ("#Find" ,["solutions v_i_"])
30.367 - ],
30.368 - assoc_rls "matches",
30.369 - SOME "solve (e_::bool, v_)", []));
30.370 -
30.371 -store_pbt
30.372 - (prep_pbt (theory "Test") "pbl_test_uni" [] e_pblID
30.373 - (["univariate","equation","test"],
30.374 - [("#Given" ,["equality e_","solveFor v_"]),
30.375 - ("#Where" ,["matches (?a = ?b) e_"]),
30.376 - ("#Find" ,["solutions v_i_"])
30.377 - ],
30.378 - assoc_rls "matches",
30.379 - SOME "solve (e_::bool, v_)", []));
30.380 -
30.381 -store_pbt
30.382 - (prep_pbt (theory "Test") "pbl_test_uni_lin" [] e_pblID
30.383 - (["linear","univariate","equation","test"],
30.384 - [("#Given" ,["equality e_","solveFor v_"]),
30.385 - ("#Where" ,["(matches ( v_ = 0) e_) | (matches ( ?b*v_ = 0) e_) |" ^
30.386 - "(matches (?a+v_ = 0) e_) | (matches (?a+?b*v_ = 0) e_) "]),
30.387 - ("#Find" ,["solutions v_i_"])
30.388 - ],
30.389 - assoc_rls "matches",
30.390 - SOME "solve (e_::bool, v_)", [["Test","solve_linear"]]));
30.391 -
30.392 -(*25.8.01 ------
30.393 -store_pbt
30.394 - (prep_pbt (theory "Test")
30.395 - (["(theory "Test")"],
30.396 - [("#Given" ,"boolTestGiven g_"),
30.397 - ("#Find" ,"boolTestFind f_")
30.398 - ],
30.399 - []));
30.400 -
30.401 -store_pbt
30.402 - (prep_pbt (theory "Test")
30.403 - (["testeq","(theory "Test")"],
30.404 - [("#Given" ,"boolTestGiven g_"),
30.405 - ("#Find" ,"boolTestFind f_")
30.406 - ],
30.407 - []));
30.408 -
30.409 -
30.410 -val ttt = (term_of o the o (parse Isac.thy)) "(matches ( v_ = 0) e_)";
30.411 -
30.412 - ------ 25.8.01*)
30.413 -
30.414 -
30.415 -(** methods **)
30.416 -store_met
30.417 - (prep_met Diff.thy "met_test" [] e_metID
30.418 - (["Test"],
30.419 - [],
30.420 - {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
30.421 - crls=Atools_erls, nrls=e_rls(*,
30.422 - asm_rls=[],asm_thm=[]*)}, "empty_script"));
30.423 -(*
30.424 -store_met
30.425 - (prep_met Script.thy
30.426 - (e_metID,(*empty method*)
30.427 - [],
30.428 - {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
30.429 - asm_rls=[],asm_thm=[]},
30.430 - "Undef"));*)
30.431 -store_met
30.432 - (prep_met (theory "Test") "met_test_solvelin" [] e_metID
30.433 - (["Test","solve_linear"]:metID,
30.434 - [("#Given" ,["equality e_","solveFor v_"]),
30.435 - ("#Where" ,["matches (?a = ?b) e_"]),
30.436 - ("#Find" ,["solutions v_i_"])
30.437 - ],
30.438 - {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,
30.439 - prls=assoc_rls "matches",
30.440 - calc=[],
30.441 - crls=tval_rls, nrls=Test_simplify},
30.442 - "Script Solve_linear (e_::bool) (v_::real)= " ^
30.443 - "(let e_ =" ^
30.444 - " Repeat" ^
30.445 - " (((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@" ^
30.446 - " (Rewrite_Set Test_simplify False))) e_" ^
30.447 - " in [e_::bool])"
30.448 - )
30.449 -(*, prep_met (theory "Test") (*test for equations*)
30.450 - (["Test","testeq"]:metID,
30.451 - [("#Given" ,["boolTestGiven g_"]),
30.452 - ("#Find" ,["boolTestFind f_"])
30.453 - ],
30.454 - {rew_ord'="e_rew_ord",rls'="tval_rls",asm_rls=[],
30.455 - asm_thm=[("square_equation_left","")]},
30.456 - "Script Testeq (eq_::bool) = " ^
30.457 - "Repeat " ^
30.458 - " (let e_ = Try (Repeat (Rewrite rroot_square_inv False eq_)); " ^
30.459 - " e_ = Try (Repeat (Rewrite square_equation_left True e_)); " ^
30.460 - " e_ = Try (Repeat (Rewrite rmult_0 False e_)) " ^
30.461 - " in e_) Until (is_root_free e_)" (*deleted*)
30.462 - )
30.463 -, ---------27.4.02*)
30.464 -);
30.465 -
30.466 -
30.467 -
30.468 -
30.469 -ruleset' := overwritelthy thy (!ruleset',
30.470 - [("norm_equation", prep_rls norm_equation),
30.471 - ("ac_plus_times", prep_rls ac_plus_times),
30.472 - ("rearrange_assoc", prep_rls rearrange_assoc)
30.473 - ]);
30.474 -
30.475 -
30.476 -fun bin_o (Const (op_,(Type ("fun",
30.477 - [Type (s2,[]),Type ("fun",
30.478 - [Type (s4,tl4),Type (s5,tl5)])])))) =
30.479 - if (s2=s4)andalso(s4=s5)then[op_]else[]
30.480 - | bin_o _ = [];
30.481 -
30.482 -fun bin_op (t1 $ t2) = union op = (bin_op t1) (bin_op t2)
30.483 - | bin_op t = bin_o t;
30.484 -fun is_bin_op t = ((bin_op t)<>[]);
30.485 -
30.486 -fun bin_op_arg1 ((Const (op_,(Type ("fun",
30.487 - [Type (s2,[]),Type ("fun",
30.488 - [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) =
30.489 - arg1;
30.490 -fun bin_op_arg2 ((Const (op_,(Type ("fun",
30.491 - [Type (s2,[]),Type ("fun",
30.492 - [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) =
30.493 - arg2;
30.494 -
30.495 -
30.496 -exception NO_EQUATION_TERM;
30.497 -fun is_equation ((Const ("op =",(Type ("fun",
30.498 - [Type (_,[]),Type ("fun",
30.499 - [Type (_,[]),Type ("bool",[])])])))) $ _ $ _)
30.500 - = true
30.501 - | is_equation _ = false;
30.502 -fun equ_lhs ((Const ("op =",(Type ("fun",
30.503 - [Type (_,[]),Type ("fun",
30.504 - [Type (_,[]),Type ("bool",[])])])))) $ l $ r)
30.505 - = l
30.506 - | equ_lhs _ = raise NO_EQUATION_TERM;
30.507 -fun equ_rhs ((Const ("op =",(Type ("fun",
30.508 - [Type (_,[]),Type ("fun",
30.509 - [Type (_,[]),Type ("bool",[])])])))) $ l $ r)
30.510 - = r
30.511 - | equ_rhs _ = raise NO_EQUATION_TERM;
30.512 -
30.513 -
30.514 -fun atom (Const (_,Type (_,[]))) = true
30.515 - | atom (Free (_,Type (_,[]))) = true
30.516 - | atom (Var (_,Type (_,[]))) = true
30.517 -(*| atom (_ (_,"?DUMMY" )) = true ..ML-error *)
30.518 - | atom((Const ("Bin.integ_of_bin",_)) $ _) = true
30.519 - | atom _ = false;
30.520 -
30.521 -fun varids (Const (s,Type (_,[]))) = [strip_thy s]
30.522 - | varids (Free (s,Type (_,[]))) = if is_no s then []
30.523 - else [strip_thy s]
30.524 - | varids (Var((s,_),Type (_,[]))) = [strip_thy s]
30.525 -(*| varids (_ (s,"?DUMMY" )) = ..ML-error *)
30.526 - | varids((Const ("Bin.integ_of_bin",_)) $ _)= [](*8.01: superfluous?*)
30.527 - | varids (Abs(a,T,t)) = union op = [a] (varids t)
30.528 - | varids (t1 $ t2) = union op = (varids t1) (varids t2)
30.529 - | varids _ = [];
30.530 -(*> val t = term_of (hd (parse Diophant.thy "x"));
30.531 -val t = Free ("x","?DUMMY") : term
30.532 -> varids t;
30.533 -val it = [] : string list [] !!! *)
30.534 -
30.535 -
30.536 -fun bin_ops_only ((Const op_) $ t1 $ t2) =
30.537 - if(is_bin_op (Const op_))
30.538 - then(bin_ops_only t1)andalso(bin_ops_only t2)
30.539 - else false
30.540 - | bin_ops_only t =
30.541 - if atom t then true else bin_ops_only t;
30.542 -
30.543 -fun polynomial opl t bdVar = (* bdVar TODO *)
30.544 - subset op = (bin_op t, opl) andalso (bin_ops_only t);
30.545 -
30.546 -fun poly_equ opl bdVar t = is_equation t (* bdVar TODO *)
30.547 - andalso polynomial opl (equ_lhs t) bdVar
30.548 - andalso polynomial opl (equ_rhs t) bdVar
30.549 - andalso (subset op = (varids bdVar, varids (equ_lhs t)) orelse
30.550 - subset op = (varids bdVar, varids (equ_lhs t)));
30.551 -
30.552 -(*fun max is =
30.553 - let fun max_ m [] = m
30.554 - | max_ m (i::is) = if m<i then max_ i is else max_ m is;
30.555 - in max_ (hd is) is end;
30.556 -> max [1,5,3,7,4,2];
30.557 -val it = 7 : int *)
30.558 -
30.559 -fun max (a,b) = if a < b then b else a;
30.560 -
30.561 -fun degree addl mul bdVar t =
30.562 -let
30.563 -fun deg _ _ v (Const (s,Type (_,[]))) = if v=strip_thy s then 1 else 0
30.564 - | deg _ _ v (Free (s,Type (_,[]))) = if v=strip_thy s then 1 else 0
30.565 - | deg _ _ v (Var((s,_),Type (_,[]))) = if v=strip_thy s then 1 else 0
30.566 -(*| deg _ _ v (_ (s,"?DUMMY" )) = ..ML-error *)
30.567 - | deg _ _ v((Const ("Bin.integ_of_bin",_)) $ _ )= 0
30.568 - | deg addl mul v (h $ t1 $ t2) =
30.569 - if subset op = (bin_op h, addl)
30.570 - then max (deg addl mul v t1 ,deg addl mul v t2)
30.571 - else (*mul!*)(deg addl mul v t1)+(deg addl mul v t2)
30.572 -in if polynomial (addl @ [mul]) t bdVar
30.573 - then SOME (deg addl mul (id_of bdVar) t) else (NONE:int option)
30.574 -end;
30.575 -fun degree_ addl mul bdVar t = (* do not export *)
30.576 - let fun opt (SOME i)= i
30.577 - | opt NONE = 0
30.578 -in opt (degree addl mul bdVar t) end;
30.579 -
30.580 -
30.581 -fun linear addl mul t bdVar = (degree_ addl mul bdVar t)<2;
30.582 -
30.583 -fun linear_equ addl mul bdVar t =
30.584 - if is_equation t
30.585 - then let val degl = degree_ addl mul bdVar (equ_lhs t);
30.586 - val degr = degree_ addl mul bdVar (equ_rhs t)
30.587 - in if (degl>0 orelse degr>0)andalso max(degl,degr)<2
30.588 - then true else false
30.589 - end
30.590 - else false;
30.591 -(* strip_thy op_ before *)
30.592 -fun is_div_op (dv,(Const (op_,(Type ("fun",
30.593 - [Type (s2,[]),Type ("fun",
30.594 - [Type (s4,tl4),Type (s5,tl5)])])))) )= (dv = strip_thy op_)
30.595 - | is_div_op _ = false;
30.596 -
30.597 -fun is_denom bdVar div_op t =
30.598 - let fun is bool[v]dv (Const (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
30.599 - | is bool[v]dv (Free (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
30.600 - | is bool[v]dv (Var((s,_),Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
30.601 - | is bool[v]dv((Const ("Bin.integ_of_bin",_)) $ _) = false
30.602 - | is bool[v]dv (h$n$d) =
30.603 - if is_div_op(dv,h)
30.604 - then (is false[v]dv n)orelse(is true[v]dv d)
30.605 - else (is bool [v]dv n)orelse(is bool[v]dv d)
30.606 -in is false (varids bdVar) (strip_thy div_op) t end;
30.607 -
30.608 -
30.609 -fun rational t div_op bdVar =
30.610 - is_denom bdVar div_op t andalso bin_ops_only t;
30.611 -
30.612 -
30.613 -
30.614 -(** problem types **)
30.615 -
30.616 -store_pbt
30.617 - (prep_pbt (theory "Test") "pbl_test_uni_plain2" [] e_pblID
30.618 - (["plain_square","univariate","equation","test"],
30.619 - [("#Given" ,["equality e_","solveFor v_"]),
30.620 - ("#Where" ,["(matches (?a + ?b*v_ ^^^2 = 0) e_) |" ^
30.621 - "(matches ( ?b*v_ ^^^2 = 0) e_) |" ^
30.622 - "(matches (?a + v_ ^^^2 = 0) e_) |" ^
30.623 - "(matches ( v_ ^^^2 = 0) e_)"]),
30.624 - ("#Find" ,["solutions v_i_"])
30.625 - ],
30.626 - assoc_rls "matches",
30.627 - SOME "solve (e_::bool, v_)", [["Test","solve_plain_square"]]));
30.628 -(*
30.629 - val e_ = (term_of o the o (parse thy)) "e_::bool";
30.630 - val ve = (term_of o the o (parse thy)) "4 + 3*x^^^2 = 0";
30.631 - val env = [(e_,ve)];
30.632 -
30.633 - val pre = (term_of o the o (parse thy))
30.634 - "(matches (a + b*v_ ^^^2 = 0, e_::bool)) |" ^
30.635 - "(matches ( b*v_ ^^^2 = 0, e_::bool)) |" ^
30.636 - "(matches (a + v_ ^^^2 = 0, e_::bool)) |" ^
30.637 - "(matches ( v_ ^^^2 = 0, e_::bool))";
30.638 - val prei = subst_atomic env pre;
30.639 - val cpre = (cterm_of thy) prei;
30.640 -
30.641 - val SOME (ct,_) = rewrite_set_ thy false tval_rls cpre;
30.642 -val ct = "True | False | False | False" : cterm
30.643 -
30.644 -> val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
30.645 -> val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
30.646 -> val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
30.647 -val ct = "True" : cterm
30.648 -
30.649 -*)
30.650 -
30.651 -store_pbt
30.652 - (prep_pbt (theory "Test") "pbl_test_uni_poly" [] e_pblID
30.653 - (["polynomial","univariate","equation","test"],
30.654 - [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
30.655 - ("#Where" ,["False"]),
30.656 - ("#Find" ,["solutions v_i_"])
30.657 - ],
30.658 - e_rls, SOME "solve (e_::bool, v_)", []));
30.659 -
30.660 -store_pbt
30.661 - (prep_pbt (theory "Test") "pbl_test_uni_poly_deg2" [] e_pblID
30.662 - (["degree_two","polynomial","univariate","equation","test"],
30.663 - [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
30.664 - ("#Find" ,["solutions v_i_"])
30.665 - ],
30.666 - e_rls, SOME "solve (v_ ^^^2 + p_ * v_ + q__ = 0, v_)", []));
30.667 -
30.668 -store_pbt
30.669 - (prep_pbt (theory "Test") "pbl_test_uni_poly_deg2_pq" [] e_pblID
30.670 - (["pq_formula","degree_two","polynomial","univariate","equation","test"],
30.671 - [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
30.672 - ("#Find" ,["solutions v_i_"])
30.673 - ],
30.674 - e_rls, SOME "solve (v_ ^^^2 + p_ * v_ + q__ = 0, v_)", []));
30.675 -
30.676 -store_pbt
30.677 - (prep_pbt (theory "Test") "pbl_test_uni_poly_deg2_abc" [] e_pblID
30.678 - (["abc_formula","degree_two","polynomial","univariate","equation","test"],
30.679 - [("#Given" ,["equality (a_ * x ^^^2 + b_ * x + c_ = 0)","solveFor v_"]),
30.680 - ("#Find" ,["solutions v_i_"])
30.681 - ],
30.682 - e_rls, SOME "solve (a_ * x ^^^2 + b_ * x + c_ = 0, v_)", []));
30.683 -
30.684 -store_pbt
30.685 - (prep_pbt (theory "Test") "pbl_test_uni_root" [] e_pblID
30.686 - (["squareroot","univariate","equation","test"],
30.687 - [("#Given" ,["equality e_","solveFor v_"]),
30.688 - ("#Where" ,["contains_root (e_::bool)"]),
30.689 - ("#Find" ,["solutions v_i_"])
30.690 - ],
30.691 - append_rls "contains_root" e_rls [Calc ("Test.contains'_root",
30.692 - eval_contains_root "#contains_root_")],
30.693 - SOME "solve (e_::bool, v_)", [["Test","square_equation"]]));
30.694 -
30.695 -store_pbt
30.696 - (prep_pbt (theory "Test") "pbl_test_uni_norm" [] e_pblID
30.697 - (["normalize","univariate","equation","test"],
30.698 - [("#Given" ,["equality e_","solveFor v_"]),
30.699 - ("#Where" ,[]),
30.700 - ("#Find" ,["solutions v_i_"])
30.701 - ],
30.702 - e_rls, SOME "solve (e_::bool, v_)", [["Test","norm_univar_equation"]]));
30.703 -
30.704 -store_pbt
30.705 - (prep_pbt (theory "Test") "pbl_test_uni_roottest" [] e_pblID
30.706 - (["sqroot-test","univariate","equation","test"],
30.707 - [("#Given" ,["equality e_","solveFor v_"]),
30.708 - (*("#Where" ,["contains_root (e_::bool)"]),*)
30.709 - ("#Find" ,["solutions v_i_"])
30.710 - ],
30.711 - e_rls, SOME "solve (e_::bool, v_)", []));
30.712 -
30.713 -(*
30.714 -(#ppc o get_pbt) ["sqroot-test","univariate","equation"];
30.715 - *)
30.716 -
30.717 -
30.718 -store_met
30.719 - (prep_met (theory "Test") "met_test_sqrt" [] e_metID
30.720 -(*root-equation, version for tests before 8.01.01*)
30.721 - (["Test","sqrt-equ-test"]:metID,
30.722 - [("#Given" ,["equality e_","solveFor v_"]),
30.723 - ("#Where" ,["contains_root (e_::bool)"]),
30.724 - ("#Find" ,["solutions v_i_"])
30.725 - ],
30.726 - {rew_ord'="e_rew_ord",rls'=tval_rls,
30.727 - srls =append_rls "srls_contains_root" e_rls
30.728 - [Calc ("Test.contains'_root",eval_contains_root "")],
30.729 - prls =append_rls "prls_contains_root" e_rls
30.730 - [Calc ("Test.contains'_root",eval_contains_root "")],
30.731 - calc=[],
30.732 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],
30.733 - asm_thm=[("square_equation_left",""),
30.734 - ("square_equation_right","")]*)},
30.735 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.736 - "(let e_ = " ^
30.737 - " ((While (contains_root e_) Do" ^
30.738 - " ((Rewrite square_equation_left True) @@" ^
30.739 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.740 - " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
30.741 - " (Try (Rewrite_Set isolate_root False)) @@" ^
30.742 - " (Try (Rewrite_Set Test_simplify False)))) @@" ^
30.743 - " (Try (Rewrite_Set norm_equation False)) @@" ^
30.744 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.745 - " (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@" ^
30.746 - " (Try (Rewrite_Set Test_simplify False)))" ^
30.747 - " e_" ^
30.748 - " in [e_::bool])"
30.749 - ));
30.750 -
30.751 -store_met
30.752 - (prep_met (theory "Test") "met_test_sqrt2" [] e_metID
30.753 -(*root-equation ... for test-*.sml until 8.01*)
30.754 - (["Test","squ-equ-test2"]:metID,
30.755 - [("#Given" ,["equality e_","solveFor v_"]),
30.756 - ("#Find" ,["solutions v_i_"])
30.757 - ],
30.758 - {rew_ord'="e_rew_ord",rls'=tval_rls,
30.759 - srls = append_rls "srls_contains_root" e_rls
30.760 - [Calc ("Test.contains'_root",eval_contains_root"")],
30.761 - prls=e_rls,calc=[],
30.762 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],
30.763 - asm_thm=[("square_equation_left",""),
30.764 - ("square_equation_right","")]*)},
30.765 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.766 - "(let e_ = " ^
30.767 - " ((While (contains_root e_) Do" ^
30.768 - " ((Rewrite square_equation_left True) @@" ^
30.769 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.770 - " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
30.771 - " (Try (Rewrite_Set isolate_root False)) @@" ^
30.772 - " (Try (Rewrite_Set Test_simplify False)))) @@" ^
30.773 - " (Try (Rewrite_Set norm_equation False)) @@" ^
30.774 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.775 - " (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@" ^
30.776 - " (Try (Rewrite_Set Test_simplify False)))" ^
30.777 - " e_;" ^
30.778 - " (L_::bool list) = Tac subproblem_equation_dummy; " ^
30.779 - " L_ = Tac solve_equation_dummy " ^
30.780 - " in Check_elementwise L_ {(v_::real). Assumptions})"
30.781 - ));
30.782 -
30.783 -store_met
30.784 - (prep_met (theory "Test") "met_test_squ_sub" [] e_metID
30.785 -(*tests subproblem fixed linear*)
30.786 - (["Test","squ-equ-test-subpbl1"]:metID,
30.787 - [("#Given" ,["equality e_","solveFor v_"]),
30.788 - ("#Find" ,["solutions v_i_"])
30.789 - ],
30.790 - {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
30.791 - crls=tval_rls, nrls=Test_simplify},
30.792 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.793 - " (let e_ = ((Try (Rewrite_Set norm_equation False)) @@ " ^
30.794 - " (Try (Rewrite_Set Test_simplify False))) e_; " ^
30.795 - "(L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test]," ^
30.796 - " [Test,solve_linear]) [bool_ e_, real_ v_])" ^
30.797 - "in Check_elementwise L_ {(v_::real). Assumptions})"
30.798 - ));
30.799 -
30.800 -store_met
30.801 - (prep_met (theory "Test") "met_test_squ_sub2" [] e_metID
30.802 - (*tests subproblem fixed degree 2*)
30.803 - (["Test","squ-equ-test-subpbl2"]:metID,
30.804 - [("#Given" ,["equality e_","solveFor v_"]),
30.805 - ("#Find" ,["solutions v_i_"])
30.806 - ],
30.807 - {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
30.808 - crls=tval_rls, nrls=e_rls(*,
30.809 - asm_rls=[],asm_thm=[("square_equation_left",""),
30.810 - ("square_equation_right","")]*)},
30.811 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.812 - " (let e_ = Try (Rewrite_Set norm_equation False) e_; " ^
30.813 - "(L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test]," ^
30.814 - " [Test,solve_by_pq_formula]) [bool_ e_, real_ v_])" ^
30.815 - "in Check_elementwise L_ {(v_::real). Assumptions})"
30.816 - ));
30.817 -
30.818 -store_met
30.819 - (prep_met (theory "Test") "met_test_squ_nonterm" [] e_metID
30.820 - (*root-equation: see foils..., but notTerminating*)
30.821 - (["Test","square_equation...notTerminating"]:metID,
30.822 - [("#Given" ,["equality e_","solveFor v_"]),
30.823 - ("#Find" ,["solutions v_i_"])
30.824 - ],
30.825 - {rew_ord'="e_rew_ord",rls'=tval_rls,
30.826 - srls = append_rls "srls_contains_root" e_rls
30.827 - [Calc ("Test.contains'_root",eval_contains_root"")],
30.828 - prls=e_rls,calc=[],
30.829 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],
30.830 - asm_thm=[("square_equation_left",""),
30.831 - ("square_equation_right","")]*)},
30.832 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.833 - "(let e_ = " ^
30.834 - " ((While (contains_root e_) Do" ^
30.835 - " ((Rewrite square_equation_left True) @@" ^
30.836 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.837 - " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
30.838 - " (Try (Rewrite_Set isolate_root False)) @@" ^
30.839 - " (Try (Rewrite_Set Test_simplify False)))) @@" ^
30.840 - " (Try (Rewrite_Set norm_equation False)) @@" ^
30.841 - " (Try (Rewrite_Set Test_simplify False)))" ^
30.842 - " e_;" ^
30.843 - " (L_::bool list) = " ^
30.844 - " (SubProblem (Test_,[linear,univariate,equation,test]," ^
30.845 - " [Test,solve_linear]) [bool_ e_, real_ v_])" ^
30.846 - "in Check_elementwise L_ {(v_::real). Assumptions})"
30.847 - ));
30.848 -
30.849 -store_met
30.850 - (prep_met (theory "Test") "met_test_eq1" [] e_metID
30.851 -(*root-equation1:*)
30.852 - (["Test","square_equation1"]:metID,
30.853 - [("#Given" ,["equality e_","solveFor v_"]),
30.854 - ("#Find" ,["solutions v_i_"])
30.855 - ],
30.856 - {rew_ord'="e_rew_ord",rls'=tval_rls,
30.857 - srls = append_rls "srls_contains_root" e_rls
30.858 - [Calc ("Test.contains'_root",eval_contains_root"")],
30.859 - prls=e_rls,calc=[],
30.860 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],
30.861 - asm_thm=[("square_equation_left",""),
30.862 - ("square_equation_right","")]*)},
30.863 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.864 - "(let e_ = " ^
30.865 - " ((While (contains_root e_) Do" ^
30.866 - " ((Rewrite square_equation_left True) @@" ^
30.867 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.868 - " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
30.869 - " (Try (Rewrite_Set isolate_root False)) @@" ^
30.870 - " (Try (Rewrite_Set Test_simplify False)))) @@" ^
30.871 - " (Try (Rewrite_Set norm_equation False)) @@" ^
30.872 - " (Try (Rewrite_Set Test_simplify False)))" ^
30.873 - " e_;" ^
30.874 - " (L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test]," ^
30.875 - " [Test,solve_linear]) [bool_ e_, real_ v_])" ^
30.876 - " in Check_elementwise L_ {(v_::real). Assumptions})"
30.877 - ));
30.878 -
30.879 -store_met
30.880 - (prep_met (theory "Test") "met_test_squ2" [] e_metID
30.881 - (*root-equation2*)
30.882 - (["Test","square_equation2"]:metID,
30.883 - [("#Given" ,["equality e_","solveFor v_"]),
30.884 - ("#Find" ,["solutions v_i_"])
30.885 - ],
30.886 - {rew_ord'="e_rew_ord",rls'=tval_rls,
30.887 - srls = append_rls "srls_contains_root" e_rls
30.888 - [Calc ("Test.contains'_root",eval_contains_root"")],
30.889 - prls=e_rls,calc=[],
30.890 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],
30.891 - asm_thm=[("square_equation_left",""),
30.892 - ("square_equation_right","")]*)},
30.893 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.894 - "(let e_ = " ^
30.895 - " ((While (contains_root e_) Do" ^
30.896 - " (((Rewrite square_equation_left True) Or " ^
30.897 - " (Rewrite square_equation_right True)) @@" ^
30.898 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.899 - " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
30.900 - " (Try (Rewrite_Set isolate_root False)) @@" ^
30.901 - " (Try (Rewrite_Set Test_simplify False)))) @@" ^
30.902 - " (Try (Rewrite_Set norm_equation False)) @@" ^
30.903 - " (Try (Rewrite_Set Test_simplify False)))" ^
30.904 - " e_;" ^
30.905 - " (L_::bool list) = (SubProblem (Test_,[plain_square,univariate,equation,test]," ^
30.906 - " [Test,solve_plain_square]) [bool_ e_, real_ v_])" ^
30.907 - " in Check_elementwise L_ {(v_::real). Assumptions})"
30.908 - ));
30.909 -
30.910 -store_met
30.911 - (prep_met (theory "Test") "met_test_squeq" [] e_metID
30.912 - (*root-equation*)
30.913 - (["Test","square_equation"]:metID,
30.914 - [("#Given" ,["equality e_","solveFor v_"]),
30.915 - ("#Find" ,["solutions v_i_"])
30.916 - ],
30.917 - {rew_ord'="e_rew_ord",rls'=tval_rls,
30.918 - srls = append_rls "srls_contains_root" e_rls
30.919 - [Calc ("Test.contains'_root",eval_contains_root"")],
30.920 - prls=e_rls,calc=[],
30.921 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],
30.922 - asm_thm=[("square_equation_left",""),
30.923 - ("square_equation_right","")]*)},
30.924 - "Script Solve_root_equation (e_::bool) (v_::real) = " ^
30.925 - "(let e_ = " ^
30.926 - " ((While (contains_root e_) Do" ^
30.927 - " (((Rewrite square_equation_left True) Or" ^
30.928 - " (Rewrite square_equation_right True)) @@" ^
30.929 - " (Try (Rewrite_Set Test_simplify False)) @@" ^
30.930 - " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
30.931 - " (Try (Rewrite_Set isolate_root False)) @@" ^
30.932 - " (Try (Rewrite_Set Test_simplify False)))) @@" ^
30.933 - " (Try (Rewrite_Set norm_equation False)) @@" ^
30.934 - " (Try (Rewrite_Set Test_simplify False)))" ^
30.935 - " e_;" ^
30.936 - " (L_::bool list) = (SubProblem (Test_,[univariate,equation,test]," ^
30.937 - " [no_met]) [bool_ e_, real_ v_])" ^
30.938 - " in Check_elementwise L_ {(v_::real). Assumptions})"
30.939 - ) ); (*#######*)
30.940 -
30.941 -store_met
30.942 - (prep_met (theory "Test") "met_test_eq_plain" [] e_metID
30.943 - (*solve_plain_square*)
30.944 - (["Test","solve_plain_square"]:metID,
30.945 - [("#Given",["equality e_","solveFor v_"]),
30.946 - ("#Where" ,["(matches (?a + ?b*v_ ^^^2 = 0) e_) |" ^
30.947 - "(matches ( ?b*v_ ^^^2 = 0) e_) |" ^
30.948 - "(matches (?a + v_ ^^^2 = 0) e_) |" ^
30.949 - "(matches ( v_ ^^^2 = 0) e_)"]),
30.950 - ("#Find" ,["solutions v_i_"])
30.951 - ],
30.952 - {rew_ord'="e_rew_ord",rls'=tval_rls,calc=[],srls=e_rls,
30.953 - prls = assoc_rls "matches",
30.954 - crls=tval_rls, nrls=e_rls(*,
30.955 - asm_rls=[],asm_thm=[]*)},
30.956 - "Script Solve_plain_square (e_::bool) (v_::real) = " ^
30.957 - " (let e_ = ((Try (Rewrite_Set isolate_bdv False)) @@ " ^
30.958 - " (Try (Rewrite_Set Test_simplify False)) @@ " ^
30.959 - " ((Rewrite square_equality_0 False) Or " ^
30.960 - " (Rewrite square_equality True)) @@ " ^
30.961 - " (Try (Rewrite_Set tval_rls False))) e_ " ^
30.962 - " in ((Or_to_List e_)::bool list))"
30.963 - ));
30.964 -
30.965 -store_met
30.966 - (prep_met (theory "Test") "met_test_norm_univ" [] e_metID
30.967 - (["Test","norm_univar_equation"]:metID,
30.968 - [("#Given",["equality e_","solveFor v_"]),
30.969 - ("#Where" ,[]),
30.970 - ("#Find" ,["solutions v_i_"])
30.971 - ],
30.972 - {rew_ord'="e_rew_ord",rls'=tval_rls,srls = e_rls,prls=e_rls,
30.973 - calc=[],
30.974 - crls=tval_rls, nrls=e_rls(*,asm_rls=[],asm_thm=[]*)},
30.975 - "Script Norm_univar_equation (e_::bool) (v_::real) = " ^
30.976 - " (let e_ = ((Try (Rewrite rnorm_equation_add False)) @@ " ^
30.977 - " (Try (Rewrite_Set Test_simplify False))) e_ " ^
30.978 - " in (SubProblem (Test_,[univariate,equation,test], " ^
30.979 - " [no_met]) [bool_ e_, real_ v_]))"
30.980 - ));
30.981 -
30.982 -
30.983 -
30.984 -(*17.9.02 aus SqRoot.ML------------------------------^^^---*)
30.985 -
30.986 -(*8.4.03 aus Poly.ML--------------------------------vvv---
30.987 - make_polynomial ---> make_poly
30.988 - ^-- for user ^-- for systest _ONLY_*)
30.989 -
30.990 -local (*. for make_polytest .*)
30.991 -
30.992 -open Term; (* for type order = EQUAL | LESS | GREATER *)
30.993 -
30.994 -fun pr_ord EQUAL = "EQUAL"
30.995 - | pr_ord LESS = "LESS"
30.996 - | pr_ord GREATER = "GREATER";
30.997 -
30.998 -fun dest_hd' (Const (a, T)) = (* ~ term.ML *)
30.999 - (case a of
30.1000 - "Atools.pow" => ((("|||||||||||||", 0), T), 0) (*WN greatest *)
30.1001 - | _ => (((a, 0), T), 0))
30.1002 - | dest_hd' (Free (a, T)) = (((a, 0), T), 1)
30.1003 - | dest_hd' (Var v) = (v, 2)
30.1004 - | dest_hd' (Bound i) = ((("", i), dummyT), 3)
30.1005 - | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
30.1006 -(* RL *)
30.1007 -fun get_order_pow (t $ (Free(order,_))) =
30.1008 - (case int_of_str (order) of
30.1009 - SOME d => d
30.1010 - | NONE => 0)
30.1011 - | get_order_pow _ = 0;
30.1012 -
30.1013 -fun size_of_term' (Const(str,_) $ t) =
30.1014 - if "Atools.pow"=str then 1000 + size_of_term' t else 1 + size_of_term' t(*WN*)
30.1015 - | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
30.1016 - | size_of_term' (f$t) = size_of_term' f + size_of_term' t
30.1017 - | size_of_term' _ = 1;
30.1018 -
30.1019 -fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
30.1020 - (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
30.1021 - | term_ord' pr thy (t, u) =
30.1022 - (if pr then
30.1023 - let
30.1024 - val (f, ts) = strip_comb t and (g, us) = strip_comb u;
30.1025 - val _=writeln("t= f@ts= " ^ "" ^
30.1026 - ((Syntax.string_of_term (thy2ctxt thy)) f)^ "\" @ " ^ "[" ^
30.1027 - (commas(map(Syntax.string_of_term (thy2ctxt thy)) ts)) ^ "]""");
30.1028 - val _=writeln("u= g@us= " ^ "" ^
30.1029 - ((Syntax.string_of_term (thy2ctxt thy)) g) ^ "\" @ " ^ "[" ^
30.1030 - (commas(map(Syntax.string_of_term (thy2ctxt thy)) us))^"]""");
30.1031 - val _=writeln("size_of_term(t,u)= ("^
30.1032 - (string_of_int(size_of_term' t)) ^ ", " ^
30.1033 - (string_of_int(size_of_term' u)) ^ ")");
30.1034 - val _=writeln("hd_ord(f,g) = " ^ ((pr_ord o hd_ord)(f,g)));
30.1035 - val _=writeln("terms_ord(ts,us) = " ^
30.1036 - ((pr_ord o terms_ord str false)(ts,us)));
30.1037 - val _=writeln("-------");
30.1038 - in () end
30.1039 - else ();
30.1040 - case int_ord (size_of_term' t, size_of_term' u) of
30.1041 - EQUAL =>
30.1042 - let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
30.1043 - (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
30.1044 - | ord => ord)
30.1045 - end
30.1046 - | ord => ord)
30.1047 -and hd_ord (f, g) = (* ~ term.ML *)
30.1048 - prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f, dest_hd' g)
30.1049 -and terms_ord str pr (ts, us) =
30.1050 - list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
30.1051 -in
30.1052 -
30.1053 -fun ord_make_polytest (pr:bool) thy (_:subst) tu =
30.1054 - (term_ord' pr thy(***) tu = LESS );
30.1055 -
30.1056 -end;(*local*)
30.1057 -
30.1058 -rew_ord' := overwritel (!rew_ord',
30.1059 -[("termlessI", termlessI),
30.1060 - ("ord_make_polytest", ord_make_polytest false thy)
30.1061 - ]);
30.1062 -
30.1063 -(*WN060510 this was a preparation for prep_rls ...
30.1064 -val scr_make_polytest =
30.1065 -"Script Expand_binomtest t_ =" ^
30.1066 -"(Repeat " ^
30.1067 -"((Try (Repeat (Rewrite real_diff_minus False))) @@ " ^
30.1068 -
30.1069 -" (Try (Repeat (Rewrite real_add_mult_distrib False))) @@ " ^
30.1070 -" (Try (Repeat (Rewrite real_add_mult_distrib2 False))) @@ " ^
30.1071 -" (Try (Repeat (Rewrite real_diff_mult_distrib False))) @@ " ^
30.1072 -" (Try (Repeat (Rewrite real_diff_mult_distrib2 False))) @@ " ^
30.1073 -
30.1074 -" (Try (Repeat (Rewrite real_mult_1 False))) @@ " ^
30.1075 -" (Try (Repeat (Rewrite real_mult_0 False))) @@ " ^
30.1076 -" (Try (Repeat (Rewrite real_add_zero_left False))) @@ " ^
30.1077 -
30.1078 -" (Try (Repeat (Rewrite real_mult_commute False))) @@ " ^
30.1079 -" (Try (Repeat (Rewrite real_mult_left_commute False))) @@ " ^
30.1080 -" (Try (Repeat (Rewrite real_mult_assoc False))) @@ " ^
30.1081 -" (Try (Repeat (Rewrite real_add_commute False))) @@ " ^
30.1082 -" (Try (Repeat (Rewrite real_add_left_commute False))) @@ " ^
30.1083 -" (Try (Repeat (Rewrite real_add_assoc False))) @@ " ^
30.1084 -
30.1085 -" (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ " ^
30.1086 -" (Try (Repeat (Rewrite realpow_plus_1 False))) @@ " ^
30.1087 -" (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ " ^
30.1088 -" (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ " ^
30.1089 -
30.1090 -" (Try (Repeat (Rewrite real_num_collect False))) @@ " ^
30.1091 -" (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ " ^
30.1092 -
30.1093 -" (Try (Repeat (Rewrite real_one_collect False))) @@ " ^
30.1094 -" (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ " ^
30.1095 -
30.1096 -" (Try (Repeat (Calculate plus ))) @@ " ^
30.1097 -" (Try (Repeat (Calculate times ))) @@ " ^
30.1098 -" (Try (Repeat (Calculate power_)))) " ^
30.1099 -" t_)";
30.1100 ------------------------------------------------------*)
30.1101 -
30.1102 -val make_polytest =
30.1103 - Rls{id = "make_polytest", preconds = []:term list, rew_ord = ("ord_make_polytest",
30.1104 - ord_make_polytest false Poly.thy),
30.1105 - erls = testerls, srls = Erls,
30.1106 - calc = [("PLUS" , ("op +", eval_binop "#add_")),
30.1107 - ("TIMES" , ("op *", eval_binop "#mult_")),
30.1108 - ("POWER", ("Atools.pow", eval_binop "#power_"))
30.1109 - ],
30.1110 - (*asm_thm = [],*)
30.1111 - rules = [Thm ("real_diff_minus",num_str real_diff_minus),
30.1112 - (*"a - b = a + (-1) * b"*)
30.1113 - Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
30.1114 - (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
30.1115 - Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
30.1116 - (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
30.1117 - Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
30.1118 - (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
30.1119 - Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
30.1120 - (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
30.1121 - Thm ("real_mult_1",num_str real_mult_1),
30.1122 - (*"1 * z = z"*)
30.1123 - Thm ("real_mult_0",num_str real_mult_0),
30.1124 - (*"0 * z = 0"*)
30.1125 - Thm ("real_add_zero_left",num_str real_add_zero_left),
30.1126 - (*"0 + z = z"*)
30.1127 -
30.1128 - (*AC-rewriting*)
30.1129 - Thm ("real_mult_commute",num_str real_mult_commute),
30.1130 - (* z * w = w * z *)
30.1131 - Thm ("real_mult_left_commute",num_str real_mult_left_commute),
30.1132 - (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
30.1133 - Thm ("real_mult_assoc",num_str real_mult_assoc),
30.1134 - (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
30.1135 - Thm ("real_add_commute",num_str real_add_commute),
30.1136 - (*z + w = w + z*)
30.1137 - Thm ("real_add_left_commute",num_str real_add_left_commute),
30.1138 - (*x + (y + z) = y + (x + z)*)
30.1139 - Thm ("real_add_assoc",num_str real_add_assoc),
30.1140 - (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
30.1141 -
30.1142 - Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
30.1143 - (*"r1 * r1 = r1 ^^^ 2"*)
30.1144 - Thm ("realpow_plus_1",num_str realpow_plus_1),
30.1145 - (*"r * r ^^^ n = r ^^^ (n + 1)"*)
30.1146 - Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
30.1147 - (*"z1 + z1 = 2 * z1"*)
30.1148 - Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
30.1149 - (*"z1 + (z1 + k) = 2 * z1 + k"*)
30.1150 -
30.1151 - Thm ("real_num_collect",num_str real_num_collect),
30.1152 - (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
30.1153 - Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
30.1154 - (*"[| l is_const; m is_const |] ==>
30.1155 - l * n + (m * n + k) = (l + m) * n + k"*)
30.1156 - Thm ("real_one_collect",num_str real_one_collect),
30.1157 - (*"m is_const ==> n + m * n = (1 + m) * n"*)
30.1158 - Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
30.1159 - (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
30.1160 -
30.1161 - Calc ("op +", eval_binop "#add_"),
30.1162 - Calc ("op *", eval_binop "#mult_"),
30.1163 - Calc ("Atools.pow", eval_binop "#power_")
30.1164 - ],
30.1165 - scr = EmptyScr(*Script ((term_of o the o (parse thy))
30.1166 - scr_make_polytest)*)
30.1167 - }:rls;
30.1168 -(*WN060510 this was done before 'fun prep_rls' ...
30.1169 -val scr_expand_binomtest =
30.1170 -"Script Expand_binomtest t_ =" ^
30.1171 -"(Repeat " ^
30.1172 -"((Try (Repeat (Rewrite real_plus_binom_pow2 False))) @@ " ^
30.1173 -" (Try (Repeat (Rewrite real_plus_binom_times False))) @@ " ^
30.1174 -" (Try (Repeat (Rewrite real_minus_binom_pow2 False))) @@ " ^
30.1175 -" (Try (Repeat (Rewrite real_minus_binom_times False))) @@ " ^
30.1176 -" (Try (Repeat (Rewrite real_plus_minus_binom1 False))) @@ " ^
30.1177 -" (Try (Repeat (Rewrite real_plus_minus_binom2 False))) @@ " ^
30.1178 -
30.1179 -" (Try (Repeat (Rewrite real_mult_1 False))) @@ " ^
30.1180 -" (Try (Repeat (Rewrite real_mult_0 False))) @@ " ^
30.1181 -" (Try (Repeat (Rewrite real_add_zero_left False))) @@ " ^
30.1182 -
30.1183 -" (Try (Repeat (Calculate plus ))) @@ " ^
30.1184 -" (Try (Repeat (Calculate times ))) @@ " ^
30.1185 -" (Try (Repeat (Calculate power_))) @@ " ^
30.1186 -
30.1187 -" (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ " ^
30.1188 -" (Try (Repeat (Rewrite realpow_plus_1 False))) @@ " ^
30.1189 -" (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ " ^
30.1190 -" (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ " ^
30.1191 -
30.1192 -" (Try (Repeat (Rewrite real_num_collect False))) @@ " ^
30.1193 -" (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ " ^
30.1194 -
30.1195 -" (Try (Repeat (Rewrite real_one_collect False))) @@ " ^
30.1196 -" (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ " ^
30.1197 -
30.1198 -" (Try (Repeat (Calculate plus ))) @@ " ^
30.1199 -" (Try (Repeat (Calculate times ))) @@ " ^
30.1200 -" (Try (Repeat (Calculate power_)))) " ^
30.1201 -" t_)";
30.1202 -------------------------------------------------------*)
30.1203 -
30.1204 -val expand_binomtest =
30.1205 - Rls{id = "expand_binomtest", preconds = [],
30.1206 - rew_ord = ("termlessI",termlessI),
30.1207 - erls = testerls, srls = Erls,
30.1208 - calc = [("PLUS" , ("op +", eval_binop "#add_")),
30.1209 - ("TIMES" , ("op *", eval_binop "#mult_")),
30.1210 - ("POWER", ("Atools.pow", eval_binop "#power_"))
30.1211 - ],
30.1212 - (*asm_thm = [],*)
30.1213 - rules = [Thm ("real_plus_binom_pow2" ,num_str real_plus_binom_pow2),
30.1214 - (*"(a + b) ^^^ 2 = a ^^^ 2 + 2 * a * b + b ^^^ 2"*)
30.1215 - Thm ("real_plus_binom_times" ,num_str real_plus_binom_times),
30.1216 - (*"(a + b)*(a + b) = ...*)
30.1217 - Thm ("real_minus_binom_pow2" ,num_str real_minus_binom_pow2),
30.1218 - (*"(a - b) ^^^ 2 = a ^^^ 2 - 2 * a * b + b ^^^ 2"*)
30.1219 - Thm ("real_minus_binom_times",num_str real_minus_binom_times),
30.1220 - (*"(a - b)*(a - b) = ...*)
30.1221 - Thm ("real_plus_minus_binom1",num_str real_plus_minus_binom1),
30.1222 - (*"(a + b) * (a - b) = a ^^^ 2 - b ^^^ 2"*)
30.1223 - Thm ("real_plus_minus_binom2",num_str real_plus_minus_binom2),
30.1224 - (*"(a - b) * (a + b) = a ^^^ 2 - b ^^^ 2"*)
30.1225 - (*RL 020915*)
30.1226 - Thm ("real_pp_binom_times",num_str real_pp_binom_times),
30.1227 - (*(a + b)*(c + d) = a*c + a*d + b*c + b*d*)
30.1228 - Thm ("real_pm_binom_times",num_str real_pm_binom_times),
30.1229 - (*(a + b)*(c - d) = a*c - a*d + b*c - b*d*)
30.1230 - Thm ("real_mp_binom_times",num_str real_mp_binom_times),
30.1231 - (*(a - b)*(c p d) = a*c + a*d - b*c - b*d*)
30.1232 - Thm ("real_mm_binom_times",num_str real_mm_binom_times),
30.1233 - (*(a - b)*(c p d) = a*c - a*d - b*c + b*d*)
30.1234 - Thm ("realpow_multI",num_str realpow_multI),
30.1235 - (*(a*b)^^^n = a^^^n * b^^^n*)
30.1236 - Thm ("real_plus_binom_pow3",num_str real_plus_binom_pow3),
30.1237 - (* (a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3 *)
30.1238 - Thm ("real_minus_binom_pow3",num_str real_minus_binom_pow3),
30.1239 - (* (a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3 *)
30.1240 -
30.1241 -
30.1242 - (* Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
30.1243 - (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
30.1244 - Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
30.1245 - (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
30.1246 - Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
30.1247 - (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
30.1248 - Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
30.1249 - (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
30.1250 - *)
30.1251 -
30.1252 - Thm ("real_mult_1",num_str real_mult_1), (*"1 * z = z"*)
30.1253 - Thm ("real_mult_0",num_str real_mult_0), (*"0 * z = 0"*)
30.1254 - Thm ("real_add_zero_left",num_str real_add_zero_left),(*"0 + z = z"*)
30.1255 -
30.1256 - Calc ("op +", eval_binop "#add_"),
30.1257 - Calc ("op *", eval_binop "#mult_"),
30.1258 - Calc ("Atools.pow", eval_binop "#power_"),
30.1259 - (*
30.1260 - Thm ("real_mult_commute",num_str real_mult_commute), (*AC-rewriting*)
30.1261 - Thm ("real_mult_left_commute",num_str real_mult_left_commute), (**)
30.1262 - Thm ("real_mult_assoc",num_str real_mult_assoc), (**)
30.1263 - Thm ("real_add_commute",num_str real_add_commute), (**)
30.1264 - Thm ("real_add_left_commute",num_str real_add_left_commute), (**)
30.1265 - Thm ("real_add_assoc",num_str real_add_assoc), (**)
30.1266 - *)
30.1267 -
30.1268 - Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
30.1269 - (*"r1 * r1 = r1 ^^^ 2"*)
30.1270 - Thm ("realpow_plus_1",num_str realpow_plus_1),
30.1271 - (*"r * r ^^^ n = r ^^^ (n + 1)"*)
30.1272 - (*Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
30.1273 - (*"z1 + z1 = 2 * z1"*)*)
30.1274 - Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
30.1275 - (*"z1 + (z1 + k) = 2 * z1 + k"*)
30.1276 -
30.1277 - Thm ("real_num_collect",num_str real_num_collect),
30.1278 - (*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
30.1279 - Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
30.1280 - (*"[| l is_const; m is_const |] ==> l * n + (m * n + k) = (l + m) * n + k"*)
30.1281 - Thm ("real_one_collect",num_str real_one_collect),
30.1282 - (*"m is_const ==> n + m * n = (1 + m) * n"*)
30.1283 - Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
30.1284 - (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
30.1285 -
30.1286 - Calc ("op +", eval_binop "#add_"),
30.1287 - Calc ("op *", eval_binop "#mult_"),
30.1288 - Calc ("Atools.pow", eval_binop "#power_")
30.1289 - ],
30.1290 - scr = EmptyScr
30.1291 -(*Script ((term_of o the o (parse thy)) scr_expand_binomtest)*)
30.1292 - }:rls;
30.1293 -
30.1294 -
30.1295 -ruleset' := overwritelthy thy (!ruleset',
30.1296 - [("make_polytest", prep_rls make_polytest),
30.1297 - ("expand_binomtest", prep_rls expand_binomtest)
30.1298 - ]);
30.1299 -
30.1300 -
30.1301 -
30.1302 -
30.1303 -
30.1304 -
31.1 --- a/src/Tools/isac/Knowledge/Test.thy Fri Aug 27 10:39:12 2010 +0200
31.2 +++ b/src/Tools/isac/Knowledge/Test.thy Fri Aug 27 14:56:54 2010 +0200
31.3 @@ -1,29 +1,31 @@
31.4 -(* use_thy"Knowledge/Test";
31.5 - *)
31.6 +(* some tests are based on specficially simple scripts etc.
31.7 + Author: Walther Neuper 2003
31.8 + (c) due to copyright terms
31.9 +*)
31.10
31.11 -Test = Atools + Rational + Root + Poly +
31.12 +theory Test imports Atools + Rational + Root + Poly +
31.13
31.14 consts
31.15
31.16 (*"cancel":: [real, real] => real (infixl "'/'/'/" 70) ...divide 2002*)
31.17
31.18 Expand'_binomtest
31.19 - :: "['y, \
31.20 - \ 'y] => 'y"
31.21 - ("((Script Expand'_binomtest (_ =))// \
31.22 - \ (_))" 9)
31.23 + :: "['y,
31.24 + 'y] => 'y"
31.25 + ("((Script Expand'_binomtest (_ =))//
31.26 + (_))" 9)
31.27
31.28 Solve'_univar'_err
31.29 - :: "[bool,real,bool, \
31.30 - \ bool list] => bool list"
31.31 - ("((Script Solve'_univar'_err (_ _ _ =))// \
31.32 - \ (_))" 9)
31.33 + :: "[bool,real,bool,
31.34 + bool list] => bool list"
31.35 + ("((Script Solve'_univar'_err (_ _ _ =))//
31.36 + (_))" 9)
31.37
31.38 Solve'_linear
31.39 - :: "[bool,real, \
31.40 - \ bool list] => bool list"
31.41 - ("((Script Solve'_linear (_ _ =))// \
31.42 - \ (_))" 9)
31.43 + :: "[bool,real,
31.44 + bool list] => bool list"
31.45 + ("((Script Solve'_linear (_ _ =))//
31.46 + (_))" 9)
31.47
31.48 (*17.9.02 aus SqRoot.thy------------------------------vvv---*)
31.49
31.50 @@ -31,32 +33,32 @@
31.51 "contains'_root" :: 'a => bool ("contains'_root _" 10)
31.52
31.53 Solve'_root'_equation
31.54 - :: "[bool,real, \
31.55 - \ bool list] => bool list"
31.56 - ("((Script Solve'_root'_equation (_ _ =))// \
31.57 - \ (_))" 9)
31.58 + :: "[bool,real,
31.59 + bool list] => bool list"
31.60 + ("((Script Solve'_root'_equation (_ _ =))//
31.61 + (_))" 9)
31.62
31.63 Solve'_plain'_square
31.64 - :: "[bool,real, \
31.65 - \ bool list] => bool list"
31.66 - ("((Script Solve'_plain'_square (_ _ =))// \
31.67 - \ (_))" 9)
31.68 + :: "[bool,real,
31.69 + bool list] => bool list"
31.70 + ("((Script Solve'_plain'_square (_ _ =))//
31.71 + (_))" 9)
31.72
31.73 Norm'_univar'_equation
31.74 - :: "[bool,real, \
31.75 - \ bool] => bool"
31.76 - ("((Script Norm'_univar'_equation (_ _ =))// \
31.77 - \ (_))" 9)
31.78 + :: "[bool,real,
31.79 + bool] => bool"
31.80 + ("((Script Norm'_univar'_equation (_ _ =))//
31.81 + (_))" 9)
31.82
31.83 STest'_simplify
31.84 - :: "['z, \
31.85 - \ 'z] => 'z"
31.86 - ("((Script STest'_simplify (_ =))// \
31.87 - \ (_))" 9)
31.88 + :: "['z,
31.89 + 'z] => 'z"
31.90 + ("((Script STest'_simplify (_ =))//
31.91 + (_))" 9)
31.92
31.93 (*17.9.02 aus SqRoot.thy------------------------------^^^---*)
31.94
31.95 -rules (*stated as axioms, todo: prove as theorems*)
31.96 +axioms (*TODO: prove as theorems*)
31.97
31.98 radd_mult_distrib2 "(k::real) * (m + n) = k * m + k * n"
31.99 rdistr_right_assoc "(k::real) + l * n + m * n = k + (l + m) * n"
31.100 @@ -161,9 +163,1292 @@
31.101 "is_root_free a ==> (a = c*sqrt b) = (a + (-1)*c*sqrt b = 0)"
31.102 rroot_to_lhs_add_mult
31.103 "is_root_free a ==> (a = d+c*sqrt b) = (a + (-1)*c*sqrt b = d)"
31.104 -
31.105 -
31.106 (*17.9.02 aus SqRoot.thy------------------------------^^^---*)
31.107
31.108 +ML {*
31.109 +(** evaluation of numerals and predicates **)
31.110 +
31.111 +(*does a term contain a root ?*)
31.112 +fun eval_root_free (thmid:string) _ (t as (Const(op0,t0) $ arg)) thy =
31.113 + if strip_thy op0 <> "is'_root'_free"
31.114 + then raise error ("eval_root_free: wrong "^op0)
31.115 + else if const_in (strip_thy op0) arg
31.116 + then SOME (mk_thmid thmid ""
31.117 + ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
31.118 + Trueprop $ (mk_equality (t, false_as_term)))
31.119 + else SOME (mk_thmid thmid ""
31.120 + ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
31.121 + Trueprop $ (mk_equality (t, true_as_term)))
31.122 + | eval_root_free _ _ _ _ = NONE;
31.123 +
31.124 +(*does a term contain a root ?*)
31.125 +fun eval_contains_root (thmid:string) _
31.126 + (t as (Const("Test.contains'_root",t0) $ arg)) thy =
31.127 + if member op = (ids_of arg) "sqrt"
31.128 + then SOME (mk_thmid thmid ""
31.129 + ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
31.130 + Trueprop $ (mk_equality (t, true_as_term)))
31.131 + else SOME (mk_thmid thmid ""
31.132 + ((Syntax.string_of_term (thy2ctxt thy)) arg) "",
31.133 + Trueprop $ (mk_equality (t, false_as_term)))
31.134 + | eval_contains_root _ _ _ _ = NONE;
31.135 +
31.136 +calclist':= overwritel (!calclist',
31.137 + [("is_root_free", ("Test.is'_root'_free",
31.138 + eval_root_free"#is_root_free_")),
31.139 + ("contains_root", ("Test.contains'_root",
31.140 + eval_contains_root"#contains_root_"))
31.141 + ]);
31.142 +
31.143 +(** term order **)
31.144 +fun term_order (_:subst) tu = (term_ordI [] tu = LESS);
31.145 +
31.146 +(** rule sets **)
31.147 +
31.148 +val testerls =
31.149 + Rls {id = "testerls", preconds = [], rew_ord = ("termlessI",termlessI),
31.150 + erls = e_rls, srls = Erls,
31.151 + calc = [],
31.152 + rules = [Thm ("refl",num_str refl),
31.153 + Thm ("le_refl",num_str le_refl),
31.154 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
31.155 + Thm ("not_true",num_str not_true),
31.156 + Thm ("not_false",num_str not_false),
31.157 + Thm ("and_true",and_true),
31.158 + Thm ("and_false",and_false),
31.159 + Thm ("or_true",or_true),
31.160 + Thm ("or_false",or_false),
31.161 + Thm ("and_commute",num_str and_commute),
31.162 + Thm ("or_commute",num_str or_commute),
31.163 +
31.164 + Calc ("Atools.is'_const",eval_const "#is_const_"),
31.165 + Calc ("Tools.matches",eval_matches ""),
31.166 +
31.167 + Calc ("op +",eval_binop "#add_"),
31.168 + Calc ("op *",eval_binop "#mult_"),
31.169 + Calc ("Atools.pow" ,eval_binop "#power_"),
31.170 +
31.171 + Calc ("op <",eval_equ "#less_"),
31.172 + Calc ("op <=",eval_equ "#less_equal_"),
31.173 +
31.174 + Calc ("Atools.ident",eval_ident "#ident_")],
31.175 + scr = Script ((term_of o the o (parse thy))
31.176 + "empty_script")
31.177 + }:rls;
31.178 +
31.179 +(*.for evaluation of conditions in rewrite rules.*)
31.180 +(*FIXXXXXXME 10.8.02: handle like _simplify*)
31.181 +val tval_rls =
31.182 + Rls{id = "tval_rls", preconds = [],
31.183 + rew_ord = ("sqrt_right",sqrt_right false (theory "Pure")),
31.184 + erls=testerls,srls = e_rls,
31.185 + calc=[],
31.186 + rules = [Thm ("refl",num_str refl),
31.187 + Thm ("le_refl",num_str le_refl),
31.188 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
31.189 + Thm ("not_true",num_str not_true),
31.190 + Thm ("not_false",num_str not_false),
31.191 + Thm ("and_true",and_true),
31.192 + Thm ("and_false",and_false),
31.193 + Thm ("or_true",or_true),
31.194 + Thm ("or_false",or_false),
31.195 + Thm ("and_commute",num_str and_commute),
31.196 + Thm ("or_commute",num_str or_commute),
31.197 +
31.198 + Thm ("real_diff_minus",num_str real_diff_minus),
31.199 +
31.200 + Thm ("root_ge0",num_str root_ge0),
31.201 + Thm ("root_add_ge0",num_str root_add_ge0),
31.202 + Thm ("root_ge0_1",num_str root_ge0_1),
31.203 + Thm ("root_ge0_2",num_str root_ge0_2),
31.204 +
31.205 + Calc ("Atools.is'_const",eval_const "#is_const_"),
31.206 + Calc ("Test.is'_root'_free",eval_root_free "#is_root_free_"),
31.207 + Calc ("Tools.matches",eval_matches ""),
31.208 + Calc ("Test.contains'_root",
31.209 + eval_contains_root"#contains_root_"),
31.210 +
31.211 + Calc ("op +",eval_binop "#add_"),
31.212 + Calc ("op *",eval_binop "#mult_"),
31.213 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
31.214 + Calc ("Atools.pow" ,eval_binop "#power_"),
31.215 +
31.216 + Calc ("op <",eval_equ "#less_"),
31.217 + Calc ("op <=",eval_equ "#less_equal_"),
31.218 +
31.219 + Calc ("Atools.ident",eval_ident "#ident_")],
31.220 + scr = Script ((term_of o the o (parse thy))
31.221 + "empty_script")
31.222 + }:rls;
31.223 +
31.224 +
31.225 +ruleset' := overwritelthy thy (!ruleset',
31.226 + [("testerls", prep_rls testerls)
31.227 + ]);
31.228 +
31.229 +
31.230 +(*make () dissappear*)
31.231 +val rearrange_assoc =
31.232 + Rls{id = "rearrange_assoc", preconds = [],
31.233 + rew_ord = ("e_rew_ord",e_rew_ord),
31.234 + erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
31.235 + rules =
31.236 + [Thm ("sym_radd_assoc",num_str (radd_assoc RS sym)),
31.237 + Thm ("sym_rmult_assoc",num_str (rmult_assoc RS sym))],
31.238 + scr = Script ((term_of o the o (parse thy))
31.239 + "empty_script")
31.240 + }:rls;
31.241 +
31.242 +val ac_plus_times =
31.243 + Rls{id = "ac_plus_times", preconds = [], rew_ord = ("term_order",term_order),
31.244 + erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
31.245 + rules =
31.246 + [Thm ("radd_commute",radd_commute),
31.247 + Thm ("radd_left_commute",radd_left_commute),
31.248 + Thm ("radd_assoc",radd_assoc),
31.249 + Thm ("rmult_commute",rmult_commute),
31.250 + Thm ("rmult_left_commute",rmult_left_commute),
31.251 + Thm ("rmult_assoc",rmult_assoc)],
31.252 + scr = Script ((term_of o the o (parse thy))
31.253 + "empty_script")
31.254 + }:rls;
31.255 +
31.256 +(*todo: replace by Rewrite("rnorm_equation_add",num_str rnorm_equation_add)*)
31.257 +val norm_equation =
31.258 + Rls{id = "norm_equation", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
31.259 + erls = tval_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
31.260 + rules = [Thm ("rnorm_equation_add",num_str rnorm_equation_add)
31.261 + ],
31.262 + scr = Script ((term_of o the o (parse thy))
31.263 + "empty_script")
31.264 + }:rls;
31.265 +
31.266 +(** rule sets **)
31.267 +
31.268 +val STest_simplify = (* vv--- not changed to real by parse*)
31.269 + "Script STest_simplify (t_::'z) = " ^
31.270 + "(Repeat" ^
31.271 + " ((Try (Repeat (Rewrite real_diff_minus False))) @@ " ^
31.272 + " (Try (Repeat (Rewrite radd_mult_distrib2 False))) @@ " ^
31.273 + " (Try (Repeat (Rewrite rdistr_right_assoc False))) @@ " ^
31.274 + " (Try (Repeat (Rewrite rdistr_right_assoc_p False))) @@" ^
31.275 + " (Try (Repeat (Rewrite rdistr_div_right False))) @@ " ^
31.276 + " (Try (Repeat (Rewrite rbinom_power_2 False))) @@ " ^
31.277 +
31.278 + " (Try (Repeat (Rewrite radd_commute False))) @@ " ^
31.279 + " (Try (Repeat (Rewrite radd_left_commute False))) @@ " ^
31.280 + " (Try (Repeat (Rewrite radd_assoc False))) @@ " ^
31.281 + " (Try (Repeat (Rewrite rmult_commute False))) @@ " ^
31.282 + " (Try (Repeat (Rewrite rmult_left_commute False))) @@ " ^
31.283 + " (Try (Repeat (Rewrite rmult_assoc False))) @@ " ^
31.284 +
31.285 + " (Try (Repeat (Rewrite radd_real_const_eq False))) @@ " ^
31.286 + " (Try (Repeat (Rewrite radd_real_const False))) @@ " ^
31.287 + " (Try (Repeat (Calculate plus))) @@ " ^
31.288 + " (Try (Repeat (Calculate times))) @@ " ^
31.289 + " (Try (Repeat (Calculate divide_))) @@" ^
31.290 + " (Try (Repeat (Calculate power_))) @@ " ^
31.291 +
31.292 + " (Try (Repeat (Rewrite rcollect_right False))) @@ " ^
31.293 + " (Try (Repeat (Rewrite rcollect_one_left False))) @@ " ^
31.294 + " (Try (Repeat (Rewrite rcollect_one_left_assoc False))) @@ " ^
31.295 + " (Try (Repeat (Rewrite rcollect_one_left_assoc_p False))) @@ " ^
31.296 +
31.297 + " (Try (Repeat (Rewrite rshift_nominator False))) @@ " ^
31.298 + " (Try (Repeat (Rewrite rcancel_den False))) @@ " ^
31.299 + " (Try (Repeat (Rewrite rroot_square_inv False))) @@ " ^
31.300 + " (Try (Repeat (Rewrite rroot_times_root False))) @@ " ^
31.301 + " (Try (Repeat (Rewrite rroot_times_root_assoc_p False))) @@ " ^
31.302 + " (Try (Repeat (Rewrite rsqare False))) @@ " ^
31.303 + " (Try (Repeat (Rewrite power_1 False))) @@ " ^
31.304 + " (Try (Repeat (Rewrite rtwo_of_the_same False))) @@ " ^
31.305 + " (Try (Repeat (Rewrite rtwo_of_the_same_assoc_p False))) @@ " ^
31.306 +
31.307 + " (Try (Repeat (Rewrite rmult_1 False))) @@ " ^
31.308 + " (Try (Repeat (Rewrite rmult_1_right False))) @@ " ^
31.309 + " (Try (Repeat (Rewrite rmult_0 False))) @@ " ^
31.310 + " (Try (Repeat (Rewrite rmult_0_right False))) @@ " ^
31.311 + " (Try (Repeat (Rewrite radd_0 False))) @@ " ^
31.312 + " (Try (Repeat (Rewrite radd_0_right False)))) " ^
31.313 + " t_)";
31.314 +
31.315 +
31.316 +(* expects * distributed over + *)
31.317 +val Test_simplify =
31.318 + Rls{id = "Test_simplify", preconds = [],
31.319 + rew_ord = ("sqrt_right",sqrt_right false (theory "Pure")),
31.320 + erls = tval_rls, srls = e_rls,
31.321 + calc=[(*since 040209 filled by prep_rls*)],
31.322 + (*asm_thm = [],*)
31.323 + rules = [
31.324 + Thm ("real_diff_minus",num_str real_diff_minus),
31.325 + Thm ("radd_mult_distrib2",num_str radd_mult_distrib2),
31.326 + Thm ("rdistr_right_assoc",num_str rdistr_right_assoc),
31.327 + Thm ("rdistr_right_assoc_p",num_str rdistr_right_assoc_p),
31.328 + Thm ("rdistr_div_right",num_str rdistr_div_right),
31.329 + Thm ("rbinom_power_2",num_str rbinom_power_2),
31.330 +
31.331 + Thm ("radd_commute",num_str radd_commute),
31.332 + Thm ("radd_left_commute",num_str radd_left_commute),
31.333 + Thm ("radd_assoc",num_str radd_assoc),
31.334 + Thm ("rmult_commute",num_str rmult_commute),
31.335 + Thm ("rmult_left_commute",num_str rmult_left_commute),
31.336 + Thm ("rmult_assoc",num_str rmult_assoc),
31.337 +
31.338 + Thm ("radd_real_const_eq",num_str radd_real_const_eq),
31.339 + Thm ("radd_real_const",num_str radd_real_const),
31.340 + (* these 2 rules are invers to distr_div_right wrt. termination.
31.341 + thus they MUST be done IMMEDIATELY before calc *)
31.342 + Calc ("op +", eval_binop "#add_"),
31.343 + Calc ("op *", eval_binop "#mult_"),
31.344 + Calc ("HOL.divide", eval_cancel "#divide_"),
31.345 + Calc ("Atools.pow", eval_binop "#power_"),
31.346 +
31.347 + Thm ("rcollect_right",num_str rcollect_right),
31.348 + Thm ("rcollect_one_left",num_str rcollect_one_left),
31.349 + Thm ("rcollect_one_left_assoc",num_str rcollect_one_left_assoc),
31.350 + Thm ("rcollect_one_left_assoc_p",num_str rcollect_one_left_assoc_p),
31.351 +
31.352 + Thm ("rshift_nominator",num_str rshift_nominator),
31.353 + Thm ("rcancel_den",num_str rcancel_den),
31.354 + Thm ("rroot_square_inv",num_str rroot_square_inv),
31.355 + Thm ("rroot_times_root",num_str rroot_times_root),
31.356 + Thm ("rroot_times_root_assoc_p",num_str rroot_times_root_assoc_p),
31.357 + Thm ("rsqare",num_str rsqare),
31.358 + Thm ("power_1",num_str power_1),
31.359 + Thm ("rtwo_of_the_same",num_str rtwo_of_the_same),
31.360 + Thm ("rtwo_of_the_same_assoc_p",num_str rtwo_of_the_same_assoc_p),
31.361 +
31.362 + Thm ("rmult_1",num_str rmult_1),
31.363 + Thm ("rmult_1_right",num_str rmult_1_right),
31.364 + Thm ("rmult_0",num_str rmult_0),
31.365 + Thm ("rmult_0_right",num_str rmult_0_right),
31.366 + Thm ("radd_0",num_str radd_0),
31.367 + Thm ("radd_0_right",num_str radd_0_right)
31.368 + ],
31.369 + scr = Script ((term_of o the o (parse thy)) "empty_script")
31.370 + (*since 040209 filled by prep_rls: STest_simplify*)
31.371 + }:rls;
31.372 +
31.373 +
31.374 +
31.375 +
31.376 +
31.377 +(** rule sets **)
31.378 +
31.379 +
31.380 +
31.381 +(*isolate the root in a root-equation*)
31.382 +val isolate_root =
31.383 + Rls{id = "isolate_root", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
31.384 + erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
31.385 + rules = [Thm ("rroot_to_lhs",num_str rroot_to_lhs),
31.386 + Thm ("rroot_to_lhs_mult",num_str rroot_to_lhs_mult),
31.387 + Thm ("rroot_to_lhs_add_mult",num_str rroot_to_lhs_add_mult),
31.388 + Thm ("risolate_root_add",num_str risolate_root_add),
31.389 + Thm ("risolate_root_mult",num_str risolate_root_mult),
31.390 + Thm ("risolate_root_div",num_str risolate_root_div) ],
31.391 + scr = Script ((term_of o the o (parse thy))
31.392 + "empty_script")
31.393 + }:rls;
31.394 +
31.395 +(*isolate the bound variable in an equation; 'bdv' is a meta-constant*)
31.396 +val isolate_bdv =
31.397 + Rls{id = "isolate_bdv", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
31.398 + erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
31.399 + rules =
31.400 + [Thm ("risolate_bdv_add",num_str risolate_bdv_add),
31.401 + Thm ("risolate_bdv_mult_add",num_str risolate_bdv_mult_add),
31.402 + Thm ("risolate_bdv_mult",num_str risolate_bdv_mult),
31.403 + Thm ("mult_square",num_str mult_square),
31.404 + Thm ("constant_square",num_str constant_square),
31.405 + Thm ("constant_mult_square",num_str constant_mult_square)
31.406 + ],
31.407 + scr = Script ((term_of o the o (parse thy))
31.408 + "empty_script")
31.409 + }:rls;
31.410 +
31.411 +
31.412 +
31.413 +
31.414 +(* association list for calculate_, calculate
31.415 + "op +" etc. not usable in scripts *)
31.416 +val calclist =
31.417 + [
31.418 + (*as Tools.ML*)
31.419 + ("Vars" ,("Tools.Vars" ,eval_var "#Vars_")),
31.420 + ("matches",("Tools.matches",eval_matches "#matches_")),
31.421 + ("lhs" ,("Tools.lhs" ,eval_lhs "")),
31.422 + (*aus Atools.ML*)
31.423 + ("PLUS" ,("op +" ,eval_binop "#add_")),
31.424 + ("TIMES" ,("op *" ,eval_binop "#mult_")),
31.425 + ("DIVIDE" ,("HOL.divide" ,eval_cancel "#divide_")),
31.426 + ("POWER" ,("Atools.pow" ,eval_binop "#power_")),
31.427 + ("is_const",("Atools.is'_const",eval_const "#is_const_")),
31.428 + ("le" ,("op <" ,eval_equ "#less_")),
31.429 + ("leq" ,("op <=" ,eval_equ "#less_equal_")),
31.430 + ("ident" ,("Atools.ident",eval_ident "#ident_")),
31.431 + (*von hier (ehem.SqRoot*)
31.432 + ("sqrt" ,("Root.sqrt" ,eval_sqrt "#sqrt_")),
31.433 + ("Test.is_root_free",("is'_root'_free", eval_root_free"#is_root_free_")),
31.434 + ("Test.contains_root",("contains'_root",
31.435 + eval_contains_root"#contains_root_"))
31.436 + ];
31.437 +
31.438 +ruleset' := overwritelthy thy (!ruleset',
31.439 + [("Test_simplify", prep_rls Test_simplify),
31.440 + ("tval_rls", prep_rls tval_rls),
31.441 + ("isolate_root", prep_rls isolate_root),
31.442 + ("isolate_bdv", prep_rls isolate_bdv),
31.443 + ("matches",
31.444 + prep_rls (append_rls "matches" testerls
31.445 + [Calc ("Tools.matches",eval_matches "#matches_")]))
31.446 + ]);
31.447 +
31.448 +(** problem types **)
31.449 +store_pbt
31.450 + (prep_pbt (theory "Test") "pbl_test" [] e_pblID
31.451 + (["test"],
31.452 + [],
31.453 + e_rls, NONE, []));
31.454 +store_pbt
31.455 + (prep_pbt (theory "Test") "pbl_test_equ" [] e_pblID
31.456 + (["equation","test"],
31.457 + [("#Given" ,["equality e_","solveFor v_"]),
31.458 + ("#Where" ,["matches (?a = ?b) e_"]),
31.459 + ("#Find" ,["solutions v_i_"])
31.460 + ],
31.461 + assoc_rls "matches",
31.462 + SOME "solve (e_::bool, v_)", []));
31.463 +
31.464 +store_pbt
31.465 + (prep_pbt (theory "Test") "pbl_test_uni" [] e_pblID
31.466 + (["univariate","equation","test"],
31.467 + [("#Given" ,["equality e_","solveFor v_"]),
31.468 + ("#Where" ,["matches (?a = ?b) e_"]),
31.469 + ("#Find" ,["solutions v_i_"])
31.470 + ],
31.471 + assoc_rls "matches",
31.472 + SOME "solve (e_::bool, v_)", []));
31.473 +
31.474 +store_pbt
31.475 + (prep_pbt (theory "Test") "pbl_test_uni_lin" [] e_pblID
31.476 + (["linear","univariate","equation","test"],
31.477 + [("#Given" ,["equality e_","solveFor v_"]),
31.478 + ("#Where" ,["(matches ( v_ = 0) e_) | (matches ( ?b*v_ = 0) e_) |" ^
31.479 + "(matches (?a+v_ = 0) e_) | (matches (?a+?b*v_ = 0) e_) "]),
31.480 + ("#Find" ,["solutions v_i_"])
31.481 + ],
31.482 + assoc_rls "matches",
31.483 + SOME "solve (e_::bool, v_)", [["Test","solve_linear"]]));
31.484 +
31.485 +(*25.8.01 ------
31.486 +store_pbt
31.487 + (prep_pbt (theory "Test")
31.488 + (["(theory "Test")"],
31.489 + [("#Given" ,"boolTestGiven g_"),
31.490 + ("#Find" ,"boolTestFind f_")
31.491 + ],
31.492 + []));
31.493 +
31.494 +store_pbt
31.495 + (prep_pbt (theory "Test")
31.496 + (["testeq","(theory "Test")"],
31.497 + [("#Given" ,"boolTestGiven g_"),
31.498 + ("#Find" ,"boolTestFind f_")
31.499 + ],
31.500 + []));
31.501 +
31.502 +
31.503 +val ttt = (term_of o the o (parse (theory "Isac"))) "(matches ( v_ = 0) e_)";
31.504 +
31.505 + ------ 25.8.01*)
31.506 +
31.507 +
31.508 +(** methods **)
31.509 +store_met
31.510 + (prep_met (theory "Diff") "met_test" [] e_metID
31.511 + (["Test"],
31.512 + [],
31.513 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
31.514 + crls=Atools_erls, nrls=e_rls(*,
31.515 + asm_rls=[],asm_thm=[]*)}, "empty_script"));
31.516 +(*
31.517 +store_met
31.518 + (prep_met (theory "Script")
31.519 + (e_metID,(*empty method*)
31.520 + [],
31.521 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
31.522 + asm_rls=[],asm_thm=[]},
31.523 + "Undef"));*)
31.524 +store_met
31.525 + (prep_met (theory "Test") "met_test_solvelin" [] e_metID
31.526 + (["Test","solve_linear"]:metID,
31.527 + [("#Given" ,["equality e_","solveFor v_"]),
31.528 + ("#Where" ,["matches (?a = ?b) e_"]),
31.529 + ("#Find" ,["solutions v_i_"])
31.530 + ],
31.531 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,
31.532 + prls=assoc_rls "matches",
31.533 + calc=[],
31.534 + crls=tval_rls, nrls=Test_simplify},
31.535 + "Script Solve_linear (e_::bool) (v_::real)= " ^
31.536 + "(let e_ =" ^
31.537 + " Repeat" ^
31.538 + " (((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@" ^
31.539 + " (Rewrite_Set Test_simplify False))) e_" ^
31.540 + " in [e_::bool])"
31.541 + )
31.542 +(*, prep_met (theory "Test") (*test for equations*)
31.543 + (["Test","testeq"]:metID,
31.544 + [("#Given" ,["boolTestGiven g_"]),
31.545 + ("#Find" ,["boolTestFind f_"])
31.546 + ],
31.547 + {rew_ord'="e_rew_ord",rls'="tval_rls",asm_rls=[],
31.548 + asm_thm=[("square_equation_left","")]},
31.549 + "Script Testeq (eq_::bool) = " ^
31.550 + "Repeat " ^
31.551 + " (let e_ = Try (Repeat (Rewrite rroot_square_inv False eq_)); " ^
31.552 + " e_ = Try (Repeat (Rewrite square_equation_left True e_)); " ^
31.553 + " e_ = Try (Repeat (Rewrite rmult_0 False e_)) " ^
31.554 + " in e_) Until (is_root_free e_)" (*deleted*)
31.555 + )
31.556 +, ---------27.4.02*)
31.557 +);
31.558 +
31.559 +
31.560 +
31.561 +
31.562 +ruleset' := overwritelthy thy (!ruleset',
31.563 + [("norm_equation", prep_rls norm_equation),
31.564 + ("ac_plus_times", prep_rls ac_plus_times),
31.565 + ("rearrange_assoc", prep_rls rearrange_assoc)
31.566 + ]);
31.567 +
31.568 +
31.569 +fun bin_o (Const (op_,(Type ("fun",
31.570 + [Type (s2,[]),Type ("fun",
31.571 + [Type (s4,tl4),Type (s5,tl5)])])))) =
31.572 + if (s2=s4)andalso(s4=s5)then[op_]else[]
31.573 + | bin_o _ = [];
31.574 +
31.575 +fun bin_op (t1 $ t2) = union op = (bin_op t1) (bin_op t2)
31.576 + | bin_op t = bin_o t;
31.577 +fun is_bin_op t = ((bin_op t)<>[]);
31.578 +
31.579 +fun bin_op_arg1 ((Const (op_,(Type ("fun",
31.580 + [Type (s2,[]),Type ("fun",
31.581 + [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) =
31.582 + arg1;
31.583 +fun bin_op_arg2 ((Const (op_,(Type ("fun",
31.584 + [Type (s2,[]),Type ("fun",
31.585 + [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) =
31.586 + arg2;
31.587 +
31.588 +
31.589 +exception NO_EQUATION_TERM;
31.590 +fun is_equation ((Const ("op =",(Type ("fun",
31.591 + [Type (_,[]),Type ("fun",
31.592 + [Type (_,[]),Type ("bool",[])])])))) $ _ $ _)
31.593 + = true
31.594 + | is_equation _ = false;
31.595 +fun equ_lhs ((Const ("op =",(Type ("fun",
31.596 + [Type (_,[]),Type ("fun",
31.597 + [Type (_,[]),Type ("bool",[])])])))) $ l $ r)
31.598 + = l
31.599 + | equ_lhs _ = raise NO_EQUATION_TERM;
31.600 +fun equ_rhs ((Const ("op =",(Type ("fun",
31.601 + [Type (_,[]),Type ("fun",
31.602 + [Type (_,[]),Type ("bool",[])])])))) $ l $ r)
31.603 + = r
31.604 + | equ_rhs _ = raise NO_EQUATION_TERM;
31.605 +
31.606 +
31.607 +fun atom (Const (_,Type (_,[]))) = true
31.608 + | atom (Free (_,Type (_,[]))) = true
31.609 + | atom (Var (_,Type (_,[]))) = true
31.610 +(*| atom (_ (_,"?DUMMY" )) = true ..ML-error *)
31.611 + | atom((Const ("Bin.integ_of_bin",_)) $ _) = true
31.612 + | atom _ = false;
31.613 +
31.614 +fun varids (Const (s,Type (_,[]))) = [strip_thy s]
31.615 + | varids (Free (s,Type (_,[]))) = if is_no s then []
31.616 + else [strip_thy s]
31.617 + | varids (Var((s,_),Type (_,[]))) = [strip_thy s]
31.618 +(*| varids (_ (s,"?DUMMY" )) = ..ML-error *)
31.619 + | varids((Const ("Bin.integ_of_bin",_)) $ _)= [](*8.01: superfluous?*)
31.620 + | varids (Abs(a,T,t)) = union op = [a] (varids t)
31.621 + | varids (t1 $ t2) = union op = (varids t1) (varids t2)
31.622 + | varids _ = [];
31.623 +(*> val t = term_of (hd (parse Diophant.thy "x"));
31.624 +val t = Free ("x","?DUMMY") : term
31.625 +> varids t;
31.626 +val it = [] : string list [] !!! *)
31.627 +
31.628 +
31.629 +fun bin_ops_only ((Const op_) $ t1 $ t2) =
31.630 + if(is_bin_op (Const op_))
31.631 + then(bin_ops_only t1)andalso(bin_ops_only t2)
31.632 + else false
31.633 + | bin_ops_only t =
31.634 + if atom t then true else bin_ops_only t;
31.635 +
31.636 +fun polynomial opl t bdVar = (* bdVar TODO *)
31.637 + subset op = (bin_op t, opl) andalso (bin_ops_only t);
31.638 +
31.639 +fun poly_equ opl bdVar t = is_equation t (* bdVar TODO *)
31.640 + andalso polynomial opl (equ_lhs t) bdVar
31.641 + andalso polynomial opl (equ_rhs t) bdVar
31.642 + andalso (subset op = (varids bdVar, varids (equ_lhs t)) orelse
31.643 + subset op = (varids bdVar, varids (equ_lhs t)));
31.644 +
31.645 +(*fun max is =
31.646 + let fun max_ m [] = m
31.647 + | max_ m (i::is) = if m<i then max_ i is else max_ m is;
31.648 + in max_ (hd is) is end;
31.649 +> max [1,5,3,7,4,2];
31.650 +val it = 7 : int *)
31.651 +
31.652 +fun max (a,b) = if a < b then b else a;
31.653 +
31.654 +fun degree addl mul bdVar t =
31.655 +let
31.656 +fun deg _ _ v (Const (s,Type (_,[]))) = if v=strip_thy s then 1 else 0
31.657 + | deg _ _ v (Free (s,Type (_,[]))) = if v=strip_thy s then 1 else 0
31.658 + | deg _ _ v (Var((s,_),Type (_,[]))) = if v=strip_thy s then 1 else 0
31.659 +(*| deg _ _ v (_ (s,"?DUMMY" )) = ..ML-error *)
31.660 + | deg _ _ v((Const ("Bin.integ_of_bin",_)) $ _ )= 0
31.661 + | deg addl mul v (h $ t1 $ t2) =
31.662 + if subset op = (bin_op h, addl)
31.663 + then max (deg addl mul v t1 ,deg addl mul v t2)
31.664 + else (*mul!*)(deg addl mul v t1)+(deg addl mul v t2)
31.665 +in if polynomial (addl @ [mul]) t bdVar
31.666 + then SOME (deg addl mul (id_of bdVar) t) else (NONE:int option)
31.667 +end;
31.668 +fun degree_ addl mul bdVar t = (* do not export *)
31.669 + let fun opt (SOME i)= i
31.670 + | opt NONE = 0
31.671 +in opt (degree addl mul bdVar t) end;
31.672 +
31.673 +
31.674 +fun linear addl mul t bdVar = (degree_ addl mul bdVar t)<2;
31.675 +
31.676 +fun linear_equ addl mul bdVar t =
31.677 + if is_equation t
31.678 + then let val degl = degree_ addl mul bdVar (equ_lhs t);
31.679 + val degr = degree_ addl mul bdVar (equ_rhs t)
31.680 + in if (degl>0 orelse degr>0)andalso max(degl,degr)<2
31.681 + then true else false
31.682 + end
31.683 + else false;
31.684 +(* strip_thy op_ before *)
31.685 +fun is_div_op (dv,(Const (op_,(Type ("fun",
31.686 + [Type (s2,[]),Type ("fun",
31.687 + [Type (s4,tl4),Type (s5,tl5)])])))) )= (dv = strip_thy op_)
31.688 + | is_div_op _ = false;
31.689 +
31.690 +fun is_denom bdVar div_op t =
31.691 + let fun is bool[v]dv (Const (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
31.692 + | is bool[v]dv (Free (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
31.693 + | is bool[v]dv (Var((s,_),Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
31.694 + | is bool[v]dv((Const ("Bin.integ_of_bin",_)) $ _) = false
31.695 + | is bool[v]dv (h$n$d) =
31.696 + if is_div_op(dv,h)
31.697 + then (is false[v]dv n)orelse(is true[v]dv d)
31.698 + else (is bool [v]dv n)orelse(is bool[v]dv d)
31.699 +in is false (varids bdVar) (strip_thy div_op) t end;
31.700 +
31.701 +
31.702 +fun rational t div_op bdVar =
31.703 + is_denom bdVar div_op t andalso bin_ops_only t;
31.704 +
31.705 +
31.706 +
31.707 +(** problem types **)
31.708 +
31.709 +store_pbt
31.710 + (prep_pbt (theory "Test") "pbl_test_uni_plain2" [] e_pblID
31.711 + (["plain_square","univariate","equation","test"],
31.712 + [("#Given" ,["equality e_","solveFor v_"]),
31.713 + ("#Where" ,["(matches (?a + ?b*v_ ^^^2 = 0) e_) |" ^
31.714 + "(matches ( ?b*v_ ^^^2 = 0) e_) |" ^
31.715 + "(matches (?a + v_ ^^^2 = 0) e_) |" ^
31.716 + "(matches ( v_ ^^^2 = 0) e_)"]),
31.717 + ("#Find" ,["solutions v_i_"])
31.718 + ],
31.719 + assoc_rls "matches",
31.720 + SOME "solve (e_::bool, v_)", [["Test","solve_plain_square"]]));
31.721 +(*
31.722 + val e_ = (term_of o the o (parse thy)) "e_::bool";
31.723 + val ve = (term_of o the o (parse thy)) "4 + 3*x^^^2 = 0";
31.724 + val env = [(e_,ve)];
31.725 +
31.726 + val pre = (term_of o the o (parse thy))
31.727 + "(matches (a + b*v_ ^^^2 = 0, e_::bool)) |" ^
31.728 + "(matches ( b*v_ ^^^2 = 0, e_::bool)) |" ^
31.729 + "(matches (a + v_ ^^^2 = 0, e_::bool)) |" ^
31.730 + "(matches ( v_ ^^^2 = 0, e_::bool))";
31.731 + val prei = subst_atomic env pre;
31.732 + val cpre = (cterm_of thy) prei;
31.733 +
31.734 + val SOME (ct,_) = rewrite_set_ thy false tval_rls cpre;
31.735 +val ct = "True | False | False | False" : cterm
31.736 +
31.737 +> val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
31.738 +> val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
31.739 +> val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
31.740 +val ct = "True" : cterm
31.741 +
31.742 +*)
31.743 +
31.744 +store_pbt
31.745 + (prep_pbt (theory "Test") "pbl_test_uni_poly" [] e_pblID
31.746 + (["polynomial","univariate","equation","test"],
31.747 + [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
31.748 + ("#Where" ,["False"]),
31.749 + ("#Find" ,["solutions v_i_"])
31.750 + ],
31.751 + e_rls, SOME "solve (e_::bool, v_)", []));
31.752 +
31.753 +store_pbt
31.754 + (prep_pbt (theory "Test") "pbl_test_uni_poly_deg2" [] e_pblID
31.755 + (["degree_two","polynomial","univariate","equation","test"],
31.756 + [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
31.757 + ("#Find" ,["solutions v_i_"])
31.758 + ],
31.759 + e_rls, SOME "solve (v_ ^^^2 + p_ * v_ + q__ = 0, v_)", []));
31.760 +
31.761 +store_pbt
31.762 + (prep_pbt (theory "Test") "pbl_test_uni_poly_deg2_pq" [] e_pblID
31.763 + (["pq_formula","degree_two","polynomial","univariate","equation","test"],
31.764 + [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
31.765 + ("#Find" ,["solutions v_i_"])
31.766 + ],
31.767 + e_rls, SOME "solve (v_ ^^^2 + p_ * v_ + q__ = 0, v_)", []));
31.768 +
31.769 +store_pbt
31.770 + (prep_pbt (theory "Test") "pbl_test_uni_poly_deg2_abc" [] e_pblID
31.771 + (["abc_formula","degree_two","polynomial","univariate","equation","test"],
31.772 + [("#Given" ,["equality (a_ * x ^^^2 + b_ * x + c_ = 0)","solveFor v_"]),
31.773 + ("#Find" ,["solutions v_i_"])
31.774 + ],
31.775 + e_rls, SOME "solve (a_ * x ^^^2 + b_ * x + c_ = 0, v_)", []));
31.776 +
31.777 +store_pbt
31.778 + (prep_pbt (theory "Test") "pbl_test_uni_root" [] e_pblID
31.779 + (["squareroot","univariate","equation","test"],
31.780 + [("#Given" ,["equality e_","solveFor v_"]),
31.781 + ("#Where" ,["contains_root (e_::bool)"]),
31.782 + ("#Find" ,["solutions v_i_"])
31.783 + ],
31.784 + append_rls "contains_root" e_rls [Calc ("Test.contains'_root",
31.785 + eval_contains_root "#contains_root_")],
31.786 + SOME "solve (e_::bool, v_)", [["Test","square_equation"]]));
31.787 +
31.788 +store_pbt
31.789 + (prep_pbt (theory "Test") "pbl_test_uni_norm" [] e_pblID
31.790 + (["normalize","univariate","equation","test"],
31.791 + [("#Given" ,["equality e_","solveFor v_"]),
31.792 + ("#Where" ,[]),
31.793 + ("#Find" ,["solutions v_i_"])
31.794 + ],
31.795 + e_rls, SOME "solve (e_::bool, v_)", [["Test","norm_univar_equation"]]));
31.796 +
31.797 +store_pbt
31.798 + (prep_pbt (theory "Test") "pbl_test_uni_roottest" [] e_pblID
31.799 + (["sqroot-test","univariate","equation","test"],
31.800 + [("#Given" ,["equality e_","solveFor v_"]),
31.801 + (*("#Where" ,["contains_root (e_::bool)"]),*)
31.802 + ("#Find" ,["solutions v_i_"])
31.803 + ],
31.804 + e_rls, SOME "solve (e_::bool, v_)", []));
31.805 +
31.806 +(*
31.807 +(#ppc o get_pbt) ["sqroot-test","univariate","equation"];
31.808 + *)
31.809 +
31.810 +
31.811 +store_met
31.812 + (prep_met (theory "Test") "met_test_sqrt" [] e_metID
31.813 +(*root-equation, version for tests before 8.01.01*)
31.814 + (["Test","sqrt-equ-test"]:metID,
31.815 + [("#Given" ,["equality e_","solveFor v_"]),
31.816 + ("#Where" ,["contains_root (e_::bool)"]),
31.817 + ("#Find" ,["solutions v_i_"])
31.818 + ],
31.819 + {rew_ord'="e_rew_ord",rls'=tval_rls,
31.820 + srls =append_rls "srls_contains_root" e_rls
31.821 + [Calc ("Test.contains'_root",eval_contains_root "")],
31.822 + prls =append_rls "prls_contains_root" e_rls
31.823 + [Calc ("Test.contains'_root",eval_contains_root "")],
31.824 + calc=[],
31.825 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
31.826 + asm_thm=[("square_equation_left",""),
31.827 + ("square_equation_right","")]*)},
31.828 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.829 + "(let e_ = " ^
31.830 + " ((While (contains_root e_) Do" ^
31.831 + " ((Rewrite square_equation_left True) @@" ^
31.832 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.833 + " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
31.834 + " (Try (Rewrite_Set isolate_root False)) @@" ^
31.835 + " (Try (Rewrite_Set Test_simplify False)))) @@" ^
31.836 + " (Try (Rewrite_Set norm_equation False)) @@" ^
31.837 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.838 + " (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@" ^
31.839 + " (Try (Rewrite_Set Test_simplify False)))" ^
31.840 + " e_" ^
31.841 + " in [e_::bool])"
31.842 + ));
31.843 +
31.844 +store_met
31.845 + (prep_met (theory "Test") "met_test_sqrt2" [] e_metID
31.846 +(*root-equation ... for test-*.sml until 8.01*)
31.847 + (["Test","squ-equ-test2"]:metID,
31.848 + [("#Given" ,["equality e_","solveFor v_"]),
31.849 + ("#Find" ,["solutions v_i_"])
31.850 + ],
31.851 + {rew_ord'="e_rew_ord",rls'=tval_rls,
31.852 + srls = append_rls "srls_contains_root" e_rls
31.853 + [Calc ("Test.contains'_root",eval_contains_root"")],
31.854 + prls=e_rls,calc=[],
31.855 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
31.856 + asm_thm=[("square_equation_left",""),
31.857 + ("square_equation_right","")]*)},
31.858 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.859 + "(let e_ = " ^
31.860 + " ((While (contains_root e_) Do" ^
31.861 + " ((Rewrite square_equation_left True) @@" ^
31.862 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.863 + " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
31.864 + " (Try (Rewrite_Set isolate_root False)) @@" ^
31.865 + " (Try (Rewrite_Set Test_simplify False)))) @@" ^
31.866 + " (Try (Rewrite_Set norm_equation False)) @@" ^
31.867 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.868 + " (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@" ^
31.869 + " (Try (Rewrite_Set Test_simplify False)))" ^
31.870 + " e_;" ^
31.871 + " (L_::bool list) = Tac subproblem_equation_dummy; " ^
31.872 + " L_ = Tac solve_equation_dummy " ^
31.873 + " in Check_elementwise L_ {(v_::real). Assumptions})"
31.874 + ));
31.875 +
31.876 +store_met
31.877 + (prep_met (theory "Test") "met_test_squ_sub" [] e_metID
31.878 +(*tests subproblem fixed linear*)
31.879 + (["Test","squ-equ-test-subpbl1"]:metID,
31.880 + [("#Given" ,["equality e_","solveFor v_"]),
31.881 + ("#Find" ,["solutions v_i_"])
31.882 + ],
31.883 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
31.884 + crls=tval_rls, nrls=Test_simplify},
31.885 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.886 + " (let e_ = ((Try (Rewrite_Set norm_equation False)) @@ " ^
31.887 + " (Try (Rewrite_Set Test_simplify False))) e_; " ^
31.888 + "(L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test]," ^
31.889 + " [Test,solve_linear]) [bool_ e_, real_ v_])" ^
31.890 + "in Check_elementwise L_ {(v_::real). Assumptions})"
31.891 + ));
31.892 +
31.893 +store_met
31.894 + (prep_met (theory "Test") "met_test_squ_sub2" [] e_metID
31.895 + (*tests subproblem fixed degree 2*)
31.896 + (["Test","squ-equ-test-subpbl2"]:metID,
31.897 + [("#Given" ,["equality e_","solveFor v_"]),
31.898 + ("#Find" ,["solutions v_i_"])
31.899 + ],
31.900 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
31.901 + crls=tval_rls, nrls=e_rls(*,
31.902 + asm_rls=[],asm_thm=[("square_equation_left",""),
31.903 + ("square_equation_right","")]*)},
31.904 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.905 + " (let e_ = Try (Rewrite_Set norm_equation False) e_; " ^
31.906 + "(L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test]," ^
31.907 + " [Test,solve_by_pq_formula]) [bool_ e_, real_ v_])" ^
31.908 + "in Check_elementwise L_ {(v_::real). Assumptions})"
31.909 + ));
31.910 +
31.911 +store_met
31.912 + (prep_met (theory "Test") "met_test_squ_nonterm" [] e_metID
31.913 + (*root-equation: see foils..., but notTerminating*)
31.914 + (["Test","square_equation...notTerminating"]:metID,
31.915 + [("#Given" ,["equality e_","solveFor v_"]),
31.916 + ("#Find" ,["solutions v_i_"])
31.917 + ],
31.918 + {rew_ord'="e_rew_ord",rls'=tval_rls,
31.919 + srls = append_rls "srls_contains_root" e_rls
31.920 + [Calc ("Test.contains'_root",eval_contains_root"")],
31.921 + prls=e_rls,calc=[],
31.922 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
31.923 + asm_thm=[("square_equation_left",""),
31.924 + ("square_equation_right","")]*)},
31.925 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.926 + "(let e_ = " ^
31.927 + " ((While (contains_root e_) Do" ^
31.928 + " ((Rewrite square_equation_left True) @@" ^
31.929 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.930 + " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
31.931 + " (Try (Rewrite_Set isolate_root False)) @@" ^
31.932 + " (Try (Rewrite_Set Test_simplify False)))) @@" ^
31.933 + " (Try (Rewrite_Set norm_equation False)) @@" ^
31.934 + " (Try (Rewrite_Set Test_simplify False)))" ^
31.935 + " e_;" ^
31.936 + " (L_::bool list) = " ^
31.937 + " (SubProblem (Test_,[linear,univariate,equation,test]," ^
31.938 + " [Test,solve_linear]) [bool_ e_, real_ v_])" ^
31.939 + "in Check_elementwise L_ {(v_::real). Assumptions})"
31.940 + ));
31.941 +
31.942 +store_met
31.943 + (prep_met (theory "Test") "met_test_eq1" [] e_metID
31.944 +(*root-equation1:*)
31.945 + (["Test","square_equation1"]:metID,
31.946 + [("#Given" ,["equality e_","solveFor v_"]),
31.947 + ("#Find" ,["solutions v_i_"])
31.948 + ],
31.949 + {rew_ord'="e_rew_ord",rls'=tval_rls,
31.950 + srls = append_rls "srls_contains_root" e_rls
31.951 + [Calc ("Test.contains'_root",eval_contains_root"")],
31.952 + prls=e_rls,calc=[],
31.953 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
31.954 + asm_thm=[("square_equation_left",""),
31.955 + ("square_equation_right","")]*)},
31.956 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.957 + "(let e_ = " ^
31.958 + " ((While (contains_root e_) Do" ^
31.959 + " ((Rewrite square_equation_left True) @@" ^
31.960 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.961 + " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
31.962 + " (Try (Rewrite_Set isolate_root False)) @@" ^
31.963 + " (Try (Rewrite_Set Test_simplify False)))) @@" ^
31.964 + " (Try (Rewrite_Set norm_equation False)) @@" ^
31.965 + " (Try (Rewrite_Set Test_simplify False)))" ^
31.966 + " e_;" ^
31.967 + " (L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test]," ^
31.968 + " [Test,solve_linear]) [bool_ e_, real_ v_])" ^
31.969 + " in Check_elementwise L_ {(v_::real). Assumptions})"
31.970 + ));
31.971 +
31.972 +store_met
31.973 + (prep_met (theory "Test") "met_test_squ2" [] e_metID
31.974 + (*root-equation2*)
31.975 + (["Test","square_equation2"]:metID,
31.976 + [("#Given" ,["equality e_","solveFor v_"]),
31.977 + ("#Find" ,["solutions v_i_"])
31.978 + ],
31.979 + {rew_ord'="e_rew_ord",rls'=tval_rls,
31.980 + srls = append_rls "srls_contains_root" e_rls
31.981 + [Calc ("Test.contains'_root",eval_contains_root"")],
31.982 + prls=e_rls,calc=[],
31.983 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
31.984 + asm_thm=[("square_equation_left",""),
31.985 + ("square_equation_right","")]*)},
31.986 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.987 + "(let e_ = " ^
31.988 + " ((While (contains_root e_) Do" ^
31.989 + " (((Rewrite square_equation_left True) Or " ^
31.990 + " (Rewrite square_equation_right True)) @@" ^
31.991 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.992 + " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
31.993 + " (Try (Rewrite_Set isolate_root False)) @@" ^
31.994 + " (Try (Rewrite_Set Test_simplify False)))) @@" ^
31.995 + " (Try (Rewrite_Set norm_equation False)) @@" ^
31.996 + " (Try (Rewrite_Set Test_simplify False)))" ^
31.997 + " e_;" ^
31.998 + " (L_::bool list) = (SubProblem (Test_,[plain_square,univariate,equation,test]," ^
31.999 + " [Test,solve_plain_square]) [bool_ e_, real_ v_])" ^
31.1000 + " in Check_elementwise L_ {(v_::real). Assumptions})"
31.1001 + ));
31.1002 +
31.1003 +store_met
31.1004 + (prep_met (theory "Test") "met_test_squeq" [] e_metID
31.1005 + (*root-equation*)
31.1006 + (["Test","square_equation"]:metID,
31.1007 + [("#Given" ,["equality e_","solveFor v_"]),
31.1008 + ("#Find" ,["solutions v_i_"])
31.1009 + ],
31.1010 + {rew_ord'="e_rew_ord",rls'=tval_rls,
31.1011 + srls = append_rls "srls_contains_root" e_rls
31.1012 + [Calc ("Test.contains'_root",eval_contains_root"")],
31.1013 + prls=e_rls,calc=[],
31.1014 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
31.1015 + asm_thm=[("square_equation_left",""),
31.1016 + ("square_equation_right","")]*)},
31.1017 + "Script Solve_root_equation (e_::bool) (v_::real) = " ^
31.1018 + "(let e_ = " ^
31.1019 + " ((While (contains_root e_) Do" ^
31.1020 + " (((Rewrite square_equation_left True) Or" ^
31.1021 + " (Rewrite square_equation_right True)) @@" ^
31.1022 + " (Try (Rewrite_Set Test_simplify False)) @@" ^
31.1023 + " (Try (Rewrite_Set rearrange_assoc False)) @@" ^
31.1024 + " (Try (Rewrite_Set isolate_root False)) @@" ^
31.1025 + " (Try (Rewrite_Set Test_simplify False)))) @@" ^
31.1026 + " (Try (Rewrite_Set norm_equation False)) @@" ^
31.1027 + " (Try (Rewrite_Set Test_simplify False)))" ^
31.1028 + " e_;" ^
31.1029 + " (L_::bool list) = (SubProblem (Test_,[univariate,equation,test]," ^
31.1030 + " [no_met]) [bool_ e_, real_ v_])" ^
31.1031 + " in Check_elementwise L_ {(v_::real). Assumptions})"
31.1032 + ) ); (*#######*)
31.1033 +
31.1034 +store_met
31.1035 + (prep_met (theory "Test") "met_test_eq_plain" [] e_metID
31.1036 + (*solve_plain_square*)
31.1037 + (["Test","solve_plain_square"]:metID,
31.1038 + [("#Given",["equality e_","solveFor v_"]),
31.1039 + ("#Where" ,["(matches (?a + ?b*v_ ^^^2 = 0) e_) |" ^
31.1040 + "(matches ( ?b*v_ ^^^2 = 0) e_) |" ^
31.1041 + "(matches (?a + v_ ^^^2 = 0) e_) |" ^
31.1042 + "(matches ( v_ ^^^2 = 0) e_)"]),
31.1043 + ("#Find" ,["solutions v_i_"])
31.1044 + ],
31.1045 + {rew_ord'="e_rew_ord",rls'=tval_rls,calc=[],srls=e_rls,
31.1046 + prls = assoc_rls "matches",
31.1047 + crls=tval_rls, nrls=e_rls(*,
31.1048 + asm_rls=[],asm_thm=[]*)},
31.1049 + "Script Solve_plain_square (e_::bool) (v_::real) = " ^
31.1050 + " (let e_ = ((Try (Rewrite_Set isolate_bdv False)) @@ " ^
31.1051 + " (Try (Rewrite_Set Test_simplify False)) @@ " ^
31.1052 + " ((Rewrite square_equality_0 False) Or " ^
31.1053 + " (Rewrite square_equality True)) @@ " ^
31.1054 + " (Try (Rewrite_Set tval_rls False))) e_ " ^
31.1055 + " in ((Or_to_List e_)::bool list))"
31.1056 + ));
31.1057 +
31.1058 +store_met
31.1059 + (prep_met (theory "Test") "met_test_norm_univ" [] e_metID
31.1060 + (["Test","norm_univar_equation"]:metID,
31.1061 + [("#Given",["equality e_","solveFor v_"]),
31.1062 + ("#Where" ,[]),
31.1063 + ("#Find" ,["solutions v_i_"])
31.1064 + ],
31.1065 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls = e_rls,prls=e_rls,
31.1066 + calc=[],
31.1067 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],asm_thm=[]*)},
31.1068 + "Script Norm_univar_equation (e_::bool) (v_::real) = " ^
31.1069 + " (let e_ = ((Try (Rewrite rnorm_equation_add False)) @@ " ^
31.1070 + " (Try (Rewrite_Set Test_simplify False))) e_ " ^
31.1071 + " in (SubProblem (Test_,[univariate,equation,test], " ^
31.1072 + " [no_met]) [bool_ e_, real_ v_]))"
31.1073 + ));
31.1074 +
31.1075 +
31.1076 +
31.1077 +(*17.9.02 aus SqRoot.ML------------------------------^^^---*)
31.1078 +
31.1079 +(*8.4.03 aus Poly.ML--------------------------------vvv---
31.1080 + make_polynomial ---> make_poly
31.1081 + ^-- for user ^-- for systest _ONLY_*)
31.1082 +
31.1083 +local (*. for make_polytest .*)
31.1084 +
31.1085 +open Term; (* for type order = EQUAL | LESS | GREATER *)
31.1086 +
31.1087 +fun pr_ord EQUAL = "EQUAL"
31.1088 + | pr_ord LESS = "LESS"
31.1089 + | pr_ord GREATER = "GREATER";
31.1090 +
31.1091 +fun dest_hd' (Const (a, T)) = (* ~ term.ML *)
31.1092 + (case a of
31.1093 + "Atools.pow" => ((("|||||||||||||", 0), T), 0) (*WN greatest *)
31.1094 + | _ => (((a, 0), T), 0))
31.1095 + | dest_hd' (Free (a, T)) = (((a, 0), T), 1)
31.1096 + | dest_hd' (Var v) = (v, 2)
31.1097 + | dest_hd' (Bound i) = ((("", i), dummyT), 3)
31.1098 + | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
31.1099 +(* RL *)
31.1100 +fun get_order_pow (t $ (Free(order,_))) =
31.1101 + (case int_of_str (order) of
31.1102 + SOME d => d
31.1103 + | NONE => 0)
31.1104 + | get_order_pow _ = 0;
31.1105 +
31.1106 +fun size_of_term' (Const(str,_) $ t) =
31.1107 + if "Atools.pow"=str then 1000 + size_of_term' t else 1 + size_of_term' t(*WN*)
31.1108 + | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
31.1109 + | size_of_term' (f$t) = size_of_term' f + size_of_term' t
31.1110 + | size_of_term' _ = 1;
31.1111 +
31.1112 +fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
31.1113 + (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
31.1114 + | term_ord' pr thy (t, u) =
31.1115 + (if pr then
31.1116 + let
31.1117 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
31.1118 + val _=writeln("t= f@ts= " ^ "" ^
31.1119 + ((Syntax.string_of_term (thy2ctxt thy)) f)^ "\" @ " ^ "[" ^
31.1120 + (commas(map(Syntax.string_of_term (thy2ctxt thy)) ts)) ^ "]""");
31.1121 + val _=writeln("u= g@us= " ^ "" ^
31.1122 + ((Syntax.string_of_term (thy2ctxt thy)) g) ^ "\" @ " ^ "[" ^
31.1123 + (commas(map(Syntax.string_of_term (thy2ctxt thy)) us))^"]""");
31.1124 + val _=writeln("size_of_term(t,u)= ("^
31.1125 + (string_of_int(size_of_term' t)) ^ ", " ^
31.1126 + (string_of_int(size_of_term' u)) ^ ")");
31.1127 + val _=writeln("hd_ord(f,g) = " ^ ((pr_ord o hd_ord)(f,g)));
31.1128 + val _=writeln("terms_ord(ts,us) = " ^
31.1129 + ((pr_ord o terms_ord str false)(ts,us)));
31.1130 + val _=writeln("-------");
31.1131 + in () end
31.1132 + else ();
31.1133 + case int_ord (size_of_term' t, size_of_term' u) of
31.1134 + EQUAL =>
31.1135 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
31.1136 + (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
31.1137 + | ord => ord)
31.1138 + end
31.1139 + | ord => ord)
31.1140 +and hd_ord (f, g) = (* ~ term.ML *)
31.1141 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f, dest_hd' g)
31.1142 +and terms_ord str pr (ts, us) =
31.1143 + list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
31.1144 +in
31.1145 +
31.1146 +fun ord_make_polytest (pr:bool) thy (_:subst) tu =
31.1147 + (term_ord' pr thy(***) tu = LESS );
31.1148 +
31.1149 +end;(*local*)
31.1150 +
31.1151 +rew_ord' := overwritel (!rew_ord',
31.1152 +[("termlessI", termlessI),
31.1153 + ("ord_make_polytest", ord_make_polytest false thy)
31.1154 + ]);
31.1155 +
31.1156 +(*WN060510 this was a preparation for prep_rls ...
31.1157 +val scr_make_polytest =
31.1158 +"Script Expand_binomtest t_ =" ^
31.1159 +"(Repeat " ^
31.1160 +"((Try (Repeat (Rewrite real_diff_minus False))) @@ " ^
31.1161 +
31.1162 +" (Try (Repeat (Rewrite real_add_mult_distrib False))) @@ " ^
31.1163 +" (Try (Repeat (Rewrite real_add_mult_distrib2 False))) @@ " ^
31.1164 +" (Try (Repeat (Rewrite real_diff_mult_distrib False))) @@ " ^
31.1165 +" (Try (Repeat (Rewrite real_diff_mult_distrib2 False))) @@ " ^
31.1166 +
31.1167 +" (Try (Repeat (Rewrite real_mult_1 False))) @@ " ^
31.1168 +" (Try (Repeat (Rewrite real_mult_0 False))) @@ " ^
31.1169 +" (Try (Repeat (Rewrite real_add_zero_left False))) @@ " ^
31.1170 +
31.1171 +" (Try (Repeat (Rewrite real_mult_commute False))) @@ " ^
31.1172 +" (Try (Repeat (Rewrite real_mult_left_commute False))) @@ " ^
31.1173 +" (Try (Repeat (Rewrite real_mult_assoc False))) @@ " ^
31.1174 +" (Try (Repeat (Rewrite real_add_commute False))) @@ " ^
31.1175 +" (Try (Repeat (Rewrite real_add_left_commute False))) @@ " ^
31.1176 +" (Try (Repeat (Rewrite real_add_assoc False))) @@ " ^
31.1177 +
31.1178 +" (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ " ^
31.1179 +" (Try (Repeat (Rewrite realpow_plus_1 False))) @@ " ^
31.1180 +" (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ " ^
31.1181 +" (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ " ^
31.1182 +
31.1183 +" (Try (Repeat (Rewrite real_num_collect False))) @@ " ^
31.1184 +" (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ " ^
31.1185 +
31.1186 +" (Try (Repeat (Rewrite real_one_collect False))) @@ " ^
31.1187 +" (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ " ^
31.1188 +
31.1189 +" (Try (Repeat (Calculate plus ))) @@ " ^
31.1190 +" (Try (Repeat (Calculate times ))) @@ " ^
31.1191 +" (Try (Repeat (Calculate power_)))) " ^
31.1192 +" t_)";
31.1193 +-----------------------------------------------------*)
31.1194 +
31.1195 +val make_polytest =
31.1196 + Rls{id = "make_polytest", preconds = []:term list,
31.1197 + rew_ord = ("ord_make_polytest", ord_make_polytest false (theory "Poly")),
31.1198 + erls = testerls, srls = Erls,
31.1199 + calc = [("PLUS" , ("op +", eval_binop "#add_")),
31.1200 + ("TIMES" , ("op *", eval_binop "#mult_")),
31.1201 + ("POWER", ("Atools.pow", eval_binop "#power_"))
31.1202 + ],
31.1203 + (*asm_thm = [],*)
31.1204 + rules = [Thm ("real_diff_minus",num_str real_diff_minus),
31.1205 + (*"a - b = a + (-1) * b"*)
31.1206 + Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
31.1207 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
31.1208 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
31.1209 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
31.1210 + Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
31.1211 + (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
31.1212 + Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
31.1213 + (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
31.1214 + Thm ("real_mult_1",num_str real_mult_1),
31.1215 + (*"1 * z = z"*)
31.1216 + Thm ("real_mult_0",num_str real_mult_0),
31.1217 + (*"0 * z = 0"*)
31.1218 + Thm ("real_add_zero_left",num_str real_add_zero_left),
31.1219 + (*"0 + z = z"*)
31.1220 +
31.1221 + (*AC-rewriting*)
31.1222 + Thm ("real_mult_commute",num_str real_mult_commute),
31.1223 + (* z * w = w * z *)
31.1224 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
31.1225 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
31.1226 + Thm ("real_mult_assoc",num_str real_mult_assoc),
31.1227 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
31.1228 + Thm ("real_add_commute",num_str real_add_commute),
31.1229 + (*z + w = w + z*)
31.1230 + Thm ("real_add_left_commute",num_str real_add_left_commute),
31.1231 + (*x + (y + z) = y + (x + z)*)
31.1232 + Thm ("real_add_assoc",num_str real_add_assoc),
31.1233 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
31.1234 +
31.1235 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
31.1236 + (*"r1 * r1 = r1 ^^^ 2"*)
31.1237 + Thm ("realpow_plus_1",num_str realpow_plus_1),
31.1238 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
31.1239 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
31.1240 + (*"z1 + z1 = 2 * z1"*)
31.1241 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
31.1242 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
31.1243 +
31.1244 + Thm ("real_num_collect",num_str real_num_collect),
31.1245 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
31.1246 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
31.1247 + (*"[| l is_const; m is_const |] ==>
31.1248 + l * n + (m * n + k) = (l + m) * n + k"*)
31.1249 + Thm ("real_one_collect",num_str real_one_collect),
31.1250 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
31.1251 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
31.1252 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
31.1253 +
31.1254 + Calc ("op +", eval_binop "#add_"),
31.1255 + Calc ("op *", eval_binop "#mult_"),
31.1256 + Calc ("Atools.pow", eval_binop "#power_")
31.1257 + ],
31.1258 + scr = EmptyScr(*Script ((term_of o the o (parse thy))
31.1259 + scr_make_polytest)*)
31.1260 + }:rls;
31.1261 +(*WN060510 this was done before 'fun prep_rls' ...
31.1262 +val scr_expand_binomtest =
31.1263 +"Script Expand_binomtest t_ =" ^
31.1264 +"(Repeat " ^
31.1265 +"((Try (Repeat (Rewrite real_plus_binom_pow2 False))) @@ " ^
31.1266 +" (Try (Repeat (Rewrite real_plus_binom_times False))) @@ " ^
31.1267 +" (Try (Repeat (Rewrite real_minus_binom_pow2 False))) @@ " ^
31.1268 +" (Try (Repeat (Rewrite real_minus_binom_times False))) @@ " ^
31.1269 +" (Try (Repeat (Rewrite real_plus_minus_binom1 False))) @@ " ^
31.1270 +" (Try (Repeat (Rewrite real_plus_minus_binom2 False))) @@ " ^
31.1271 +
31.1272 +" (Try (Repeat (Rewrite real_mult_1 False))) @@ " ^
31.1273 +" (Try (Repeat (Rewrite real_mult_0 False))) @@ " ^
31.1274 +" (Try (Repeat (Rewrite real_add_zero_left False))) @@ " ^
31.1275 +
31.1276 +" (Try (Repeat (Calculate plus ))) @@ " ^
31.1277 +" (Try (Repeat (Calculate times ))) @@ " ^
31.1278 +" (Try (Repeat (Calculate power_))) @@ " ^
31.1279 +
31.1280 +" (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ " ^
31.1281 +" (Try (Repeat (Rewrite realpow_plus_1 False))) @@ " ^
31.1282 +" (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ " ^
31.1283 +" (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ " ^
31.1284 +
31.1285 +" (Try (Repeat (Rewrite real_num_collect False))) @@ " ^
31.1286 +" (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ " ^
31.1287 +
31.1288 +" (Try (Repeat (Rewrite real_one_collect False))) @@ " ^
31.1289 +" (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ " ^
31.1290 +
31.1291 +" (Try (Repeat (Calculate plus ))) @@ " ^
31.1292 +" (Try (Repeat (Calculate times ))) @@ " ^
31.1293 +" (Try (Repeat (Calculate power_)))) " ^
31.1294 +" t_)";
31.1295 +------------------------------------------------------*)
31.1296 +
31.1297 +val expand_binomtest =
31.1298 + Rls{id = "expand_binomtest", preconds = [],
31.1299 + rew_ord = ("termlessI",termlessI),
31.1300 + erls = testerls, srls = Erls,
31.1301 + calc = [("PLUS" , ("op +", eval_binop "#add_")),
31.1302 + ("TIMES" , ("op *", eval_binop "#mult_")),
31.1303 + ("POWER", ("Atools.pow", eval_binop "#power_"))
31.1304 + ],
31.1305 + (*asm_thm = [],*)
31.1306 + rules = [Thm ("real_plus_binom_pow2" ,num_str real_plus_binom_pow2),
31.1307 + (*"(a + b) ^^^ 2 = a ^^^ 2 + 2 * a * b + b ^^^ 2"*)
31.1308 + Thm ("real_plus_binom_times" ,num_str real_plus_binom_times),
31.1309 + (*"(a + b)*(a + b) = ...*)
31.1310 + Thm ("real_minus_binom_pow2" ,num_str real_minus_binom_pow2),
31.1311 + (*"(a - b) ^^^ 2 = a ^^^ 2 - 2 * a * b + b ^^^ 2"*)
31.1312 + Thm ("real_minus_binom_times",num_str real_minus_binom_times),
31.1313 + (*"(a - b)*(a - b) = ...*)
31.1314 + Thm ("real_plus_minus_binom1",num_str real_plus_minus_binom1),
31.1315 + (*"(a + b) * (a - b) = a ^^^ 2 - b ^^^ 2"*)
31.1316 + Thm ("real_plus_minus_binom2",num_str real_plus_minus_binom2),
31.1317 + (*"(a - b) * (a + b) = a ^^^ 2 - b ^^^ 2"*)
31.1318 + (*RL 020915*)
31.1319 + Thm ("real_pp_binom_times",num_str real_pp_binom_times),
31.1320 + (*(a + b)*(c + d) = a*c + a*d + b*c + b*d*)
31.1321 + Thm ("real_pm_binom_times",num_str real_pm_binom_times),
31.1322 + (*(a + b)*(c - d) = a*c - a*d + b*c - b*d*)
31.1323 + Thm ("real_mp_binom_times",num_str real_mp_binom_times),
31.1324 + (*(a - b)*(c p d) = a*c + a*d - b*c - b*d*)
31.1325 + Thm ("real_mm_binom_times",num_str real_mm_binom_times),
31.1326 + (*(a - b)*(c p d) = a*c - a*d - b*c + b*d*)
31.1327 + Thm ("realpow_multI",num_str realpow_multI),
31.1328 + (*(a*b)^^^n = a^^^n * b^^^n*)
31.1329 + Thm ("real_plus_binom_pow3",num_str real_plus_binom_pow3),
31.1330 + (* (a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3 *)
31.1331 + Thm ("real_minus_binom_pow3",num_str real_minus_binom_pow3),
31.1332 + (* (a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3 *)
31.1333 +
31.1334 +
31.1335 + (* Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
31.1336 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
31.1337 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
31.1338 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
31.1339 + Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
31.1340 + (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
31.1341 + Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
31.1342 + (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
31.1343 + *)
31.1344 +
31.1345 + Thm ("real_mult_1",num_str real_mult_1), (*"1 * z = z"*)
31.1346 + Thm ("real_mult_0",num_str real_mult_0), (*"0 * z = 0"*)
31.1347 + Thm ("real_add_zero_left",num_str real_add_zero_left),(*"0 + z = z"*)
31.1348 +
31.1349 + Calc ("op +", eval_binop "#add_"),
31.1350 + Calc ("op *", eval_binop "#mult_"),
31.1351 + Calc ("Atools.pow", eval_binop "#power_"),
31.1352 + (*
31.1353 + Thm ("real_mult_commute",num_str real_mult_commute), (*AC-rewriting*)
31.1354 + Thm ("real_mult_left_commute",num_str real_mult_left_commute), (**)
31.1355 + Thm ("real_mult_assoc",num_str real_mult_assoc), (**)
31.1356 + Thm ("real_add_commute",num_str real_add_commute), (**)
31.1357 + Thm ("real_add_left_commute",num_str real_add_left_commute), (**)
31.1358 + Thm ("real_add_assoc",num_str real_add_assoc), (**)
31.1359 + *)
31.1360 +
31.1361 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
31.1362 + (*"r1 * r1 = r1 ^^^ 2"*)
31.1363 + Thm ("realpow_plus_1",num_str realpow_plus_1),
31.1364 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
31.1365 + (*Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
31.1366 + (*"z1 + z1 = 2 * z1"*)*)
31.1367 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
31.1368 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
31.1369 +
31.1370 + Thm ("real_num_collect",num_str real_num_collect),
31.1371 + (*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
31.1372 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
31.1373 + (*"[| l is_const; m is_const |] ==> l * n + (m * n + k) = (l + m) * n + k"*)
31.1374 + Thm ("real_one_collect",num_str real_one_collect),
31.1375 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
31.1376 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
31.1377 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
31.1378 +
31.1379 + Calc ("op +", eval_binop "#add_"),
31.1380 + Calc ("op *", eval_binop "#mult_"),
31.1381 + Calc ("Atools.pow", eval_binop "#power_")
31.1382 + ],
31.1383 + scr = EmptyScr
31.1384 +(*Script ((term_of o the o (parse thy)) scr_expand_binomtest)*)
31.1385 + }:rls;
31.1386 +
31.1387 +
31.1388 +ruleset' := overwritelthy thy (!ruleset',
31.1389 + [("make_polytest", prep_rls make_polytest),
31.1390 + ("expand_binomtest", prep_rls expand_binomtest)
31.1391 + ]);
31.1392 +*}
31.1393
31.1394 end