1.1 --- a/.hgignore Wed Jul 21 09:59:35 2010 +0200
1.2 +++ b/.hgignore Wed Jul 21 13:53:39 2010 +0200
1.3 @@ -24,6 +24,8 @@
1.4 ^doc-src/.*\.rao
1.5 ^doc-src/.*\.toc
1.6
1.7 +^doc/.*
1.8 +
1.9 ^src/Tools/jEdit/nbproject/private/
1.10 ^src/Tools/jEdit/build/
1.11 ^src/Tools/jEdit/dist/
2.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2 +++ b/INSTALL Wed Jul 21 13:53:39 2010 +0200
2.3 @@ -0,0 +1,89 @@
2.4 +WN1900721 copy from Isabelle2009-1
2.5 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2.6 +
2.7 +Isabelle installation notes
2.8 +===========================
2.9 +
2.10 +1) System installation
2.11 +----------------------
2.12 +
2.13 +The Isabelle distribution includes both complete sources and
2.14 +precompiled binary packages for common Unix-like platforms.
2.15 +
2.16 +
2.17 +Quick installation
2.18 +------------------
2.19 +
2.20 +Ready-to-go packages are provided for the ML compiler and runtime
2.21 +system, the Isabelle sources, and some major object-logics. A minimal
2.22 +site installation of Isabelle on Linux/x86 works like this:
2.23 +
2.24 + tar -C /usr/local -xzf Isabelle.tar.gz
2.25 + tar -C /usr/local -xzf polyml.tar.gz
2.26 + tar -C /usr/local -xzf HOL_x86-linux.tar.gz
2.27 +
2.28 +The install prefix given above may be changed as appropriate; there is
2.29 +no need to install into a system directory like /usr/local at all. By
2.30 +default the ML system (and other contributed packages) are expected in
2.31 +any of the following locations:
2.32 +
2.33 + 1) [ISABELLE_HOME]/contrib
2.34 + 2) [ISABELLE_HOME]/..
2.35 + 4) /usr/local
2.36 + 3) /usr/share
2.37 + 5) /opt
2.38 +
2.39 +This may be changed by editing [ISABELLE_HOME]/etc/settings manually.
2.40 +
2.41 +The installation may be finished as follows:
2.42 +
2.43 + cd [ISABELLE_HOME]
2.44 + ./bin/isabelle install -p /usr/local/bin
2.45 +
2.46 +The install utility creates global references to the present Isabelle
2.47 +installation, enabling users to invoke the Isabelle executables
2.48 +without explicit path names. This is the only place where a static
2.49 +reference to [ISABELLE_HOME] is created; thus isabelle install has to
2.50 +be run again whenever the Isabelle distribution is moved later.
2.51 +
2.52 +
2.53 +Compiling logics
2.54 +----------------
2.55 +
2.56 +The Isabelle.tar.gz archive already contains all Isabelle sources (and
2.57 +documentation). Precompiled object-logics are provided for
2.58 +convenience.
2.59 +
2.60 +Assuming proper configuration of the underlying ML system
2.61 +(cf. Isabelle's etc/settings), further object-logics may be compiled
2.62 +like this:
2.63 +
2.64 + [ISABELLE_HOME]/build FOL
2.65 +
2.66 +Special object-logic targets may be specified as follows:
2.67 +
2.68 + [ISABELLE_HOME]/build -m HOL-Algebra HOL
2.69 +
2.70 +
2.71 +2) User installation
2.72 +--------------------
2.73 +
2.74 +Running the Isabelle binaries
2.75 +-----------------------------
2.76 +
2.77 +Users may invoke the main Isabelle binaries (isabelle and
2.78 +isabelle-process) directly from their location within the distribution
2.79 +directory [ISABELLE_HOME] like this:
2.80 +
2.81 + [ISABELLE_HOME]/bin/isabelle tty -l HOL
2.82 +
2.83 +This starts an interactive Isabelle session within the current text
2.84 +terminal. [ISABELLE_HOME]/bin may be put into the shell's search
2.85 +PATH. An alternative is to create global references to the Isabelle
2.86 +executables as follows:
2.87 +
2.88 + [ISABELLE_HOME]/bin/isabelle install -p ~/bin
2.89 +
2.90 +Note that the site-wide Isabelle installation may already provide
2.91 +Isabelle executables in some global bin directory (such as
2.92 +/usr/local/bin).
3.1 --- a/README_REPOSITORY Wed Jul 21 09:59:35 2010 +0200
3.2 +++ b/README_REPOSITORY Wed Jul 21 13:53:39 2010 +0200
3.3 @@ -1,3 +1,34 @@
3.4 +100721 download Isabelle repository + install runnable system
3.5 +===========================================================WN
3.6 +
3.7 +# clone the repository
3.8 + /usr/local$ sudo hg clone http://isabelle.in.tum.de/repos/isabelle isabisac
3.9 + /usr/local/isabisac$ sudo chown -r neuper * #become owner
3.10 + hg update -C Isabelle2009-2 #go to release
3.11 + hg branch isac-from-Isabelle2009-2 #make branch
3.12 + hg ci #commit
3.13 +
3.14 +# download Isabelle2009-2 distribution, cp missing dirs to repository
3.15 + ~/Downloads/Isabelle2009-2$ sudo cp -r contrib/ /usr/local/isabisac/
3.16 + sudo cp -r heaps/ /usr/local/isabisac/
3.17 + /usr/local$ ln -s isabisac Isabelle
3.18 +
3.19 + export SCALA_HOME=/usr/local/isabisac/contrib/scala-2.8.0.RC5
3.20 + isabisac/Admin$ ./build jars
3.21 +
3.22 + !test runnable distribution!
3.23 +
3.24 +# insert the isac-hooks in Pure/thm.ML into isabelle
3.25 + hg ci
3.26 +
3.27 +# cp isac into the repository
3.28 + ...$ cp -r isac /usr/local/isabisac/src/Pure
3.29 + hg add .......................
3.30 + hg ci
3.31 +
3.32 +
3.33 +
3.34 +
3.35 Important notes on Mercurial repository access for Isabelle
3.36 ===========================================================
3.37
4.1 --- a/etc/components Wed Jul 21 09:59:35 2010 +0200
4.2 +++ b/etc/components Wed Jul 21 13:53:39 2010 +0200
4.3 @@ -17,3 +17,9 @@
4.4 src/HOL/Mirabelle
4.5 src/HOL/Library/Sum_Of_Squares
4.6 src/HOL/Tools/SMT
4.7 +#bundled components
4.8 +contrib/e-1.0-004
4.9 +contrib/jedit-4.3.2
4.10 +contrib/kodkodi-1.2.13
4.11 +contrib/scala-2.8.0.RC5
4.12 +contrib/spass-3.7
5.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
5.2 +++ b/src/Pure/isac/#Isac_Mathengine.thy# Wed Jul 21 13:53:39 2010 +0200
5.3 @@ -0,0 +1,176 @@
5.4 +(* Title: ~~~/isac/Isac_Mathengine.thy
5.5 + Author: Walther Neuper, TU Graz
5.6 +
5.7 +$ cd /usr/local/Isabelle2009-1/src/Pure/isac
5.8 +$ /usr/local/Isabelle2009-1/bin/isabelle emacs Isac_Mathengine.thy &
5.9 +
5.10 +OR tty (unusable: after errors wrong toplevel):
5.11 +$ cd "/home/neuper/proto2/isac/src/sml"
5.12 +$ isabelle-process HOL HOL-Isac
5.13 +ML> use_thy "Isac_Mathengine";
5.14 +*)
5.15 +
5.16 +header {* Loading the isac mathengine *}
5.17 +
5.18 +theory Isac_Mathengine
5.19 +imports Complex_Main
5.20 +(*imports Complex_Main "Scripts/Script" (*ListG, Tools, Script*)*)
5.21 +begin
5.22 +
5.23 +ML {* 1.2;3.4;5; *}
5.24 +
5.25 +use "library.sml"
5.26 +use "calcelems.sml"
5.27 +ML {* check_guhs_unique := true *}
5.28 +
5.29 +use "Scripts/term_G.sml"
5.30 +use "Scripts/calculate.sml"
5.31 +
5.32 +use "Scripts/rewrite.sml"
5.33 +(*
5.34 +use_thy"Scripts/Script"
5.35 +use "Scripts/ListG.ML"
5.36 +use "Scripts/Tools.ML"
5.37 +use "Scripts/Script.ML"
5.38 +
5.39 +use "Scripts/scrtools.sml"
5.40 +
5.41 +use "ME/mstools.sml"
5.42 +use "ME/ctree.sml"
5.43 +use "ME/ptyps.sml"
5.44 +use "ME/generate.sml"
5.45 +use "ME/calchead.sml"
5.46 +use "ME/appl.sml"
5.47 +use "ME/rewtools.sml"
5.48 +use "ME/script.sml"
5.49 +use "ME/solve.sml"
5.50 +use "ME/inform.sml"
5.51 +use "ME/mathengine.sml"
5.52 +
5.53 +use "xmlsrc/mathml.sml"
5.54 +use "xmlsrc/datatypes.sml"
5.55 +use "xmlsrc/pbl-met-hierarchy.sml"
5.56 +use "xmlsrc/thy-hierarchy.sml"
5.57 +use "xmlsrc/interface-xml.sml"
5.58 +
5.59 +use "FE-interface/messages.sml"
5.60 +use "FE-interface/states.sml"
5.61 +use "FE-interface/interface.sml"
5.62 +
5.63 +use "print_exn_G.sml"
5.64 +
5.65 +text "**** build math-engine complete *************************"
5.66 +*)(*
5.67 +setup {*
5.68 + Code_Preproc.setup
5.69 + #> Code_ML.setup
5.70 + #> Code_Haskell.setup
5.71 + #> Nbe.setup
5.72 +*}
5.73 +*)
5.74 +
5.75 +
5.76 +(*cleaner output from...*)
5.77 +ML_command {*
5.78 +"----- ";
5.79 +writeln "werwerw";
5.80 +*}
5.81 +
5.82 +ML {* @{prop "False"} *}
5.83 +(*ML {* @{type "int"} *} only new version*)
5.84 +ML {* @{thm conjI} *}
5.85 +ML {* @{thms conjI TrueI} *}
5.86 +ML {* @{theory} *}
5.87 +
5.88 +ML{* @{const_name plus} *} (*creates long names (extern names)*)
5.89 +term plus
5.90 +
5.91 +term foo
5.92 +(*ML{* @{const_name foo} *} only new version*)
5.93 +
5.94 +text {*
5.95 +werwer
5.96 + *}
5.97 +
5.98 +ML {*
5.99 + fun inc_by_five x =
5.100 + x |> (fn x => x + 1)
5.101 +*}
5.102 +
5.103 +(*canonical argument order introduced after 1997*)
5.104 +
5.105 +text{*
5.106 +this is the most appropriate fold for lists (generalizes to lists of lists by (fold o fold o fold))
5.107 +@{ML fold}
5.108 +
5.109 +@{ML fold_rev}
5.110 +
5.111 +for accumulating side results in |>
5.112 +@{ML fold_map}
5.113 +*}
5.114 +
5.115 +ML {*
5.116 + val items = 1 upto 10;
5.117 + val l1 = fold cons items []; (*alternating useful frequently*)
5.118 +*}
5.119 +
5.120 +ML{*
5.121 + fun merge_list eq (xs, ys) = fold_rev (insert eq) ys xs;
5.122 +*}
5.123 +ML{*
5.124 + merge_list (op =) ([3,2,1], [7,5,3,1]);
5.125 + merge_list (op =) ([3,2,1], [7,5,3,1]);
5.126 +*}
5.127 +
5.128 +(*session 2-------Christian+Makarius---------------*)
5.129 +ML{*
5.130 +let
5.131 + val ctxt = @{context}
5.132 +in 1 end
5.133 +*}
5.134 +
5.135 +(* build and handle tables THIS IS THE ACCESS-STRUCTURE...
5.136 +ML{*
5.137 + structure Data = Theory_Data
5.138 + (
5.139 + type T = term Symtab.table
5.140 + val empty = Symtab.empty
5.141 + val extend = O
5.142 + fun merge (t1, t2) = Symtab.merge (op = ) (t1, t2)
5.143 + )
5.144 +*}
5.145 +*)
5.146 +(*session 3-------Blanchette--------------------
5.147 +working on nitpic, ML level tool
5.148 +
5.149 +SEE THESE LECTURE NOTES !!!*)
5.150 +
5.151 +(*
5.152 +ML{*
5.153 +Const ("x", dummyT) |> Syntax.check_term @{context}
5.154 + ^^^^^^^^^^^^^^^^^
5.155 +*}
5.156 +*)
5.157 +
5.158 +text{*
5.159 +SEE funs for
5.160 +# deleting identifiers
5.161 +# handle Bounds when made visible
5.162 +# kill trivial quantifiers, e.g. \foral x. (NO x)
5.163 +# handling name clashes in Abs
5.164 +# which constants, free vars ... occur in a term !!!!!!!!!!!
5.165 +# Var (("x", 2), dummyT) ... 25 old from Larry "maxidx"
5.166 +# get fresh Const, Var
5.167 +# use the "Name" structure
5.168 +
5.169 +*}
5.170 +
5.171 +ML{* val context = Name.make_context ["d"] *}
5.172 +
5.173 +(*
5.174 +ML{* Name.invents context "foo" 10 *}
5.175 +(*ML{* Name variants ... *}*)
5.176 +*)
5.177 +
5.178 +end
5.179 +
6.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
6.2 +++ b/src/Pure/isac/CLEANUP Wed Jul 21 13:53:39 2010 +0200
6.3 @@ -0,0 +1,80 @@
6.4 +rm *~
6.5 +rm *.tar*
6.6 +cd Scripts
6.7 + rm *~
6.8 + rm #*
6.9 + rm .#*
6.10 + rm *.tar*
6.11 + cd ..
6.12 +cd ME
6.13 + rm *~
6.14 + rm #*
6.15 + rm .#*
6.16 + rm *.tar*
6.17 + cd ..
6.18 +cd xmlsrc
6.19 + rm *~
6.20 + rm #*
6.21 + rm .#*
6.22 + rm *.tar*
6.23 + cd ..
6.24 +cd FE-interface
6.25 + rm *~
6.26 + rm #*
6.27 + rm .#*
6.28 + rm *.tar*
6.29 + cd ..
6.30 +cd IsacKnowledge
6.31 + rm *~
6.32 + rm #*
6.33 + rm .#*
6.34 + rm *.tar*
6.35 + cd ..
6.36 +cd systest
6.37 + rm *~
6.38 + rm #*
6.39 + rm .#*
6.40 + rm *.tar*
6.41 + cd ../..
6.42 +cd smltest
6.43 + rm *~
6.44 + rm #*
6.45 + rm .#*
6.46 + rm *.tar*
6.47 + cd ../
6.48 +cd smltest/FE-interface
6.49 + rm *~
6.50 + rm #*
6.51 + rm .#*
6.52 + rm *.tar*
6.53 + cd ../..
6.54 +cd smltest/IsacKnowledge
6.55 + rm *~
6.56 + rm #*
6.57 + rm .#*
6.58 + rm *.tar*
6.59 + cd ../..
6.60 +cd smltest/ME
6.61 + rm *~
6.62 + rm #*
6.63 + rm .#*
6.64 + rm *.tar*
6.65 + cd ../..
6.66 +cd smltest/Scripts
6.67 + rm *~
6.68 + rm #*
6.69 + rm .#*
6.70 + rm *.tar*
6.71 + cd ../..
6.72 +cd smltest/xmlsrc
6.73 + rm *~
6.74 + rm #*
6.75 + rm .#*
6.76 + rm *.tar*
6.77 + cd ../..
6.78 +cd sml/systest
6.79 + rm *~
6.80 + rm #*
6.81 + rm .#*
6.82 + rm *.tar*
6.83 + cd ..
7.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
7.2 +++ b/src/Pure/isac/FE-interface/interface.sml Wed Jul 21 13:53:39 2010 +0200
7.3 @@ -0,0 +1,840 @@
7.4 +(* the interface between the isac-kernel and the java-frontend;
7.5 + the isac-kernel holds calc-trees; stdout in XML-format.
7.6 + authors: Walther Neuper 2002
7.7 + (c) due to copyright terms
7.8 +
7.9 +use"FE-interface/interface.sml";
7.10 +use"interface.sml";
7.11 +*)
7.12 +
7.13 +signature INTERFACE =
7.14 + sig
7.15 + val CalcTree : fmz list -> unit
7.16 + val DEconstrCalcTree : calcID -> unit
7.17 + val Iterator : calcID -> unit
7.18 + val IteratorTEST : calcID -> iterID
7.19 + val appendFormula : calcID -> cterm' -> unit
7.20 + val autoCalculate : calcID -> auto -> unit
7.21 + val checkContext : calcID -> pos' -> guh -> unit
7.22 + val fetchApplicableTactics : calcID -> int -> pos' -> unit
7.23 + val fetchProposedTactic : calcID -> unit
7.24 + val applyTactic : calcID -> pos' -> tac -> unit
7.25 + val getAccumulatedAsms : calcID -> pos' -> unit
7.26 + val getActiveFormula : calcID -> unit
7.27 + val getAssumptions : calcID -> pos' -> unit
7.28 + val initContext : calcID -> ketype -> pos' -> unit
7.29 + val getFormulaeFromTo : calcID -> pos' -> pos' -> int -> bool -> unit
7.30 + val getTactic : calcID -> pos' -> unit
7.31 + val interSteps : calcID -> pos' -> unit
7.32 + val modifyCalcHead : calcID -> icalhd -> unit
7.33 + val moveActiveCalcHead : calcID -> unit
7.34 + val moveActiveDown : calcID -> unit
7.35 + val moveActiveDownTEST : calcID -> unit
7.36 + val moveActiveFormula : calcID -> pos' -> unit
7.37 + val moveActiveLevelDown : calcID -> unit
7.38 + val moveActiveLevelUp : calcID -> unit
7.39 + val moveActiveRoot : calcID -> unit
7.40 + val moveActiveRootTEST : calcID -> unit
7.41 + val moveActiveUp : calcID -> unit
7.42 + val moveCalcHead : calcID -> pos' -> unit
7.43 + val moveDown : calcID -> pos' -> unit
7.44 + val moveLevelDown : calcID -> pos' -> unit
7.45 + val moveLevelUp : calcID -> pos' -> unit
7.46 + val moveRoot : calcID -> unit
7.47 + val moveUp : calcID -> pos' -> unit
7.48 + val refFormula : calcID -> pos' -> unit
7.49 + val replaceFormula : calcID -> cterm' -> unit
7.50 + val resetCalcHead : calcID -> unit
7.51 + val modelProblem : calcID -> unit
7.52 + val refineProblem : calcID -> pos' -> guh -> unit
7.53 + val setContext : calcID -> pos' -> guh -> unit
7.54 + val setMethod : calcID -> metID -> unit
7.55 + val setNextTactic : calcID -> tac -> unit
7.56 + val setProblem : calcID -> pblID -> unit
7.57 + val setTheory : calcID -> thyID -> unit
7.58 + end
7.59 +
7.60 +
7.61 +(*------------------------------------------------------------------*)
7.62 +structure interface : INTERFACE =
7.63 +struct
7.64 +(*------------------------------------------------------------------*)
7.65 +
7.66 +(*.encode "Isabelle"-strings as seen by the user to the
7.67 + format accepted by Isabelle.
7.68 + encode "^" ---> "^^^"; see IsacKnowledge/Atools.thy;
7.69 + called for each cterm', icalhd, fmz in this interface;
7.70 + + see "fun decode" in xmlsrc/mathml.sml.*)
7.71 +fun encode (str:cterm') =
7.72 + let fun enc [] = []
7.73 + | enc ("^"::cs) = "^"::"^"::"^"::(enc cs)
7.74 + | enc (c::cs) = c::(enc cs)
7.75 + in (implode o enc o explode) str:cterm' end;
7.76 +fun encode_imodel (imodel:imodel) =
7.77 + let fun enc (Given ifos) = Given (map encode ifos)
7.78 + | enc (Find ifos) = Find (map encode ifos)
7.79 + | enc (Relate ifos) = Relate (map encode ifos)
7.80 + in map enc imodel:imodel end;
7.81 +fun encode_icalhd ((pos', headl, imodel, pos_, spec):icalhd) =
7.82 + (pos', encode headl, encode_imodel imodel, pos_, spec):icalhd;
7.83 +fun encode_fmz ((ifos, spec):fmz) = (map encode ifos, spec):fmz;
7.84 +
7.85 +
7.86 +(***. CalcTree .***)
7.87 +
7.88 +(** add and delete users **)
7.89 +
7.90 +(*.'Iterator 1' must exist with each CalcTree;
7.91 + the only for updating the calc-tree
7.92 + WN.0411: only 'Iterator 1' is stored,
7.93 + all others are just calculated on the fly
7.94 + TODO: adapt Iterator, add_user(= add_iterator!),etc. accordingly .*)
7.95 +fun Iterator (cI:calcID) = (*returned ID unnecessary after WN.0411*)
7.96 + (adduserOK2xml cI (add_user (cI:calcID)))
7.97 + handle _ => sysERROR2xml cI "error in kernel";
7.98 +fun IteratorTEST (cI:calcID) = add_user (cI:calcID);
7.99 +(*fun DEconstructIterator (cI:calcID) (uI:iterID) =
7.100 + deluserOK2xml (del_user cI uI);*)
7.101 +
7.102 +(*.create a calc-tree; for calls from java: thus ^^^ decoded to ^;
7.103 + compare "fun CalcTreeTEST" which does NOT decode.*)
7.104 +fun CalcTree
7.105 + [(fmz, sp):fmz] (*for several variants lateron*) =
7.106 +(* val[(fmz,sp):fmz]=[(["fixedValues [r=Arbfix]","maximum A","valuesFor [a,b]",
7.107 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
7.108 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
7.109 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
7.110 + "boundVariable a","boundVariable b","boundVariable alpha",
7.111 + "interval {x::real. 0 <= x & x <= 2*r}",
7.112 + "interval {x::real. 0 <= x & x <= 2*r}",
7.113 + "interval {x::real. 0 <= x & x <= pi}",
7.114 + "errorBound (eps=(0::real))"],
7.115 + ("DiffApp.thy", ["maximum_of","function"],
7.116 + ["DiffApp","max_by_calculus"]))];
7.117 +
7.118 + *)
7.119 + (let val cs = nxt_specify_init_calc (encode_fmz (fmz, sp))
7.120 + (*FIXME.WN.8.03: error-handling missing*)
7.121 + val cI = add_calc cs
7.122 + in calctreeOK2xml cI end)
7.123 + handle _ => sysERROR2xml 0 "error in kernel";
7.124 +
7.125 +fun DEconstrCalcTree (cI:calcID) =
7.126 + deconstructcalctreeOK2xml (del_calc cI);
7.127 +
7.128 +
7.129 +fun getActiveFormula (cI:calcID) = iteratorOK2xml cI (get_pos cI 1);
7.130 +
7.131 +fun moveActiveFormula (cI:calcID) (p:pos') =
7.132 + let val ((pt,_),_) = get_calc cI
7.133 + in if existpt' p pt then (upd_ipos cI 1 p; iteratorOK2xml cI p)
7.134 + else sysERROR2xml cI "frontend sends a non-existing pos" end;
7.135 +
7.136 +(*. set the next tactic to be applied: dont't change the calc-tree,
7.137 + but remember the envisaged changes for fun autoCalculate;
7.138 + compare force NextTactic .*)
7.139 +(* val (cI, tac) = (1, Add_Given "equality (x ^^^ 2 + 4 * x + 3 = 0)");
7.140 + val (cI, tac) = (1, Specify_Theory "PolyEq.thy");
7.141 + val (cI, tac) = (1, Specify_Problem ["normalize","polynomial",
7.142 + "univariate","equation"]);
7.143 + val (cI, tac) = (1, Subproblem ("Poly.thy",
7.144 + ["polynomial","univariate","equation"]));
7.145 + val (cI, tac) = (1, Model_Problem["linear","univariate","equation","test"]);
7.146 + val (cI, tac) = (1, Detail_Set "Test_simplify");
7.147 + val (cI, tac) = (1, Apply_Method ["Test", "solve_linear"]);
7.148 + val (cI, tac) = (1, Rewrite_Set "Test_simplify");
7.149 + *)
7.150 +fun setNextTactic (cI:calcID) tac =
7.151 + let val ((pt, _), _) = get_calc cI
7.152 + val ip = get_pos cI 1
7.153 + in case locatetac tac (pt, ip) of
7.154 +(* val ("ok", (tacis, c, (_,p'))) = locatetac tac (pt, ip);
7.155 + *)
7.156 + ("ok", (tacis, _, _)) =>
7.157 + (upd_calc cI ((pt, ip), tacis); setnexttactic2xml cI "ok")
7.158 + | ("unsafe-ok", (tacis, _, _)) =>
7.159 + (upd_calc cI ((pt, ip), tacis); setnexttactic2xml cI "unsafe-ok")
7.160 + | ("not-applicable",_) => setnexttactic2xml cI "not-applicable"
7.161 + | ("end-of-calculation",_) =>
7.162 + setnexttactic2xml cI "end-of-calculation"
7.163 + | ("failure",_) => sysERROR2xml cI "failure"
7.164 + end;
7.165 +
7.166 +(*. apply a tactic at a position and update the calc-tree if applicable .*)
7.167 +(*WN080226 java-code is missing, errors smltest/IsacKnowledge/polyminus.sml*)
7.168 +(* val (cI, ip, tac) = (1, p, hd appltacs);
7.169 + val (cI, ip, tac) = (1, p, (hd (sel_appl_atomic_tacs pt p)));
7.170 + *)
7.171 +fun applyTactic (cI:calcID) ip tac =
7.172 + let val ((pt, _), _) = get_calc cI
7.173 + val p = get_pos cI 1
7.174 + in case locatetac tac (pt, ip) of
7.175 +(* val ("ok", (tacis, c, (pt',p'))) = locatetac tac (pt, ip);
7.176 + *)
7.177 + ("ok", (_, c, ptp as (_,p'))) =>
7.178 + (upd_calc cI (ptp, []); upd_ipos cI 1 p';
7.179 + autocalculateOK2xml cI p (if null c then p'
7.180 + else last_elem c) p')
7.181 + | ("unsafe-ok", (_, c, ptp as (_,p'))) =>
7.182 + (upd_calc cI (ptp, []); upd_ipos cI 1 p';
7.183 + autocalculateOK2xml cI p (if null c then p'
7.184 + else last_elem c) p')
7.185 + | ("end-of-calculation", (_, c, ptp as (_,p'))) =>
7.186 + (upd_calc cI (ptp, []); upd_ipos cI 1 p';
7.187 + autocalculateOK2xml cI p (if null c then p'
7.188 + else last_elem c) p')
7.189 +
7.190 +
7.191 + | (str,_) => autocalculateERROR2xml cI "failure"
7.192 + end;
7.193 +
7.194 +
7.195 +
7.196 +(* val cI = 1;
7.197 + *)
7.198 +fun fetchProposedTactic (cI:calcID) =
7.199 + (case step (get_pos cI 1) (get_calc cI) of
7.200 + ("ok", (tacis, _, _)) =>
7.201 + let val _= upd_tacis cI tacis
7.202 + val (tac,_,_) = last_elem tacis
7.203 + in fetchproposedtacticOK2xml cI tac end
7.204 + | ("helpless",_) => fetchproposedtacticERROR2xml cI "helpless"
7.205 + | ("no-fmz-spec",_) => fetchproposedtacticERROR2xml cI "no-fmz-spec"
7.206 + | ("end-of-calculation",_) =>
7.207 + fetchproposedtacticERROR2xml cI "end-of-calculation")
7.208 + handle _ => sysERROR2xml cI "error in kernel";
7.209 +
7.210 +(*datatype auto = FIXXXME040624: does NOT match interfaces/ITOCalc.java
7.211 + Step of int (*1 do #int steps (may stop in model/specify)
7.212 + IS VERY INEFFICIENT IN MODEL/SPECIY*)
7.213 +| CompleteModel (*2 complete modeling
7.214 + if model complete, finish specifying*)
7.215 +| CompleteCalcHead (*3 complete model/specify in one go*)
7.216 +| CompleteToSubpbl (*4 stop at the next begin of a subproblem,
7.217 + if none, complete the actual (sub)problem*)
7.218 +| CompleteSubpbl (*5 complete the actual (sub)problem (incl.ev.subproblems)*)
7.219 +| CompleteCalc; (*6 complete the calculation as a whole*)*)
7.220 +fun autoCalculate (cI:calcID) auto =
7.221 +(* val (cI, auto) = (1,CompleteCalc);
7.222 + val (cI, auto) = (1,CompleteModel);
7.223 + val (cI, auto) = (1,CompleteCalcHead);
7.224 + val (cI, auto) = (1,Step 1);
7.225 + *)
7.226 + (let val pold = get_pos cI 1
7.227 + val x = autocalc [] pold (get_calc cI) auto
7.228 + in
7.229 + case x of
7.230 +(* val (str, c, ptp as (_,p)) = x;
7.231 + *)
7.232 + ("ok", c, ptp as (_,p)) =>
7.233 + (upd_calc cI (ptp, []); upd_ipos cI 1 p;
7.234 + autocalculateOK2xml cI pold (if null c then pold
7.235 + else last_elem c) p)
7.236 + | ("end-of-calculation", c, ptp as (_,p)) =>
7.237 + (upd_calc cI (ptp, []); upd_ipos cI 1 p;
7.238 + autocalculateOK2xml cI pold (if null c then pold
7.239 + else last_elem c) p)
7.240 + | (str, _, _) => autocalculateERROR2xml cI str
7.241 + end)
7.242 + handle _ => sysERROR2xml cI "error in kernel";
7.243 +
7.244 +
7.245 +(* val (cI:calcID, ichd as ((p,_),_,_,_,_):icalhd) =
7.246 + (1, (([],Pbl), "not used here",
7.247 + [Given ["fixedValues [r=Arbfix]"],
7.248 + Find ["maximum A", "valuesFor [a,b]"(*new input*)],
7.249 + Relate ["relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]"]], Pbl,
7.250 + ("DiffApp.thy", ["maximum_of","function"],
7.251 + ["DiffApp","max_by_calculus"])));
7.252 + val (cI:calcID, ichd as ((p,_),_,_,_,_):icalhd) =
7.253 + (1, (([],Pbl),"solve (x+1=2, x)",
7.254 + [Given ["equality (x+1=2)", "solveFor x"],
7.255 + Find ["solutions L"]],
7.256 + Pbl,
7.257 + ("Test.thy", ["linear","univariate","equation","test"],
7.258 + ["Test","solve_linear"])));
7.259 + val (cI:calcID, ichd as ((p,_),_,_,_,_):icalhd) =
7.260 + (1, (([],Pbl),"solveTest (1+-1*2+x=0,x)", [], Pbl, ("", [], [])));
7.261 + val (cI, p:pos')=(1, ([1],Frm));
7.262 + val (cI, p:pos')=(1, ([1,2,1,3],Res));
7.263 + *)
7.264 +fun getTactic cI (p:pos') =
7.265 + (let val ((pt,_),_) = get_calc cI
7.266 + val (form, tac, asms) = pt_extract (pt, p)
7.267 + in case tac of
7.268 +(* val Some ta = tac;
7.269 + *)
7.270 + Some ta => gettacticOK2xml cI ta
7.271 + | None => gettacticERROR2xml cI ("no tactic at position "^pos'2str p)
7.272 + end)
7.273 + handle _ => sysERROR2xml cI "syserror in getTactic";
7.274 +
7.275 +(*. see ICalcIterator#fetchApplicableTactics
7.276 + @see #TACTICS_ALL
7.277 + @see #TACTICS_CURRENT_THEORY
7.278 + @see #TACTICS_CURRENT_METHOD ..the only impl.WN040307.*)
7.279 +(*. fetch tactics to be applied to a particular step.*)
7.280 +(* WN071231 kept this version for later parametrisation*)
7.281 +(*.version 1: fetch _all_ tactics from script .*)
7.282 +fun fetchApplicableTactics cI (scope:int) (p:pos') =
7.283 + (let val ((pt, _), _) = get_calc cI
7.284 + in (applicabletacticsOK cI (sel_rules pt p))
7.285 + handle PTREE str => sysERROR2xml cI str
7.286 + end)
7.287 + handle _ => sysERROR2xml cI "error in kernel";
7.288 +(*.version 2: fetch _applicable_ _elementary_ (ie. recursively
7.289 + decompose rule-sets) Rewrite*, Calculate .*)
7.290 +fun fetchApplicableTactics cI (scope:int) (p:pos') =
7.291 + (let val ((pt, _), _) = get_calc cI
7.292 + in (applicabletacticsOK cI (sel_appl_atomic_tacs pt p))
7.293 + handle PTREE str => sysERROR2xml cI str
7.294 + end)
7.295 + handle _ => sysERROR2xml cI "error in kernel";
7.296 +
7.297 +fun getAssumptions cI (p:pos') =
7.298 + (let val ((pt,_),_) = get_calc cI
7.299 + val (_, _, asms) = pt_extract (pt, p)
7.300 + in getasmsOK2xml cI asms end)
7.301 + handle _ => sysERROR2xml cI "syserror in getAssumptions";
7.302 +
7.303 +(*WN0502 @see ME/ctree: type asms: illdesigned, thus no positions returned*)
7.304 +fun getAccumulatedAsms cI (p:pos') =
7.305 + (let val ((pt, _), _) = get_calc cI
7.306 + val ass = map fst (get_assumptions_ pt p)
7.307 + in (*getaccuasmsOK2xml cI (get_assumptions_ pt p)*)
7.308 + getasmsOK2xml cI ass end)
7.309 + handle _ => sysERROR2xml cI "syserror in getAccumulatedAsms";
7.310 +
7.311 +
7.312 +(*since moveActive* does NOT transfer pos java --> sml (only sml --> java)
7.313 + refFormula might become involved in far-off errors !!!*)
7.314 +fun refFormula cI (p:pos') = (*WN0501 rename to 'fun getElement' !*)
7.315 +(* val (cI, uI) = (1,1);
7.316 + *)
7.317 + (let val ((pt,_),_) = get_calc cI
7.318 + val (form, tac, asms) = pt_extract (pt, p)
7.319 + in refformulaOK2xml cI p form end)
7.320 + handle _ => sysERROR2xml cI "error in kernel";
7.321 +
7.322 +(*.get formulae 'from' 'to' w.r.t. ordering in Position#compareTo(Position p);
7.323 + in case of CalcHeads only the headline is taken
7.324 + (the pos' allows distinction between PrfObj and PblObj anyway);
7.325 + 'level' is adjusted such that an 'interval' of formulae is returned;
7.326 + 'from' 'to' are designed for use by iterators of calcChangedEvent;
7.327 + thus 'from' is the last unchanged position.*)
7.328 +fun getFormulaeFromTo cI (from as ([],Pbl):pos') (to as ([],Pbl):pos')_ false =
7.329 +(*special case because 'from' is _before_ the first elements to be returned*)
7.330 +(* val (cI, from, to, level) = (1, ([],Pbl), ([],Pbl), 1);
7.331 + *)
7.332 + ((let val ((pt,_),_) = get_calc cI
7.333 + val (ModSpec (_,_,headline,_,_,_),_,_) = pt_extract (pt, to)
7.334 + in getintervalOK cI [(to, headline)] end)
7.335 + handle _ => sysERROR2xml cI "error in kernel")
7.336 +
7.337 + | getFormulaeFromTo cI (from as ([],Pbl):pos') (to as ([],Met):pos')_ false =
7.338 + getFormulaeFromTo cI ([],Pbl) ([],Pbl) (~00000) false
7.339 +
7.340 + | getFormulaeFromTo cI (from:pos') (to:pos') level false =
7.341 +(* val (cI, from, to, level) = (1, unc, gen, 0);
7.342 + val (cI, from, to, level) = (1, unc, gen, 1);
7.343 + val (cI, from, to, level) = (1, ([],Pbl), ([],Met), 1);
7.344 + *)
7.345 + (if from = to then sysERROR2xml cI "getFormulaeFromTo: From = To"
7.346 + else
7.347 + (case from of
7.348 + ([],Res) => sysERROR2xml cI "getFormulaeFromTo does: moveDown \
7.349 + \from=([],Res) .. goes beyond result"
7.350 + | _ => let val ((pt,_),_) = get_calc cI
7.351 + val f = move_dn [] pt from
7.352 + fun max (a,b) = if a < b then b else a
7.353 + (*must reach margins ...*)
7.354 + val lev = max (level, max (lev_of from, lev_of to))
7.355 + in getintervalOK cI (get_interval f to lev pt) end)
7.356 + handle _ => sysERROR2xml cI "error in getFormulaeFromTo")
7.357 +
7.358 + | getFormulaeFromTo cI from to level true =
7.359 + sysERROR2xml cI "getFormulaeFromTo impl.for formulae only,\
7.360 + \i.e. last arg only impl. for false, _NOT_ true";
7.361 +
7.362 +
7.363 +(* val (cI, ip) = (1, ([1,9], Res));
7.364 + val (cI, ip) = (1, ([], Res));
7.365 + val (cI, ip) = (1, ([2], Res));
7.366 + val (cI, ip) = (1, ([3,1], Res));
7.367 + val (cI, ip) = (1, ([1,2,1], Res));
7.368 + *)
7.369 +fun interSteps cI ip =
7.370 + (let val ((pt,p), tacis) = get_calc cI
7.371 + in if (not o is_interpos) ip
7.372 + then interStepsERROR cI "only formulae with position (_,Res) \
7.373 + \may have intermediate steps above them"
7.374 + else let val ip' = lev_pred' pt ip
7.375 +(* val (str, pt', lastpos) = detailstep pt ip;
7.376 + *)
7.377 + in case detailstep pt ip of
7.378 + ("detailrls", pt(*, pos'forms*), lastpos) =>
7.379 + (upd_calc cI ((pt, p), tacis);
7.380 + interStepsOK cI (*pos'forms*) ip' ip' lastpos)
7.381 + | ("no-Rewrite_Set...", _, _) =>
7.382 + sysERROR2xml cI "no Rewrite_Set..."
7.383 + | (_, _(*, pos'formshds*), lastpos) =>
7.384 + interStepsOK cI (*pos'formshds*) ip' ip' lastpos
7.385 + end
7.386 + end)
7.387 + handle _ => sysERROR2xml cI "error in kernel";
7.388 +
7.389 +fun modifyCalcHead (cI:calcID) (ichd as ((p,_),_,_,_,_):icalhd) =
7.390 + (let val ((pt,_),_) = get_calc cI
7.391 + val (pt, chd as (_,p_,_,_,_,_)) = input_icalhd pt ichd
7.392 + in (upd_calc cI ((pt, (p,p_)), []);
7.393 + modifycalcheadOK2xml cI chd) end)
7.394 + handle _ => sysERROR2xml cI "error in kernel";
7.395 +
7.396 +(*.at the activeFormula set the Model, the Guard and the Specification
7.397 + to empty and return a CalcHead;
7.398 + the 'origin' remains (for reconstructing all that).*)
7.399 +fun resetCalcHead (cI:calcID) =
7.400 + (let val (ptp,_) = get_calc cI
7.401 + val ptp = reset_calchead ptp
7.402 + in (upd_calc cI (ptp, []);
7.403 + modifycalcheadOK2xml cI (get_ocalhd ptp)) end)
7.404 + handle _ => sysERROR2xml cI "error in kernel";
7.405 +
7.406 +(*.at the activeFormula insert all the Descriptions in the Model
7.407 + (_not_ in the Guard) and return a CalcHead;
7.408 + the Descriptions are for user-guidance; the rest of the items
7.409 + are left empty for user-input;
7.410 + includes a resetCalcHead for the Model and the Guard.*)
7.411 +fun modelProblem (cI:calcID) =
7.412 + (let val (ptp, _) = get_calc cI
7.413 + val ptp = reset_calchead ptp
7.414 + val (_, _, ptp) = nxt_specif Model_Problem ptp
7.415 + in (upd_calc cI (ptp, []);
7.416 + modifycalcheadOK2xml cI (get_ocalhd ptp)) end)
7.417 + handle _ => sysERROR2xml cI "error in kernel";
7.418 +
7.419 +
7.420 +(*.set the context determined on a knowledgebrowser to the current calc.*)
7.421 +fun setContext (cI:calcID) (ip as (_,p_):pos') (guh:guh) =
7.422 + (case (implode o (take_fromto 1 4) o explode) guh of
7.423 + "thy_" =>
7.424 +(* val (cI, ip as (_,p_), guh) = (1, p, "thy_isac_Test-rls-Test_simplify");
7.425 + *)
7.426 + if p_ mem [Pbl,Met] then message2xml cI "thy-context not to calchead"
7.427 + else if ip = ([],Res) then message2xml cI "no thy-context at result"
7.428 + else if no_thycontext guh then message2xml cI ("no thy-context for '"^
7.429 + guh ^ "'")
7.430 + else let val (ptp as (pt,pold),_) = get_calc cI
7.431 + val is = get_istate pt ip
7.432 + val subs = subs_from is "dummy" guh
7.433 + val tac = guh2rewtac guh subs
7.434 + in case locatetac tac (pt, ip) of (*='fun setNextTactic'+step*)
7.435 + ("ok", (tacis, c, ptp as (_,p))) =>
7.436 +(* val (str, (tacis, c, ptp as (_,p))) = locatetac tac (pt, ip);
7.437 + *)
7.438 + (upd_calc cI ((pt,p), []);
7.439 + autocalculateOK2xml cI pold (if null c then pold
7.440 + else last_elem c) p)
7.441 + | ("unsafe-ok", (tacis, c, ptp as (_,p))) =>
7.442 + (upd_calc cI ((pt,p), []);
7.443 + autocalculateOK2xml cI pold (if null c then pold
7.444 + else last_elem c) p)
7.445 + | ("end-of-calculation",_) =>
7.446 + message2xml cI "end-of-calculation"
7.447 + | ("failure",_) => sysERROR2xml cI "failure"
7.448 + | ("not-applicable",_) => (*the rule comes from anywhere..*)
7.449 + (case applicable_in ip pt tac of
7.450 +
7.451 + Notappl e => message2xml cI ("'" ^ tac2str tac ^
7.452 + "' not-applicable")
7.453 + | Appl m =>
7.454 + let val (p,c,_,pt) = generate1 (assoc_thy"Isac.thy")
7.455 + m Uistate ip pt
7.456 + in upd_calc cI ((pt,p),[]);
7.457 + autocalculateOK2xml cI pold (if null c then pold
7.458 + else last_elem c) p
7.459 + end)
7.460 + end
7.461 +(* val (cI, ip as (_,p_), guh) = (1, pos, guh);
7.462 + *)
7.463 + | "pbl_" =>
7.464 + let val pI = guh2kestoreID guh
7.465 + val ((pt, _), _) = get_calc cI
7.466 + (*val ip as (_, p_) = get_pos cI 1*)
7.467 + in if p_ mem [Pbl, Met]
7.468 + then let val (pt, chd) = set_problem pI (pt, ip)
7.469 + in (upd_calc cI ((pt, ip), []);
7.470 + modifycalcheadOK2xml cI chd) end
7.471 + else sysERROR2xml cI "setContext for pbl requires ActiveFormula \
7.472 + \on CalcHead"
7.473 + end
7.474 +(* val (cI, ip as (_,p_), guh) = (1, pos, "met_eq_lin");
7.475 + *)
7.476 + | "met_" =>
7.477 + let val mI = guh2kestoreID guh
7.478 + val ((pt, _), _) = get_calc cI
7.479 + in if p_ mem [Pbl, Met]
7.480 + then let val (pt, chd) = set_method mI (pt, ip)
7.481 + in (upd_calc cI ((pt, ip), []);
7.482 + modifycalcheadOK2xml cI chd) end
7.483 + else sysERROR2xml cI "setContext for met requires ActiveFormula \
7.484 + \on CalcHead"
7.485 + end)
7.486 + handle _ => sysERROR2xml cI "error in kernel";
7.487 +
7.488 +
7.489 +(*.specify the Method at the activeFormula and return a CalcHead
7.490 + containing the Guard.
7.491 + WN0512 impl.incomplete, see 'nxt_specif (Specify_Method '.*)
7.492 +fun setMethod (cI:calcID) (mI:metID) =
7.493 +(* val (cI, mI) = (1, ["Test","solve_linear"]);
7.494 + *)
7.495 + (let val ((pt, _), _) = get_calc cI
7.496 + val ip as (_, p_) = get_pos cI 1
7.497 + in if p_ mem [Pbl, Met]
7.498 + then let val (pt, chd) = set_method mI (pt, ip)
7.499 + in (upd_calc cI ((pt, ip), []);
7.500 + modifycalcheadOK2xml cI chd) end
7.501 + else sysERROR2xml cI "setMethod requires ActiveFormula on CalcHead"
7.502 + end)
7.503 + handle _ => sysERROR2xml cI "error in kernel";
7.504 +
7.505 +(*.specify the Problem at the activeFormula and return a CalcHead
7.506 + containing the Model; special case of checkContext;
7.507 + WN0512 impl.incomplete, see 'nxt_specif (Specify_Problem '.*)
7.508 +fun setProblem (cI:calcID) (pI:pblID) =
7.509 + (let val ((pt, _), _) = get_calc cI
7.510 + val ip as (_, p_) = get_pos cI 1
7.511 + in if p_ mem [Pbl, Met]
7.512 + then let val (pt, chd) = set_problem pI (pt, ip)
7.513 + in (upd_calc cI ((pt, ip), []);
7.514 + modifycalcheadOK2xml cI chd) end
7.515 + else sysERROR2xml cI "setProblem requires ActiveFormula on CalcHead"
7.516 + end)
7.517 + handle _ => sysERROR2xml cI "error in kernel";
7.518 +
7.519 +(*.specify the Theory at the activeFormula and return a CalcHead;
7.520 + special case of checkContext;
7.521 + WN0512 impl.incomplete, see 'nxt_specif (Specify_Method '.*)
7.522 +fun setTheory (cI:calcID) (tI:thyID) =
7.523 + (let val ((pt, _), _) = get_calc cI
7.524 + val ip as (_, p_) = get_pos cI 1
7.525 + in if p_ mem [Pbl, Met]
7.526 + then let val (pt, chd) = set_theory tI (pt, ip)
7.527 + in (upd_calc cI ((pt, ip), []);
7.528 + modifycalcheadOK2xml cI chd) end
7.529 + else sysERROR2xml cI "setProblem requires ActiveFormula on CalcHead"
7.530 + end)
7.531 + handle _ => sysERROR2xml cI "error in kernel";
7.532 +
7.533 +
7.534 +(**. without update of CalcTree .**)
7.535 +
7.536 +(*.match the model of a problem at pos p
7.537 + with the model-pattern of the problem with pblID*)
7.538 +(*fun tryMatchProblem cI pblID =
7.539 + (let val ((pt,_),_) = get_calc cI
7.540 + val p = get_pos cI 1
7.541 + val chd = trymatch pblID pt p
7.542 + in trymatchOK2xml cI chd end)
7.543 + handle _ => sysERROR2xml cI "error in kernel";*)
7.544 +
7.545 +(*.refinement for the parent-problem of the position.*)
7.546 +(* val (cI, (p,p_), guh) = (1, ([1],Res), "pbl_equ_univ");
7.547 + *)
7.548 +fun refineProblem cI ((p,p_) : pos') (guh : guh) =
7.549 + (let val pblID = guh2kestoreID guh
7.550 + val ((pt,_),_) = get_calc cI
7.551 + val pp = par_pblobj pt p
7.552 + val chd = tryrefine pblID pt (pp, p_)
7.553 + in matchpbl2xml cI chd end)
7.554 + handle _ => sysERROR2xml cI "error in kernel";
7.555 +
7.556 +(* val (cI, ifo) = (1, "-2 * 1 + (1 + x) = 0");
7.557 + val (cI, ifo) = (1, "x = 2");
7.558 + val (cI, ifo) = (1, "[x = 3 + -2*1]");
7.559 + val (cI, ifo) = (1, "-1 + x = 0");
7.560 + val (cI, ifo) = (1, "x - 4711 = 0");
7.561 + val (cI, ifo) = (1, "2+ -1 + x = 2");
7.562 + val (cI, ifo) = (1, " x - ");
7.563 + val (cI, ifo) = (1, "(-3 * x + 4 * y + -1 * x * y) / (x * y)");
7.564 + val (cI, ifo) = (1, "(4 * y + -3 * x) / (x * y) + -1");
7.565 + *)
7.566 +fun appendFormula cI (ifo:cterm') =
7.567 + (let val cs = get_calc cI
7.568 + val pos as (_,p_) = get_pos cI 1
7.569 + in case step pos cs of
7.570 +(* val (str, cs') = step pos cs;
7.571 + *)
7.572 + ("ok", cs') =>
7.573 + (case inform cs' (encode ifo) of
7.574 +(* val (str, (_, c, ptp as (_,p))) = inform cs' (encode ifo);
7.575 + *)
7.576 + ("ok", (_(*use in DG !!!*), c, ptp as (_,p))) =>
7.577 + (upd_calc cI (ptp, []); upd_ipos cI 1 p;
7.578 + appendformulaOK2xml cI pos (if null c then pos
7.579 + else last_elem c) p)
7.580 + | ("same-formula", (_, c, ptp as (_,p))) =>
7.581 + (upd_calc cI (ptp, []); upd_ipos cI 1 p;
7.582 + appendformulaOK2xml cI pos (if null c then pos
7.583 + else last_elem c) p)
7.584 + | (msg, _) => appendformulaERROR2xml cI msg)
7.585 + | (msg, cs') => appendformulaERROR2xml cI msg
7.586 + end)
7.587 + handle _ => sysERROR2xml cI "error in kernel";
7.588 +
7.589 +
7.590 +
7.591 +(*.replace a formula with_in_ a calculation;
7.592 + this situation applies for initial CAS-commands, too.*)
7.593 +(* val (cI, ifo) = (2, "-1 + x = 0");
7.594 + val (cI, ifo) = (1, "-1 + x = 0");
7.595 + val (cI, ifo) = (1, "x - 1 = 0");
7.596 + val (cI, ifo) = (1, "x = 1");
7.597 + val (cI, ifo) = (1, "solve(x+1=2,x)");
7.598 + val (cI, ifo) = (1, "Simplify (2*a + 3*a)");
7.599 + val (cI, ifo) = (1, "Diff (x^2 + x + 1, x)");
7.600 + *)
7.601 +fun replaceFormula cI (ifo:cterm') =
7.602 + (let val ((pt, _), _) = get_calc cI
7.603 + val p = get_pos cI 1
7.604 + in case inform (([], [], (pt, p)): calcstate') (encode ifo) of
7.605 + ("ok", (_(*tacs used for DG ?*), c, ptp' as (pt',p'))) =>
7.606 +(* val (str, (_,c, ptp' as (pt',p')))= inform ([], [], (pt, p)) (encode ifo);
7.607 + *)
7.608 + let val unc = if null (fst p) then p else move_up [] pt p
7.609 + val _ = upd_calc cI (ptp', [])
7.610 + val _ = upd_ipos cI 1 p'
7.611 + in replaceformulaOK2xml cI unc
7.612 + (if null c then unc
7.613 + else last_elem c) p'(*' NEW*) end
7.614 + | ("same-formula", _) =>
7.615 + (*TODO.WN0501 MESSAGE !*)
7.616 + replaceformulaERROR2xml cI "formula not changed"
7.617 + | (msg, _) => replaceformulaERROR2xml cI msg
7.618 + end)
7.619 + handle _ => sysERROR2xml cI "error in kernel";
7.620 +
7.621 +
7.622 +
7.623 +(***. CalcIterator
7.624 + moveActive*: set the pos' of the active formula stored with the calctree
7.625 + could take pos' as argument for consistency checks
7.626 + move*: compute the new iterator from the old one on the fly
7.627 +
7.628 +.***)
7.629 +
7.630 +fun moveActiveRoot cI =
7.631 + (let val _ = upd_ipos cI 1 ([],Pbl)
7.632 + in iteratorOK2xml cI ([],Pbl) end)
7.633 + handle e => sysERROR2xml cI "error in kernel";
7.634 +fun moveRoot cI =
7.635 + (iteratorOK2xml cI ([],Pbl))
7.636 + handle e => sysERROR2xml cI "";
7.637 +fun moveActiveRootTEST cI =
7.638 + (let val _ = upd_ipos cI 1 ([],Pbl)
7.639 + in (*iteratorOK2xml cI ([],Pbl)*)() end)
7.640 + handle e => sysERROR2xml cI "error in kernel";
7.641 +
7.642 +(* val (cI, uI) = (1,1);
7.643 + val (cI, uI) = (1,2);
7.644 + *)
7.645 +fun moveActiveDown cI =
7.646 + ((let val ((pt,_),_) = get_calc cI
7.647 +(* val (P, (Nd (_, ns)), (p::(ps as (_::_)), p_)) =([]:pos, pt, get_pos cI uI);
7.648 + val (P, (Nd (c, ns)), ([p], p_)) =([]:pos, pt, get_pos cI uI);
7.649 +
7.650 + print_depth 7;pt
7.651 + *)
7.652 + val ip' = move_dn [] pt (get_pos cI 1)
7.653 + val _ = upd_ipos cI 1 ip'
7.654 + in iteratorOK2xml cI ip' end)
7.655 + handle (PTREE e) => iteratorERROR2xml cI)
7.656 + handle _ => sysERROR2xml cI "error in kernel";
7.657 +fun moveDown cI (p:pos') =
7.658 + ((let val ((pt,_),_) = get_calc cI
7.659 +(* val (P, (Nd (_, ns)), (p::(ps as (_::_)), p_)) =([]:pos, pt, get_pos cI uI);
7.660 + val (P, (Nd (c, ns)), ([p], p_)) =([]:pos, pt, get_pos cI uI);
7.661 +
7.662 + print_depth 7;pt
7.663 + *)
7.664 + val ip' = move_dn [] pt p
7.665 + in iteratorOK2xml cI ip' end)
7.666 + handle (PTREE e) => iteratorERROR2xml cI)
7.667 + handle _ => sysERROR2xml cI "error in kernel";
7.668 +fun moveActiveDownTEST cI =
7.669 + let val ((pt,_),_) = get_calc cI
7.670 + val ip = get_pos cI 1
7.671 + val ip' = (move_dn [] pt ip)
7.672 + handle _ => ip
7.673 + val _ = upd_ipos cI 1 ip'
7.674 + in (*iteratorOK2xml cI uI*)() end;
7.675 +
7.676 +fun moveActiveLevelDown cI =
7.677 + ((let val ((pt,_),_) = get_calc cI
7.678 + val ip' = movelevel_dn [] pt (get_pos cI 1)
7.679 + val _ = upd_ipos cI 1 ip'
7.680 + in iteratorOK2xml cI ip' end)
7.681 + handle (PTREE e) => iteratorERROR2xml cI)
7.682 + handle _ => sysERROR2xml cI "error in kernel";
7.683 +fun moveLevelDown cI (p:pos') =
7.684 + ((let val ((pt,_),_) = get_calc cI
7.685 + val ip' = movelevel_dn [] pt p
7.686 + in iteratorOK2xml cI ip' end)
7.687 + handle (PTREE e) => iteratorERROR2xml cI)
7.688 + handle _ => sysERROR2xml cI "error in kernel";
7.689 +
7.690 +fun moveActiveUp cI =
7.691 + ((let val ((pt,_),_) = get_calc cI
7.692 + val ip' = move_up [] pt (get_pos cI 1)
7.693 + val _ = upd_ipos cI 1 ip'
7.694 + in iteratorOK2xml cI ip' end)
7.695 + handle PTREE e => iteratorERROR2xml cI)
7.696 + handle _ => sysERROR2xml cI "error in kernel";
7.697 +fun moveUp cI (p:pos') =
7.698 + ((let val ((pt,_),_) = get_calc cI
7.699 + val ip' = move_up [] pt p
7.700 + in iteratorOK2xml cI ip' end)
7.701 + handle PTREE e => iteratorERROR2xml cI)
7.702 + handle _ => sysERROR2xml cI "error in kernel";
7.703 +
7.704 +fun moveActiveLevelUp cI =
7.705 + ((let val ((pt,_),_) = get_calc cI
7.706 + val ip' = movelevel_up [] pt (get_pos cI 1)
7.707 + val _ = upd_ipos cI 1 ip'
7.708 + in iteratorOK2xml cI ip' end)
7.709 + handle PTREE e => iteratorERROR2xml cI)
7.710 + handle _ => sysERROR2xml cI "error in kernel";
7.711 +fun moveLevelUp cI (p:pos') =
7.712 + ((let val ((pt,_),_) = get_calc cI
7.713 + val ip' = movelevel_up [] pt p
7.714 + in iteratorOK2xml cI ip' end)
7.715 + handle PTREE e => iteratorERROR2xml cI)
7.716 + handle _ => sysERROR2xml cI "error in kernel";
7.717 +
7.718 +fun moveActiveCalcHead cI =
7.719 + ((let val ((pt,_),_) = get_calc cI
7.720 + val ip' = movecalchd_up pt (get_pos cI 1)
7.721 + val _ = upd_ipos cI 1 ip'
7.722 + in iteratorOK2xml cI ip' end)
7.723 + handle PTREE e => iteratorERROR2xml cI)
7.724 + handle _ => sysERROR2xml cI "error in kernel";
7.725 +fun moveCalcHead cI (p:pos') =
7.726 + ((let val ((pt,_),_) = get_calc cI
7.727 + val ip' = movecalchd_up pt p
7.728 + in iteratorOK2xml cI ip' end)
7.729 + handle PTREE e => iteratorERROR2xml cI)
7.730 + handle _ => sysERROR2xml cI "error in kernel";
7.731 +
7.732 +
7.733 +(*.initContext Thy_ is conceptually impossible at [Pbl,Met]
7.734 + and at positions with Check_Postcond and End_Trans;
7.735 + at possible pos's there can be NO rewrite (returned as a context, too).*)
7.736 +(* val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([1], Frm));
7.737 + val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([], Res));
7.738 + val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([2], Res));
7.739 + val (cI, Thy_, (pos as (p,p_):pos')) = (1, Thy_, ([1,1], Frm));
7.740 + *)
7.741 +fun initContext (cI:calcID) Thy_ (pos as (p,p_):pos') =
7.742 + ((if p_ mem [Pbl,Met] then message2xml cI "thy-context not to calchead"
7.743 + else if pos = ([],Res) then message2xml cI "no thy-context at result"
7.744 + else let val cs as (ptp as (pt,_),_) = get_calc cI
7.745 + in if exist_lev_on' pt pos
7.746 + then let val pos' = lev_on' pt pos
7.747 + val tac = get_tac_checked pt pos'
7.748 + in if is_rewtac tac
7.749 + then contextthyOK2xml cI (context_thy (pt,pos) tac)
7.750 + else message2xml cI ("no thy-context at tac '" ^
7.751 + tac2str tac ^ "'")
7.752 + end
7.753 + else if is_curr_endof_calc pt pos
7.754 + then case step pos cs of
7.755 +(* val (str, (tacis, _, (pt,_))) = step pos cs;
7.756 + val ("ok", (tacis, _, (pt,_))) = step pos cs;
7.757 + *)
7.758 + ("ok", (tacis, _, (pt,_))) =>
7.759 + let val tac = fst3 (last_elem tacis)
7.760 + in if is_rewtac tac
7.761 + then contextthyOK2xml
7.762 + cI (context_thy ptp tac)
7.763 + else message2xml cI ("no thy-context at tac '" ^
7.764 + tac2str tac ^ "'")
7.765 + end
7.766 + | (msg, _) => message2xml cI msg
7.767 + else message2xml cI "no thy-context at this position"
7.768 + end)
7.769 + handle _ => sysERROR2xml cI "error in kernel")
7.770 +
7.771 +(* val (cI, Pbl_, pos as (p,p_)) = (1, Pbl_, ([],Pbl));
7.772 + *)
7.773 + | initContext cI Pbl_ (pos as (p,p_):pos') =
7.774 + ((let val ((pt,_),_) = get_calc cI
7.775 + val pp = par_pblobj pt p
7.776 + val chd = initcontext_pbl pt (pp,p_)
7.777 + in matchpbl2xml cI chd end)
7.778 + handle _ => sysERROR2xml cI "error in kernel")
7.779 +
7.780 + | initContext cI Met_ (pos as (p,p_):pos') =
7.781 + ((let val ((pt,_),_) = get_calc cI
7.782 + val pp = par_pblobj pt p
7.783 + val chd = initcontext_met pt (pp,p_)
7.784 + in matchmet2xml cI chd end)
7.785 + handle _ => sysERROR2xml cI "error in kernel");
7.786 +
7.787 +
7.788 +
7.789 +(*.match a theorem, a ruleset (etc., selected in the knowledge-browser)
7.790 +with the formula in the focus on the worksheet;
7.791 +string contains the thy, thus it is unique as thmID, rlsID for this thy;
7.792 +take the substitution from the istate of the formula.*)
7.793 +(* use"../smltest/IsacKnowledge/poly.sml";
7.794 + val (cI, pos as (p,p_), guh) = (1, ([1,1,1], Frm),
7.795 + "thy_Poly-thm-real_diff_minus");
7.796 + val (cI, pos as (p,p_), guh) = (1, ([1,1], Frm), "norm_Poly");
7.797 + val (cI, pos as (p,p_), guh) =
7.798 + (1, ([1], Res), "thy_isac_Test-rls-Test_simplify");
7.799 + *)
7.800 +fun checkContext (cI:calcID) (pos:pos' as (p,p_)) (guh:guh) =
7.801 + (case (implode o (take_fromto 1 4) o explode) guh of
7.802 + "thy_" =>
7.803 + if p_ mem [Pbl,Met] then message2xml cI "thy-context not to calchead"
7.804 + else if pos = ([],Res) then message2xml cI "no thy-context at result"
7.805 + else if no_thycontext guh then message2xml cI ("no thy-context for '"^
7.806 + guh ^ "'")
7.807 + else let val (ptp as (pt,_),_) = get_calc cI
7.808 + val is = get_istate pt pos
7.809 + val subs = subs_from is "dummy" guh
7.810 + val tac = guh2rewtac guh subs
7.811 + in contextthyOK2xml cI (context_thy (pt, pos) tac) end
7.812 +
7.813 + (*.match the model of a problem at pos p
7.814 + with the model-pattern of the problem with pblID.*)
7.815 +(* val (cI, pos:pos' as (p,p_), guh) =
7.816 + (1, p, kestoreID2guh Pbl_ ["univariate","equation"]);
7.817 + val (cI, pos:pos' as (p,p_), guh) =
7.818 + (1, ([],Pbl), kestoreID2guh Pbl_ ["univariate","equation"]);
7.819 + val (cI, pos:pos' as (p,p_), guh) =
7.820 + (1, ([],Pbl), "pbl_equ_univ");
7.821 + *)
7.822 + | "pbl_" =>
7.823 + let val ((pt,_),_) = get_calc cI
7.824 + val pp = par_pblobj pt p
7.825 + val keID = guh2kestoreID guh
7.826 + val chd = context_pbl keID pt pp
7.827 + in matchpbl2xml cI chd end
7.828 +(* val (cI, pos:pos' as (p,p_), guh) =
7.829 + (1, ([],Pbl), kestoreID2guh Met_ ["LinEq", "solve_lineq_equation"]);
7.830 + *)
7.831 + | "met_" =>
7.832 + let val ((pt,_),_) = get_calc cI
7.833 + val pp = par_pblobj pt p
7.834 + val keID = guh2kestoreID guh
7.835 + val chd = context_met keID pt pp
7.836 + in matchmet2xml cI chd end)
7.837 + handle _ => sysERROR2xml cI "error in kernel";
7.838 +
7.839 +
7.840 +(*------------------------------------------------------------------*)
7.841 +end
7.842 +open interface;
7.843 +(*------------------------------------------------------------------*)
8.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2 +++ b/src/Pure/isac/FE-interface/messages.sml Wed Jul 21 13:53:39 2010 +0200
8.3 @@ -0,0 +1,43 @@
8.4 +(* all messages are encoded to integers for the multi-language system
8.5 + use"FE-interface/messages.sml";
8.6 + use"messages.sml";
8.7 + *)
8.8 +
8.9 +datatype language = English | German | Japanese;
8.10 +fun language2str English = "English"
8.11 + | language2str German = "German"
8.12 + | language2str Japanese = "Japanese";
8.13 +
8.14 +val language = English;
8.15 +
8.16 +(*1000 system*)
8.17 +fun msg2str 1000 English =
8.18 + "msg 1000 English"
8.19 + | msg2str 1000 German =
8.20 + "msg 1000 German"
8.21 +
8.22 +(*2000 user in model- and specify-phase*)
8.23 + | msg2str 2020 English =
8.24 + "Kernel cannot propose a tactic (helpless!)"
8.25 +
8.26 +
8.27 +(*3000 user in solve-phase*)
8.28 +
8.29 +(*4000 general*)
8.30 +
8.31 +(*5000 general*)
8.32 +
8.33 +(*6000 general*)
8.34 +
8.35 +(*7000 general*)
8.36 +
8.37 +(*1000 general*)
8.38 +
8.39 +(*1000 general*)
8.40 +
8.41 +(*1000 general*)
8.42 +
8.43 +(*1000 general*)
8.44 +
8.45 + | msg2str i l = raise error ("no message for No. "^
8.46 + string_of_int i^" "^language2str l);
9.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2 +++ b/src/Pure/isac/FE-interface/states.sml Wed Jul 21 13:53:39 2010 +0200
9.3 @@ -0,0 +1,487 @@
9.4 +(* states for calculation in global refs
9.5 + use"../states.sml";
9.6 + use"states.sml";
9.7 + *)
9.8 +
9.9 +(*
9.10 +type hide = (pblID *
9.11 + string list * (*hide: tacs +
9.12 + "ALL", .. result immediately
9.13 + "MODELPBL", .. modeling hidden
9.14 + "SPEC", .. specifying hidden
9.15 + "MODELMET", .. (additional itms !)
9.16 + "APPLY", .. solving hidden
9.17 + detail: rls
9.18 + "Rewrite_*" (as strings) must _not_ be ..
9.19 + .. contained in this list, rls _only_ !*)
9.20 + bool) (*inherit to children in pbl-herarchy*)
9.21 + list;
9.22 +
9.23 +(*. points a pbl/metID to a sub-hierarchy of key ?.*)
9.24 +fun is_child_of child key =
9.25 + let fun is_ch [] [] = true (*is child of itself*)
9.26 + | is_ch (c::_) [] = true
9.27 + | is_ch [] (k::_) = false
9.28 + | is_ch (c::cs) (k::ks) =
9.29 + if c = k then is_ch cs ks else false
9.30 + in is_ch (rev child) (rev key) end;
9.31 +(*
9.32 +is_child_of ["root","univar","equation"] ["univar","equation"];
9.33 +val it = true : bool
9.34 +is_child_of ["root","univar","equation"] ["system","equation"];
9.35 +val it = false : bool
9.36 +is_child_of ["equation"] ["system","equation"];
9.37 +val it = false : bool
9.38 +is_child_of ["root","univar","equation"] ["linear","univar","equation"];
9.39 +val it = false : bool
9.40 +*)
9.41 +
9.42 +(*.what tactics have to be hidden (in model/specify these may be several).*)
9.43 +datatype hid =
9.44 + Show (**)
9.45 + | Hundef (**)
9.46 + | Htac (*a tactic has to be hidden*)
9.47 + | Hmodel (*the model of the (sub)problem has to be hidden*)
9.48 + | Hspecify (*the specification of the (sub)problem has to be hidden*)
9.49 + | Happly; (*solving the (sub)problem has to be hidden*)
9.50 +
9.51 +(*. search all pbls if there is some tactic or model/spec/calc to hide .*)
9.52 +fun is_hid pblID arg [] = Show
9.53 + | is_hid pblID arg ((pblID', strs, inherit)::pts) =
9.54 + let fun is_mem arg =
9.55 + if arg mem strs then Htac
9.56 + else if arg mem ["Add_Given","Add_Find","Add_Relation"]
9.57 + andalso "MODEL" mem strs then Hmodel
9.58 + else if arg mem ["Specify_Theory","Specify_Problem",
9.59 + "Specify_Method"]
9.60 + andalso "SPEC" mem strs then Hspecify
9.61 + else if "APPLY" mem strs then Htac
9.62 + else Hundef
9.63 + in if inherit then
9.64 + if is_child_of (pblID:pblID) pblID'
9.65 + then case is_mem arg of Hundef => is_hid pblID arg (pts:hide)
9.66 + | hid => hid
9.67 + else is_hid pblID arg pts
9.68 + else if pblID = pblID'
9.69 + then case is_mem arg of Hundef => is_hid pblID arg (pts:hide)
9.70 + | hid => hid
9.71 + else is_hid pblID arg pts
9.72 + end;
9.73 +(*val hide = [([],["Refine_Tacitly"],true),
9.74 + (["univar","equation"],["Apply_Method","Model_Problem","SPEC"],
9.75 + false)]
9.76 + :hide;
9.77 +is_hid [] "Rewrite" hide;
9.78 +val it = Show
9.79 +is_hid ["any","problem"] "Refine_Tacitly" hide;
9.80 +val it = Htac
9.81 +is_hid ["root","univar","equation"] "Apply_Method" hide;
9.82 +val it = Show
9.83 +is_hid ["univar","equation"] "Apply_Method" hide;
9.84 +val it = Htac
9.85 +is_hid ["univar","equation"] "Specify_Problem" hide;
9.86 +val it = Hspecify
9.87 +*)
9.88 +
9.89 +fun is_hide pblID (tac as (Subproblem (_,pI))) (det:detail) =
9.90 + is_hid pblID "SELF" det
9.91 + | is_hide pblID (tac as (Rewrite (thmID,_))) det =
9.92 + is_hid pblID thmID det
9.93 + | is_hide pblID (tac as (Rewrite_Inst (_,(thmID,_)))) det =
9.94 + is_hid pblID thmID det
9.95 + | is_hide pblID (tac as (Rewrite_Set rls)) det =
9.96 + is_hid pblID rls det
9.97 + | is_hide pblID (tac as (Rewrite_Set_Inst (_,rls))) det =
9.98 + is_hid pblID rls det
9.99 + | is_hide pblID tac det = is_hid pblID (tac2IDstr tac) det;
9.100 +(*val hide = [([],["Refine_Tacitly"],true),
9.101 + (["univar","equation"],["Apply_Method","Model_Problem",
9.102 + "SPEC","SELF"],
9.103 + false)]
9.104 + :hide;
9.105 +is_hide [] (Rewrite ("","")) hide;
9.106 +val it = Show
9.107 +is_hide ["any","problem"] (Refine_Tacitly []) hide;
9.108 +val it = Htac
9.109 +is_hide ["root","univar","equation"] (Apply_Method []) hide;
9.110 +val it = Show
9.111 +is_hide ["univar","equation"] (Apply_Method []) hide;
9.112 +val it = Htac
9.113 +is_hide ["univar","equation"] (Specify_Problem []) hide;
9.114 +val it = Hspecify
9.115 +is_hide ["univar","equation"] (Subproblem (e_domID,["univar","equation"]))hide;
9.116 +val it = Htac
9.117 +is_hide ["equation"] (Subproblem (e_domID,["univar","equation"]))hide;
9.118 +val it = Show
9.119 +*)
9.120 +
9.121 +
9.122 +(*. search all pbls in detail if there is some rls' to be detailed .*)
9.123 +fun is_det pblID arg [] = false
9.124 + | is_det pblID arg ((pblID', rlss, inherit)::pts) =
9.125 + if inherit then
9.126 + if is_child_of (pblID:pblID) pblID'
9.127 + then if arg mem rlss then true
9.128 + else is_det pblID arg (pts:detail)
9.129 + else is_det pblID arg pts
9.130 + else if pblID = pblID'
9.131 + then if arg mem rlss then true
9.132 + else is_det pblID arg (pts:detail)
9.133 + else is_det pblID arg pts;
9.134 +
9.135 +(*fun is_detail pblID (tac as (Subproblem (_,pI))) (det:detail) =
9.136 + is_det pblID "SELF" det*)
9.137 +fun is_detail pblID (tac as (Rewrite_Set rls)) det =
9.138 + is_det pblID rls det
9.139 + | is_detail pblID (tac as (Rewrite_Set_Inst (_,rls))) det =
9.140 + is_det pblID rls det
9.141 + | is_detail _ _ _ = false;
9.142 +----------------------------------------*)
9.143 +
9.144 +type iterID = int;
9.145 +type calcID = int;
9.146 +
9.147 +(*FIXME.WN.9.03: ev. resdesign calcstate + pos for CalcIterator
9.148 +type state =
9.149 + (*pos' * set by the CalcIterator ---> for each user*)
9.150 + calcstate; (*to which ev.included 'preview' tac_s could be applied*)
9.151 +val e_state = (e_pos', e_calcstate):state;
9.152 +val states = ref ([]:(iterID * (calcID * state) list) list);
9.153 +*)
9.154 +
9.155 +val states =
9.156 + ref ([]:(calcID *
9.157 + (calcstate *
9.158 + (iterID * (*1 sets the 'active formula'*)
9.159 + pos' (*for iterator of a user *)
9.160 + ) list)) list);
9.161 +(*
9.162 +states:= [(3,(e_calcstate, [(1,e_pos'),
9.163 + (3,e_pos')])),
9.164 + (4,(e_calcstate, [(1,e_pos'),
9.165 + (2,e_pos')]))];
9.166 +*)
9.167 +
9.168 +(** create new instances of users and ptrees
9.169 + new keys are the lowest possible in the association list **)
9.170 +
9.171 +(* add users *)
9.172 +fun new_key u n = case assoc (u, n) of
9.173 + None => n
9.174 +| Some _ => new_key u (n+1);
9.175 +(*///10.10
9.176 +fun get_calcID (u:(calcID * (calcstate * (iterID * pos') list)) list) =
9.177 + (new_key u 1):calcID;*)
9.178 +(*
9.179 +val new_iterID = get_calcID (!states);
9.180 +val it = 1 : int
9.181 +states:= (!states) @ [(new_iterID, [])];
9.182 +!states;
9.183 +val it = [(3,[(#,#),(#,#)]),(4,[(#,#),(#,#)]),(1,[])]
9.184 +*)
9.185 +
9.186 +(*///7.10.03/// add states to a users active states
9.187 +fun get_calcID (uI:iterID) (p:(iterID * (calcID * state) list) list) =
9.188 + case assoc (p, uI) of
9.189 + None => raise error ("get_calcID: no iterID " ^
9.190 + (string_of_int uI))
9.191 + | Some ps => (new_key ps 1):calcID;
9.192 +> get_calcID 1 (!states);
9.193 +val it = 1 : calcID
9.194 +*)
9.195 +(* add users to a calcstate *)
9.196 +fun get_iterID (cI:calcID)
9.197 + (p:(calcID * (calcstate * (iterID * pos') list)) list) =
9.198 + case assoc (p, cI) of
9.199 + None => raise error ("get_iterID: no iterID " ^ (string_of_int cI))
9.200 + | Some (_, us) => (new_key us 1):iterID;
9.201 +(* get_iterID 3 (!states);
9.202 +val it = 2 : iterID*)
9.203 +
9.204 +
9.205 +(** retrieve, update, delete a state by iterID, calcID **)
9.206 +
9.207 +(*//////7.10.
9.208 +fun get_cal (uI:iterID) (pI:calcID) (p:(iterID * (calcID * state) list) list) =
9.209 + (the (assoc2 (p,(uI, pI))))
9.210 + handle _ => raise error ("get_state " ^ (string_of_int uI) ^
9.211 + " " ^ (string_of_int pI) ^ " not existent");
9.212 +> get_cal 3 1 (!states);
9.213 +val it = (((EmptyPtree,(#,#)),[]),([],[])) : state
9.214 +*)
9.215 +
9.216 +(*///7.10.
9.217 +fun get_state (uI:iterID) (pI:calcID) = get_cal uI pI (!states);
9.218 +fun get_calc (uI:iterID) (pI:calcID) = (snd o (get_cal uI pI)) (!states);
9.219 +*)
9.220 +fun get_calc (cI:calcID) =
9.221 + case assoc (!states, cI) of
9.222 + None => raise error ("get_calc "^(string_of_int cI)^" not existent")
9.223 + | Some (c, _) => c;
9.224 +fun get_pos (cI:calcID) (uI:iterID) =
9.225 + case assoc (!states, cI) of
9.226 + None => raise error ("get_pos: calc " ^ (string_of_int cI)
9.227 + ^ " not existent")
9.228 + | Some (_, us) =>
9.229 + (case assoc (us, uI) of
9.230 + None => raise error ("get_pos: user " ^ (string_of_int uI)
9.231 + ^ " not existent")
9.232 + | Some p => p);
9.233 +
9.234 +
9.235 +fun del_assoc ([],_) = []
9.236 + | del_assoc a =
9.237 + let fun del ([], key) ps = ps
9.238 + | del ((keyi, xi) :: pairs, key) ps =
9.239 + if key = keyi then ps @ pairs
9.240 + else del (pairs, key) (ps @ [(keyi, xi)])
9.241 + in del a [] end;
9.242 +(*
9.243 +> val ps = [(1,"1"),(2,"2"),(3,"3"),(4,"4")];
9.244 +> del_assoc (ps,3);
9.245 +val it = [(1,"1"),(2,"2"),(4,"4")] : (int * string) list
9.246 +*)
9.247 +
9.248 +(* delete doesn't report non existing elements *)
9.249 +(*/////7.10.
9.250 +fun del_assoc2 (uI:iterID) (pI:calcID) ps =
9.251 + let val new_ps = del_assoc (the (assoc (ps, uI)), pI)
9.252 + in overwrite (ps, (uI, new_ps)) end;*)
9.253 +(*
9.254 +> states:= del_assoc2 4 41 (!states);
9.255 +> !states;
9.256 +val it = [(3,[(#,#),(#,#),(#,#)]),(4,[(#,#)]),(1,[(#,#)])] : states
9.257 +
9.258 +> del_user 3;
9.259 +> !states;
9.260 +val it = [(4,[(#,#)]),(1,[(#,#)])] : states
9.261 +*)
9.262 +fun del_assoc2 (cI:calcID) (uI:iterID) ps =
9.263 + case assoc (ps, cI) of
9.264 + None => ps
9.265 + | Some (cs, us) =>
9.266 + overwrite (ps, (cI, (cs, del_assoc (us, uI))));
9.267 +(*
9.268 +> del_assoc2 4 1 (!states);
9.269 +val it =
9.270 + [(3, (((EmptyPtree, ([], Und)), []), [(1, ([], Und)), (3, ([], Und))])),
9.271 + (4, (((EmptyPtree, ([], Und)), []), [(2, ([], Und))]))]*)
9.272 +
9.273 +(*///7.10.
9.274 +fun overwrite2 (ps, (((uI:iterID), (pI:calcID)), p)) =
9.275 + let val new_ps = overwrite (the (assoc (ps, uI)), (pI, p))
9.276 + in (overwrite (ps, (uI, new_ps)))
9.277 + handle _ => raise error ("overwrite2 " ^ (string_of_int uI) ^
9.278 + " " ^ (string_of_int pI) ^ " not existent")
9.279 + end;*)
9.280 +fun overwrite2 (ps, (((cI:calcID), (uI:iterID)), p)) =
9.281 + case assoc (ps, cI) of
9.282 + None =>
9.283 + raise error ("overwrite2: calc " ^ (string_of_int uI) ^" not existent")
9.284 + | Some (cs, us) =>
9.285 + overwrite (ps, (cI ,(cs, overwrite (us, (uI, p)))));
9.286 +
9.287 +fun upd_calc (cI:calcID) cs =
9.288 + case assoc (!states, cI) of
9.289 + None => raise error ("upd_calc "^(string_of_int cI)^" not existent")
9.290 + | Some (_, us) => states:= overwrite (!states, (cI, (cs, us)));
9.291 +(*WN051210 testing before initac: only 1 taci in calcstate so far:
9.292 +fun upd_calc (cI:calcID) (cs as (_, tacis):calcstate) =
9.293 + (if length tacis > 1
9.294 + then raise error ("upd_calc, |tacis|>1: "^tacis2str tacis)
9.295 + else ();
9.296 + case assoc (!states, cI) of
9.297 + None => raise error ("upd_calc "^(string_of_int cI)^" not existent")
9.298 + | Some (_, us) => states:= overwrite (!states, (cI, (cs, us)))
9.299 + );*)
9.300 +
9.301 +
9.302 +(*///7.10.
9.303 +fun upd_tacis (uI:iterID) (pI:calcID) tacis =
9.304 + let val (p, (ptp,_)) = get_state uI pI
9.305 + in states:=
9.306 + overwrite2 ((!states), ((uI, pI), (p, (ptp, tacis)))) end;*)
9.307 +fun upd_tacis (cI:calcID) tacis =
9.308 + case assoc (!states, cI) of
9.309 + None =>
9.310 + raise error ("upd_tacis: calctree "^(string_of_int cI)^" not existent")
9.311 + | Some ((ptp,_), us) =>
9.312 + states:= overwrite (!states, (cI, ((ptp, tacis), us)));
9.313 +(*///7.10.
9.314 +fun upd_ipos (uI:iterID) (pI:calcID) (ip:pos') =
9.315 + let val (_, calc) = get_state uI pI
9.316 + in states:= overwrite2 ((!states), ((uI, pI), (ip, calc))) end;*)
9.317 +fun upd_ipos (cI:calcID) (uI:iterID) (ip:pos') =
9.318 + case assoc (!states, cI) of
9.319 + None =>
9.320 + raise error ("upd_ipos: calctree "^(string_of_int cI)^" not existent")
9.321 + | Some (cs, us) =>
9.322 + states:= overwrite2 (!states, ((cI, uI), ip));
9.323 +
9.324 +
9.325 +(** add and delete calcs **)
9.326 +
9.327 +(*///7.10
9.328 +fun add_pID (uI:iterID) (s:state) (p:(iterID * (calcID * state) list) list) =
9.329 + let val new_ID = get_calcID uI p;
9.330 + val new_states = (the (assoc (p, uI))) @ [(new_ID, s)];
9.331 + in (new_ID, (overwrite (p, (uI, new_states)))) end;*)
9.332 +(*
9.333 +> val (new_calcID, new_states) = add_pID 1 (!states);
9.334 +> states:= new_states;
9.335 +> !states;
9.336 +val it = [(3,[(#,#),(#,#)]),(4,[(#,#),(#,#)]),(1,[(#,#)])] : states
9.337 +> val (new_calcID, new_states) = add_pID 3 (!states);
9.338 +> states:= new_states;
9.339 +> !states;
9.340 +val it = [(3,[(#,#),(#,#),(#,#)]),(4,[(#,#),(#,#)]),(1,[(#,#)])] : states
9.341 +> assoc2 (!states, (3, 1));
9.342 +val it = Some EmptyPtree : ptree option
9.343 +> assoc2 (!states, (3, 2));
9.344 +val it = None : ptree option
9.345 +*)
9.346 +(*///7.10
9.347 +fun add_calc (uI:iterID) (s:state) =
9.348 + let val (new_calcID, new_calcs) = add_pID uI s (!states)
9.349 + in states:= new_calcs;
9.350 + new_calcID end; *)
9.351 +fun add_user (cI:calcID) =
9.352 + case assoc (!states, cI) of
9.353 + None =>
9.354 + raise error ("add_user: calctree "^(string_of_int cI)^" not existent")
9.355 + | Some (cs, us) =>
9.356 + let val new_uI = new_key us 1
9.357 + in states:= overwrite2 (!states, ((cI, new_uI), e_pos'));
9.358 + new_uI:iterID end;
9.359 +
9.360 +(*///10.10.
9.361 +fun del_calc (uI:iterID) (pI:calcID) =
9.362 + (states:= del_assoc2 uI pI (!states); pI);*)
9.363 +fun del_user (cI:calcID) (uI:iterID) =
9.364 + (states:= del_assoc2 cI uI (!states); uI);
9.365 +
9.366 +
9.367 +(** add and delete calculations **)
9.368 +(**///7.10 add and delete users **)
9.369 +(*///7.10
9.370 +fun add_user () =
9.371 + let val new_uI = get_calcID (!states)
9.372 + in states:= (!states) @ [(new_uI, [])];
9.373 + new_uI end;*)
9.374 +fun add_calc (cs:calcstate) =
9.375 + let val new_cI = new_key (!states) 1
9.376 + in states:= (!states) @ [(new_cI, (cs, []))];
9.377 + new_cI:calcID end;
9.378 +
9.379 +(* delete doesn't report non existing elements *)
9.380 +(*///7.10
9.381 +fun del_user (uI:userID) =
9.382 + (states:= del_assoc (!states, uI); uI);*)
9.383 +fun del_calc (cI:calcID) =
9.384 + (states:= del_assoc (!states, cI); cI:calcID);
9.385 +
9.386 +(* -------------- test all exported funs --------------
9.387 +///7.10
9.388 +Compiler.Control.Print.printDepth:=8;
9.389 +states:=[];
9.390 +add_user (); add_user (); !states;
9.391 +ML> val it = 1 : userID
9.392 +ML> val it = 2 : userID
9.393 +ML> val it = [(1,[]),(2,[])]
9.394 +
9.395 +val (hide,detail) = ([(["pI"],["tac"],true)]:hide,
9.396 + [(["pI"],["tac"],true)]:detail);
9.397 +add_calc 1 e_state;
9.398 +add_calc 1 (e_calcstate,(hide,detail)); !states;
9.399 +ML> val it = 1 : calcID
9.400 +ML> val it = 2 : calcID
9.401 +ML> val it =
9.402 + [(1,
9.403 + [(1,(((EmptyPtree,(#,#)),[]),([],[]))),
9.404 + (2,(((EmptyPtree,(#,#)),[]),([(#,#,#)],[(#,#,#)])))]),(2,[])]
9.405 +
9.406 +val (pt,(p,p_)) = (EmptyPtree,e_pos');
9.407 +val (pt,_) = cappend_problem pt p Uistate ([],e_spec);
9.408 +upd_calc 1 2 ((pt,(p,p_)),[]); !states;
9.409 +ML> val it =
9.410 + [(1,
9.411 + [(1,(((EmptyPtree,(#,#)),[]),([],[]))),
9.412 + (2,(((Nd #,(#,#)),[]),([(#,#,#)],[(#,#,#)])))]),(2,[])]
9.413 +(* ~~~~~~~~~~~~~~~~~~~~ unchanged !!!*)
9.414 +
9.415 +get_state 1 1; get_state 1 2;
9.416 +ML> val it = (((EmptyPtree,([],Und)),[]),([],[])) : state
9.417 +ML> val it =
9.418 + (((Nd
9.419 + (PblObj
9.420 + {branch=NoBranch,cell=[],env=(#,#,#,#),loc=(#,#),meth=[],
9.421 + model={Find=#,Given=#,Relate=#,Where=#,With=#},origin=(#,#),
9.422 + ostate=Incomplete,probl=[],result=(#,#),spec=(#,#,#)},[]),([],Und)),
9.423 + []),([(["pI"],["tac"],true)],[(["pI"],["tac"],true)])) : state
9.424 +
9.425 +del_calc 2 1 (*non existent - NO msg!*); del_calc 1 2; !states;
9.426 +ML> val it = [(1,[(1,(((EmptyPtree,(#,#)),[]),([],[])))]),(2,[])]
9.427 +
9.428 +del_user 1; !states;
9.429 +ML> val it = [(2,[])]
9.430 +
9.431 +add_user (); add_user (); !states;
9.432 +ML> val it = 1 : userID
9.433 +ML> val it = 3 : userID
9.434 +ML> val it = [(2,[]),(1,[]),(3,[])]
9.435 +*)
9.436 +
9.437 +
9.438 +(* -------------- test all exported funs --------------
9.439 +print_depth 9;
9.440 +states:=[];
9.441 +add_calc e_calcstate; add_calc e_calcstate; !states;
9.442 +|val it = 1 : calcID
9.443 +|val it = 2 : calcID
9.444 +|val it =
9.445 +| [(1, (((EmptyPtree, ([], Und)), []), [])),
9.446 +| (2, (((EmptyPtree, ([], Und)), []), []))]
9.447 +
9.448 +add_user 2; add_user 2; !states;
9.449 +|val it = 1 : userID
9.450 +|val it = 2 : userID
9.451 +|val it =
9.452 +| [(1, (((EmptyPtree, ([], Und)), []), [])),
9.453 +| (2, (((EmptyPtree, ([], Und)), []), [(1, ([], Und)), (2, ([], Und))]))]
9.454 +
9.455 +
9.456 +val cs = ((EmptyPtree, ([111], Und)), []) : calcstate;
9.457 +upd_calc 1 cs; !states;
9.458 +|val it =
9.459 +| [(1, (((EmptyPtree, ([111], Und)), []), [])),
9.460 +| (2, (((EmptyPtree, ([], Und)), []), [(1, ([], Und)), (2, ([], Und))]))]
9.461 +
9.462 +get_calc 1; get_calc 2;
9.463 +|val it = ((EmptyPtree, ([111], Und)), []) : calcstate
9.464 +|val it = ((EmptyPtree, ([], Und)), []) : calcstate
9.465 +
9.466 +del_user 2 3 (*non existent - NO msg!*); del_user 2 1; !states;
9.467 +|val it = 3 : userID
9.468 +|val it = 1 : userID
9.469 +|val it =
9.470 +| [(1, (((EmptyPtree, ([111], Und)), []), [])),
9.471 +| (2, (((EmptyPtree, ([], Und)), []), [(2, ([], Und))]))]
9.472 +
9.473 +del_calc 1; !states;
9.474 +|val it = 1 : calcID
9.475 +|val it = [(2, (((EmptyPtree, ([], Und)), []), [(2, ([], Und))]))]
9.476 +
9.477 +add_calc e_calcstate; add_calc e_calcstate; !states;
9.478 +|val it = 1 : calcID
9.479 +|val it = 3 : calcID
9.480 +|val it =
9.481 +| [(2, (((EmptyPtree, ([], Und)), []), [(2, ([], Und))])),
9.482 +| (1, (((EmptyPtree, ([], Und)), []), [])),
9.483 +| (3, (((EmptyPtree, ([], Und)), []), []))]
9.484 +
9.485 +add_user 2; !states;
9.486 +|val it =
9.487 +| [(2, (((EmptyPtree, ([], Und)), []), [(2, ([], Und)), (1, ([], Und))])),
9.488 +| (1, (((EmptyPtree, ([], Und)), []), [])),
9.489 +| (3, (((EmptyPtree, ([], Und)), []), []))]
9.490 +*)
9.491 \ No newline at end of file
10.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2 +++ b/src/Pure/isac/IsacKnowledge/AlgEin.ML Wed Jul 21 13:53:39 2010 +0200
10.3 @@ -0,0 +1,141 @@
10.4 +(* Algebra Einf"uhrung, Unterrichtsversuch IMST-Projekt
10.5 + author: Walther Neuper 2007
10.6 + (c) due to copyright terms
10.7 +
10.8 +use"IsacKnowledge/AlgEin.ML";
10.9 +use"AlgEin.ML";
10.10 +
10.11 +remove_thy"Typefix";
10.12 +remove_thy"AlgEin";
10.13 +use_thy"IsacKnowledge/Isac";
10.14 +*)
10.15 +
10.16 +(** interface isabelle -- isac **)
10.17 +
10.18 +theory' := overwritel (!theory', [("AlgEin.thy",AlgEin.thy)]);
10.19 +
10.20 +(** problems **)
10.21 +
10.22 +store_pbt
10.23 + (prep_pbt AlgEin.thy "pbl_algein" [] e_pblID
10.24 + (["Berechnung"], [], e_rls, None,
10.25 + []));
10.26 +(* WN070405
10.27 +store_pbt
10.28 + (prep_pbt AlgEin.thy "pbl_algein_num" [] e_pblID
10.29 + (["numerische", "Berechnung"],
10.30 + [("#Given" ,["KantenUnten u_", "KantenSenkrecht s_", "KantenOben o_"]),
10.31 + ("#Find" ,["GesamtLaenge l_"])
10.32 + ],
10.33 + append_rls "e_rls" e_rls [],
10.34 + None,
10.35 + []));
10.36 +*)
10.37 +store_pbt
10.38 + (prep_pbt AlgEin.thy "pbl_algein_numsym" [] e_pblID
10.39 + (["numerischSymbolische", "Berechnung"],
10.40 + [("#Given" ,["KantenLaenge k_","Querschnitt q__"(*q_ in Biegelinie.thy*),
10.41 + "KantenUnten u_", "KantenSenkrecht s_", "KantenOben o_"]),
10.42 + ("#Find" ,["GesamtLaenge l_"])
10.43 + ],
10.44 + e_rls,
10.45 + None,
10.46 + [["Berechnung","erstNumerisch"],["Berechnung","erstSymbolisch"]]));
10.47 +
10.48 +(* show_ptyps();
10.49 + *)
10.50 +
10.51 +
10.52 +(** methods **)
10.53 +
10.54 +store_met
10.55 + (prep_met AlgEin.thy "met_algein" [] e_metID
10.56 + (["Berechnung"],
10.57 + [],
10.58 + {rew_ord'="tless_true", rls'= Erls, calc = [],
10.59 + srls = Erls, prls = Erls,
10.60 + crls =Erls , nrls = Erls},
10.61 +"empty_script"
10.62 +));
10.63 +
10.64 +store_met
10.65 + (prep_met AlgEin.thy "met_algein_numsym" [] e_metID
10.66 + (["Berechnung","erstNumerisch"],
10.67 + [],
10.68 + {rew_ord'="tless_true", rls'= Erls, calc = [],
10.69 + srls = Erls, prls = Erls,
10.70 + crls =Erls , nrls = Erls},
10.71 +"empty_script"
10.72 +));
10.73 +
10.74 +store_met
10.75 + (prep_met AlgEin.thy "met_algein_numsym" [] e_metID
10.76 + (["Berechnung","erstNumerisch"],
10.77 + [("#Given" ,["KantenLaenge k_","Querschnitt q__",
10.78 + "KantenUnten u_", "KantenSenkrecht s_",
10.79 + "KantenOben o_"]),
10.80 + ("#Find" ,["GesamtLaenge l_"])
10.81 + ],
10.82 + {rew_ord'="tless_true", rls'= e_rls, calc = [],
10.83 + srls = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
10.84 + [Calc ("Atools.boollist2sum",
10.85 + eval_boollist2sum "")],
10.86 + prls = e_rls, crls =e_rls , nrls = norm_Rational},
10.87 +"Script RechnenSymbolScript (k_::bool) (q__::bool) \
10.88 +\(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =\
10.89 +\ (let t_ = Take (l_ = oben + senkrecht + unten); \
10.90 +\ sum_ = boollist2sum o_;\
10.91 +\ t_ = Substitute [oben = sum_] t_;\
10.92 +\ t_ = Substitute o_ t_;\
10.93 +\ t_ = Substitute [k_, q__] t_;\
10.94 +\ t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_;\
10.95 +\ sum_ = boollist2sum s_;\
10.96 +\ t_ = Substitute [senkrecht = sum_] t_;\
10.97 +\ t_ = Substitute s_ t_;\
10.98 +\ t_ = Substitute [k_, q__] t_;\
10.99 +\ t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_;\
10.100 +\ sum_ = boollist2sum u_;\
10.101 +\ t_ = Substitute [unten = sum_] t_;\
10.102 +\ t_ = Substitute u_ t_;\
10.103 +\ t_ = Substitute [k_, q__] t_;\
10.104 +\ t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_\
10.105 +\ in (Try (Rewrite_Set norm_Poly False)) t_)"
10.106 +));
10.107 +
10.108 +store_met
10.109 + (prep_met AlgEin.thy "met_algein_symnum" [] e_metID
10.110 + (["Berechnung","erstSymbolisch"],
10.111 + [("#Given" ,["KantenLaenge k_","Querschnitt q__",
10.112 + "KantenUnten u_", "KantenSenkrecht s_",
10.113 + "KantenOben o_"]),
10.114 + ("#Find" ,["GesamtLaenge l_"])
10.115 + ],
10.116 + {rew_ord'="tless_true", rls'= e_rls, calc = [],
10.117 + srls = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
10.118 + [Calc ("Atools.boollist2sum",
10.119 + eval_boollist2sum "")],
10.120 + prls = e_rls,
10.121 + crls =e_rls , nrls = norm_Rational},
10.122 +"Script RechnenSymbolScript (k_::bool) (q__::bool) \
10.123 +\(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =\
10.124 +\ (let t_ = Take (l_ = oben + senkrecht + unten); \
10.125 +\ sum_ = boollist2sum o_;\
10.126 +\ t_ = Substitute [oben = sum_] t_;\
10.127 +\ t_ = Substitute o_ t_;\
10.128 +\ t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_;\
10.129 +\ sum_ = boollist2sum s_;\
10.130 +\ t_ = Substitute [senkrecht = sum_] t_;\
10.131 +\ t_ = Substitute s_ t_;\
10.132 +\ t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_;\
10.133 +\ sum_ = boollist2sum u_;\
10.134 +\ t_ = Substitute [unten = sum_] t_;\
10.135 +\ t_ = Substitute u_ t_;\
10.136 +\ t_ = (Repeat (Try (Rewrite_Set norm_Poly False))) t_;\
10.137 +\ t_ = Substitute [k_, q__] t_\
10.138 +\ in (Try (Rewrite_Set norm_Poly False)) t_)"
10.139 +));
10.140 +
10.141 +(* show_mets();
10.142 + *)
10.143 +(* use"IsacKnowledge/AlgEin.ML";
10.144 + *)
10.145 \ No newline at end of file
11.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
11.2 +++ b/src/Pure/isac/IsacKnowledge/AlgEin.thy Wed Jul 21 13:53:39 2010 +0200
11.3 @@ -0,0 +1,37 @@
11.4 +(* Algebra Einf"uhrung, Unterrichtsversuch IMST-Projekt
11.5 + author: Walther Neuper 2007
11.6 + (c) due to copyright terms
11.7 +
11.8 +remove_thy"AlgEin";
11.9 +use_thy"IsacKnowledge/AlgEin";
11.10 +use_thy_only"IsacKnowledge/AlgEin";
11.11 +
11.12 +remove_thy"AlgEin";
11.13 +use_thy"IsacKnowledge/Isac";
11.14 +*)
11.15 +
11.16 +AlgEin = Rational +
11.17 +(*Poly + ..shouldbe sufficient, but norm_Poly *)
11.18 +
11.19 +consts
11.20 +
11.21 + (*new Descriptions in the related problems*)
11.22 + KantenUnten :: bool list => una
11.23 + KantenSenkrecht :: bool list => una
11.24 + KantenOben :: bool list => una
11.25 + KantenLaenge :: bool => una
11.26 + Querschnitt :: bool => una
11.27 + GesamtLaenge :: real => una
11.28 +
11.29 + (*Script-names*)
11.30 + RechnenSymbolScript :: "[bool,bool,bool list,bool list,bool list,real,
11.31 + bool] => bool"
11.32 + ("((Script RechnenSymbolScript (_ _ _ _ _ _ =))// (_))" 9)
11.33 +
11.34 +(*
11.35 +rules
11.36 + (*this axiom creates a contradictory formal system,
11.37 + see problem TOOODO *)
11.38 +*)
11.39 +
11.40 +end
12.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
12.2 +++ b/src/Pure/isac/IsacKnowledge/Atools.ML Wed Jul 21 13:53:39 2010 +0200
12.3 @@ -0,0 +1,645 @@
12.4 +(* tools for arithmetic
12.5 + WN.8.3.01
12.6 + use"../IsacKnowledge/Atools.ML";
12.7 + use"IsacKnowledge/Atools.ML";
12.8 + use"Atools.ML";
12.9 + *)
12.10 +
12.11 +(*
12.12 +copy from doc/math-eng.tex WN.28.3.03
12.13 +WN071228 extended
12.14 +
12.15 +\section{Coding standards}
12.16 +
12.17 +%WN071228 extended -----vvv
12.18 +\subsection{Identifiers}
12.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).
12.20 +
12.21 +This are the preliminary rules for naming identifiers>
12.22 +\begin{description}
12.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}.
12.24 +\item [descriptions in problem-patterns] must contain at least 1 capital letter and must not contain underscores, e.g. {\tt Probe, forPolynomials}.
12.25 +\item [CAS-commands] follow the same rules as descriptions in problem-patterns above, thus beware of conflicts~!
12.26 +\item [script identifiers] always end with {\tt Script}, e.g. {\tt ProbeScript}.
12.27 +\item [???] ???
12.28 +\item [???] ???
12.29 +\end{description}
12.30 +%WN071228 extended -----^^^
12.31 +
12.32 +
12.33 +\subsection{Rule sets}
12.34 +The actual version of the coding standards for rulesets is in {\tt /IsacKnowledge/Atools.ML where it can be viewed using the knowledge browsers.
12.35 +
12.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.
12.37 +\begin{description}
12.38 +
12.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).
12.40 +
12.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.
12.42 +
12.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.
12.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).
12.45 +
12.46 +\end{description}
12.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.
12.48 +The following rulesets are used for internal purposes and usually invisible to the (naive) user:
12.49 +\begin{description}
12.50 +
12.51 +\item [*\_erls]
12.52 +\item [*\_prls]
12.53 +\item [*\_srls]
12.54 +
12.55 +\end{description}
12.56 +{\tt append_rls, merge_rls, remove_rls}
12.57 +*)
12.58 +
12.59 +"******* Atools.ML begin *******";
12.60 +theory' := overwritel (!theory', [("Atools.thy",Atools.thy)]);
12.61 +
12.62 +(** evaluation of numerals and special predicates on the meta-level **)
12.63 +(*-------------------------functions---------------------*)
12.64 +local (* rlang 09.02 *)
12.65 + (*.a 'c is coefficient of v' if v does occur in c.*)
12.66 + fun coeff_in v c = v mem (vars c);
12.67 +in
12.68 + fun occurs_in v t = coeff_in v t;
12.69 +end;
12.70 +
12.71 +(*("occurs_in", ("Atools.occurs'_in", eval_occurs_in ""))*)
12.72 +fun eval_occurs_in _ "Atools.occurs'_in"
12.73 + (p as (Const ("Atools.occurs'_in",_) $ v $ t)) _ =
12.74 + ((*writeln("@@@ eval_occurs_in: v= "^(term2str v));
12.75 + writeln("@@@ eval_occurs_in: t= "^(term2str t));*)
12.76 + if occurs_in v t
12.77 + then Some ((term2str p) ^ " = True",
12.78 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
12.79 + else Some ((term2str p) ^ " = False",
12.80 + Trueprop $ (mk_equality (p, HOLogic.false_const))))
12.81 + | eval_occurs_in _ _ _ _ = None;
12.82 +
12.83 +(*some of the (bound) variables (eg. in an eqsys) "vs" occur in term "t"*)
12.84 +fun some_occur_in vs t =
12.85 + let fun occurs_in' a b = occurs_in b a
12.86 + in foldl or_ (false, map (occurs_in' t) vs) end;
12.87 +
12.88 +(*("some_occur_in", ("Atools.some'_occur'_in",
12.89 + eval_some_occur_in "#eval_some_occur_in_"))*)
12.90 +fun eval_some_occur_in _ "Atools.some'_occur'_in"
12.91 + (p as (Const ("Atools.some'_occur'_in",_)
12.92 + $ vs $ t)) _ =
12.93 + if some_occur_in (isalist2list vs) t
12.94 + then Some ((term2str p) ^ " = True",
12.95 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
12.96 + else Some ((term2str p) ^ " = False",
12.97 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
12.98 + | eval_some_occur_in _ _ _ _ = None;
12.99 +
12.100 +
12.101 +
12.102 +
12.103 +(*evaluate 'is_atom'*)
12.104 +(*("is_atom",("Atools.is'_atom",eval_is_atom "#is_atom_"))*)
12.105 +fun eval_is_atom (thmid:string) "Atools.is'_atom"
12.106 + (t as (Const(op0,_) $ arg)) thy =
12.107 + (case arg of
12.108 + Free (n,_) => Some (mk_thmid thmid op0 n "",
12.109 + Trueprop $ (mk_equality (t, true_as_term)))
12.110 + | _ => Some (mk_thmid thmid op0 "" "",
12.111 + Trueprop $ (mk_equality (t, false_as_term))))
12.112 + | eval_is_atom _ _ _ _ = None;
12.113 +
12.114 +(*evaluate 'is_even'*)
12.115 +fun even i = (i div 2) * 2 = i;
12.116 +(*("is_even",("Atools.is'_even",eval_is_even "#is_even_"))*)
12.117 +fun eval_is_even (thmid:string) "Atools.is'_even"
12.118 + (t as (Const(op0,_) $ arg)) thy =
12.119 + (case arg of
12.120 + Free (n,_) =>
12.121 + (case int_of_str n of
12.122 + Some i =>
12.123 + if even i then Some (mk_thmid thmid op0 n "",
12.124 + Trueprop $ (mk_equality (t, true_as_term)))
12.125 + else Some (mk_thmid thmid op0 "" "",
12.126 + Trueprop $ (mk_equality (t, false_as_term)))
12.127 + | _ => None)
12.128 + | _ => None)
12.129 + | eval_is_even _ _ _ _ = None;
12.130 +
12.131 +(*evaluate 'is_const'*)
12.132 +(*("is_const",("Atools.is'_const",eval_const "#is_const_"))*)
12.133 +fun eval_const (thmid:string) _(*"Atools.is'_const" WN050820 diff.beh. rooteq*)
12.134 + (t as (Const(op0,t0) $ arg)) (thy:theory) =
12.135 + (*eval_const FIXXXXXME.WN.16.5.03 still forgets ComplexI*)
12.136 + (case arg of
12.137 + Const (n1,_) =>
12.138 + Some (mk_thmid thmid op0 n1 "",
12.139 + Trueprop $ (mk_equality (t, false_as_term)))
12.140 + | Free (n1,_) =>
12.141 + if is_numeral n1
12.142 + then Some (mk_thmid thmid op0 n1 "",
12.143 + Trueprop $ (mk_equality (t, true_as_term)))
12.144 + else Some (mk_thmid thmid op0 n1 "",
12.145 + Trueprop $ (mk_equality (t, false_as_term)))
12.146 + | Const ("Float.Float",_) =>
12.147 + Some (mk_thmid thmid op0 (term2str arg) "",
12.148 + Trueprop $ (mk_equality (t, true_as_term)))
12.149 + | _ => (*None*)
12.150 + Some (mk_thmid thmid op0 (term2str arg) "",
12.151 + Trueprop $ (mk_equality (t, false_as_term))))
12.152 + | eval_const _ _ _ _ = None;
12.153 +
12.154 +(*. evaluate binary, associative, commutative operators: *,+,^ .*)
12.155 +(*("plus" ,("op +" ,eval_binop "#add_")),
12.156 + ("times" ,("op *" ,eval_binop "#mult_")),
12.157 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))*)
12.158 +
12.159 +(* val (thmid,op_,t as(Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2)),thy) =
12.160 + ("xxxxxx",op_,t,thy);
12.161 + *)
12.162 +fun mk_thmid_f thmid ((v11, v12), (p11, p12)) ((v21, v22), (p21, p22)) =
12.163 + thmid ^ "Float ((" ^
12.164 + (string_of_int v11)^","^(string_of_int v12)^"), ("^
12.165 + (string_of_int p11)^","^(string_of_int p12)^")) __ (("^
12.166 + (string_of_int v21)^","^(string_of_int v22)^"), ("^
12.167 + (string_of_int p21)^","^(string_of_int p22)^"))";
12.168 +
12.169 +(*.convert int and float to internal floatingpoint prepresentation.*)
12.170 +fun numeral (Free (str, T)) =
12.171 + (case int_of_str str of
12.172 + Some i => Some ((i, 0), (0, 0))
12.173 + | None => None)
12.174 + | numeral (Const ("Float.Float", _) $
12.175 + (Const ("Pair", _) $
12.176 + (Const ("Pair", T) $ Free (v1, _) $ Free (v2,_)) $
12.177 + (Const ("Pair", _) $ Free (p1, _) $ Free (p2,_))))=
12.178 + (case (int_of_str v1, int_of_str v2, int_of_str p1, int_of_str p2) of
12.179 + (Some v1', Some v2', Some p1', Some p2') =>
12.180 + Some ((v1', v2'), (p1', p2'))
12.181 + | _ => None)
12.182 + | numeral _ = None;
12.183 +
12.184 +(*.evaluate binary associative operations.*)
12.185 +fun eval_binop (thmid:string) (op_:string)
12.186 + (t as ( Const(op0,t0) $
12.187 + (Const(op0',t0') $ v $ t1) $ t2))
12.188 + thy = (*binary . (v.n1).n2*)
12.189 + if op0 = op0' then
12.190 + case (numeral t1, numeral t2) of
12.191 + (Some n1, Some n2) =>
12.192 + let val (T1,T2,Trange) = dest_binop_typ t0
12.193 + val res = calc (if op0 = "op -" then "op +" else op0) n1 n2
12.194 + (*WN071229 "HOL.divide" never tried*)
12.195 + val rhs = var_op_float v op_ t0 T1 res
12.196 + val prop = Trueprop $ (mk_equality (t, rhs))
12.197 + in Some (mk_thmid_f thmid n1 n2, prop) end
12.198 + | _ => None
12.199 + else None
12.200 + | eval_binop (thmid:string) (op_:string)
12.201 + (t as
12.202 + (Const (op0, t0) $ t1 $
12.203 + (Const (op0', t0') $ t2 $ v)))
12.204 + thy = (*binary . n1.(n2.v)*)
12.205 + if op0 = op0' then
12.206 + case (numeral t1, numeral t2) of
12.207 + (Some n1, Some n2) =>
12.208 + if op0 = "op -" then None else
12.209 + let val (T1,T2,Trange) = dest_binop_typ t0
12.210 + val res = calc op0 n1 n2
12.211 + val rhs = float_op_var v op_ t0 T1 res
12.212 + val prop = Trueprop $ (mk_equality (t, rhs))
12.213 + in Some (mk_thmid_f thmid n1 n2, prop) end
12.214 + | _ => None
12.215 + else None
12.216 +
12.217 + | eval_binop (thmid:string) (op_:string)
12.218 + (t as (Const (op0,t0) $ t1 $ t2)) thy = (*binary . n1.n2*)
12.219 + (case (numeral t1, numeral t2) of
12.220 + (Some n1, Some n2) =>
12.221 + let val (T1,T2,Trange) = dest_binop_typ t0;
12.222 + val res = calc op0 n1 n2;
12.223 + val rhs = term_of_float Trange res;
12.224 + val prop = Trueprop $ (mk_equality (t, rhs));
12.225 + in Some (mk_thmid_f thmid n1 n2, prop) end
12.226 + | _ => None)
12.227 + | eval_binop _ _ _ _ = None;
12.228 +(*
12.229 +> val Some (thmid, t) = eval_binop "#add_" "op +" (str2term "-1 + 2") thy;
12.230 +> term2str t;
12.231 +val it = "-1 + 2 = 1"
12.232 +> val t = str2term "-1 * (-1 * a)";
12.233 +> val Some (thmid, t) = eval_binop "#mult_" "op *" t thy;
12.234 +> term2str t;
12.235 +val it = "-1 * (-1 * a) = 1 * a"*)
12.236 +
12.237 +
12.238 +
12.239 +(*.evaluate < and <= for numerals.*)
12.240 +(*("le" ,("op <" ,eval_equ "#less_")),
12.241 + ("leq" ,("op <=" ,eval_equ "#less_equal_"))*)
12.242 +fun eval_equ (thmid:string) (op_:string) (t as
12.243 + (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) thy =
12.244 + (case (int_of_str n1, int_of_str n2) of
12.245 + (Some n1', Some n2') =>
12.246 + if calc_equ (strip_thy op0) (n1', n2')
12.247 + then Some (mk_thmid thmid op0 n1 n2,
12.248 + Trueprop $ (mk_equality (t, true_as_term)))
12.249 + else Some (mk_thmid thmid op0 n1 n2,
12.250 + Trueprop $ (mk_equality (t, false_as_term)))
12.251 + | _ => None)
12.252 +
12.253 + | eval_equ _ _ _ _ = None;
12.254 +
12.255 +
12.256 +(*evaluate identity
12.257 +> reflI;
12.258 +val it = "(?t = ?t) = True"
12.259 +> val t = str2term "x = 0";
12.260 +> val None = rewrite_ thy dummy_ord e_rls false reflI t;
12.261 +
12.262 +> val t = str2term "1 = 0";
12.263 +> val None = rewrite_ thy dummy_ord e_rls false reflI t;
12.264 +----------- thus needs Calc !
12.265 +> val t = str2term "0 = 0";
12.266 +> val Some (t',_) = rewrite_ thy dummy_ord e_rls false reflI t;
12.267 +> term2str t';
12.268 +val it = "True"
12.269 +
12.270 +val t = str2term "Not (x = 0)";
12.271 +atomt t; term2str t;
12.272 +*** -------------
12.273 +*** Const ( Not)
12.274 +*** . Const ( op =)
12.275 +*** . . Free ( x, )
12.276 +*** . . Free ( 0, )
12.277 +val it = "x ~= 0" : string*)
12.278 +
12.279 +(*.evaluate identity on the term-level, =!= ,i.e. without evaluation of
12.280 + the arguments: thus special handling by 'fun eval_binop'*)
12.281 +(*("ident" ,("Atools.ident",eval_ident "#ident_")):calc*)
12.282 +fun eval_ident (thmid:string) "Atools.ident" (t as
12.283 + (Const (op0,t0) $ t1 $ t2 )) thy =
12.284 + if t1 = t2
12.285 + then Some (mk_thmid thmid op0
12.286 + ("("^(Sign.string_of_term (sign_of thy) t1)^")")
12.287 + ("("^(Sign.string_of_term (sign_of thy) t2)^")"),
12.288 + Trueprop $ (mk_equality (t, true_as_term)))
12.289 + else Some (mk_thmid thmid op0
12.290 + ("("^(Sign.string_of_term (sign_of thy) t1)^")")
12.291 + ("("^(Sign.string_of_term (sign_of thy) t2)^")"),
12.292 + Trueprop $ (mk_equality (t, false_as_term)))
12.293 + | eval_ident _ _ _ _ = None;
12.294 +(* TODO
12.295 +> val t = str2term "x =!= 0";
12.296 +> val Some (str, t') = eval_ident "ident_" "b" t thy;
12.297 +> term2str t';
12.298 +val str = "ident_(x)_(0)" : string
12.299 +val it = "(x =!= 0) = False" : string
12.300 +> val t = str2term "1 =!= 0";
12.301 +> val Some (str, t') = eval_ident "ident_" "b" t thy;
12.302 +> term2str t';
12.303 +val str = "ident_(1)_(0)" : string
12.304 +val it = "(1 =!= 0) = False" : string
12.305 +> val t = str2term "0 =!= 0";
12.306 +> val Some (str, t') = eval_ident "ident_" "b" t thy;
12.307 +> term2str t';
12.308 +val str = "ident_(0)_(0)" : string
12.309 +val it = "(0 =!= 0) = True" : string
12.310 +*)
12.311 +
12.312 +(*.evaluate identity of terms, which stay ready for evaluation in turn;
12.313 + thus returns False only for atoms.*)
12.314 +(*("equal" ,("op =",eval_equal "#equal_")):calc*)
12.315 +fun eval_equal (thmid:string) "op =" (t as
12.316 + (Const (op0,t0) $ t1 $ t2 )) thy =
12.317 + if t1 = t2
12.318 + then ((*writeln"... eval_equal: t1 = t2 --> True";*)
12.319 + Some (mk_thmid thmid op0
12.320 + ("("^(Sign.string_of_term (sign_of thy) t1)^")")
12.321 + ("("^(Sign.string_of_term (sign_of thy) t2)^")"),
12.322 + Trueprop $ (mk_equality (t, true_as_term)))
12.323 + )
12.324 + else (case (is_atom t1, is_atom t2) of
12.325 + (true, true) =>
12.326 + ((*writeln"... eval_equal: t1<>t2, is_atom t1,t2 --> False";*)
12.327 + Some (mk_thmid thmid op0
12.328 + ("("^(term2str t1)^")") ("("^(term2str t2)^")"),
12.329 + Trueprop $ (mk_equality (t, false_as_term)))
12.330 + )
12.331 + | _ => ((*writeln"... eval_equal: t1<>t2, NOT is_atom t1,t2 --> go-on";*)
12.332 + None))
12.333 + | eval_equal _ _ _ _ = (writeln"... eval_equal: error-exit";
12.334 + None);
12.335 +(*
12.336 +val t = str2term "x ~= 0";
12.337 +val None = eval_equal "equal_" "b" t thy;
12.338 +
12.339 +
12.340 +> val t = str2term "(x + 1) = (x + 1)";
12.341 +> val Some (str, t') = eval_equal "equal_" "b" t thy;
12.342 +> term2str t';
12.343 +val str = "equal_(x + 1)_(x + 1)" : string
12.344 +val it = "(x + 1 = x + 1) = True" : string
12.345 +> val t = str2term "x = 0";
12.346 +> val None = eval_equal "equal_" "b" t thy;
12.347 +
12.348 +> val t = str2term "1 = 0";
12.349 +> val Some (str, t') = eval_equal "equal_" "b" t thy;
12.350 +> term2str t';
12.351 +val str = "equal_(1)_(0)" : string
12.352 +val it = "(1 = 0) = False" : string
12.353 +> val t = str2term "0 = 0";
12.354 +> val Some (str, t') = eval_equal "equal_" "b" t thy;
12.355 +> term2str t';
12.356 +val str = "equal_(0)_(0)" : string
12.357 +val it = "(0 = 0) = True" : string
12.358 +*)
12.359 +
12.360 +
12.361 +(** evaluation on the metalevel **)
12.362 +
12.363 +(*. evaluate HOL.divide .*)
12.364 +(*("divide_" ,("HOL.divide" ,eval_cancel "#divide_"))*)
12.365 +fun eval_cancel (thmid:string) "HOL.divide" (t as
12.366 + (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) thy =
12.367 + (case (int_of_str n1, int_of_str n2) of
12.368 + (Some n1', Some n2') =>
12.369 + let
12.370 + val sg = sign2 n1' n2';
12.371 + val (T1,T2,Trange) = dest_binop_typ t0;
12.372 + val gcd' = gcd (abs n1') (abs n2');
12.373 + in if gcd' = abs n2'
12.374 + then let val rhs = term_of_num Trange (sg * (abs n1') div gcd')
12.375 + val prop = Trueprop $ (mk_equality (t, rhs))
12.376 + in Some (mk_thmid thmid op0 n1 n2, prop) end
12.377 + else if 0 < n2' andalso gcd' = 1 then None
12.378 + else let val rhs = num_op_num T1 T2 (op0,t0) (sg * (abs n1') div gcd')
12.379 + ((abs n2') div gcd')
12.380 + val prop = Trueprop $ (mk_equality (t, rhs))
12.381 + in Some (mk_thmid thmid op0 n1 n2, prop) end
12.382 + end
12.383 + | _ => ((*writeln"@@@ eval_cancel None";*)None))
12.384 +
12.385 + | eval_cancel _ _ _ _ = None;
12.386 +
12.387 +(*. get the argument from a function-definition.*)
12.388 +(*("argument_in" ,("Atools.argument'_in",
12.389 + eval_argument_in "Atools.argument'_in"))*)
12.390 +fun eval_argument_in _ "Atools.argument'_in"
12.391 + (t as (Const ("Atools.argument'_in", _) $ (f $ arg))) _ =
12.392 + if is_Free arg (*could be something to be simplified before*)
12.393 + then Some (term2str t ^ " = " ^ term2str arg,
12.394 + Trueprop $ (mk_equality (t, arg)))
12.395 + else None
12.396 + | eval_argument_in _ _ _ _ = None;
12.397 +
12.398 +(*.check if the function-identifier of the first argument matches
12.399 + the function-identifier of the lhs of the second argument.*)
12.400 +(*("sameFunId" ,("Atools.sameFunId",
12.401 + eval_same_funid "Atools.sameFunId"))*)
12.402 +fun eval_sameFunId _ "Atools.sameFunId"
12.403 + (p as Const ("Atools.sameFunId",_) $
12.404 + (f1 $ _) $
12.405 + (Const ("op =", _) $ (f2 $ _) $ _)) _ =
12.406 + if f1 = f2
12.407 + then Some ((term2str p) ^ " = True",
12.408 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
12.409 + else Some ((term2str p) ^ " = False",
12.410 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
12.411 +| eval_sameFunId _ _ _ _ = None;
12.412 +
12.413 +
12.414 +(*.from a list of fun-definitions "f x = ..." as 2nd argument
12.415 + filter the elements with the same fun-identfier in "f y"
12.416 + as the fst argument;
12.417 + this is, because Isabelles filter takes more than 1 sec.*)
12.418 +fun same_funid f1 (Const ("op =", _) $ (f2 $ _) $ _) = f1 = f2
12.419 + | same_funid f1 t = raise error ("same_funid called with t = ("
12.420 + ^term2str f1^") ("^term2str t^")");
12.421 +(*("filter_sameFunId" ,("Atools.filter'_sameFunId",
12.422 + eval_filter_sameFunId "Atools.filter'_sameFunId"))*)
12.423 +fun eval_filter_sameFunId _ "Atools.filter'_sameFunId"
12.424 + (p as Const ("Atools.filter'_sameFunId",_) $
12.425 + (fid $ _) $ fs) _ =
12.426 + let val fs' = ((list2isalist HOLogic.boolT) o
12.427 + (filter (same_funid fid))) (isalist2list fs)
12.428 + in Some (term2str (mk_equality (p, fs')),
12.429 + Trueprop $ (mk_equality (p, fs'))) end
12.430 +| eval_filter_sameFunId _ _ _ _ = None;
12.431 +
12.432 +
12.433 +(*make a list of terms to a sum*)
12.434 +fun list2sum [] = error ("list2sum called with []")
12.435 + | list2sum [s] = s
12.436 + | list2sum (s::ss) =
12.437 + let fun sum su [s'] =
12.438 + Const ("op +", [HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
12.439 + $ su $ s'
12.440 + | sum su (s'::ss') =
12.441 + sum (Const ("op +", [HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
12.442 + $ su $ s') ss'
12.443 + in sum s ss end;
12.444 +
12.445 +(*make a list of equalities to the sum of the lhs*)
12.446 +(*("boollist2sum" ,("Atools.boollist2sum" ,eval_boollist2sum "")):calc*)
12.447 +fun eval_boollist2sum _ "Atools.boollist2sum"
12.448 + (p as Const ("Atools.boollist2sum", _) $
12.449 + (l as Const ("List.list.Cons", _) $ _ $ _)) _ =
12.450 + let val isal = isalist2list l
12.451 + val lhss = map lhs isal
12.452 + val sum = list2sum lhss
12.453 + in Some ((term2str p) ^ " = " ^ (term2str sum),
12.454 + Trueprop $ (mk_equality (p, sum)))
12.455 + end
12.456 +| eval_boollist2sum _ _ _ _ = None;
12.457 +
12.458 +
12.459 +
12.460 +local
12.461 +
12.462 +open Term;
12.463 +
12.464 +in
12.465 +fun termlessI (_:subst) uv = termless uv;
12.466 +fun term_ordI (_:subst) uv = term_ord uv;
12.467 +end;
12.468 +
12.469 +
12.470 +(** rule set, for evaluating list-expressions in scripts 8.01.02 **)
12.471 +
12.472 +
12.473 +val list_rls =
12.474 + append_rls "list_rls" list_rls
12.475 + [Calc ("op *",eval_binop "#mult_"),
12.476 + Calc ("op +", eval_binop "#add_"),
12.477 + Calc ("op <",eval_equ "#less_"),
12.478 + Calc ("op <=",eval_equ "#less_equal_"),
12.479 + Calc ("Atools.ident",eval_ident "#ident_"),
12.480 + Calc ("op =",eval_equal "#equal_"),(*atom <> atom -> False*)
12.481 +
12.482 + Calc ("Tools.Vars",eval_var "#Vars_"),
12.483 +
12.484 + Thm ("if_True",num_str if_True),
12.485 + Thm ("if_False",num_str if_False)
12.486 + ];
12.487 +
12.488 +ruleset' := overwritelthy thy (!ruleset',
12.489 + [("list_rls",list_rls)
12.490 + ]);
12.491 +
12.492 +(*TODO.WN0509 reduce ids: tless_true = e_rew_ord' = e_rew_ord = dummy_ord*)
12.493 +val tless_true = dummy_ord;
12.494 +rew_ord' := overwritel (!rew_ord',
12.495 + [("tless_true", tless_true),
12.496 + ("e_rew_ord'", tless_true),
12.497 + ("dummy_ord", dummy_ord)]);
12.498 +
12.499 +val calculate_Atools =
12.500 + append_rls "calculate_Atools" e_rls
12.501 + [Calc ("op <",eval_equ "#less_"),
12.502 + Calc ("op <=",eval_equ "#less_equal_"),
12.503 + Calc ("op =",eval_equal "#equal_"),
12.504 +
12.505 + Thm ("real_unari_minus",num_str real_unari_minus),
12.506 + Calc ("op +",eval_binop "#add_"),
12.507 + Calc ("op -",eval_binop "#sub_"),
12.508 + Calc ("op *",eval_binop "#mult_")
12.509 + ];
12.510 +
12.511 +val Atools_erls =
12.512 + append_rls "Atools_erls" e_rls
12.513 + [Calc ("op =",eval_equal "#equal_"),
12.514 + Thm ("not_true",num_str not_true),
12.515 + (*"(~ True) = False"*)
12.516 + Thm ("not_false",num_str not_false),
12.517 + (*"(~ False) = True"*)
12.518 + Thm ("and_true",and_true),
12.519 + (*"(?a & True) = ?a"*)
12.520 + Thm ("and_false",and_false),
12.521 + (*"(?a & False) = False"*)
12.522 + Thm ("or_true",or_true),
12.523 + (*"(?a | True) = True"*)
12.524 + Thm ("or_false",or_false),
12.525 + (*"(?a | False) = ?a"*)
12.526 +
12.527 + Thm ("rat_leq1",rat_leq1),
12.528 + Thm ("rat_leq2",rat_leq2),
12.529 + Thm ("rat_leq3",rat_leq3),
12.530 + Thm ("refl",num_str refl),
12.531 + Thm ("le_refl",num_str le_refl),
12.532 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
12.533 +
12.534 + Calc ("op <",eval_equ "#less_"),
12.535 + Calc ("op <=",eval_equ "#less_equal_"),
12.536 +
12.537 + Calc ("Atools.ident",eval_ident "#ident_"),
12.538 + Calc ("Atools.is'_const",eval_const "#is_const_"),
12.539 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
12.540 + Calc ("Tools.matches",eval_matches "")
12.541 + ];
12.542 +
12.543 +val Atools_crls =
12.544 + append_rls "Atools_crls" e_rls
12.545 + [Calc ("op =",eval_equal "#equal_"),
12.546 + Thm ("not_true",num_str not_true),
12.547 + Thm ("not_false",num_str not_false),
12.548 + Thm ("and_true",and_true),
12.549 + Thm ("and_false",and_false),
12.550 + Thm ("or_true",or_true),
12.551 + Thm ("or_false",or_false),
12.552 +
12.553 + Thm ("rat_leq1",rat_leq1),
12.554 + Thm ("rat_leq2",rat_leq2),
12.555 + Thm ("rat_leq3",rat_leq3),
12.556 + Thm ("refl",num_str refl),
12.557 + Thm ("le_refl",num_str le_refl),
12.558 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
12.559 +
12.560 + Calc ("op <",eval_equ "#less_"),
12.561 + Calc ("op <=",eval_equ "#less_equal_"),
12.562 +
12.563 + Calc ("Atools.ident",eval_ident "#ident_"),
12.564 + Calc ("Atools.is'_const",eval_const "#is_const_"),
12.565 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
12.566 + Calc ("Tools.matches",eval_matches "")
12.567 + ];
12.568 +
12.569 +(*val atools_erls = ... waere zu testen ...
12.570 + merge_rls calculate_Atools
12.571 + (append_rls Atools_erls (*i.A. zu viele rules*)
12.572 + [Calc ("Atools.ident",eval_ident "#ident_"),
12.573 + Calc ("Atools.is'_const",eval_const "#is_const_"),
12.574 + Calc ("Atools.occurs'_in",
12.575 + eval_occurs_in "#occurs_in"),
12.576 + Calc ("Tools.matches",eval_matches "#matches")
12.577 + ] (*i.A. zu viele rules*)
12.578 + );*)
12.579 +(* val atools_erls = prep_rls(
12.580 + Rls {id="atools_erls",preconds = [], rew_ord = ("termlessI",termlessI),
12.581 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
12.582 + rules = [Thm ("refl",num_str refl),
12.583 + Thm ("le_refl",num_str le_refl),
12.584 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
12.585 + Thm ("not_true",num_str not_true),
12.586 + Thm ("not_false",num_str not_false),
12.587 + Thm ("and_true",and_true),
12.588 + Thm ("and_false",and_false),
12.589 + Thm ("or_true",or_true),
12.590 + Thm ("or_false",or_false),
12.591 + Thm ("and_commute",num_str and_commute),
12.592 + Thm ("or_commute",num_str or_commute),
12.593 +
12.594 + Calc ("op <",eval_equ "#less_"),
12.595 + Calc ("op <=",eval_equ "#less_equal_"),
12.596 +
12.597 + Calc ("Atools.ident",eval_ident "#ident_"),
12.598 + Calc ("Atools.is'_const",eval_const "#is_const_"),
12.599 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
12.600 + Calc ("Tools.matches",eval_matches "")
12.601 + ],
12.602 + scr = Script ((term_of o the o (parse thy))
12.603 + "empty_script")
12.604 + }:rls);
12.605 +ruleset' := overwritelth thy
12.606 + (!ruleset',
12.607 + [("atools_erls",atools_erls)(*FIXXXME:del with rls.rls'*)
12.608 + ]);
12.609 +*)
12.610 +"******* Atools.ML end *******";
12.611 +
12.612 +calclist':= overwritel (!calclist',
12.613 + [("occurs_in",("Atools.occurs'_in", eval_occurs_in "#occurs_in_")),
12.614 + ("some_occur_in",
12.615 + ("Atools.some'_occur'_in", eval_some_occur_in "#some_occur_in_")),
12.616 + ("is_atom" ,("Atools.is'_atom",eval_is_atom "#is_atom_")),
12.617 + ("is_even" ,("Atools.is'_even",eval_is_even "#is_even_")),
12.618 + ("is_const" ,("Atools.is'_const",eval_const "#is_const_")),
12.619 + ("le" ,("op <" ,eval_equ "#less_")),
12.620 + ("leq" ,("op <=" ,eval_equ "#less_equal_")),
12.621 + ("ident" ,("Atools.ident",eval_ident "#ident_")),
12.622 + ("equal" ,("op =",eval_equal "#equal_")),
12.623 + ("plus" ,("op +" ,eval_binop "#add_")),
12.624 + ("minus" ,("op -",eval_binop "#sub_")), (*040207 only for prep_rls
12.625 + no script with "minus"*)
12.626 + ("times" ,("op *" ,eval_binop "#mult_")),
12.627 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
12.628 + ("power_" ,("Atools.pow" ,eval_binop "#power_")),
12.629 + ("boollist2sum",("Atools.boollist2sum",eval_boollist2sum ""))
12.630 + ]);
12.631 +
12.632 +val list_rls = prep_rls(
12.633 + merge_rls "list_erls"
12.634 + (Rls {id="replaced",preconds = [],
12.635 + rew_ord = ("termlessI", termlessI),
12.636 + erls = Rls {id="list_elrs", preconds = [],
12.637 + rew_ord = ("termlessI",termlessI),
12.638 + erls = e_rls,
12.639 + srls = Erls, calc = [], (*asm_thm = [],*)
12.640 + rules = [Calc ("op +", eval_binop "#add_"),
12.641 + Calc ("op <",eval_equ "#less_")
12.642 + (* ~~~~~~ for nth_Cons_*)
12.643 + ],
12.644 + scr = EmptyScr},
12.645 + srls = Erls, calc = [], (*asm_thm = [], *)
12.646 + rules = [], scr = EmptyScr})
12.647 + list_rls);
12.648 +ruleset' := overwritelthy thy (!ruleset', [("list_rls", list_rls)]);
13.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
13.2 +++ b/src/Pure/isac/IsacKnowledge/Atools.thy Wed Jul 21 13:53:39 2010 +0200
13.3 @@ -0,0 +1,76 @@
13.4 +(* tools for arithmetic
13.5 + author: Walther Neuper 010308
13.6 +
13.7 +remove_thy"Atools";
13.8 +use_thy"IsacKnowledge/Atools";
13.9 +use_thy"IsacKnowledge/Isac";
13.10 +
13.11 +use_thy_only"IsacKnowledge/Atools";
13.12 +use_thy"IsacKnowledge/Isac";
13.13 +*)
13.14 +
13.15 +
13.16 +Atools = ComplexI + Descript +
13.17 +
13.18 +(*-------------------- consts------------------------------------------------*)
13.19 +consts
13.20 +
13.21 + Arbfix, Undef :: real
13.22 + dummy :: real
13.23 +
13.24 + some'_occur'_in :: "[real list, 'a] => bool" ("some'_of _ occur'_in _")
13.25 + occurs'_in :: "[real , 'a] => bool" ("_ occurs'_in _")
13.26 +
13.27 + "pow" :: [real, real] => real (infixr "^^^" 80)
13.28 +(* ~~~ power doesn't allow Free("2",real) ^ Free("2",nat)
13.29 + ~~~~ ~~~~ ~~~~ ~~~*)
13.30 +(*WN0603 at FE-interface encoded strings to '^',
13.31 + see 'fun encode', fun 'decode'*)
13.32 +
13.33 + "abs" :: real => real ("(|| _ ||)")
13.34 +(* ~~~ FIXXXME Isabelle2002 has abs already !!!*)
13.35 + "absset":: real set => real ("(||| _ |||)")
13.36 + (*is numeral constant ?*)
13.37 + "is'_const" :: real => bool ("_ is'_const" 10)
13.38 + (*is_const rename to is_num FIXXXME.WN.16.5.03 *)
13.39 + "is'_atom" :: real => bool ("_ is'_atom" 10)
13.40 + "is'_even" :: real => bool ("_ is'_even" 10)
13.41 +
13.42 + (* identity on term level*)
13.43 + "ident" :: ['a, 'a] => bool ("(_ =!=/ _)" [51, 51] 50)
13.44 +
13.45 + "argument'_in" :: real => real ("argument'_in _" 10)
13.46 + "sameFunId" :: [real, bool] => bool (**"same'_funid _ _" 10
13.47 + WN0609 changed the id, because ".. _ _" inhibits currying**)
13.48 + "filter'_sameFunId":: [real, bool list] => bool list
13.49 + ("filter'_sameFunId _ _" 10)
13.50 + "boollist2sum" :: bool list => real
13.51 +
13.52 +(*-------------------- rules -------------------------------------*)
13.53 +rules (*for evaluating the assumptions of conditional rules*)
13.54 +
13.55 + last_thmI "lastI (x#xs) = (if xs =!= [] then x else lastI xs)"
13.56 + real_unari_minus "- a = (-1) * a"
13.57 +
13.58 + rle_refl "(n::real) <= n"
13.59 +(*reflI "(t = t) = True"*)
13.60 + radd_left_cancel_le "((k::real) + m <= k + n) = (m <= n)"
13.61 + not_true "(~ True) = False"
13.62 + not_false "(~ False) = True"
13.63 + and_true "(a & True) = a"
13.64 + and_false "(a & False) = False"
13.65 + or_true "(a | True) = True"
13.66 + or_false "(a | False) = a"
13.67 + and_commute "(a & b) = (b & a)"
13.68 + or_commute "(a | b) = (b | a)"
13.69 +
13.70 + (*.should be in Rational.thy, but:
13.71 + needed for asms in e.g. d2_pqformula1 in PolyEq.ML, RootEq.ML.*)
13.72 + rat_leq1 "[| b ~= 0; d ~= 0 |] ==> \
13.73 + \((a / b) <= (c / d)) = ((a*d) <= (b*c))"(*Isa?*)
13.74 + rat_leq2 "d ~= 0 ==> \
13.75 + \( a <= (c / d)) = ((a*d) <= c )"(*Isa?*)
13.76 + rat_leq3 "b ~= 0 ==> \
13.77 + \((a / b) <= c ) = ( a <= (b*c))"(*Isa?*)
13.78 +
13.79 +end
14.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
14.2 +++ b/src/Pure/isac/IsacKnowledge/Biegelinie.ML Wed Jul 21 13:53:39 2010 +0200
14.3 @@ -0,0 +1,468 @@
14.4 +(* chapter 'Biegelinie' from the textbook:
14.5 + Timischl, Kaiser. Ingenieur-Mathematik 3. Wien 1999. p.268-271.
14.6 + authors: Walther Neuper 2005
14.7 + (c) due to copyright terms
14.8 +
14.9 +use"IsacKnowledge/Biegelinie.ML";
14.10 +use"Biegelinie.ML";
14.11 +
14.12 +remove_thy"Typefix";
14.13 +remove_thy"Biegelinie";
14.14 +use_thy"IsacKnowledge/Isac";
14.15 +*)
14.16 +
14.17 +(** interface isabelle -- isac **)
14.18 +
14.19 +theory' := overwritel (!theory', [("Biegelinie.thy",Biegelinie.thy)]);
14.20 +
14.21 +(** theory elements **)
14.22 +
14.23 +store_isa ["IsacKnowledge"] [];
14.24 +store_thy Biegelinie.thy
14.25 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.26 +store_isa ["IsacKnowledge", theory2thyID Biegelinie.thy, "Theorems"]
14.27 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.28 +store_thm Biegelinie.thy ("Belastung_Querkraft", Belastung_Querkraft)
14.29 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.30 +store_thm Biegelinie.thy ("Moment_Neigung", Moment_Neigung)
14.31 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.32 +store_thm Biegelinie.thy ("Moment_Querkraft", Moment_Querkraft)
14.33 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.34 +store_thm Biegelinie.thy ("Neigung_Moment", Neigung_Moment)
14.35 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.36 +store_thm Biegelinie.thy ("Querkraft_Belastung", Querkraft_Belastung)
14.37 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.38 +store_thm Biegelinie.thy ("Querkraft_Moment", Querkraft_Moment)
14.39 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.40 +store_thm Biegelinie.thy ("make_fun_explicit", make_fun_explicit)
14.41 + ["Walther Neuper 2005 supported by a grant from NMI Austria"];
14.42 +
14.43 +
14.44 +(** problems **)
14.45 +
14.46 +store_pbt
14.47 + (prep_pbt Biegelinie.thy "pbl_bieg" [] e_pblID
14.48 + (["Biegelinien"],
14.49 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__"]),
14.50 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
14.51 + ("#Find" ,["Biegelinie b_"]),
14.52 + ("#Relate",["Randbedingungen rb_"])
14.53 + ],
14.54 + append_rls "e_rls" e_rls [],
14.55 + None,
14.56 + [["IntegrierenUndKonstanteBestimmen2"]]));
14.57 +
14.58 +store_pbt
14.59 + (prep_pbt Biegelinie.thy "pbl_bieg_mom" [] e_pblID
14.60 + (["MomentBestimmte","Biegelinien"],
14.61 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__"]),
14.62 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
14.63 + ("#Find" ,["Biegelinie b_"]),
14.64 + ("#Relate",["RandbedingungenBiegung rb_","RandbedingungenMoment rm_"])
14.65 + ],
14.66 + append_rls "e_rls" e_rls [],
14.67 + None,
14.68 + [["IntegrierenUndKonstanteBestimmen"]]));
14.69 +
14.70 +store_pbt
14.71 + (prep_pbt Biegelinie.thy "pbl_bieg_momg" [] e_pblID
14.72 + (["MomentGegebene","Biegelinien"],
14.73 + [],
14.74 + append_rls "e_rls" e_rls [],
14.75 + None,
14.76 + [["IntegrierenUndKonstanteBestimmen","2xIntegrieren"]]));
14.77 +
14.78 +store_pbt
14.79 + (prep_pbt Biegelinie.thy "pbl_bieg_einf" [] e_pblID
14.80 + (["einfache","Biegelinien"],
14.81 + [],
14.82 + append_rls "e_rls" e_rls [],
14.83 + None,
14.84 + [["IntegrierenUndKonstanteBestimmen","4x4System"]]));
14.85 +
14.86 +store_pbt
14.87 + (prep_pbt Biegelinie.thy "pbl_bieg_momquer" [] e_pblID
14.88 + (["QuerkraftUndMomentBestimmte","Biegelinien"],
14.89 + [],
14.90 + append_rls "e_rls" e_rls [],
14.91 + None,
14.92 + [["IntegrierenUndKonstanteBestimmen","1xIntegrieren"]]));
14.93 +
14.94 +store_pbt
14.95 + (prep_pbt Biegelinie.thy "pbl_bieg_vonq" [] e_pblID
14.96 + (["vonBelastungZu","Biegelinien"],
14.97 + [("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
14.98 + ("#Find" ,["Funktionen funs___"])],
14.99 + append_rls "e_rls" e_rls [],
14.100 + None,
14.101 + [["Biegelinien","ausBelastung"]]));
14.102 +
14.103 +store_pbt
14.104 + (prep_pbt Biegelinie.thy "pbl_bieg_randbed" [] e_pblID
14.105 + (["setzeRandbedingungen","Biegelinien"],
14.106 + [("#Given" ,["Funktionen funs_","Randbedingungen rb_"]),
14.107 + ("#Find" ,["Gleichungen equs___"])],
14.108 + append_rls "e_rls" e_rls [],
14.109 + None,
14.110 + [["Biegelinien","setzeRandbedingungenEin"]]));
14.111 +
14.112 +store_pbt
14.113 + (prep_pbt Biegelinie.thy "pbl_equ_fromfun" [] e_pblID
14.114 + (["makeFunctionTo","equation"],
14.115 + [("#Given" ,["functionEq fun_","substitution sub_"]),
14.116 + ("#Find" ,["equality equ___"])],
14.117 + append_rls "e_rls" e_rls [],
14.118 + None,
14.119 + [["Equation","fromFunction"]]));
14.120 +
14.121 +
14.122 +
14.123 +(** methods **)
14.124 +
14.125 +val srls = Rls {id="srls_IntegrierenUnd..",
14.126 + preconds = [],
14.127 + rew_ord = ("termlessI",termlessI),
14.128 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
14.129 + [(*for asm in nth_Cons_ ...*)
14.130 + Calc ("op <",eval_equ "#less_"),
14.131 + (*2nd nth_Cons_ pushes n+-1 into asms*)
14.132 + Calc("op +", eval_binop "#add_")
14.133 + ],
14.134 + srls = Erls, calc = [],
14.135 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
14.136 + Calc("op +", eval_binop "#add_"),
14.137 + Thm ("nth_Nil_",num_str nth_Nil_),
14.138 + Calc("Tools.lhs", eval_lhs"eval_lhs_"),
14.139 + Calc("Tools.rhs", eval_rhs"eval_rhs_"),
14.140 + Calc("Atools.argument'_in",
14.141 + eval_argument_in "Atools.argument'_in")
14.142 + ],
14.143 + scr = EmptyScr};
14.144 +
14.145 +val srls2 =
14.146 + Rls {id="srls_IntegrierenUnd..",
14.147 + preconds = [],
14.148 + rew_ord = ("termlessI",termlessI),
14.149 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
14.150 + [(*for asm in nth_Cons_ ...*)
14.151 + Calc ("op <",eval_equ "#less_"),
14.152 + (*2nd nth_Cons_ pushes n+-1 into asms*)
14.153 + Calc("op +", eval_binop "#add_")
14.154 + ],
14.155 + srls = Erls, calc = [],
14.156 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
14.157 + Calc("op +", eval_binop "#add_"),
14.158 + Thm ("nth_Nil_", num_str nth_Nil_),
14.159 + Calc("Tools.lhs", eval_lhs "eval_lhs_"),
14.160 + Calc("Atools.filter'_sameFunId",
14.161 + eval_filter_sameFunId "Atools.filter'_sameFunId"),
14.162 + (*WN070514 just for smltest/../biegelinie.sml ...*)
14.163 + Calc("Atools.sameFunId", eval_sameFunId "Atools.sameFunId"),
14.164 + Thm ("filter_Cons", num_str filter_Cons),
14.165 + Thm ("filter_Nil", num_str filter_Nil),
14.166 + Thm ("if_True", num_str if_True),
14.167 + Thm ("if_False", num_str if_False),
14.168 + Thm ("hd_thm", num_str hd_thm)
14.169 + ],
14.170 + scr = EmptyScr};
14.171 +(*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
14.172 +(* use"IsacKnowledge/Biegelinie.ML";
14.173 + *)
14.174 +
14.175 +store_met
14.176 + (prep_met Biegelinie.thy "met_biege" [] e_metID
14.177 + (["IntegrierenUndKonstanteBestimmen"],
14.178 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__",
14.179 + "FunktionsVariable v_"]),
14.180 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
14.181 + ("#Find" ,["Biegelinie b_"]),
14.182 + ("#Relate",["RandbedingungenBiegung rb_",
14.183 + "RandbedingungenMoment rm_"])
14.184 + ],
14.185 + {rew_ord'="tless_true",
14.186 + rls' = append_rls "erls_IntegrierenUndK.." e_rls
14.187 + [Calc ("Atools.ident",eval_ident "#ident_"),
14.188 + Thm ("not_true",num_str not_true),
14.189 + Thm ("not_false",num_str not_false)],
14.190 + calc = [], srls = srls, prls = Erls,
14.191 + crls = Atools_erls, nrls = Erls},
14.192 +"Script BiegelinieScript \
14.193 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
14.194 +\(rb_::bool list) (rm_::bool list) = \
14.195 +\ (let q___ = Take (q_ v_ = q__); \
14.196 +\ q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ \
14.197 +\ (Rewrite Belastung_Querkraft True)) q___; \
14.198 +\ (Q__:: bool) = \
14.199 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.200 +\ [diff,integration,named]) \
14.201 +\ [real_ (rhs q___), real_ v_, real_real_ Q]); \
14.202 +\ Q__ = Rewrite Querkraft_Moment True Q__; \
14.203 +\ (M__::bool) = \
14.204 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.205 +\ [diff,integration,named]) \
14.206 +\ [real_ (rhs Q__), real_ v_, real_real_ M_b]); \
14.207 +\ e1__ = nth_ 1 rm_; \
14.208 +\ (x1__::real) = argument_in (lhs e1__); \
14.209 +\ (M1__::bool) = (Substitute [v_ = x1__]) M__; \
14.210 +\ M1__ = (Substitute [e1__]) M1__ ; \
14.211 +\ M2__ = Take M__; "^
14.212 +(*without this Take 'Substitute [v_ = x2__]' takes _last formula from ctree_*)
14.213 +" e2__ = nth_ 2 rm_; \
14.214 +\ (x2__::real) = argument_in (lhs e2__); \
14.215 +\ (M2__::bool) = ((Substitute [v_ = x2__]) @@ \
14.216 +\ (Substitute [e2__])) M2__; \
14.217 +\ (c_1_2__::bool list) = \
14.218 +\ (SubProblem (Biegelinie_,[linear,system],[no_met]) \
14.219 +\ [booll_ [M1__, M2__], reall [c,c_2]]); \
14.220 +\ M__ = Take M__; \
14.221 +\ M__ = ((Substitute c_1_2__) @@ \
14.222 +\ (Try (Rewrite_Set_Inst [(bdv_1, c),(bdv_2, c_2)]\
14.223 +\ simplify_System False)) @@ \
14.224 +\ (Rewrite Moment_Neigung False) @@ \
14.225 +\ (Rewrite make_fun_explicit False)) M__; "^
14.226 +(*----------------------- and the same once more ------------------------*)
14.227 +" (N__:: bool) = \
14.228 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.229 +\ [diff,integration,named]) \
14.230 +\ [real_ (rhs M__), real_ v_, real_real_ y']); \
14.231 +\ (B__:: bool) = \
14.232 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.233 +\ [diff,integration,named]) \
14.234 +\ [real_ (rhs N__), real_ v_, real_real_ y]); \
14.235 +\ e1__ = nth_ 1 rb_; \
14.236 +\ (x1__::real) = argument_in (lhs e1__); \
14.237 +\ (B1__::bool) = (Substitute [v_ = x1__]) B__; \
14.238 +\ B1__ = (Substitute [e1__]) B1__ ; \
14.239 +\ B2__ = Take B__; \
14.240 +\ e2__ = nth_ 2 rb_; \
14.241 +\ (x2__::real) = argument_in (lhs e2__); \
14.242 +\ (B2__::bool) = ((Substitute [v_ = x2__]) @@ \
14.243 +\ (Substitute [e2__])) B2__; \
14.244 +\ (c_1_2__::bool list) = \
14.245 +\ (SubProblem (Biegelinie_,[linear,system],[no_met]) \
14.246 +\ [booll_ [B1__, B2__], reall [c,c_2]]); \
14.247 +\ B__ = Take B__; \
14.248 +\ B__ = ((Substitute c_1_2__) @@ \
14.249 +\ (Rewrite_Set_Inst [(bdv, x)] make_ratpoly_in False)) B__ \
14.250 +\ in B__)"
14.251 +));
14.252 +
14.253 +store_met
14.254 + (prep_met Biegelinie.thy "met_biege_2" [] e_metID
14.255 + (["IntegrierenUndKonstanteBestimmen2"],
14.256 + [("#Given" ,["Traegerlaenge l_", "Streckenlast q__",
14.257 + "FunktionsVariable v_"]),
14.258 + (*("#Where",["0 < l_"]), ...wait for < and handling Arbfix*)
14.259 + ("#Find" ,["Biegelinie b_"]),
14.260 + ("#Relate",["Randbedingungen rb_"])
14.261 + ],
14.262 + {rew_ord'="tless_true",
14.263 + rls' = append_rls "erls_IntegrierenUndK.." e_rls
14.264 + [Calc ("Atools.ident",eval_ident "#ident_"),
14.265 + Thm ("not_true",num_str not_true),
14.266 + Thm ("not_false",num_str not_false)],
14.267 + calc = [],
14.268 + srls = append_rls "erls_IntegrierenUndK.." e_rls
14.269 + [Calc("Tools.rhs", eval_rhs"eval_rhs_"),
14.270 + Calc ("Atools.ident",eval_ident "#ident_"),
14.271 + Thm ("last_thmI",num_str last_thmI),
14.272 + Thm ("if_True",num_str if_True),
14.273 + Thm ("if_False",num_str if_False)
14.274 + ],
14.275 + prls = Erls, crls = Atools_erls, nrls = Erls},
14.276 +"Script Biegelinie2Script \
14.277 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) (rb_::bool list) = \
14.278 +\ (let \
14.279 +\ (funs_:: bool list) = \
14.280 +\ (SubProblem (Biegelinie_,[vonBelastungZu,Biegelinien], \
14.281 +\ [Biegelinien,ausBelastung]) \
14.282 +\ [real_ q__, real_ v_]); \
14.283 +\ (equs_::bool list) = \
14.284 +\ (SubProblem (Biegelinie_,[setzeRandbedingungen,Biegelinien],\
14.285 +\ [Biegelinien,setzeRandbedingungenEin]) \
14.286 +\ [booll_ funs_, booll_ rb_]); \
14.287 +\ (cons_::bool list) = \
14.288 +\ (SubProblem (Biegelinie_,[linear,system],[no_met]) \
14.289 +\ [booll_ equs_, reall [c,c_2,c_3,c_4]]); \
14.290 +\ B_ = Take (lastI funs_); \
14.291 +\ B_ = ((Substitute cons_) @@ \
14.292 +\ (Rewrite_Set_Inst [(bdv, v_)] make_ratpoly_in False)) B_ \
14.293 +\ in B_)"
14.294 +));
14.295 +
14.296 +store_met
14.297 + (prep_met Biegelinie.thy "met_biege_intconst_2" [] e_metID
14.298 + (["IntegrierenUndKonstanteBestimmen","2xIntegrieren"],
14.299 + [],
14.300 + {rew_ord'="tless_true", rls'=Erls, calc = [],
14.301 + srls = e_rls,
14.302 + prls=e_rls,
14.303 + crls = Atools_erls, nrls = e_rls},
14.304 +"empty_script"
14.305 +));
14.306 +
14.307 +store_met
14.308 + (prep_met Biegelinie.thy "met_biege_intconst_4" [] e_metID
14.309 + (["IntegrierenUndKonstanteBestimmen","4x4System"],
14.310 + [],
14.311 + {rew_ord'="tless_true", rls'=Erls, calc = [],
14.312 + srls = e_rls,
14.313 + prls=e_rls,
14.314 + crls = Atools_erls, nrls = e_rls},
14.315 +"empty_script"
14.316 +));
14.317 +
14.318 +store_met
14.319 + (prep_met Biegelinie.thy "met_biege_intconst_1" [] e_metID
14.320 + (["IntegrierenUndKonstanteBestimmen","1xIntegrieren"],
14.321 + [],
14.322 + {rew_ord'="tless_true", rls'=Erls, calc = [],
14.323 + srls = e_rls,
14.324 + prls=e_rls,
14.325 + crls = Atools_erls, nrls = e_rls},
14.326 +"empty_script"
14.327 +));
14.328 +
14.329 +store_met
14.330 + (prep_met Biegelinie.thy "met_biege2" [] e_metID
14.331 + (["Biegelinien"],
14.332 + [],
14.333 + {rew_ord'="tless_true", rls'=Erls, calc = [],
14.334 + srls = e_rls,
14.335 + prls=e_rls,
14.336 + crls = Atools_erls, nrls = e_rls},
14.337 +"empty_script"
14.338 +));
14.339 +
14.340 +store_met
14.341 + (prep_met Biegelinie.thy "met_biege_ausbelast" [] e_metID
14.342 + (["Biegelinien","ausBelastung"],
14.343 + [("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
14.344 + ("#Find" ,["Funktionen funs_"])],
14.345 + {rew_ord'="tless_true",
14.346 + rls' = append_rls "erls_ausBelastung" e_rls
14.347 + [Calc ("Atools.ident",eval_ident "#ident_"),
14.348 + Thm ("not_true",num_str not_true),
14.349 + Thm ("not_false",num_str not_false)],
14.350 + calc = [],
14.351 + srls = append_rls "srls_ausBelastung" e_rls
14.352 + [Calc("Tools.rhs", eval_rhs"eval_rhs_")],
14.353 + prls = e_rls, crls = Atools_erls, nrls = e_rls},
14.354 +"Script Belastung2BiegelScript (q__::real) (v_::real) = \
14.355 +\ (let q___ = Take (q_ v_ = q__); \
14.356 +\ q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ \
14.357 +\ (Rewrite Belastung_Querkraft True)) q___; \
14.358 +\ (Q__:: bool) = \
14.359 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.360 +\ [diff,integration,named]) \
14.361 +\ [real_ (rhs q___), real_ v_, real_real_ Q]); \
14.362 +\ M__ = Rewrite Querkraft_Moment True Q__; \
14.363 +\ (M__::bool) = \
14.364 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.365 +\ [diff,integration,named]) \
14.366 +\ [real_ (rhs M__), real_ v_, real_real_ M_b]); \
14.367 +\ N__ = ((Rewrite Moment_Neigung False) @@ \
14.368 +\ (Rewrite make_fun_explicit False)) M__; \
14.369 +\ (N__:: bool) = \
14.370 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.371 +\ [diff,integration,named]) \
14.372 +\ [real_ (rhs N__), real_ v_, real_real_ y']); \
14.373 +\ (B__:: bool) = \
14.374 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
14.375 +\ [diff,integration,named]) \
14.376 +\ [real_ (rhs N__), real_ v_, real_real_ y]) \
14.377 +\ in [Q__, M__, N__, B__])"
14.378 +));
14.379 +
14.380 +store_met
14.381 + (prep_met Biegelinie.thy "met_biege_setzrand" [] e_metID
14.382 + (["Biegelinien","setzeRandbedingungenEin"],
14.383 + [("#Given" ,["Funktionen funs_","Randbedingungen rb_"]),
14.384 + ("#Find" ,["Gleichungen equs___"])],
14.385 + {rew_ord'="tless_true", rls'=Erls, calc = [],
14.386 + srls = srls2,
14.387 + prls=e_rls,
14.388 + crls = Atools_erls, nrls = e_rls},
14.389 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = \
14.390 +\ (let b1_ = nth_ 1 rb_; \
14.391 +\ fs_ = filter_sameFunId (lhs b1_) funs_; \
14.392 +\ (e1_::bool) = \
14.393 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.394 +\ [Equation,fromFunction]) \
14.395 +\ [bool_ (hd fs_), bool_ b1_]); \
14.396 +\ b2_ = nth_ 2 rb_; \
14.397 +\ fs_ = filter_sameFunId (lhs b2_) funs_; \
14.398 +\ (e2_::bool) = \
14.399 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.400 +\ [Equation,fromFunction]) \
14.401 +\ [bool_ (hd fs_), bool_ b2_]); \
14.402 +\ b3_ = nth_ 3 rb_; \
14.403 +\ fs_ = filter_sameFunId (lhs b3_) funs_; \
14.404 +\ (e3_::bool) = \
14.405 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.406 +\ [Equation,fromFunction]) \
14.407 +\ [bool_ (hd fs_), bool_ b3_]); \
14.408 +\ b4_ = nth_ 4 rb_; \
14.409 +\ fs_ = filter_sameFunId (lhs b4_) funs_; \
14.410 +\ (e4_::bool) = \
14.411 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.412 +\ [Equation,fromFunction]) \
14.413 +\ [bool_ (hd fs_), bool_ b4_]) \
14.414 +\ in [e1_,e2_,e3_,e4_])"
14.415 +(* filter requires more than 1 sec !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
14.416 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = \
14.417 +\ (let b1_ = nth_ 1 rb_; \
14.418 +\ fs_ = filter (sameFunId (lhs b1_)) funs_; \
14.419 +\ (e1_::bool) = \
14.420 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.421 +\ [Equation,fromFunction]) \
14.422 +\ [bool_ (hd fs_), bool_ b1_]); \
14.423 +\ b2_ = nth_ 2 rb_; \
14.424 +\ fs_ = filter (sameFunId (lhs b2_)) funs_; \
14.425 +\ (e2_::bool) = \
14.426 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.427 +\ [Equation,fromFunction]) \
14.428 +\ [bool_ (hd fs_), bool_ b2_]); \
14.429 +\ b3_ = nth_ 3 rb_; \
14.430 +\ fs_ = filter (sameFunId (lhs b3_)) funs_; \
14.431 +\ (e3_::bool) = \
14.432 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.433 +\ [Equation,fromFunction]) \
14.434 +\ [bool_ (hd fs_), bool_ b3_]); \
14.435 +\ b4_ = nth_ 4 rb_; \
14.436 +\ fs_ = filter (sameFunId (lhs b4_)) funs_; \
14.437 +\ (e4_::bool) = \
14.438 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
14.439 +\ [Equation,fromFunction]) \
14.440 +\ [bool_ (hd fs_), bool_ b4_]) \
14.441 +\ in [e1_,e2_,e3_,e4_])"*)
14.442 +));
14.443 +
14.444 +store_met
14.445 + (prep_met Biegelinie.thy "met_equ_fromfun" [] e_metID
14.446 + (["Equation","fromFunction"],
14.447 + [("#Given" ,["functionEq fun_","substitution sub_"]),
14.448 + ("#Find" ,["equality equ___"])],
14.449 + {rew_ord'="tless_true", rls'=Erls, calc = [],
14.450 + srls = append_rls "srls_in_EquationfromFunc" e_rls
14.451 + [Calc("Tools.lhs", eval_lhs"eval_lhs_"),
14.452 + Calc("Atools.argument'_in",
14.453 + eval_argument_in
14.454 + "Atools.argument'_in")],
14.455 + prls=e_rls,
14.456 + crls = Atools_erls, nrls = e_rls},
14.457 +(*(M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2) (M_b L = 0) -->
14.458 + 0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2*)
14.459 +"Script Function2Equality (fun_::bool) (sub_::bool) =\
14.460 +\ (let fun_ = Take fun_; \
14.461 +\ bdv_ = argument_in (lhs fun_); \
14.462 +\ val_ = argument_in (lhs sub_); \
14.463 +\ equ_ = (Substitute [bdv_ = val_]) fun_; \
14.464 +\ equ_ = (Substitute [sub_]) fun_ \
14.465 +\ in (Rewrite_Set norm_Rational False) equ_) "
14.466 +));
14.467 +
14.468 +
14.469 +
14.470 +(* use"IsacKnowledge/Biegelinie.ML";
14.471 + *)
14.472 \ No newline at end of file
15.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
15.2 +++ b/src/Pure/isac/IsacKnowledge/Biegelinie.thy Wed Jul 21 13:53:39 2010 +0200
15.3 @@ -0,0 +1,82 @@
15.4 +(* chapter 'Biegelinie' from the textbook:
15.5 + Timischl, Kaiser. Ingenieur-Mathematik 3. Wien 1999. p.268-271.
15.6 + author: Walther Neuper
15.7 + 050826,
15.8 + (c) due to copyright terms
15.9 +
15.10 +remove_thy"Biegelinie";
15.11 +use_thy"IsacKnowledge/Biegelinie";
15.12 +use_thy_only"IsacKnowledge/Biegelinie";
15.13 +
15.14 +remove_thy"Biegelinie";
15.15 +use_thy"IsacKnowledge/Isac";
15.16 +*)
15.17 +
15.18 +Biegelinie = Integrate + Equation + EqSystem +
15.19 +
15.20 +consts
15.21 +
15.22 + q_ :: real => real ("q'_") (* Streckenlast *)
15.23 + Q :: real => real (* Querkraft *)
15.24 + Q' :: real => real (* Ableitung der Querkraft *)
15.25 + M'_b :: real => real ("M'_b") (* Biegemoment *)
15.26 + M'_b' :: real => real ("M'_b'") (* Ableitung des Biegemoments *)
15.27 + y'' :: real => real (* 2.Ableitung der Biegeline *)
15.28 + y' :: real => real (* Neigung der Biegeline *)
15.29 +(*y :: real => real (* Biegeline *)*)
15.30 + EI :: real (* Biegesteifigkeit *)
15.31 +
15.32 + (*new Descriptions in the related problems*)
15.33 + Traegerlaenge :: real => una
15.34 + Streckenlast :: real => una
15.35 + BiegemomentVerlauf :: bool => una
15.36 + Biegelinie :: (real => real) => una
15.37 + Randbedingungen :: bool list => una
15.38 + RandbedingungenBiegung :: bool list => una
15.39 + RandbedingungenNeigung :: bool list => una
15.40 + RandbedingungenMoment :: bool list => una
15.41 + RandbedingungenQuerkraft :: bool list => una
15.42 + FunktionsVariable :: real => una
15.43 + Funktionen :: bool list => una
15.44 + Gleichungen :: bool list => una
15.45 +
15.46 + (*Script-names*)
15.47 + Biegelinie2Script :: "[real,real,real,real=>real,bool list,
15.48 + bool] => bool"
15.49 + ("((Script Biegelinie2Script (_ _ _ _ _ =))// (_))" 9)
15.50 + BiegelinieScript :: "[real,real,real,real=>real,bool list,bool list,
15.51 + bool] => bool"
15.52 + ("((Script BiegelinieScript (_ _ _ _ _ _ =))// (_))" 9)
15.53 + Biege2xIntegrierenScript :: "[real,real,real,bool,real=>real,bool list,
15.54 + bool] => bool"
15.55 + ("((Script Biege2xIntegrierenScript (_ _ _ _ _ _ =))// (_))" 9)
15.56 + Biege4x4SystemScript :: "[real,real,real,real=>real,bool list,
15.57 + bool] => bool"
15.58 + ("((Script Biege4x4SystemScript (_ _ _ _ _ =))// (_))" 9)
15.59 + Biege1xIntegrierenScript ::
15.60 + "[real,real,real,real=>real,bool list,bool list,bool list,
15.61 + bool] => bool"
15.62 + ("((Script Biege1xIntegrierenScript (_ _ _ _ _ _ _ =))// (_))" 9)
15.63 + Belastung2BiegelScript :: "[real,real,
15.64 + bool list] => bool list"
15.65 + ("((Script Belastung2BiegelScript (_ _ =))// (_))" 9)
15.66 + SetzeRandbedScript :: "[bool list,bool list,
15.67 + bool list] => bool list"
15.68 + ("((Script SetzeRandbedScript (_ _ =))// (_))" 9)
15.69 +
15.70 +rules
15.71 +
15.72 + Querkraft_Belastung "Q' x = -q_ x"
15.73 + Belastung_Querkraft "-q_ x = Q' x"
15.74 +
15.75 + Moment_Querkraft "M_b' x = Q x"
15.76 + Querkraft_Moment "Q x = M_b' x"
15.77 +
15.78 + Neigung_Moment "y'' x = -M_b x/ EI"
15.79 + Moment_Neigung "M_b x = -EI * y'' x"
15.80 +
15.81 + (*according to rls 'simplify_Integral': .. = 1/a * .. instead .. = ../ a*)
15.82 + make_fun_explicit "Not (a =!= 0) ==> (a * (f x) = b) = (f x = 1/a * b)"
15.83 +
15.84 +end
15.85 +
16.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
16.2 +++ b/src/Pure/isac/IsacKnowledge/Calculus.thy Wed Jul 21 13:53:39 2010 +0200
16.3 @@ -0,0 +1,4 @@
16.4 +
16.5 +Calculus = Real +
16.6 +
16.7 +end
16.8 \ No newline at end of file
17.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
17.2 +++ b/src/Pure/isac/IsacKnowledge/Complex.ML Wed Jul 21 13:53:39 2010 +0200
17.3 @@ -0,0 +1,22 @@
17.4 +(*Komplexe Zahlen, anders als von Isabelle vorgeschlagen,
17.5 + und naeher an der traditionellen Schreibweise (sh.auch Mathematica)*)
17.6 +
17.7 +
17.8 +(*---- solche Tests gehoeren nach kbtest/complex.sml ---
17.9 + val t = (term_of o the o (parse thy)) "I__";
17.10 + atomt t;
17.11 + val t = (term_of o the o (parse thy)) "1 + 2 * I__";
17.12 + atomt t;
17.13 + val t = (term_of o the o (parse thy))
17.14 + "1 + 2 * I__ + 3 + 4 * I__ * (5 + 6 * I__) / (7 + 8 * I__)";
17.15 + atomt t;
17.16 +(*andere konkrete Syntax ???*)
17.17 +
17.18 + val t = (term_of o the o (parse thy)) "Float ((1,2),(0,0)) * I__";
17.19 + atomt t;
17.20 + (*term2str t;*)
17.21 + val t = (term_of o the o (parse thy))
17.22 + "Float ((1,2),(0,0)) + Float ((3,4),(0,0)) * I__";
17.23 + atomt t;
17.24 + (*term2str t;*)
17.25 +---------------------------------------------------------*)
17.26 \ No newline at end of file
18.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
18.2 +++ b/src/Pure/isac/IsacKnowledge/Complex.thy Wed Jul 21 13:53:39 2010 +0200
18.3 @@ -0,0 +1,27 @@
18.4 +(* imaginary unit, close to traditional notation in algebra systems;
18.5 + types questionable, see Isabelle/HOL/Real/Complex_Numbers.thy
18.6 +
18.7 + use_thy_only"IsacKnowledge/Complex";
18.8 + use_thy_only"Complex";
18.9 +
18.10 + use_thy"knowledge/Complex";
18.11 + use_thy"Complex";
18.12 + *)
18.13 +
18.14 +
18.15 +Complex = Float +
18.16 +
18.17 +consts
18.18 +(* waere auch eine Moeglichkeit
18.19 + "I'_'_" :: "real => real" ("_ I'_'_" [999] 998)
18.20 +*)
18.21 + "I'_'_" :: "real" ("I'_'_")
18.22 +
18.23 +rules
18.24 +(* waere auch eine Moeglichkeit
18.25 + add_I "a I__ + b I__ = (a + b) I__"
18.26 + mult_I "a I__ * b I__ = -1 * a * b"
18.27 +*)
18.28 + square_I "I__ * I__ = -1"
18.29 +
18.30 +end
18.31 \ No newline at end of file
19.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
19.2 +++ b/src/Pure/isac/IsacKnowledge/ComplexI.ML Wed Jul 21 13:53:39 2010 +0200
19.3 @@ -0,0 +1,22 @@
19.4 +(*Komplexe Zahlen, anders als von Isabelle vorgeschlagen,
19.5 + und naeher an der traditionellen Schreibweise (sh.auch Mathematica)*)
19.6 +
19.7 +
19.8 +(*---- solche Tests gehoeren nach kbtest/complex.sml ---
19.9 + val t = (term_of o the o (parse thy)) "I__";
19.10 + atomt t;
19.11 + val t = (term_of o the o (parse thy)) "1 + 2 * I__";
19.12 + atomt t;
19.13 + val t = (term_of o the o (parse thy))
19.14 + "1 + 2 * I__ + 3 + 4 * I__ * (5 + 6 * I__) / (7 + 8 * I__)";
19.15 + atomt t;
19.16 +(*andere konkrete Syntax ???*)
19.17 +
19.18 + val t = (term_of o the o (parse thy)) "Float ((1,2),(0,0)) * I__";
19.19 + atomt t;
19.20 + (*term2str t;*)
19.21 + val t = (term_of o the o (parse thy))
19.22 + "Float ((1,2),(0,0)) + Float ((3,4),(0,0)) * I__";
19.23 + atomt t;
19.24 + (*term2str t;*)
19.25 +---------------------------------------------------------*)
19.26 \ No newline at end of file
20.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
20.2 +++ b/src/Pure/isac/IsacKnowledge/ComplexI.thy Wed Jul 21 13:53:39 2010 +0200
20.3 @@ -0,0 +1,27 @@
20.4 +(* imaginary unit, close to traditional notation in algebra systems;
20.5 + types questionable, see Isabelle/HOL/Real/Complex_Numbers.thy
20.6 +
20.7 + use_thy_only"IsacKnowledge/ComplexI";
20.8 + use_thy_only"ComplexI";
20.9 +
20.10 + use_thy"knowledge/ComplexI";
20.11 + use_thy"ComplexI";
20.12 + *)
20.13 +
20.14 +
20.15 +ComplexI = Float +
20.16 +
20.17 +consts
20.18 +(* waere auch eine Moeglichkeit
20.19 + "I'_'_" :: "real => real" ("_ I'_'_" [999] 998)
20.20 +*)
20.21 + "I'_'_" :: "real" ("I'_'_")
20.22 +
20.23 +rules
20.24 +(* waere auch eine Moeglichkeit
20.25 + add_I "a I__ + b I__ = (a + b) I__"
20.26 + mult_I "a I__ * b I__ = -1 * a * b"
20.27 +*)
20.28 + square_I "I__ * I__ = -1"
20.29 +
20.30 +end
20.31 \ No newline at end of file
21.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
21.2 +++ b/src/Pure/isac/IsacKnowledge/Descript.thy Wed Jul 21 13:53:39 2010 +0200
21.3 @@ -0,0 +1,55 @@
21.4 +(* descriptions for items in problem-types
21.5 + WN 1.3.00
21.6 + + see WN, Reactive User-Guidance ... Vers. Oct.2000 p.48 ff
21.7 +*)
21.8 +(* descriptions for items in model-patterns of problems and in method's guards
21.9 + author: Walther Neuper
21.10 + 000301,
21.11 + (c) due to copyright terms
21.12 +
21.13 +remove_thy"Descript";
21.14 +use_thy"IsacKnowledge/Descript";
21.15 +use_thy_only"IsacKnowledge/Descript";
21.16 +
21.17 +remove_thy"Typefix";
21.18 +use_thy"IsacKnowledge/Isac";
21.19 +*)
21.20 +
21.21 +Descript = Script +
21.22 +
21.23 +consts
21.24 +
21.25 + someList :: 'a list => unl (*not for elementwise input, eg. inssort*)
21.26 +
21.27 + additionalRels :: bool list => una
21.28 + boundVariable :: real => una
21.29 +(*derivative :: 'a => toreal 28.11.00*)
21.30 + derivative :: real => una
21.31 + equalities :: bool list => tobooll (*WN071228 see fixedValues*)
21.32 + equality :: bool => una
21.33 + errorBound :: bool => nam
21.34 +
21.35 + fixedValues :: bool list => nam
21.36 + functionEq :: bool => una (*6.5.03: functionTerm -> functionEq*)
21.37 + antiDerivative :: bool => una
21.38 + functionOf :: real => una
21.39 +(*functionTerm :: 'a => toreal 28.11.00*)
21.40 + functionTerm :: real => una (*6.5.03: functionTerm -> functionEq*)
21.41 + interval :: real set => una
21.42 + maxArgument :: bool => toreal
21.43 + maximum :: real => toreal
21.44 +
21.45 + relations :: bool list => una
21.46 + solutions :: bool list => toreall
21.47 +(*solution :: bool => toreal WN0509 bool list=> toreall --->EqSystem*)
21.48 + solveFor :: real => una
21.49 + differentiateFor:: real => una
21.50 + unknown :: 'a => unknow
21.51 + valuesFor :: real list => toreall
21.52 +
21.53 + realTestGiven :: real => una
21.54 + realTestFind :: real => una
21.55 + boolTestGiven :: bool => una
21.56 + boolTestFind :: bool => una
21.57 +
21.58 +end
21.59 \ No newline at end of file
22.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
22.2 +++ b/src/Pure/isac/IsacKnowledge/Diff.ML Wed Jul 21 13:53:39 2010 +0200
22.3 @@ -0,0 +1,370 @@
22.4 +(* tools for differentiation
22.5 + WN.11.99
22.6 +
22.7 +use"IsacKnowledge/Diff.ML";
22.8 +use"Diff.ML";
22.9 + *)
22.10 +
22.11 +
22.12 +(** interface isabelle -- isac **)
22.13 +
22.14 +theory' := overwritel (!theory', [("Diff.thy",Diff.thy)]);
22.15 +
22.16 +
22.17 +(** eval functions **)
22.18 +
22.19 +fun primed (Const (id, T)) = Const (id ^ "'", T)
22.20 + | primed (Free (id, T)) = Free (id ^ "'", T)
22.21 + | primed t = raise error ("primed called with arg = '"^ term2str t ^"'");
22.22 +
22.23 +(*("primed", ("Diff.primed", eval_primed "#primed"))*)
22.24 +fun eval_primed _ _ (p as (Const ("Diff.primed",_) $ t)) _ =
22.25 + Some ((term2str p) ^ " = " ^ term2str (primed t),
22.26 + Trueprop $ (mk_equality (p, primed t)))
22.27 + | eval_primed _ _ _ _ = None;
22.28 +
22.29 +calclist':= overwritel (!calclist',
22.30 + [("primed", ("Diff.primed", eval_primed "#primed"))
22.31 + ]);
22.32 +
22.33 +
22.34 +(** rulesets **)
22.35 +
22.36 +(*.converts a term such that differentiation works optimally.*)
22.37 +val diff_conv =
22.38 + Rls {id="diff_conv",
22.39 + preconds = [],
22.40 + rew_ord = ("termlessI",termlessI),
22.41 + erls = append_rls "erls_diff_conv" e_rls
22.42 + [Calc ("Atools.occurs'_in", eval_occurs_in ""),
22.43 + Thm ("not_true",num_str not_true),
22.44 + Thm ("not_false",num_str not_false),
22.45 + Calc ("op <",eval_equ "#less_"),
22.46 + Thm ("and_true",num_str and_true),
22.47 + Thm ("and_false",num_str and_false)
22.48 + ],
22.49 + srls = Erls, calc = [],
22.50 + rules = [Thm ("frac_conv", num_str frac_conv),
22.51 + Thm ("sqrt_conv_bdv", num_str sqrt_conv_bdv),
22.52 + Thm ("sqrt_conv_bdv_n", num_str sqrt_conv_bdv_n),
22.53 + Thm ("sqrt_conv", num_str sqrt_conv),
22.54 + Thm ("root_conv", num_str root_conv),
22.55 + Thm ("realpow_pow_bdv", num_str realpow_pow_bdv),
22.56 + Calc ("op *", eval_binop "#mult_"),
22.57 + Thm ("rat_mult",num_str rat_mult),
22.58 + (*a / b * (c / d) = a * c / (b * d)*)
22.59 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
22.60 + (*?x * (?y / ?z) = ?x * ?y / ?z*)
22.61 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq)
22.62 + (*?y / ?z * ?x = ?y * ?x / ?z*)
22.63 + (*
22.64 + Thm ("", num_str ),*)
22.65 + ],
22.66 + scr = EmptyScr};
22.67 +
22.68 +(*.beautifies a term after differentiation.*)
22.69 +val diff_sym_conv =
22.70 + Rls {id="diff_sym_conv",
22.71 + preconds = [],
22.72 + rew_ord = ("termlessI",termlessI),
22.73 + erls = append_rls "erls_diff_sym_conv" e_rls
22.74 + [Calc ("op <",eval_equ "#less_")
22.75 + ],
22.76 + srls = Erls, calc = [],
22.77 + rules = [Thm ("frac_sym_conv", num_str frac_sym_conv),
22.78 + Thm ("sqrt_sym_conv", num_str sqrt_sym_conv),
22.79 + Thm ("root_sym_conv", num_str root_sym_conv),
22.80 + Thm ("sym_real_mult_minus1",
22.81 + num_str (real_mult_minus1 RS sym)),
22.82 + (*- ?z = "-1 * ?z"*)
22.83 + Thm ("rat_mult",num_str rat_mult),
22.84 + (*a / b * (c / d) = a * c / (b * d)*)
22.85 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
22.86 + (*?x * (?y / ?z) = ?x * ?y / ?z*)
22.87 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq),
22.88 + (*?y / ?z * ?x = ?y * ?x / ?z*)
22.89 + Calc ("op *", eval_binop "#mult_")
22.90 + ],
22.91 + scr = EmptyScr};
22.92 +
22.93 +(*..*)
22.94 +val srls_diff =
22.95 + Rls {id="srls_differentiate..",
22.96 + preconds = [],
22.97 + rew_ord = ("termlessI",termlessI),
22.98 + erls = e_rls,
22.99 + srls = Erls, calc = [],
22.100 + rules = [Calc("Tools.lhs", eval_lhs "eval_lhs_"),
22.101 + Calc("Tools.rhs", eval_rhs "eval_rhs_"),
22.102 + Calc("Diff.primed", eval_primed "Diff.primed")
22.103 + ],
22.104 + scr = EmptyScr};
22.105 +
22.106 +(*..*)
22.107 +val erls_diff =
22.108 + append_rls "erls_differentiate.." e_rls
22.109 + [Thm ("not_true",num_str not_true),
22.110 + Thm ("not_false",num_str not_false),
22.111 +
22.112 + Calc ("Atools.ident",eval_ident "#ident_"),
22.113 + Calc ("Atools.is'_atom",eval_is_atom "#is_atom_"),
22.114 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
22.115 + Calc ("Atools.is'_const",eval_const "#is_const_")
22.116 + ];
22.117 +
22.118 +(*.rules for differentiation, _no_ simplification.*)
22.119 +val diff_rules =
22.120 + Rls {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI),
22.121 + erls = erls_diff, srls = Erls, calc = [],
22.122 + rules = [Thm ("diff_sum",num_str diff_sum),
22.123 + Thm ("diff_dif",num_str diff_dif),
22.124 + Thm ("diff_prod_const",num_str diff_prod_const),
22.125 + Thm ("diff_prod",num_str diff_prod),
22.126 + Thm ("diff_quot",num_str diff_quot),
22.127 + Thm ("diff_sin",num_str diff_sin),
22.128 + Thm ("diff_sin_chain",num_str diff_sin_chain),
22.129 + Thm ("diff_cos",num_str diff_cos),
22.130 + Thm ("diff_cos_chain",num_str diff_cos_chain),
22.131 + Thm ("diff_pow",num_str diff_pow),
22.132 + Thm ("diff_pow_chain",num_str diff_pow_chain),
22.133 + Thm ("diff_ln",num_str diff_ln),
22.134 + Thm ("diff_ln_chain",num_str diff_ln_chain),
22.135 + Thm ("diff_exp",num_str diff_exp),
22.136 + Thm ("diff_exp_chain",num_str diff_exp_chain),
22.137 +(*
22.138 + Thm ("diff_sqrt",num_str diff_sqrt),
22.139 + Thm ("diff_sqrt_chain",num_str diff_sqrt_chain),
22.140 +*)
22.141 + Thm ("diff_const",num_str diff_const),
22.142 + Thm ("diff_var",num_str diff_var)
22.143 + ],
22.144 + scr = EmptyScr};
22.145 +
22.146 +(*.normalisation for checking user-input.*)
22.147 +val norm_diff =
22.148 + Rls {id="diff_rls", preconds = [], rew_ord = ("termlessI",termlessI),
22.149 + erls = Erls, srls = Erls, calc = [],
22.150 + rules = [Rls_ diff_rules,
22.151 + Rls_ norm_Poly
22.152 + ],
22.153 + scr = EmptyScr};
22.154 +ruleset' :=
22.155 +overwritelthy thy (!ruleset',
22.156 + [("diff_rules", prep_rls norm_diff),
22.157 + ("norm_diff", prep_rls norm_diff),
22.158 + ("diff_conv", prep_rls diff_conv),
22.159 + ("diff_sym_conv", prep_rls diff_sym_conv)
22.160 + ]);
22.161 +
22.162 +
22.163 +(** problem types **)
22.164 +
22.165 +store_pbt
22.166 + (prep_pbt Diff.thy "pbl_fun" [] e_pblID
22.167 + (["function"], [], e_rls, None, []));
22.168 +
22.169 +store_pbt
22.170 + (prep_pbt Diff.thy "pbl_fun_deriv" [] e_pblID
22.171 + (["derivative_of","function"],
22.172 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
22.173 + ("#Find" ,["derivative f_'_"])
22.174 + ],
22.175 + append_rls "e_rls" e_rls [],
22.176 + Some "Diff (f_, v_)", [["diff","differentiate_on_R"],
22.177 + ["diff","after_simplification"]]));
22.178 +
22.179 +(*here "named" is used differently from Integration"*)
22.180 +store_pbt
22.181 + (prep_pbt Diff.thy "pbl_fun_deriv_nam" [] e_pblID
22.182 + (["named","derivative_of","function"],
22.183 + [("#Given" ,["functionEq f_","differentiateFor v_"]),
22.184 + ("#Find" ,["derivativeEq f_'_"])
22.185 + ],
22.186 + append_rls "e_rls" e_rls [],
22.187 + Some "Differentiate (f_, v_)", [["diff","differentiate_equality"]]));
22.188 +
22.189 +
22.190 +(** methods **)
22.191 +
22.192 +store_met
22.193 + (prep_met Diff.thy "met_diff" [] e_metID
22.194 + (["diff"], [],
22.195 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
22.196 + crls = Atools_erls, nrls = norm_diff}, "empty_script"));
22.197 +
22.198 +store_met
22.199 + (prep_met Diff.thy "met_diff_onR" [] e_metID
22.200 + (["diff","differentiate_on_R"],
22.201 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
22.202 + ("#Find" ,["derivative f_'_"])
22.203 + ],
22.204 + {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
22.205 + prls=e_rls, crls = Atools_erls, nrls = norm_diff},
22.206 +"Script DiffScr (f_::real) (v_::real) = \
22.207 +\ (let f'_ = Take (d_d v_ f_) \
22.208 +\ in (((Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ \
22.209 +\ (Repeat \
22.210 +\ ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or \
22.211 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or \
22.212 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or \
22.213 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or \
22.214 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or \
22.215 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or \
22.216 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or \
22.217 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or \
22.218 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or \
22.219 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or \
22.220 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or \
22.221 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or \
22.222 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or \
22.223 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or \
22.224 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or \
22.225 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or \
22.226 +\ (Repeat (Rewrite_Set make_polynomial False)))) @@ \
22.227 +\ (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)))) f'_)"
22.228 +));
22.229 +
22.230 +store_met
22.231 + (prep_met Diff.thy "met_diff_simpl" [] e_metID
22.232 + (["diff","diff_simpl"],
22.233 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
22.234 + ("#Find" ,["derivative f_'_"])
22.235 + ],
22.236 + {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
22.237 + prls=e_rls, crls = Atools_erls, nrls = norm_diff},
22.238 +"Script DiffScr (f_::real) (v_::real) = \
22.239 +\ (let f'_ = Take (d_d v_ f_) \
22.240 +\ in (( \
22.241 +\ (Repeat \
22.242 +\ ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or \
22.243 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or \
22.244 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or \
22.245 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or \
22.246 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or \
22.247 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or \
22.248 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or \
22.249 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or \
22.250 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or \
22.251 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or \
22.252 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or \
22.253 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or \
22.254 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or \
22.255 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or \
22.256 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or \
22.257 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or \
22.258 +\ (Repeat (Rewrite_Set make_polynomial False)))) \
22.259 +\ )) f'_)"
22.260 + ));
22.261 +
22.262 +(*-----------------------------------------------------------------
22.263 + "Script DiffScr (f_::real) (v_::real) = \
22.264 + \(Repeat \
22.265 + \ ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or \
22.266 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or \
22.267 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or \
22.268 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or \
22.269 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or \
22.270 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or \
22.271 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or \
22.272 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or \
22.273 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or \
22.274 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or \
22.275 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or \
22.276 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or \
22.277 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or \
22.278 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or \
22.279 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or \
22.280 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or \
22.281 + \ (Repeat (Rewrite_Set make_polynomial False)))) \
22.282 + \ (f_::real)"
22.283 +*)
22.284 +
22.285 +store_met
22.286 + (prep_met Diff.thy "met_diff_equ" [] e_metID
22.287 + (["diff","differentiate_equality"],
22.288 + [("#Given" ,["functionEq f_","differentiateFor v_"]),
22.289 + ("#Find" ,["derivativeEq f_'_"])
22.290 + ],
22.291 + {rew_ord'="tless_true", rls' = erls_diff, calc = [],
22.292 + srls = srls_diff, prls=e_rls, crls=Atools_erls, nrls = norm_diff},
22.293 +"Script DiffEqScr (f_::bool) (v_::real) = \
22.294 +\ (let f'_ = Take ((primed (lhs f_)) = d_d v_ (rhs f_)) \
22.295 +\ in (((Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ \
22.296 +\ (Repeat \
22.297 +\ ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or \
22.298 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_dif False)) Or \
22.299 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or \
22.300 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or \
22.301 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or \
22.302 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or \
22.303 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or \
22.304 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or \
22.305 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or \
22.306 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or \
22.307 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or \
22.308 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or \
22.309 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or \
22.310 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or \
22.311 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or \
22.312 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or \
22.313 +\ (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or \
22.314 +\ (Repeat (Rewrite_Set make_polynomial False)))) @@ \
22.315 +\ (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)))) f'_)"
22.316 +));
22.317 +
22.318 +
22.319 +store_met
22.320 + (prep_met Diff.thy "met_diff_after_simp" [] e_metID
22.321 + (["diff","after_simplification"],
22.322 + [("#Given" ,["functionTerm f_","differentiateFor v_"]),
22.323 + ("#Find" ,["derivative f_'_"])
22.324 + ],
22.325 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, prls=e_rls,
22.326 + crls=Atools_erls, nrls = norm_Rational},
22.327 +"Script DiffScr (f_::real) (v_::real) = \
22.328 +\ (let f'_ = Take (d_d v_ f_) \
22.329 +\ in ((Try (Rewrite_Set norm_Rational False)) @@ \
22.330 +\ (Try (Rewrite_Set_Inst [(bdv,v_)] diff_conv False)) @@ \
22.331 +\ (Try (Rewrite_Set_Inst [(bdv,v_)] norm_diff False)) @@ \
22.332 +\ (Try (Rewrite_Set_Inst [(bdv,v_)] diff_sym_conv False)) @@ \
22.333 +\ (Try (Rewrite_Set norm_Rational False))) f'_)"
22.334 +));
22.335 +
22.336 +
22.337 +(** CAS-commands **)
22.338 +
22.339 +(*.handle cas-input like "Diff (a * x^3 + b, x)".*)
22.340 +(* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
22.341 + val [Const ("Pair", _) $ t $ bdv] = pairl;
22.342 + *)
22.343 +fun argl2dtss [Const ("Pair", _) $ t $ bdv] =
22.344 + [((term_of o the o (parse thy)) "functionTerm", [t]),
22.345 + ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
22.346 + ((term_of o the o (parse thy)) "derivative",
22.347 + [(term_of o the o (parse thy)) "f_'_"])
22.348 + ]
22.349 + | argl2dtss _ = raise error "Diff.ML: wrong argument for argl2dtss";
22.350 +castab :=
22.351 +overwritel (!castab,
22.352 + [((term_of o the o (parse thy)) "Diff",
22.353 + (("Isac.thy", ["derivative_of","function"], ["no_met"]),
22.354 + argl2dtss))
22.355 + ]);
22.356 +
22.357 +(*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
22.358 +(* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
22.359 + val [Const ("Pair", _) $ t $ bdv] = pairl;
22.360 + *)
22.361 +fun argl2dtss [Const ("Pair", _) $ t $ bdv] =
22.362 + [((term_of o the o (parse thy)) "functionEq", [t]),
22.363 + ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
22.364 + ((term_of o the o (parse thy)) "derivativeEq",
22.365 + [(term_of o the o (parse thy)) "f_'_::bool"])
22.366 + ]
22.367 + | argl2dtss _ = raise error "Diff.ML: wrong argument for argl2dtss";
22.368 +castab :=
22.369 +overwritel (!castab,
22.370 + [((term_of o the o (parse thy)) "Differentiate",
22.371 + (("Isac.thy", ["named","derivative_of","function"], ["no_met"]),
22.372 + argl2dtss))
22.373 + ]);
23.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
23.2 +++ b/src/Pure/isac/IsacKnowledge/Diff.thy Wed Jul 21 13:53:39 2010 +0200
23.3 @@ -0,0 +1,97 @@
23.4 +(* differentiation over the reals
23.5 + author: Walther Neuper
23.6 + 000516
23.7 +
23.8 +remove_thy"Diff";
23.9 +use_thy_only"IsacKnowledge/Diff";
23.10 +use_thy"IsacKnowledge/Isac";
23.11 + *)
23.12 +
23.13 +Diff = Calculus + Trig + LogExp + Rational + Root + Poly + Atools +
23.14 +
23.15 +consts
23.16 +
23.17 + d_d :: "[real, real]=> real"
23.18 + sin, cos :: "real => real"
23.19 +(*
23.20 + log, ln :: "real => real"
23.21 + nlog :: "[real, real] => real"
23.22 + exp :: "real => real" ("E'_ ^^^ _" 80)
23.23 +*)
23.24 + (*descriptions in the related problems*)
23.25 + derivativeEq :: bool => una
23.26 +
23.27 + (*predicates*)
23.28 + primed :: "'a => 'a" (*"primed A" -> "A'"*)
23.29 +
23.30 + (*the CAS-commands, eg. "Diff (2*x^^^3, x)",
23.31 + "Differentiate (A = s * (a - s), s)"*)
23.32 + Diff :: "[real * real] => real"
23.33 + Differentiate :: "[bool * real] => bool"
23.34 +
23.35 + (*subproblem and script-name*)
23.36 + differentiate :: "[ID * (ID list) * ID, real,real] => real"
23.37 + ("(differentiate (_)/ (_ _ ))" 9)
23.38 + DiffScr :: "[real,real, real] => real"
23.39 + ("((Script DiffScr (_ _ =))// (_))" 9)
23.40 + DiffEqScr :: "[bool,real, bool] => bool"
23.41 + ("((Script DiffEqScr (_ _ =))// (_))" 9)
23.42 +
23.43 +
23.44 +rules (*stated as axioms, todo: prove as theorems
23.45 + 'bdv' is a constant on the meta-level *)
23.46 + diff_const "[| Not (bdv occurs_in a) |] ==> d_d bdv a = 0"
23.47 + diff_var "d_d bdv bdv = 1"
23.48 + diff_prod_const"[| Not (bdv occurs_in u) |] ==> \
23.49 + \d_d bdv (u * v) = u * d_d bdv v"
23.50 +
23.51 + diff_sum "d_d bdv (u + v) = d_d bdv u + d_d bdv v"
23.52 + diff_dif "d_d bdv (u - v) = d_d bdv u - d_d bdv v"
23.53 + diff_prod "d_d bdv (u * v) = d_d bdv u * v + u * d_d bdv v"
23.54 + diff_quot "Not (v = 0) ==> (d_d bdv (u / v) = \
23.55 + \(d_d bdv u * v - u * d_d bdv v) / v ^^^ 2)"
23.56 +
23.57 + diff_sin "d_d bdv (sin bdv) = cos bdv"
23.58 + diff_sin_chain "d_d bdv (sin u) = cos u * d_d bdv u"
23.59 + diff_cos "d_d bdv (cos bdv) = - sin bdv"
23.60 + diff_cos_chain "d_d bdv (cos u) = - sin u * d_d bdv u"
23.61 + diff_pow "d_d bdv (bdv ^^^ n) = n * (bdv ^^^ (n - 1))"
23.62 + diff_pow_chain "d_d bdv (u ^^^ n) = n * (u ^^^ (n - 1)) * d_d bdv u"
23.63 + diff_ln "d_d bdv (ln bdv) = 1 / bdv"
23.64 + diff_ln_chain "d_d bdv (ln u) = d_d bdv u / u"
23.65 + diff_exp "d_d bdv (exp bdv) = exp bdv"
23.66 + diff_exp_chain "d_d bdv (exp u) = exp u * d_d x u"
23.67 +(*
23.68 + diff_sqrt "d_d bdv (sqrt bdv) = 1 / (2 * sqrt bdv)"
23.69 + diff_sqrt_chain"d_d bdv (sqrt u) = d_d bdv u / (2 * sqrt u)"
23.70 +*)
23.71 + (*...*)
23.72 +
23.73 + frac_conv "[| bdv occurs_in b; 0 < n |] ==> \
23.74 + \ a / (b ^^^ n) = a * b ^^^ (-n)"
23.75 + frac_sym_conv "n < 0 ==> a * b ^^^ n = a / b ^^^ (-n)"
23.76 +
23.77 + sqrt_conv_bdv "sqrt bdv = bdv ^^^ (1 / 2)"
23.78 + sqrt_conv_bdv_n "sqrt (bdv ^^^ n) = bdv ^^^ (n / 2)"
23.79 + sqrt_conv "bdv occurs_in u ==> sqrt u = u ^^^ (1 / 2)"
23.80 + sqrt_sym_conv "u ^^^ (a / 2) = sqrt (u ^^^ a)"
23.81 +
23.82 + root_conv "bdv occurs_in u ==> nroot n u = u ^^^ (1 / n)"
23.83 + root_sym_conv "u ^^^ (a / b) = nroot b (u ^^^ a)"
23.84 +
23.85 + realpow_pow_bdv "(bdv ^^^ b) ^^^ c = bdv ^^^ (b * c)"
23.86 +
23.87 +end
23.88 +
23.89 +(* a variant of the derivatives defintion:
23.90 +
23.91 + d_d :: "(real => real) => (real => real)"
23.92 +
23.93 + advantages:
23.94 +(1) no variable 'bdv' on the meta-level required
23.95 +(2) chain_rule "d_d (%x. (u (v x))) = (%x. (d_d u)) (v x) * d_d v"
23.96 +(3) and no specialized chain-rules required like
23.97 + diff_sin_chain "d_d bdv (sin u) = cos u * d_d bdv u"
23.98 +
23.99 + disadvantage: d_d (%x. 1 + x^2) = ... differs from high-school notation
23.100 +*)
24.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
24.2 +++ b/src/Pure/isac/IsacKnowledge/DiffApp-oldpbl.sml Wed Jul 21 13:53:39 2010 +0200
24.3 @@ -0,0 +1,369 @@
24.4 +(*8.01: aufgehoben wegen alter preconds, postconds*)
24.5 +
24.6 +(* rectangle with maximal area, inscribed in a circle of fixed radius
24.7 +
24.8 +problem-types and methods solving the respective problem-type
24.9 +
24.10 +(1) names of the problem-types and methods and their hierarchy
24.11 + as subproblems.
24.12 + names of problem-types are string lists (diss 5.3.), not shown
24.13 + here with exception of ["equation","univariate"] in order to
24.14 + indicate, that this particular problem needs refinement to a
24.15 + more specific type of equation solvable by tan-square, etc.
24.16 +
24.17 +problem-types methods
24.18 +------------------------------- ----------------------
24.19 +maximum maximum-by-differentiation
24.20 + maximum-by-experimentation
24.21 + make-fun make-explicit-and-substitute
24.22 + introduce-a-new-variable
24.23 + max-of-fun-on-interval max-of-fun-on-interval
24.24 + derivative differentiate
24.25 + ["equation","univariate"] tan-square
24.26 +
24.27 + find-values find-values
24.28 +
24.29 +(2) specification of the problem-types
24.30 +*)
24.31 +
24.32 +(* maximum *)
24.33 +(* ------- *)
24.34 +(* problem-type *)
24.35 +{given = ["fixed_values (cs::bool list)"],
24.36 + where_= ["foldl (op &) True (map is_equality cs)",
24.37 + "foldl (op &) True (map (Not o ((op <=) #0) o Rhs) cs)"],
24.38 + find=["maximum m","values_for (ms::real list)"],
24.39 + with_=["Ex_frees ((foldl (op &) True (r#RS)) & \
24.40 + \ (ALL m'. (subst (m,m') (foldl (op &) True (r#RS)) \
24.41 + \ --> m' <= m)))"],
24.42 + relate=["max_relation r","additional_relations RS"]};
24.43 +(* ^^^ is exponenation *)
24.44 +
24.45 +(* the functions Ex_frees, Rhs provide for the instantiation below *)
24.46 +
24.47 +(* (1) instantiation of maximum, + variant in "values_for" *)
24.48 +{given = ["fixed_values (R = #7)"],
24.49 + where_= ["is_equality (R = #7)",
24.50 + "Not (R <= #0)"],
24.51 + find =["maximum A","values_for [a,b]"],
24.52 + with_ =["EX A. A = a*b & (a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2 \
24.53 + \ (ALL A'. A' = a*b & (a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2 \
24.54 + \ --> A' <= A)))"],
24.55 + relate=["max_relation (A = a*b)",
24.56 + "additional_relations [(a//#2)^^^#2 +(b//#2)^^^#2 =R^^^#2]"]};
24.57 +(* R,a,b are bound by given, find *)
24.58 +
24.59 +(* (2) instantiation of maximum *)
24.60 +{given = ["fixed_values (R = #7)"],
24.61 + where_= ["is_equality (R = #7)",
24.62 + "Not (R <= #0)"],
24.63 + find =["maximum A","values_for [A]"],
24.64 + with_ =["EX a b alpha. A = a*b & \
24.65 + \ a = #2*R*sin alpha & b =#2*R*cos alpha &\
24.66 + \ (ALL A'. A' = a*b & a = #2*R*sin alpha & b =#2*R*cos alpha \
24.67 + \ --> A' <= A)))"],
24.68 + relate=["max_relation (A = a*b)",
24.69 + "additional_relations [a=#2*R*sin alpha, b=#2*R*cos alpha]"]};
24.70 +(* R,A are bound by given, find *)
24.71 +
24.72 +
24.73 +(* make-fun *)
24.74 +(* -------- *)
24.75 +(* problem-type *)
24.76 +{given = ["equality (lhs = rhs)","bound_variable v","equalities es"],
24.77 + where_= [],
24.78 + find = ["function_term lhs_"],
24.79 + with_ = [(*???*)],
24.80 + relate= [(*???*)]};
24.81 +(*the _ in lhs is used to transfer the lhs-identifier of equality*)
24.82 +
24.83 +(* (1) instantiation for make-explicit-and-substitute *)
24.84 +{given = ["equality A = a * b","bound_variable a",
24.85 + "equalities [(a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2]"],
24.86 + where_= [],
24.87 + find = ["function_term A_"(*=(a * #2 * sqrt(R^^^#2 - (a//#2)^^^#2))*)],
24.88 + with_ = [],
24.89 + relate= []};
24.90 +
24.91 +(* (2) instantiation for introduce-a-new-variable *)
24.92 +{given = ["equality A = a * b","bound_variable alpha",
24.93 + "equalities [a=#2*R*sin alpha, b=#2*R*cos alpha]"],
24.94 + where_= [],
24.95 + find = ["function_term A_"(*=(#2*R*sin alpha *#2*R*cos alpha)*)],
24.96 + with_ = [],
24.97 + relate= []};
24.98 +
24.99 +
24.100 +(* max-of-fun-on-interval *)
24.101 +(* ---------------------- *)
24.102 +(* problem-type *)
24.103 +{given = ["function_term t","bound_variable v",
24.104 + "domain {x::real. lower_bound <= x & x <= upper_bound}"],
24.105 + where_= [],
24.106 + find = ["maximums ms"],
24.107 + with_ = ["ALL m. m : ms --> \
24.108 + \ (ALL x::real. lower_bound <= x & x <= upper_bound \
24.109 + \ --> (%v. t) x <= m)"],
24.110 + relate= []}: string ppc;
24.111 +(* ':' is 'element', '::' is a type constraint *)
24.112 +
24.113 +(* (1) variant of instantiation *)
24.114 +{given = ["function_term (a * #2 * sqrt(R^^^#2 - (a//#2)^^^#2))",
24.115 + "bound_variable a",
24.116 + "domain {x::real. #0 <= x & x <= #2*R}"],
24.117 + where_= [],
24.118 + find = ["maximums AM"],
24.119 + with_ = ["ALL am. am : AM --> \
24.120 + \ (ALL x::real. #0 <= x & x <= #2*R \
24.121 + \ --> (%a. (a * #2 * sqrt(R^^^#2 - (a//#2)^^^#2))) x <= am)"],
24.122 + relate= []};
24.123 +
24.124 +(* (2) variant of instantiation *)
24.125 +{given = ["function_term (#2*R*sin alpha * #2*R*cos alpha)",
24.126 + "bound_variable alpha",
24.127 + "domain {x::real. #0 <= x & x <= pi//#2}"],
24.128 + where_= [],
24.129 + find = ["maximums AM"],
24.130 + with_ = ["ALL am. am : AM --> \
24.131 + \ (ALL x::real. #0 <= x & x <= pi//#2 \
24.132 + \ --> (%alpha. (#2*R*sin alpha * #2*R*cos alpha)) x <= am)"],
24.133 + relate= []};
24.134 +
24.135 +
24.136 +(* derivative *)
24.137 +(* ---------- *)
24.138 +(* problem-type *)
24.139 +{given = ["function_term t","bound_variable bdv"],
24.140 + where_= [],
24.141 + find = ["derivative t'"],
24.142 + with_ = ["t' is_derivative_of (%bdv. t)"],
24.143 + relate= []};
24.144 +(*the ' in t' is used to transfer the identifier from function_term*)
24.145 +
24.146 +
24.147 +(* ["equation","univariate"] *)
24.148 +(* ------------------------- *)
24.149 +(* problem-type *)
24.150 +{given = ["equality (lhs = rhs)",
24.151 + "bound_variable v","error_bound eps"],
24.152 + where_= [],
24.153 + find = ["solutions S"],
24.154 + with_ = ["ALL s. s : S --> || (%v. lhs) s - (%v. rhs) s || <= eps"],
24.155 + relate= []};
24.156 +
24.157 +
24.158 +(* find-values *)
24.159 +(* ----------- *)
24.160 +(* problem-type *)
24.161 +{given = ["max_relation r","additional_relations RS"],
24.162 + where_= [],
24.163 + find = ["values_for VS"],
24.164 + with_ = [(*???*)],
24.165 + relate= []};
24.166 +
24.167 +(* (1) variant of instantiation *)
24.168 +{given = ["max_relation (A = a*b)",
24.169 + "additional_relations [(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]"],
24.170 + where_= [],
24.171 + find = ["values_for [a,b]"],
24.172 + with_ = [],
24.173 + relate= []};
24.174 +
24.175 +(* (2) variant of instantiation *)
24.176 +{given = ["max_relation (A = a*b)",],
24.177 + where_= [],
24.178 + find = ["values_for [A]",
24.179 + "additional_relations [a=#2*R*sin alpha, b=#2*R*cos alpha]"],
24.180 + with_ = [],
24.181 + relate= []};
24.182 +
24.183 +(*
24.184 +(3) data-transfer between the the hidden formalization,
24.185 + the root-problem and the sub-problems;
24.186 +
24.187 +maximum -> #given.make-fun
24.188 +-------------------
24.189 +maximum.#relate "max_relation r" -> "equality (lhs = rhs)"
24.190 +formalization "bound_variable v" -> "bound_variable v"
24.191 +maximum.#relate "additional_relations RS"-> "equalities es"
24.192 +
24.193 +
24.194 +maximum + make-fun -> #given.max-of-fun-on-interval
24.195 +--------------------------------------------
24.196 +make-fun.#find "function_term lhs_" -> "function_term t"
24.197 +make-fun.#given "bound_variable v" -> "bound_variable v"
24.198 +formalization -> "domain {x::real. ...}"
24.199 +
24.200 +
24.201 +max-of-fun-on-interval -> #given.derivative
24.202 +------------------------------------
24.203 +make-fun.#find "function_term lhs_" -> "function_term t"
24.204 +make-fun.#given "bound_variable v" -> "bound_variable bdv"
24.205 +
24.206 +
24.207 +max-of-fun-on-interval + derivative ->
24.208 + #given.["equation","univariate"]
24.209 +----------------------------------------------------------------
24.210 +derivative.#find "derivative t'" -> "equality (lhs = rhs)"
24.211 + (* t'= #0 *)
24.212 +make-fun.#given "bound_variable v" -> "bound_variable v"
24.213 +formalization -> "error_bound eps"
24.214 +
24.215 +
24.216 +maximum + make-fun + max-of-fun-on-interval -> #given.find-values
24.217 +----------------------------------------------------------
24.218 +maximum.#relate "max_relation r" -> "max_relation r"
24.219 +maximum.#relate "additional_relations RS"-> "additional_relations RS"
24.220 +*)
24.221 +
24.222 +
24.223 +
24.224 +
24.225 +(* vvv--- geht nicht wegen fun-types
24.226 +parse thy "case maxmin of is_max => (m' <= m) | is_min => (m <= m')";
24.227 +parse thy "if maxmin = is_max then (m' <= m) else (m <= m')";
24.228 +parse thy "if a=b then a else b";
24.229 +parse thy "maxmin = is_max";
24.230 +parse thy "maxmin =!= is_max";
24.231 + ^^^--- geht nicht wegen fun-types *)
24.232 +
24.233 +"pbltyp --- maximum ---";
24.234 +val pbltyp = {given=["fixed_values (cs::bool list)"],
24.235 + where_=["foldl (op &) True (map is_equality cs)",
24.236 + "foldl (op &) True (map (Not o ((op <=) #0) o Rhs) cs)"],
24.237 + find=["maximum m","values_for (ms::real list)"],
24.238 + with_=["Ex_frees ((foldl (op &) True (r#rs)) & \
24.239 + \ (ALL m'. (subst (m,m') (foldl (op &) True (r#rs)) \
24.240 + \ --> m' <= m)))"],
24.241 + relate=["max_relation r","additional_relations rs"]}:string ppc;
24.242 +val chkpbltyp = ((map (the o (parse thy))) o ppc2list) pbltyp;
24.243 +"coil";
24.244 +val org = ["fixed_values [R=(R::real)]",
24.245 + "bound_variable a", "bound_variable b", "bound_variable alpha",
24.246 + "domain {x::real. #0 <= x & x <= #2*R}",
24.247 + "domain {x::real. #0 <= x & x <= #2*R}",
24.248 + "domain {x::real. #0 <= x & x <= pi}",
24.249 + "maximum A",
24.250 + "max_relation A=#2*a*b - a^^^#2",
24.251 + "additional_relations [(a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2]",
24.252 + "additional_relations [(a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2]",
24.253 + "additional_relations [a=#2*R*sin alpha, b=#2*R*cos alpha]"];
24.254 +val chkorg = map (the o (parse thy)) org;
24.255 +val pbl = {given=["fixed_values [R=(R::real)]"],where_=[],
24.256 + find=["maximum A","values_for [a,b]"],
24.257 + with_=["EX alpha. A=#2*a*b - a^^^#2 & \
24.258 + \ a=#2*R*sin alpha & b=#2*R*cos alpha & \
24.259 + \ (ALL A'. A'=#2*a*b - a^^^#2 & a=#2*R*sin alpha & b=#2*R*cos alpha \
24.260 + \ --> A' <= A)"],
24.261 + relate=["max_relation (A=#2*a*b - a^^^#2)",
24.262 + "additional_relations [a=#2*R*sin alpha, b=#2*R*cos alpha]"]
24.263 + }: string ppc;
24.264 +val chkpbl = ((map (the o (parse thy))) o ppc2list) pbl;
24.265 +
24.266 +"met --- maximum_by_differentiation ---";
24.267 +val met = {given=["fixed_values (cs::bool list)","bound_variable v",
24.268 + "domain {x::real. lower_bound <= x & x <= upper_bound}",
24.269 + "approximation apx"],
24.270 + where_=[],
24.271 + find=["maximum m","values_for (ms::real list)",
24.272 + "function_term t","max_argument mx"],
24.273 + with_=["Ex_frees ((foldl (op &) True (rs::bool list)) & \
24.274 + \ (ALL m'. (subst (m,m') (foldl (op &) True rs) \
24.275 + \ --> m' <= m))) & \
24.276 + \m = (%v. t) mx & \
24.277 + \( ALL x. lower_bound <= x & x <= upper_bound \
24.278 + \ --> (%v. t) x <= m)"],
24.279 + relate=["rs::bool list"]}: string ppc;
24.280 +val chkpbl = ((map (the o (parse thy))) o ppc2list) met;
24.281 +
24.282 +
24.283 +"pbltyp --- make_fun ---";
24.284 +(* subproblem [(hd #relate root, equality),
24.285 + (bound_variable formalization, bound_variable),
24.286 + (tl #relate root, equalities)] *)
24.287 +val pbltyp = {given=["equality e","bound_variable v", "equalities es"],
24.288 + where_=[],
24.289 + find=["function_term t"],with_=[(*???*)],
24.290 + relate=[(*???*)]}: string ppc;
24.291 +val chkpbltyp = ((map (the o (parse thy))) o ppc2list) pbltyp;
24.292 +"coil";
24.293 +val pbl = {given=["equality (A=#2*a*b - a^^^#2)","bound_variable alpha",
24.294 + "equalities [a=#2*R*sin alpha, b=#2*R*cos alpha]"],
24.295 + where_=[],
24.296 + find=["function_term t"],
24.297 + with_=[],relate=[]}: string ppc;
24.298 +val chkpbl = ((map (the o (parse thy))) o ppc2list) pbl;
24.299 +
24.300 +"met --- make_explicit_and_substitute ---";
24.301 +val met = {given=["equality e","bound_variable v", "equalities es"],
24.302 + where_=[],
24.303 + find=["function_term t"],with_=[(*???*)],
24.304 + relate=[(*???*)]}: string ppc;
24.305 +val chkmet = ((map (the o (parse thy))) o ppc2list) met;
24.306 +"met --- introduce_a_new_variable ---";
24.307 +val met = {given=["equality e","bound_variable v", "substitutions es"],
24.308 + where_=[],
24.309 + find=["function_term t"],with_=[(*???*)],
24.310 + relate=[(*???*)]}: string ppc;
24.311 +val chkmet = ((map (the o (parse thy))) o ppc2list) met;
24.312 +
24.313 +
24.314 +"pbltyp --- max_of_fun_on_interval ---";
24.315 +val pbltyp = {given=["function_term t","bound_variable v",
24.316 + "domain {x::real. lower_bound <= x & x <= upper_bound}"],
24.317 + where_=[],
24.318 + find=["maximums ms"],
24.319 + with_=["ALL m. m : ms --> \
24.320 + \ (ALL x::real. lower_bound <= x & x <= upper_bound \
24.321 + \ --> (%v. t) x <= m)"],
24.322 + relate=[]}: string ppc;
24.323 +val chkpbltyp = ((map (the o (parse thy))) o ppc2list) pbltyp;
24.324 +"coil";
24.325 +val pbl = {given=["function_term #2*(#2*R*sin alpha)*(#2*R*cos alpha) - \
24.326 + \ (#2*R*sin alpha)^^^#2","bound_variable alpha",
24.327 + "domain {x::real. #0 <= x & x <= pi}"],where_=[],
24.328 + find=["maximums [#1234]"],with_=[],relate=[]}: string ppc;
24.329 +val chkpbl = ((map (the o (parse thy))) o ppc2list) pbl;
24.330 +
24.331 +
24.332 +(* pbltyp --- max_of_fun --- *)
24.333 +(*
24.334 +{given=[],where_=[],find=[],with_=[],relate=[]}: string ppc;
24.335 +val (Some ct) = parse thy ;
24.336 +atomty thy (term_of ct);
24.337 +*)
24.338 +
24.339 +
24.340 +
24.341 +
24.342 +
24.343 +
24.344 +
24.345 +
24.346 +(* --- 14.1.00 --- *)
24.347 +"p.114";
24.348 +val org = {given=["[u=(#12::real)]"],where_=[],
24.349 + find=["[a,(b::real)]"],with_=[],
24.350 + relate=["[is_max A=a*(b::real), #2*a+#2*b=(u::real)]"]}: string ppc;
24.351 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
24.352 +"p.116";
24.353 +val org = {given=["[c=#10, h=(#4::real)]"],where_=[],
24.354 + find=["[x,(y::real)]"],with_=[],
24.355 + relate=["[A=x*(y::real), c//h=x//(h-(y::real))]"]}: string ppc;
24.356 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
24.357 +"p.117";
24.358 +val org = {given=["[r=#5]"],where_=[],
24.359 + find=["[x,(y::real)]"],with_=[],
24.360 + relate=["[is_max #0=pi*x^^^#2 + pi*x*(r::real)]"]}: string ppc;
24.361 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
24.362 +"#241";
24.363 +val org = {given=["[s=(#10::real)]"],where_=[],
24.364 + find=["[p::real]"],with_=[],
24.365 + relate=["[is_max p=n*m, s=n+(m::real)]"]}: string ppc;
24.366 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
24.367 +
24.368 +(*
24.369 +{given=[],where_=[],find=[],with_=[],relate=[]}: string ppc;
24.370 +val (Some ct) = parse thy ;
24.371 +atomty thy (term_of ct);
24.372 +*)
25.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
25.2 +++ b/src/Pure/isac/IsacKnowledge/DiffApp-oldscr.sml Wed Jul 21 13:53:39 2010 +0200
25.3 @@ -0,0 +1,96 @@
25.4 +(*8.01: alte Scripts f"ur Extremwertaufgabe gesammelt*)
25.5 +
25.6 +(* Das erste Script aus dem Maximum-Beispiel.
25.7 + parse erzeugt aus dem string 's' den
25.8 + 'cterm 's' im Isabelle-Format (pretty-printing !)*)
25.9 +
25.10 +ML> ...
25.11 +ML> val c = (the o (parse thy)) s;
25.12 +val c =
25.13 + "Script1 Maximum_value fix_ m_ rs_ v_ itv_ err_ =
25.14 + let e_ = (hd o filter (Testvar m_)) rs_;
25.15 + t_ =
25.16 + if #1 < Length rs_
25.17 + then make_fun (R, [make, function], no_met) m_ v_ rs_
25.18 + else (Lhs o hd) rs_;
25.19 + mx_ =
25.20 + max_on_interval (R, [on_interval, max_of, function],
25.21 + maximum_on_interval) t_ v_ itv_
25.22 + in find_vals (R, [find_values, tool], find_values)
25.23 + mx_ t_ v_ m_ dropWhile (op = e_) rs_" : cterm
25.24 +
25.25 +ML> set show_types;
25.26 +ML> c;
25.27 +val c =
25.28 + "Script1 Maximum_value fix_::bool list m_::real rs_::bool list v_::real itv_::real set err_::bool =
25.29 + let e_::bool = (hd o filter (Testvar m_)) rs_;
25.30 + t_::real =
25.31 + if (#1::real) < Length rs_
25.32 + then make_fun (R::ID, [make::ID, function::ID], no_met::ID) m_ v_ rs_
25.33 + else (Lhs o hd) rs_;
25.34 + mx_::real =
25.35 + max_on_interval (R, [on_interval::ID, max_of::ID, function],
25.36 + maximum_on_interval::ID) t_ v_ itv_
25.37 + in find_vals (R, [find_values::ID, tool::ID], find_values)
25.38 + mx_ t_ v_ m_ dropWhile (op = e_) rs_" : cterm
25.39 +
25.40 +
25.41 +
25.42 +(* Die ersten 3 Scripts aus dem Maximum-Beispiel.
25.43 + parse erzeugt aus dem string 's' den
25.44 + 'cterm 's' im Isabelle-Format (pretty-printing !)*)
25.45 +
25.46 +ML> ...
25.47 +ML> val c = (the o (parse thy)) s;
25.48 +val c =
25.49 + "Script maximum =
25.50 + Input [Bool fix_, Real m_, BoolList rs_, Real v_, RealSet itv_, Bool err_]
25.51 + Local [Bool e_, Real t_, Real mx_, RealList vs_]
25.52 + Tacs [SEQU
25.53 + [let e_ = (hd o filter (Testvar m_)) rs_
25.54 + in if #1 < Length rs_
25.55 + then Subproblem Spec (R, [make, function], no_met)
25.56 + InOut [In m_, In v_, In rs_, Out t_]
25.57 + else t_ := (Lhs o hd) rs_ ;
25.58 + Subproblem Spec (R, [on_interval, max_of, function],
25.59 + maximum_on_interval)
25.60 + InOut [In t_, In v_, In itv_, In err_, Out mx_] ;
25.61 + Subproblem Spec (R, [find_values, tool], find_values)
25.62 + InOut [In mx_, In t_, In v_, In m_, In (dropWhile (op = e_) rs_),
25.63 + Out vs_]]]
25.64 + Return []" : cterm
25.65 +
25.66 +ML> ...
25.67 +ML> val c = (the o (parse thy)) s;
25.68 +val c =
25.69 + "Script make_fun_by_new_variable =
25.70 + Input [Real f_, Real v_, BoolList eqs_]
25.71 + Local [Bool h_, BoolList es_, RealList vs_, Real v1_, Real v2_, Bool e1,
25.72 + Bool e2_, BoolList s_1, BoolList s_2]
25.73 + Tacs [SEQU
25.74 + [let h_ = (hd o filter (Testvar m_)) eqs_; es_ = eqs_ -- [h_];
25.75 + vs_ = Var h_ -- [f_]; v1_ = Nth #1 vs_; v2_ = Nth #2 vs_;
25.76 + e1_ = (hd o filter (Testvar v1_)) es_;
25.77 + e2_ = (hd o filter (Testvar v2_)) es_
25.78 + in Subproblem Spec (R, [univar, equation], no_met)
25.79 + InOut [In e1_, In v1_, Out s_1] ;
25.80 + Subproblem Spec (R, [univar, equation], no_met)
25.81 + InOut [In e2_, In v2_, Out s_2]],
25.82 + Take (Bool h_) ;
25.83 + Substitute [(v_1, (Rhs o hd) s_1), (v_2, (Rhs o hd) s_2)]]
25.84 + Return [Currform]" : cterm
25.85 +
25.86 +ML> ...
25.87 +ML> val c = (the o (parse thy)) s;
25.88 +val c =
25.89 + "Script make_fun_explicit =
25.90 + Input [Real f_, Real v_, BoolList eqs_]
25.91 + Local [Bool h_, Bool eq_, RealList vs_, Real v1_, BoolList ss_]
25.92 + Tacs [SEQU
25.93 + [let h_ = (hd o filter (Testvar m_)) eqs_; eq_ = hd (eqs_ -- [h_]);
25.94 + vs_ = Var h_ -- [f_]; v1_ = hd (vs_ -- [v_])
25.95 + in Subproblem Spec (R, [univar, equation], no_met)
25.96 + InOut [In eq_, In v1_, Out ss_]],
25.97 + Take (Bool h_) ; Substitute [(v1_, (Rhs o hd) ss_)]]
25.98 + Return [Currform]" : cterm
25.99 +ML>
26.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
26.2 +++ b/src/Pure/isac/IsacKnowledge/DiffApp-scrpbl.sml Wed Jul 21 13:53:39 2010 +0200
26.3 @@ -0,0 +1,429 @@
26.4 +(* use"test-coil-kernel.sml";
26.5 + W.N.22.11.99
26.6 +
26.7 +*)
26.8 +
26.9 +(* vvv--- geht nicht wegen fun-types
26.10 +parse thy "case maxmin of is_max => (m' <= m) | is_min => (m <= m')";
26.11 +parse thy "if maxmin = is_max then (m' <= m) else (m <= m')";
26.12 +parse thy "if a=b then a else b";
26.13 +parse thy "maxmin = is_max";
26.14 +parse thy "maxmin =!= is_max";
26.15 + ^^^--- geht nicht wegen fun-types *)
26.16 +
26.17 +"pbltyp --- maximum ---";
26.18 +val pbltyp = {given=["fixedValues (cs::bool list)"],
26.19 + where_=[(*"foldl (op &) True (map is_equality cs)",
26.20 + "foldl (op &) True (map (Not o ((op <=) #0) o Rhs) cs)"*)],
26.21 + find=["maximum m","values_for (ms::real list)"],
26.22 + with_=[(*"Ex_frees ((foldl (op &) True (r#rs)) & \
26.23 + \ (ALL m'. (subst (m,m') (foldl (op &) True (r#rs)) \
26.24 + \ --> m' <= m)))"*)],
26.25 + relate=["max_relation r","additionalRels rs"]}:string ppc;
26.26 +val chkpbltyp = ((map (the o (parse thy))) o ppc2list) pbltyp;
26.27 +"coil";
26.28 +val org = ["fixedValues [R=(R::real)]",
26.29 + "boundVariable a","boundVariable b","boundVariable alpha",
26.30 + "domain {x::real. #0 <= x & x <= #2*R}",
26.31 + "domain {x::real. #0 <= x & x <= #2*R}",
26.32 + "domain {x::real. #0 <= x & x <= pi}",
26.33 + "errorBound (eps = #1//#1000)",
26.34 + "maximum A",
26.35 + (*"max_relation A=#2*a*b - a^^^#2",*)
26.36 + "relations [A=#2*a*b - a^^^#2, (a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2]",
26.37 + "relations [A=#2*a*b - a^^^#2, (a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2]",
26.38 + "relations [A=#2*a*b - a^^^#2, a=#2*R*sin alpha, b=#2*R*cos alpha]"];
26.39 +val chkorg = map (the o (parse thy)) org;
26.40 +val pbl = {given=["fixedValues [R=(R::real)]"],where_=[],
26.41 + find=["maximum A","values_for [a,b]"],
26.42 + with_=[(* incompat.w. parse, ok with parseold
26.43 + "EX alpha. A=#2*a*b - a^^^#2 & \
26.44 + \ a=#2*R*sin alpha & b=#2*R*cos alpha & \
26.45 + \ (ALL A'. A'=#2*a*b - a^^^#2 & a=#2*R*sin alpha \
26.46 + \ & b=#2*R*cos alpha \
26.47 + \ --> A' <= A)"*)],
26.48 + relate=["relations [A=#2*a*b - a^^^#2, a=#2*R*sin alpha, b=#2*R*cos alpha]"]
26.49 + }: string ppc;
26.50 +val chkpbl = ((map (the o (parse thy))) o ppc2list) pbl;
26.51 +
26.52 +"met --- maximum_by_differentiation ---";
26.53 +val met = {given=["fixedValues (cs::bool list)","boundVariable v",
26.54 + "domain {x::real. lower_bound <= x & x<=upper_bound}",
26.55 + "errorBound epsilon"],
26.56 + where_=[],
26.57 + find=["maximum m","valuesFor (ms::bool list)",
26.58 + "function_term t","max_argument mx"],
26.59 + with_=[(* incompat.w. parse, ok with parseold
26.60 + "Ex_frees ((foldl (op &) True (mr#ars)) & \
26.61 + \ (ALL m'. (subst (m,m') (foldl (op &) True (mr#ars))\
26.62 + \ --> m' <= m))) & \
26.63 + \m = (%v. t) mx & \
26.64 + \( ALL x. lower_bound <= x & x <= upper_bound \
26.65 + \ --> (%v. t) x <= m)"*)],
26.66 + relate=["max_relation mr",
26.67 + "additionalRels ars"]}: string ppc;
26.68 +val chkpbl = ((map (the o (parse thy))) o ppc2list) met;
26.69 +
26.70 +"data --- maximum_by_differentiation ---";
26.71 +val met = {given=["fixedValues [R=(R::real)]","boundVariable alpha",
26.72 + "domain {x::real. #0 <= x & x <= pi//#2}",
26.73 + "errorBound (eps = #1//#1000)"],
26.74 + where_=[],
26.75 + find=["maximum A","valuesFor [a=Undef]",
26.76 + "function_term t","max_argument mx"],
26.77 + with_=[(* incompat.w. parse, ok with parseold
26.78 + "EX b alpha. A = #2*a*b - a^^^#2 & \
26.79 + \ a = #2*R*sin alpha & \
26.80 + \ b = #2*R*cos alpha & \
26.81 + \ (ALL A'. A'= #2*a*b - a^^^#2 & \
26.82 + \ a = #2*R*sin alpha & \
26.83 + \ b = #2*R*cos alpha --> A' <= A) & \
26.84 + \ A = (%alpha. t) mx & \
26.85 + \ (ALL x. #0 <= x & x <= pi --> \
26.86 + \ (%alpha. t) x <= A)"*)],
26.87 + relate=["max_relation mr",
26.88 + "additionalRels ars"]}: string ppc;
26.89 +val chkpbl = ((map (the o (parse thy))) o ppc2list) met;
26.90 +
26.91 +val (Some ct) = parseold thy "EX b. (EX alpha. A = #2*a*b - a^^^#2)";
26.92 +
26.93 +"pbltyp --- make_fun ---";
26.94 +(* subproblem [(hd #relate root, equality),
26.95 + (boundVariable formalization, boundVariable),
26.96 + (tl #relate root, equalities)] *)
26.97 +val pbltyp = {given=["equality e","boundVariable v", "equalities es"],
26.98 + where_=[],
26.99 + find=["functionTerm t"],with_=[(*???*)],
26.100 + relate=[(*???*)]}: string ppc;
26.101 +val chkpbltyp = ((map (the o (parse thy))) o ppc2list) pbltyp;
26.102 +"coil";
26.103 +val pbl = {given=["equality (A=#2*a*b - a^^^#2)","boundVariable alpha",
26.104 + "equalities [a=#2*R*sin alpha, b=#2*R*cos alpha]"],
26.105 + where_=[],
26.106 + find=["functionTerm t"],
26.107 + with_=[],relate=[]}: string ppc;
26.108 +val chkpbl = ((map (the o (parse thy))) o ppc2list) pbl;
26.109 +
26.110 +"met --- make_explicit_and_substitute ---";
26.111 +val met = {given=["equality e","boundVariable v", "equalities es"],
26.112 + where_=[],
26.113 + find=["functionTerm t"],with_=[(*???*)],
26.114 + relate=[(*???*)]}: string ppc;
26.115 +val chkmet = ((map (the o (parse thy))) o ppc2list) met;
26.116 +"met --- introduce_a_new_variable ---";
26.117 +val met = {given=["equality e","boundVariable v", "substitutions es"],
26.118 + where_=[],
26.119 + find=["functionTerm t"],with_=[(*???*)],
26.120 + relate=[(*???*)]}: string ppc;
26.121 +val chkmet = ((map (the o (parse thy))) o ppc2list) met;
26.122 +
26.123 +
26.124 +"pbltyp --- max_of_fun_on_interval ---";
26.125 +val pbltyp = {given=["functionTerm t","boundVariable v",
26.126 + "domain {x::real. lower_bound <= x & x <= upper_bound}"],
26.127 + where_=[],
26.128 + find=["maximums ms"],
26.129 + with_=[(* incompat.w. parse, ok with parseold
26.130 + "ALL m. m : ms --> \
26.131 + \ (ALL x::real. lower_bound <= x & x <= upper_bound \
26.132 + \ --> (%v. t) x <= m)"*)],
26.133 + relate=[]}: string ppc;
26.134 +val chkpbltyp = ((map (the o (parse thy))) o ppc2list) pbltyp;
26.135 +"coil";
26.136 +val pbl = {given=["functionTerm (f = #2*(#2*R*sin alpha)*(#2*R*cos alpha) - \
26.137 + \ (#2*R*sin alpha)^^^#2)","boundVariable alpha",
26.138 + "domain {x::real. #0 <= x & x <= pi}"],where_=[],
26.139 + find=["maximums [#1234]"],with_=[],relate=[]}: string ppc;
26.140 +val chkpbl = ((map (the o (parse thy))) o ppc2list) pbl;
26.141 +
26.142 +
26.143 +(* pbltyp --- max_of_fun --- *)
26.144 +(*
26.145 +{given=[],where_=[],find=[],with_=[],relate=[]}: string ppc;
26.146 +val (Some ct) = parse thy ;
26.147 +atomty (term_of ct);
26.148 +*)
26.149 +
26.150 +
26.151 +(* --- 14.1.00 ev. nicht ganz up to date bzg. oberem --- *)
26.152 +"p.114";
26.153 +val org = {given=["[u=(#12::real)]"],where_=[],
26.154 + find=["[a,(b::real)]"],with_=[],
26.155 + relate=["[is_max A=a*(b::real), #2*a+#2*b=(u::real)]"]}: string ppc;
26.156 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
26.157 +"p.116";
26.158 +val org = {given=["[c=#10, h=(#4::real)]"],where_=[],
26.159 + find=["[x,(y::real)]"],with_=[],
26.160 + relate=["[A=x*(y::real), c//h=x//(h-(y::real))]"]}: string ppc;
26.161 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
26.162 +"p.117";
26.163 +val org = {given=["[r=#5]"],where_=[],
26.164 + find=["[x,(y::real)]"],with_=[],
26.165 + relate=["[is_max #0=pi*x^^^#2 + pi*x*(r::real)]"]}: string ppc;
26.166 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
26.167 +"#241";
26.168 +val org = {given=["[s=(#10::real)]"],where_=[],
26.169 + find=["[p::real]"],with_=[],
26.170 + relate=["[is_max p=n*m, s=n+(m::real)]"]}: string ppc;
26.171 +val chkorg = ((map (the o (parse thy))) o ppc2list) org;
26.172 +
26.173 +
26.174 +
26.175 +(* -------------- coil-kernel -------------- vor 19.1.00 *)
26.176 +(* --- subproblem: make-function-by-subst ~~~~~~~~~~~ *)
26.177 +(* --- subproblem: max-of-function *)
26.178 +(* --- subproblem: derivative *)
26.179 +(* --- subproblem: tan-quadrat-equation *)
26.180 +"-------------- coil-kernel --------------";
26.181 +val origin = ["A=#2*a*b - a^^^#2",
26.182 + "a::real","b::real","{x. #0<x & x<R//#2}",
26.183 + "{(a//#2)^^^#2 + (b//#2)^^^#2 = (R//#2)^^^#2}",
26.184 + "alpha::real","{alpha::real. #0<alpha & alpha<pi//#2}",
26.185 + "{a//#2 = R*(sin alpha), b//#2 = R*(cos alpha)}",
26.186 + "{R::real}"];
26.187 +(* --- for a isa-users-mail --- FIXME
26.188 +Goal "{x. x < a} = ?z";
26.189 +{x::'a. x < a} = ?z
26.190 +Goal "{x. x < #3} = {a}";
26.191 +{x::'a. x < (#3::'a)} = {a}
26.192 +Goal "{x. #3 < x} = ?z";
26.193 +Collect (op < (#3::'a)) = ?z
26.194 +---------------------------- *)
26.195 +
26.196 +val formals = map (the o (parse thy)) origin;
26.197 +
26.198 +val given = ["formula_for_max (lhs=rhs)","boundVariable bdv",
26.199 + "interval {x. low < x & x < high}",
26.200 + "additional_conds ac","constants cs"];
26.201 +val where_ = ["lhs is_const","bdv is_const","low is_const","high is_const",
26.202 + "||| Vars equ ||| = ||| VarsSet ac ||| - ||| ac ||| + #1"];
26.203 +val find = ["f::real => real","maxs::real set"];
26.204 +val with_ = [(* incompat.w. parse, ok with parseold
26.205 + "maxs = {m. low < m & m < high & \
26.206 + \ (m is_local_max_of (%bdv. f))}"*)];
26.207 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
26.208 +val givens = map (the o (parse thy)) given;
26.209 +
26.210 +"------- 1.1 -------";
26.211 +(* 5.3.00
26.212 +val formals = map (the o (parse thy)) ["A=#2*a*b - a^^^#2",
26.213 + "a::real","{x. #0<x & x<R//#2}",
26.214 + "{(a//#2)^^^#2 + (b//#2)^^^#2 = (R//#2)^^^#2}",
26.215 + "{R::real}"];
26.216 +val tag__forms = chktyps thy (formals, givens);
26.217 +map ((atomty) o term_of) tag__forms;
26.218 +
26.219 +val formals = map (the o (parse thy)) ["A=#2*a*b - a^^^#2",
26.220 + "alpha::real","{alpha. #0<alpha & alpha<pi//#2}",
26.221 + "{a//#2 = R*(sin alpha), b//#2 = R*(cos alpha)}",
26.222 + "{R::real}"];
26.223 +val tag__forms = chktyps thy (formals, givens);
26.224 +map ((atomty) o term_of) tag__forms;
26.225 +*)
26.226 +
26.227 +" --- subproblem: make-function-by-subst --- ";
26.228 +val origin = ["A=#2*a*b - a^^^#2",
26.229 + "{a//#2 = R*(sin alpha), b//#2 = R*(cos alpha)}",
26.230 + "{R::real}"];
26.231 +val formals = map (the o (parse thy)) origin;
26.232 +
26.233 +val given = ["equation (lhs=rhs)","substitutions ss",
26.234 + "constants cs"];
26.235 +val where_ = [];
26.236 +val find = ["t::real"];
26.237 +val with_ = ["||| Vars t ||| = #1"];
26.238 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
26.239 +val givens = map (the o (parse thy)) given;
26.240 +(* 5.3.00
26.241 +val tag__forms = chktyps thy (formals, givens);
26.242 +map ((atomty) o term_of) tag__forms;
26.243 +*)
26.244 +" --- subproblem: max-of-function --- ";
26.245 +val origin = ["A = #2*(#2*R*(sin alpha))*(#2*R*(sin alpha)) - \
26.246 + \ (#2*R*(sin alpha))^^^#2",
26.247 + "{alpha. #0<alpha & alpha<pi//#2}",
26.248 + "{R::real}"];
26.249 +val formals = map (the o (parse thy)) origin;
26.250 +
26.251 +val given = ["equation (lhs=rhs)",
26.252 + "interval {x. low < x & x < high}",
26.253 + "constants cs"];
26.254 +val where_ = ["lhs is_const","low is_const","high is_const"];
26.255 +val find = ["t::real"];
26.256 +val with_ = ["||| Vars t ||| = #1"];
26.257 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
26.258 +val givens = map (the o (parse thy)) given;
26.259 +(* 5.3.00
26.260 +val tag__forms = chktyps thy (formals, givens);
26.261 +map ((atomty) o term_of) tag__forms;
26.262 +*)
26.263 +" --- subproblem: derivative --- ";
26.264 +val origin = ["x^^^#3-y^^^#3+#-3*x+#12*y+#10","x::real"];
26.265 +val formals = map (the o (parse thy)) origin;
26.266 +
26.267 +val given = ["functionTerm t",
26.268 + "boundVariable bdv"];
26.269 +val where_ = ["bdv is_const"];
26.270 +val find = ["t'::real"];
26.271 +val with_ = ["t' is_derivative_of (%bdv. t)"];
26.272 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
26.273 +val givens = map (the o (parse thy)) given;
26.274 +(*
26.275 +val tag__forms = chktyps thy (formals, givens);
26.276 +map ((atomty) o term_of) tag__forms;
26.277 +*)
26.278 +" --- subproblem: tan-quadrat-equation --- ";
26.279 +val origin = ["#8*R^^^#2*(cos alpha)^^^#2 + #-8*R^^^#2* \
26.280 + \ (cos alpha)*(sin alpha) + #8*R^^^#2*(sin alpha)^^^#2 = #0",
26.281 + "alpha::real","#1//#1000"];
26.282 +val formals = map (the o (parse thy)) origin;
26.283 +
26.284 +val given = ["equation (a*(cos bdv)^^^#2 + b*(cos bdv)*(sin bdv) + \
26.285 + \ c*(sin bdv) = #0)",
26.286 + "boundVariable bdv","errorBound epsilon"];
26.287 +val where_ = ["bdv is_const","epsilon is_const_expr"];
26.288 +val find = ["L::real set"];
26.289 +val with_ = ["L = {x. || (%bdv. a*(cos bdv)^^^#2 + b*(cos bdv)*(sin bdv) + \
26.290 + \ c*(sin bdv)) x || < epsilon}"];
26.291 +(* 5.3.00
26.292 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
26.293 +val givens = map (the o (parse thy)) given;
26.294 +val tag__forms = chktyps thy (formals, givens);
26.295 +map ((atomty) o term_of) tag__forms;
26.296 +*)
26.297 +(* use"test-coil-kernel.sml";
26.298 + *)
26.299 +
26.300 +
26.301 +" #################################################### ";
26.302 +" test specify ";
26.303 +" #################################################### ";
26.304 +
26.305 +
26.306 +val cts =
26.307 +["fixedValues [R=(R::real)]",
26.308 + "boundVariable a", "boundVariable b",
26.309 + "boundVariable alpha",
26.310 + "domain {x::real. #0 <= x & x <= #2*R}",
26.311 + "domain {x::real. #0 <= x & x <= #2*R}",
26.312 + "domain {x::real. #0 <= x & x <= pi//#2}",
26.313 + "errorBound (eps = #1//#1000)",
26.314 + "maximum A","valuesFor [a=Undef]",
26.315 + (*"functionTerm t","max_argument mx",
26.316 + "max_relation (A=#2*a*b - a^^^#2)", *)
26.317 + "additionalRels [A=#2*a*b - a^^^#2,(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]",
26.318 + "additionalRels [A=#2*a*b - a^^^#2,(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]",
26.319 + "additionalRels [A=#2*a*b - a^^^#2,a=#2*R*sin alpha, b=#2*R*cos alpha]"];
26.320 +val (dI',pI',mI')=
26.321 + ("DiffAppl.thy",["Script.thy","maximum_of","function"],e_metID);
26.322 +val c = []:cid;
26.323 +
26.324 +(*
26.325 +val pbl = {given=["fixedValues [R=(R::real)]","boundVariable alpha",
26.326 + "domain {x::real. #0 <= x & x <= pi//#2}",
26.327 + "errorBound (eps = #1//#1000)"],
26.328 + where_=[],
26.329 + find=["maximum A","valuesFor [a=Undef]"(*,
26.330 + "functionTerm t","max_argument mx"*)],
26.331 + with_=[],
26.332 + relate=["max_relation (A=#2*a*b - a^^^#2)",
26.333 + "additionalRels [(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]",
26.334 + "additionalRels [(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]",
26.335 + "additionalRels [a=#2*R*sin alpha, b=#2*R*cos alpha]"]
26.336 + }: string ppc;
26.337 +*)
26.338 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) =
26.339 + specify (Init_Proof (cts,(dI',pI',mI'))) e_pos' [] EmptyPtree;
26.340 +
26.341 +val ct = "fixedValues [R=(R::real)]";
26.342 +(*l(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify(Add_Given ct) p c pt*)
26.343 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.344 +
26.345 +val ct = "boundVariable a";
26.346 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.347 +val ct = "boundVariable alpha";
26.348 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.349 +
26.350 +val ct = "domain {x::real. #0 <= x & x <= pi//#2}";
26.351 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.352 +
26.353 +val ct = "errorBound (eps = (#1::real) // #1000)";
26.354 +val ct = "maximum A";
26.355 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.356 +
26.357 +val ct = "valuesFor [a=Undef]";
26.358 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.359 +
26.360 +val ct = "max_relation ()";
26.361 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.362 +
26.363 +val ct = "relations [A=#2*a*b - a^^^#2,(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]";
26.364 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.365 +
26.366 +(* ... nxt = Specify_Domain ...
26.367 +val ct = "additionalRels [b=#2*R*cos alpha]";
26.368 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) =
26.369 + specify(Add_Relation ct) p c pt;
26.370 +(*
26.371 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.372 +*)
26.373 +val ct = "additionalRels [a=#2*R*sin alpha]";
26.374 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) =
26.375 + specify(Add_Relation ct) p c pt;
26.376 +(*
26.377 +val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.378 +*)
26.379 +*)
26.380 +(* --- tricky case (termlist interleaving variants):
26.381 +> val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) =
26.382 + specify (Init_Proof (cts,(dI,pI,mI))) [] [] EmptyPtree;
26.383 +
26.384 +> val ct = "additionalRels [(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2, b=#2*R*cos alpha]";
26.385 +> val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.386 +*)
26.387 +
26.388 +(* --- incomplete input ---
26.389 +> val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) =
26.390 + specify (Init_Proof (cts,(dI,pI,mI))) [] [] EmptyPtree;
26.391 +
26.392 +> val ct = "[R=(R::real)]";
26.393 +> val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.394 +
26.395 +> val ct = "R=(R::real)";
26.396 +> val(p,_,Form'(PpcKF(_,_,ppc)),nxt,_,pt) = specify nxt p c pt;
26.397 +
26.398 +> val ct = "(R::real)";
26.399 +> specify nxt p c pt;
26.400 +*)
26.401 +
26.402 +
26.403 +" #################################################### ";
26.404 +" test do_ specify ";
26.405 +" #################################################### ";
26.406 +
26.407 +
26.408 +val cts = ["fixedValues [R=(R::real)]",
26.409 + "boundVariable a", "boundVariable b",
26.410 + "boundVariable alpha",
26.411 + "domain {x::real. #0 <= x & x <= #2*R}",
26.412 + "domain {x::real. #0 <= x & x <= #2*R}",
26.413 + "domain {x::real. #0 <= x & x <= pi//#2}",
26.414 + "errorBound (eps=#1//#1000)",
26.415 + "maximum A","valuesFor [a=Undef]",
26.416 + (*"functionTerm t","max_argument mx", *)
26.417 + "max_relation (A=#2*a*b - a^^^#2)",
26.418 + "additionalRels [(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]",
26.419 + "additionalRels [(a//#2)^^^#2 + (b//#2)^^^#2 =R^^^#2]",
26.420 + "additionalRels [a=#2*R*sin alpha, b=#2*R*cos alpha]"];
26.421 +val (dI',pI',mI')=
26.422 + ("DiffAppl.thy",["DiffAppl.thy","test_maximum"],e_metID);
26.423 +val p = e_pos'; val c = [];
26.424 +
26.425 +val (mI,m) = ("Init_Proof",Init_Proof (cts, (dI',pI',mI')));
26.426 +val (pst as (sc,pt,cl):pstate) = (EmptyScr, e_ptree, []);
26.427 +val (p,_,f,nxt,_,(_,pt,_)) = do_ (mI,m) p c pst;
26.428 +(*val nxt = ("Add_Given",Add_Given "fixedValues [R = R]")*)
26.429 +
26.430 +val (p,_,Form' (PpcKF (_,_,ppc)),nxt,_,(_,pt,_)) =
26.431 + do_ nxt p c (EmptyScr,pt,[]);
26.432 +(*val nxt = ("Add_Given",Add_Given "boundVariable a") *)
27.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
27.2 +++ b/src/Pure/isac/IsacKnowledge/DiffApp.ML Wed Jul 21 13:53:39 2010 +0200
27.3 @@ -0,0 +1,221 @@
27.4 +(* tools for applications of differetiation
27.5 + use"DiffApp.ML";
27.6 + use"IsacKnowledge/DiffApp.ML";
27.7 + use"../IsacKnowledge/DiffApp.ML";
27.8 +
27.9 +
27.10 +WN.6.5.03: old decisions in this file partially are being changed
27.11 + in a quick-and-dirty way to make scripts run: Maximum_value,
27.12 + Make_fun_by_new_variable, Make_fun_by_explicit.
27.13 +found to be reconsidered:
27.14 +- descriptions (Descript.thy)
27.15 +- penv: really need term list; or just rerun the whole example with num/var
27.16 +- mk_arg, itms2args ... env in script different from penv ?
27.17 +- L = SubProblem eq ... show some vars on the worksheet ? (other means for
27.18 + referencing are labels (no on worksheet))
27.19 +
27.20 +WN.6.5.03 quick-and-dirty: mk_arg, itms2args just make most convenient env
27.21 + from penv as is.
27.22 + *)
27.23 +
27.24 +
27.25 +(** interface isabelle -- isac **)
27.26 +
27.27 +theory' := overwritel (!theory', [("DiffApp.thy",DiffApp.thy)]);
27.28 +
27.29 +val eval_rls = prep_rls(
27.30 + Rls {id="eval_rls",preconds = [], rew_ord = ("termlessI",termlessI),
27.31 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
27.32 + rules = [Thm ("refl",num_str refl),
27.33 + Thm ("le_refl",num_str le_refl),
27.34 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
27.35 + Thm ("not_true",num_str not_true),
27.36 + Thm ("not_false",num_str not_false),
27.37 + Thm ("and_true",and_true),
27.38 + Thm ("and_false",and_false),
27.39 + Thm ("or_true",or_true),
27.40 + Thm ("or_false",or_false),
27.41 + Thm ("and_commute",num_str and_commute),
27.42 + Thm ("or_commute",num_str or_commute),
27.43 +
27.44 + Calc ("op <",eval_equ "#less_"),
27.45 + Calc ("op <=",eval_equ "#less_equal_"),
27.46 +
27.47 + Calc ("Atools.ident",eval_ident "#ident_"),
27.48 + Calc ("Atools.is'_const",eval_const "#is_const_"),
27.49 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
27.50 + Calc ("Tools.matches",eval_matches "")
27.51 + ],
27.52 + scr = Script ((term_of o the o (parse thy))
27.53 + "empty_script")
27.54 + }:rls);
27.55 +ruleset' := overwritelthy thy
27.56 + (!ruleset',
27.57 + [("eval_rls",Atools_erls)(*FIXXXME:del with rls.rls'*)
27.58 + ]);
27.59 +
27.60 +
27.61 +(** problem types **)
27.62 +
27.63 +store_pbt
27.64 + (prep_pbt DiffApp.thy "pbl_fun_max" [] e_pblID
27.65 + (["maximum_of","function"],
27.66 + [("#Given" ,["fixedValues fix_"]),
27.67 + ("#Find" ,["maximum m_","valuesFor vs_"]),
27.68 + ("#Relate",["relations rs_"])
27.69 + ],
27.70 + e_rls, None, []));
27.71 +
27.72 +store_pbt
27.73 + (prep_pbt DiffApp.thy "pbl_fun_make" [] e_pblID
27.74 + (["make","function"]:pblID,
27.75 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
27.76 + ("#Find" ,["functionEq f_1_"])
27.77 + ],
27.78 + e_rls, None, []));
27.79 +store_pbt
27.80 + (prep_pbt DiffApp.thy "pbl_fun_max_expl" [] e_pblID
27.81 + (["by_explicit","make","function"]:pblID,
27.82 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
27.83 + ("#Find" ,["functionEq f_1_"])
27.84 + ],
27.85 + e_rls, None, [["DiffApp","make_fun_by_explicit"]]));
27.86 +store_pbt
27.87 + (prep_pbt DiffApp.thy "pbl_fun_max_newvar" [] e_pblID
27.88 + (["by_new_variable","make","function"]:pblID,
27.89 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
27.90 + (*WN.12.5.03: precond for distinction still missing*)
27.91 + ("#Find" ,["functionEq f_1_"])
27.92 + ],
27.93 + e_rls, None, [["DiffApp","make_fun_by_new_variable"]]));
27.94 +
27.95 +store_pbt
27.96 + (prep_pbt DiffApp.thy "pbl_fun_max_interv" [] e_pblID
27.97 + (["on_interval","maximum_of","function"]:pblID,
27.98 + [("#Given" ,["functionEq t_","boundVariable v_","interval itv_"]),
27.99 + (*WN.12.5.03: precond for distinction still missing*)
27.100 + ("#Find" ,["maxArgument v_0_"])
27.101 + ],
27.102 + e_rls, None, []));
27.103 +
27.104 +store_pbt
27.105 + (prep_pbt DiffApp.thy "pbl_tool" [] e_pblID
27.106 + (["tool"]:pblID,
27.107 + [],
27.108 + e_rls, None, []));
27.109 +
27.110 +store_pbt
27.111 + (prep_pbt DiffApp.thy "pbl_tool_findvals" [] e_pblID
27.112 + (["find_values","tool"]:pblID,
27.113 + [("#Given" ,["maxArgument ma_","functionEq f_","boundVariable v_"]),
27.114 + ("#Find" ,["valuesFor vls_"]),
27.115 + ("#Relate",["additionalRels rs_"])
27.116 + ],
27.117 + e_rls, None, []));
27.118 +
27.119 +
27.120 +(** methods, scripts not yet implemented **)
27.121 +
27.122 +store_met
27.123 + (prep_met Diff.thy "met_diffapp" [] e_metID
27.124 + (["DiffApp"],
27.125 + [],
27.126 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
27.127 + crls = Atools_erls, nrls=norm_Rational
27.128 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
27.129 +store_met
27.130 + (prep_met DiffApp.thy "met_diffapp_max" [] e_metID
27.131 + (["DiffApp","max_by_calculus"]:metID,
27.132 + [("#Given" ,["fixedValues fix_","maximum m_","relations rs_",
27.133 + "boundVariable v_","interval itv_","errorBound err_"]),
27.134 + ("#Find" ,["valuesFor vs_"]),
27.135 + ("#Relate",[])
27.136 + ],
27.137 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls=list_rls,prls=e_rls,
27.138 + crls = eval_rls, nrls=norm_Rational
27.139 + (*, asm_rls=[],asm_thm=[]*)},
27.140 + "Script Maximum_value(fix_::bool list)(m_::real) (rs_::bool list)\
27.141 + \ (v_::real) (itv_::real set) (err_::bool) = \
27.142 + \ (let e_ = (hd o (filterVar m_)) rs_; \
27.143 + \ t_ = (if 1 < length_ rs_ \
27.144 + \ then (SubProblem (DiffApp_,[make,function],[no_met])\
27.145 + \ [real_ m_, real_ v_, bool_list_ rs_])\
27.146 + \ else (hd rs_)); \
27.147 + \ (mx_::real) = SubProblem(DiffApp_,[on_interval,maximum_of,function],\
27.148 + \ [DiffApp,max_on_interval_by_calculus])\
27.149 + \ [bool_ t_, real_ v_, real_set_ itv_]\
27.150 + \ in ((SubProblem (DiffApp_,[find_values,tool],[Isac,find_values]) \
27.151 + \ [real_ mx_, real_ (Rhs t_), real_ v_, real_ m_, \
27.152 + \ bool_list_ (dropWhile (ident e_) rs_)])::bool list))"
27.153 + ));
27.154 +store_met
27.155 + (prep_met DiffApp.thy "met_diffapp_funnew" [] e_metID
27.156 + (["DiffApp","make_fun_by_new_variable"]:metID,
27.157 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
27.158 + ("#Find" ,["functionEq f_1_"])
27.159 + ],
27.160 + {rew_ord'="tless_true",rls'=eval_rls,srls=list_rls,prls=e_rls,
27.161 + calc=[], crls = eval_rls, nrls=norm_Rational(*,asm_rls=[],asm_thm=[]*)},
27.162 + "Script Make_fun_by_new_variable (f_::real) (v_::real) \
27.163 + \ (eqs_::bool list) = \
27.164 + \(let h_ = (hd o (filterVar f_)) eqs_; \
27.165 + \ es_ = dropWhile (ident h_) eqs_; \
27.166 + \ vs_ = dropWhile (ident f_) (Vars h_); \
27.167 + \ v_1 = nth_ 1 vs_; \
27.168 + \ v_2 = nth_ 2 vs_; \
27.169 + \ e_1 = (hd o (filterVar v_1)) es_; \
27.170 + \ e_2 = (hd o (filterVar v_2)) es_; \
27.171 + \ (s_1::bool list) = (SubProblem (DiffApp_,[univariate,equation],[no_met])\
27.172 + \ [bool_ e_1, real_ v_1]);\
27.173 + \ (s_2::bool list) = (SubProblem (DiffApp_,[univariate,equation],[no_met])\
27.174 + \ [bool_ e_2, real_ v_2])\
27.175 + \in Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] h_)"
27.176 +));
27.177 +store_met
27.178 +(prep_met DiffApp.thy "met_diffapp_funexp" [] e_metID
27.179 +(["DiffApp","make_fun_by_explicit"]:metID,
27.180 + [("#Given" ,["functionOf f_","boundVariable v_","equalities eqs_"]),
27.181 + ("#Find" ,["functionEq f_1_"])
27.182 + ],
27.183 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls=list_rls,prls=e_rls,
27.184 + crls = eval_rls, nrls=norm_Rational
27.185 + (*, asm_rls=[],asm_thm=[]*)},
27.186 + "Script Make_fun_by_explicit (f_::real) (v_::real) \
27.187 + \ (eqs_::bool list) = \
27.188 + \ (let h_ = (hd o (filterVar f_)) eqs_; \
27.189 + \ e_1 = hd (dropWhile (ident h_) eqs_); \
27.190 + \ vs_ = dropWhile (ident f_) (Vars h_); \
27.191 + \ v_1 = hd (dropWhile (ident v_) vs_); \
27.192 + \ (s_1::bool list)=(SubProblem(DiffApp_,[univariate,equation],[no_met])\
27.193 + \ [bool_ e_1, real_ v_1])\
27.194 + \ in Substitute [(v_1 = (rhs o hd) s_1)] h_)"
27.195 + ));
27.196 +store_met
27.197 + (prep_met DiffApp.thy "met_diffapp_max_oninterval" [] e_metID
27.198 + (["DiffApp","max_on_interval_by_calculus"]:metID,
27.199 + [("#Given" ,["functionEq t_","boundVariable v_","interval itv_"(*,
27.200 + "errorBound err_"*)]),
27.201 + ("#Find" ,["maxArgument v_0_"])
27.202 + ],
27.203 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls = e_rls,prls=e_rls,
27.204 + crls = eval_rls, nrls=norm_Rational
27.205 + (*, asm_rls=[],asm_thm=[]*)},
27.206 + "empty_script"
27.207 + ));
27.208 +store_met
27.209 + (prep_met DiffApp.thy "met_diffapp_findvals" [] e_metID
27.210 + (["DiffApp","find_values"]:metID,
27.211 + [],
27.212 + {rew_ord'="tless_true",rls'=eval_rls,calc=[],srls = e_rls,prls=e_rls,
27.213 + crls = eval_rls, nrls=norm_Rational(*,
27.214 + asm_rls=[],asm_thm=[]*)},
27.215 + "empty_script"));
27.216 +
27.217 +val list_rls = append_rls "list_rls" list_rls
27.218 + [Thm ("filterVar_Const", num_str filterVar_Const),
27.219 + Thm ("filterVar_Nil", num_str filterVar_Nil)
27.220 + ];
27.221 +ruleset' := overwritelthy thy (!ruleset',
27.222 + [("list_rls",list_rls)
27.223 + ]);
27.224 +
28.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
28.2 +++ b/src/Pure/isac/IsacKnowledge/DiffApp.sml Wed Jul 21 13:53:39 2010 +0200
28.3 @@ -0,0 +1,105 @@
28.4 +(* = DiffAppl.ML
28.5 + +++ outcommented tests
28.6 +*)
28.7 +
28.8 +
28.9 +theory' := overwritel (!theory', [("DiffAppl.thy",DiffAppl.thy)]);
28.10 +
28.11 +(*
28.12 +> get_pbt ["DiffAppl.thy","maximum_of","function"];
28.13 +> get_met ("Script.thy","max_on_interval_by_calculus");
28.14 +> !pbltypes;
28.15 + *)
28.16 +pbltypes:= overwritel (!pbltypes,
28.17 +[
28.18 + prep_pbt DiffAppl.thy
28.19 + (["DiffAppl.thy","maximum_of","function"],
28.20 + [("#Given" ,"fixedValues fix_"),
28.21 + ("#Find" ,"maximum m_"),
28.22 + ("#Find" ,"valuesFor vs_"),
28.23 + ("#Relate","relations rs_") (*,
28.24 + ("#where" ,"foldl (op&) True (map (Not o ((op<=) #0) o Rhs) fix_)"),
28.25 + ("#with" ,"Ex_frees ((foldl (op &) True rs_) & \
28.26 + \ (ALL m'. (subst (m_,m') (foldl (op &) True rs_) \
28.27 + \ --> m' <= m_)))") *)
28.28 + ]),
28.29 +
28.30 + prep_pbt DiffAppl.thy
28.31 + (["DiffAppl.thy","make","function"]:pblID,
28.32 + [("#Given" ,"functionOf f_"),
28.33 + ("#Given" ,"boundVariable v_"),
28.34 + ("#Given" ,"equalities eqs_"),
28.35 + ("#Find" ,"functionTerm f_0_")
28.36 + ]),
28.37 +
28.38 + prep_pbt DiffAppl.thy
28.39 + (["DiffAppl.thy","on_interval","maximum_of","function"]:pblID,
28.40 + [("#Given" ,"functionTerm t_"),
28.41 + ("#Given" ,"boundVariable v_"),
28.42 + ("#Given" ,"interval itv_"),
28.43 + ("#Find" ,"maxArgument v_0_")
28.44 + ]),
28.45 +
28.46 + prep_pbt DiffAppl.thy
28.47 + (["DiffAppl.thy","find_values","tool"]:pblID,
28.48 + [("#Given" ,"maxArgument ma_"),
28.49 + ("#Given" ,"functionTerm f_"),
28.50 + ("#Given" ,"boundVariable v_"),
28.51 + ("#Find" ,"valuesFor vls_"),
28.52 + ("#Relate","additionalRels rs_")
28.53 + ])
28.54 +]);
28.55 +
28.56 +
28.57 +methods:= overwritel (!methods,
28.58 +[
28.59 + (("DiffAppl.thy","max_by_calculus"):metID,
28.60 + {ppc = prep_met DiffAppl.thy
28.61 + [("#Given" ,"fixedValues fix_"),
28.62 + ("#Given" ,"boundVariable v_"),
28.63 + ("#Given" ,"interval itv_"),
28.64 + ("#Given" ,"errorBound err_"),
28.65 + ("#Find" ,"maximum m_"),
28.66 + ("#Find" ,"valuesFor vs_"),
28.67 + ("#Relate","relations rs_")
28.68 + ],
28.69 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
28.70 + scr=EmptyScr} : met),
28.71 +
28.72 + (("DiffAppl.thy","make_fun_by_new_variable"):metID,
28.73 + {ppc = prep_met DiffAppl.thy
28.74 + [("#Given" ,"functionOf f_"),
28.75 + ("#Given" ,"boundVariable v_"),
28.76 + ("#Given" ,"equalities eqs_"),
28.77 + ("#Find" ,"functionTerm f_0_")
28.78 + ],
28.79 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
28.80 + scr=EmptyScr} : met),
28.81 +
28.82 + (("DiffAppl.thy","make_fun_by_explicit"):metID,
28.83 + {ppc = prep_met DiffAppl.thy
28.84 + [("#Given" ,"functionOf f_"),
28.85 + ("#Given" ,"boundVariable v_"),
28.86 + ("#Given" ,"equalities eqs_"),
28.87 + ("#Find" ,"functionTerm f_0_")
28.88 + ],
28.89 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
28.90 + scr=EmptyScr} : met),
28.91 +
28.92 + (("DiffAppl.thy","max_on_interval_by_calculus"):metID,
28.93 + {ppc = prep_met DiffAppl.thy
28.94 + [("#Given" ,"functionTerm t_"),
28.95 + ("#Given" ,"boundVariable v_"),
28.96 + ("#Given" ,"interval itv_"),
28.97 + ("#Given" ,"errorBound err_"),
28.98 + ("#Find" ,"maxArgument v_0_")
28.99 + ],
28.100 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
28.101 + scr=EmptyScr} : met),
28.102 +
28.103 + (("DiffAppl.thy","find_values"):metID,
28.104 + {ppc = prep_met DiffAppl.thy
28.105 + [],
28.106 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
28.107 + scr=EmptyScr} : met)
28.108 +]);
29.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
29.2 +++ b/src/Pure/isac/IsacKnowledge/DiffApp.thy Wed Jul 21 13:53:39 2010 +0200
29.3 @@ -0,0 +1,40 @@
29.4 +(* application of differential calculus
29.5 + use_thy_only"../IsacKnowledge/DiffApp";
29.6 + use_thy_only"DiffApp";
29.7 +
29.8 +
29.9 +*)
29.10 +
29.11 +
29.12 +DiffApp = Diff +
29.13 +
29.14 +consts
29.15 +
29.16 + Maximum'_value
29.17 + :: "[bool list,real,bool list,real,real set,bool,\
29.18 + \ bool list] => bool list"
29.19 + ("((Script Maximum'_value (_ _ _ _ _ _ =))// (_))" 9)
29.20 +
29.21 + Make'_fun'_by'_new'_variable
29.22 + :: "[real,real,bool list, \
29.23 + \ bool] => bool"
29.24 + ("((Script Make'_fun'_by'_new'_variable (_ _ _ =))// \
29.25 + \(_))" 9)
29.26 + Make'_fun'_by'_explicit
29.27 + :: "[real,real,bool list, \
29.28 + \ bool] => bool"
29.29 + ("((Script Make'_fun'_by'_explicit (_ _ _ =))// \
29.30 + \(_))" 9)
29.31 +
29.32 + dummy :: real
29.33 +
29.34 +(*for script Maximum_value*)
29.35 + filterVar :: "[real, 'a list] => 'a list"
29.36 +
29.37 +(*primrec*)rules
29.38 + filterVar_Nil "filterVar v [] = []"
29.39 + filterVar_Const "filterVar v (x#xs) = \
29.40 + \(if (v mem (Vars x)) then x#(filterVar v xs) \
29.41 + \ else filterVar v xs) "
29.42 +
29.43 +end
29.44 \ No newline at end of file
30.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
30.2 +++ b/src/Pure/isac/IsacKnowledge/EqSystem.ML Wed Jul 21 13:53:39 2010 +0200
30.3 @@ -0,0 +1,673 @@
30.4 +(* tools for systems of equations over the reals
30.5 + author: Walther Neuper 050905, 08:51
30.6 + (c) due to copyright terms
30.7 +
30.8 +use"IsacKnowledge/EqSystem.ML";
30.9 +use"EqSystem.ML";
30.10 +
30.11 +remove_thy"EqSystem";
30.12 +use_thy"IsacKnowledge/Isac";
30.13 +*)
30.14 +
30.15 +(** interface isabelle -- isac **)
30.16 +
30.17 +theory' := overwritel (!theory', [("EqSystem.thy",EqSystem.thy)]);
30.18 +
30.19 +(** eval functions **)
30.20 +
30.21 +(*certain variables of a given list occur _all_ in a term
30.22 + args: all: ..variables, which are under consideration (eg. the bound vars)
30.23 + vs: variables which must be in t,
30.24 + and none of the others in all must be in t
30.25 + t: the term under consideration
30.26 + *)
30.27 +fun occur_exactly_in vs all t =
30.28 + let fun occurs_in' a b = occurs_in b a
30.29 + in foldl and_ (true, map (occurs_in' t) vs)
30.30 + andalso not (foldl or_ (false, map (occurs_in' t) (all \\ vs)))
30.31 + end;
30.32 +
30.33 +(*("occur_exactly_in", ("EqSystem.occur'_exactly'_in",
30.34 + eval_occur_exactly_in "#eval_occur_exactly_in_"))*)
30.35 +fun eval_occur_exactly_in _ "EqSystem.occur'_exactly'_in"
30.36 + (p as (Const ("EqSystem.occur'_exactly'_in",_)
30.37 + $ vs $ all $ t)) _ =
30.38 + if occur_exactly_in (isalist2list vs) (isalist2list all) t
30.39 + then Some ((term2str p) ^ " = True",
30.40 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
30.41 + else Some ((term2str p) ^ " = False",
30.42 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
30.43 + | eval_occur_exactly_in _ _ _ _ = None;
30.44 +
30.45 +calclist':=
30.46 +overwritel (!calclist',
30.47 + [("occur_exactly_in",
30.48 + ("EqSystem.occur'_exactly'_in",
30.49 + eval_occur_exactly_in "#eval_occur_exactly_in_"))
30.50 + ]);
30.51 +
30.52 +
30.53 +(** rewrite order 'ord_simplify_System' **)
30.54 +
30.55 +(* order wrt. several linear (i.e. without exponents) variables "c","c_2",..
30.56 + which leaves the monomials containing c, c_2,... at the end of an Integral
30.57 + and puts the c, c_2,... rightmost within a monomial.
30.58 +
30.59 + WN050906 this is a quick and dirty adaption of ord_make_polynomial_in,
30.60 + which was most adequate, because it uses size_of_term*)
30.61 +(**)
30.62 +local (*. for simplify_System .*)
30.63 +(**)
30.64 +open Term; (* for type order = EQUAL | LESS | GREATER *)
30.65 +
30.66 +fun pr_ord EQUAL = "EQUAL"
30.67 + | pr_ord LESS = "LESS"
30.68 + | pr_ord GREATER = "GREATER";
30.69 +
30.70 +fun dest_hd' (Const (a, T)) = (((a, 0), T), 0)
30.71 + | dest_hd' (Free (ccc, T)) =
30.72 + (case explode ccc of
30.73 + "c"::[] => ((("|||||||||||||||||||||", 0), T), 1)(*greatest string WN*)
30.74 + | "c"::"_"::_ => ((("|||||||||||||||||||||", 0), T), 1)
30.75 + | _ => (((ccc, 0), T), 1))
30.76 + | dest_hd' (Var v) = (v, 2)
30.77 + | dest_hd' (Bound i) = ((("", i), dummyT), 3)
30.78 + | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
30.79 +
30.80 +fun size_of_term' (Free (ccc, _)) =
30.81 + (case explode ccc of (*WN0510 hack for the bound variables*)
30.82 + "c"::[] => 1000
30.83 + | "c"::"_"::is => 1000 * ((str2int o implode) is)
30.84 + | _ => 1)
30.85 + | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
30.86 + | size_of_term' (f$t) = size_of_term' f + size_of_term' t
30.87 + | size_of_term' _ = 1;
30.88 +
30.89 +fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
30.90 + (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
30.91 + | term_ord' pr thy (t, u) =
30.92 + (if pr then
30.93 + let
30.94 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
30.95 + val _=writeln("t= f@ts= \""^
30.96 + ((string_of_cterm o cterm_of (sign_of thy)) f)^"\" @ \"["^
30.97 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
30.98 + val _=writeln("u= g@us= \""^
30.99 + ((string_of_cterm o cterm_of (sign_of thy)) g)^"\" @ \"["^
30.100 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
30.101 + val _=writeln("size_of_term(t,u)= ("^
30.102 + (string_of_int(size_of_term' t))^", "^
30.103 + (string_of_int(size_of_term' u))^")");
30.104 + val _=writeln("hd_ord(f,g) = "^((pr_ord o hd_ord)(f,g)));
30.105 + val _=writeln("terms_ord(ts,us) = "^
30.106 + ((pr_ord o terms_ord str false)(ts,us)));
30.107 + val _=writeln("-------");
30.108 + in () end
30.109 + else ();
30.110 + case int_ord (size_of_term' t, size_of_term' u) of
30.111 + EQUAL =>
30.112 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
30.113 + (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
30.114 + | ord => ord)
30.115 + end
30.116 + | ord => ord)
30.117 +and hd_ord (f, g) = (* ~ term.ML *)
30.118 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f,
30.119 + dest_hd' g)
30.120 +and terms_ord str pr (ts, us) =
30.121 + list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
30.122 +(**)
30.123 +in
30.124 +(**)
30.125 +(*WN0510 for preliminary use in eval_order_system, see case-study mat-eng.tex
30.126 +fun ord_simplify_System_rev (pr:bool) thy subst tu =
30.127 + (term_ord' pr thy (Library.swap tu) = LESS);*)
30.128 +
30.129 +(*for the rls's*)
30.130 +fun ord_simplify_System (pr:bool) thy subst tu =
30.131 + (term_ord' pr thy tu = LESS);
30.132 +(**)
30.133 +end;
30.134 +(**)
30.135 +rew_ord' := overwritel (!rew_ord',
30.136 +[("ord_simplify_System", ord_simplify_System false thy)
30.137 + ]);
30.138 +
30.139 +
30.140 +(** rulesets **)
30.141 +
30.142 +(*.adapted from 'order_add_mult_in' by just replacing the rew_ord.*)
30.143 +val order_add_mult_System =
30.144 + Rls{id = "order_add_mult_System", preconds = [],
30.145 + rew_ord = ("ord_simplify_System",
30.146 + ord_simplify_System false Integrate.thy),
30.147 + erls = e_rls,srls = Erls, calc = [],
30.148 + rules = [Thm ("real_mult_commute",num_str real_mult_commute),
30.149 + (* z * w = w * z *)
30.150 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
30.151 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
30.152 + Thm ("real_mult_assoc",num_str real_mult_assoc),
30.153 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
30.154 + Thm ("real_add_commute",num_str real_add_commute),
30.155 + (*z + w = w + z*)
30.156 + Thm ("real_add_left_commute",num_str real_add_left_commute),
30.157 + (*x + (y + z) = y + (x + z)*)
30.158 + Thm ("real_add_assoc",num_str real_add_assoc)
30.159 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
30.160 + ],
30.161 + scr = EmptyScr}:rls;
30.162 +
30.163 +(*.adapted from 'norm_Rational' by
30.164 + #1 using 'ord_simplify_System' in 'order_add_mult_System'
30.165 + #2 NOT using common_nominator_p .*)
30.166 +val norm_System_noadd_fractions =
30.167 + Rls {id = "norm_System_noadd_fractions", preconds = [],
30.168 + rew_ord = ("dummy_ord",dummy_ord),
30.169 + erls = norm_rat_erls, srls = Erls, calc = [],
30.170 + rules = [(*sequence given by operator precedence*)
30.171 + Rls_ discard_minus,
30.172 + Rls_ powers,
30.173 + Rls_ rat_mult_divide,
30.174 + Rls_ expand,
30.175 + Rls_ reduce_0_1_2,
30.176 + Rls_ (*order_add_mult #1*) order_add_mult_System,
30.177 + Rls_ collect_numerals,
30.178 + (*Rls_ add_fractions_p, #2*)
30.179 + Rls_ cancel_p
30.180 + ],
30.181 + scr = Script ((term_of o the o (parse thy))
30.182 + "empty_script")
30.183 + }:rls;
30.184 +(*.adapted from 'norm_Rational' by
30.185 + *1* using 'ord_simplify_System' in 'order_add_mult_System'.*)
30.186 +val norm_System =
30.187 + Rls {id = "norm_System", preconds = [],
30.188 + rew_ord = ("dummy_ord",dummy_ord),
30.189 + erls = norm_rat_erls, srls = Erls, calc = [],
30.190 + rules = [(*sequence given by operator precedence*)
30.191 + Rls_ discard_minus,
30.192 + Rls_ powers,
30.193 + Rls_ rat_mult_divide,
30.194 + Rls_ expand,
30.195 + Rls_ reduce_0_1_2,
30.196 + Rls_ (*order_add_mult *1*) order_add_mult_System,
30.197 + Rls_ collect_numerals,
30.198 + Rls_ add_fractions_p,
30.199 + Rls_ cancel_p
30.200 + ],
30.201 + scr = Script ((term_of o the o (parse thy))
30.202 + "empty_script")
30.203 + }:rls;
30.204 +
30.205 +(*.simplify an equational system BEFORE solving it such that parentheses are
30.206 + ( ((u0*v0)*w0) + ( ((u1*v1)*w1) * c + ... +((u4*v4)*w4) * c_4 ) )
30.207 +ATTENTION: works ONLY for bound variables c, c_1, c_2, c_3, c_4 :ATTENTION
30.208 + This is a copy from 'make_ratpoly_in' with respective reductions:
30.209 + *0* expand the term, ie. distribute * and / over +
30.210 + *1* ord_simplify_System instead of termlessI
30.211 + *2* no add_fractions_p (= common_nominator_p_rls !)
30.212 + *3* discard_parentheses only for (.*(.*.))
30.213 + analoguous to simplify_Integral .*)
30.214 +val simplify_System_parenthesized =
30.215 + Seq {id = "simplify_System_parenthesized", preconds = []:term list,
30.216 + rew_ord = ("dummy_ord", dummy_ord),
30.217 + erls = Atools_erls, srls = Erls, calc = [],
30.218 + rules = [Thm ("real_add_mult_distrib",num_str real_add_mult_distrib),
30.219 + (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
30.220 + Thm ("real_add_divide_distrib",num_str real_add_divide_distrib),
30.221 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
30.222 + (*^^^^^ *0* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
30.223 + Rls_ norm_Rational_noadd_fractions(**2**),
30.224 + Rls_ (*order_add_mult_in*) norm_System_noadd_fractions (**1**),
30.225 + Thm ("sym_real_mult_assoc", num_str (real_mult_assoc RS sym))
30.226 + (*Rls_ discard_parentheses *3**),
30.227 + Rls_ collect_bdv, (*from make_polynomial_in WN051031 welldone?*)
30.228 + Rls_ separate_bdv2,
30.229 + Calc ("HOL.divide" ,eval_cancel "#divide_")
30.230 + ],
30.231 + scr = EmptyScr}:rls;
30.232 +
30.233 +(*.simplify an equational system AFTER solving it;
30.234 + This is a copy of 'make_ratpoly_in' with the differences
30.235 + *1* ord_simplify_System instead of termlessI .*)
30.236 +(*TODO.WN051031 ^^^^^^^^^^ should be in EACH rls contained *)
30.237 +val simplify_System =
30.238 + Seq {id = "simplify_System", preconds = []:term list,
30.239 + rew_ord = ("dummy_ord", dummy_ord),
30.240 + erls = Atools_erls, srls = Erls, calc = [],
30.241 + rules = [Rls_ norm_Rational,
30.242 + Rls_ (*order_add_mult_in*) norm_System (**1**),
30.243 + Rls_ discard_parentheses,
30.244 + Rls_ collect_bdv, (*from make_polynomial_in WN051031 welldone?*)
30.245 + Rls_ separate_bdv2,
30.246 + Calc ("HOL.divide" ,eval_cancel "#divide_")
30.247 + ],
30.248 + scr = EmptyScr}:rls;
30.249 +(*
30.250 +val simplify_System =
30.251 + append_rls "simplify_System" simplify_System_parenthesized
30.252 + [Thm ("sym_real_add_assoc", num_str (real_add_assoc RS sym))];
30.253 +*)
30.254 +
30.255 +val isolate_bdvs =
30.256 + Rls {id="isolate_bdvs", preconds = [],
30.257 + rew_ord = ("e_rew_ord", e_rew_ord),
30.258 + erls = append_rls "erls_isolate_bdvs" e_rls
30.259 + [(Calc ("EqSystem.occur'_exactly'_in",
30.260 + eval_occur_exactly_in
30.261 + "#eval_occur_exactly_in_"))
30.262 + ],
30.263 + srls = Erls, calc = [],
30.264 + rules = [Thm ("commute_0_equality",
30.265 + num_str commute_0_equality),
30.266 + Thm ("separate_bdvs_add", num_str separate_bdvs_add),
30.267 + Thm ("separate_bdvs_mult", num_str separate_bdvs_mult)],
30.268 + scr = EmptyScr};
30.269 +val isolate_bdvs_4x4 =
30.270 + Rls {id="isolate_bdvs_4x4", preconds = [],
30.271 + rew_ord = ("e_rew_ord", e_rew_ord),
30.272 + erls = append_rls
30.273 + "erls_isolate_bdvs_4x4" e_rls
30.274 + [Calc ("EqSystem.occur'_exactly'_in",
30.275 + eval_occur_exactly_in "#eval_occur_exactly_in_"),
30.276 + Calc ("Atools.ident",eval_ident "#ident_"),
30.277 + Calc ("Atools.some'_occur'_in",
30.278 + eval_some_occur_in "#some_occur_in_"),
30.279 + Thm ("not_true",num_str not_true),
30.280 + Thm ("not_false",num_str not_false)
30.281 + ],
30.282 + srls = Erls, calc = [],
30.283 + rules = [Thm ("commute_0_equality",
30.284 + num_str commute_0_equality),
30.285 + Thm ("separate_bdvs0", num_str separate_bdvs0),
30.286 + Thm ("separate_bdvs_add1", num_str separate_bdvs_add1),
30.287 + Thm ("separate_bdvs_add1", num_str separate_bdvs_add2),
30.288 + Thm ("separate_bdvs_mult", num_str separate_bdvs_mult)],
30.289 + scr = EmptyScr};
30.290 +
30.291 +(*.order the equations in a system such, that a triangular system (if any)
30.292 + appears as [..c_4 = .., ..., ..., ..c_1 + ..c_2 + ..c_3 ..c_4 = ..].*)
30.293 +val order_system =
30.294 + Rls {id="order_system", preconds = [],
30.295 + rew_ord = ("ord_simplify_System",
30.296 + ord_simplify_System false thy),
30.297 + erls = Erls, srls = Erls, calc = [],
30.298 + rules = [Thm ("order_system_NxN", num_str order_system_NxN)
30.299 + ],
30.300 + scr = EmptyScr};
30.301 +
30.302 +val prls_triangular =
30.303 + Rls {id="prls_triangular", preconds = [],
30.304 + rew_ord = ("e_rew_ord", e_rew_ord),
30.305 + erls = Rls {id="erls_prls_triangular", preconds = [],
30.306 + rew_ord = ("e_rew_ord", e_rew_ord),
30.307 + erls = Erls, srls = Erls, calc = [],
30.308 + rules = [(*for precond nth_Cons_ ...*)
30.309 + Calc ("op <",eval_equ "#less_"),
30.310 + Calc ("op +", eval_binop "#add_")
30.311 + (*immediately repeated rewrite pushes
30.312 + '+' into precondition !*)
30.313 + ],
30.314 + scr = EmptyScr},
30.315 + srls = Erls, calc = [],
30.316 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
30.317 + Calc ("op +", eval_binop "#add_"),
30.318 + Thm ("nth_Nil_",num_str nth_Nil_),
30.319 + Thm ("tl_Cons",num_str tl_Cons),
30.320 + Thm ("tl_Nil",num_str tl_Nil),
30.321 + Calc ("EqSystem.occur'_exactly'_in",
30.322 + eval_occur_exactly_in
30.323 + "#eval_occur_exactly_in_")
30.324 + ],
30.325 + scr = EmptyScr};
30.326 +
30.327 +(*WN060914 quickly created for 4x4;
30.328 + more similarity to prls_triangular desirable*)
30.329 +val prls_triangular4 =
30.330 + Rls {id="prls_triangular4", preconds = [],
30.331 + rew_ord = ("e_rew_ord", e_rew_ord),
30.332 + erls = Rls {id="erls_prls_triangular4", preconds = [],
30.333 + rew_ord = ("e_rew_ord", e_rew_ord),
30.334 + erls = Erls, srls = Erls, calc = [],
30.335 + rules = [(*for precond nth_Cons_ ...*)
30.336 + Calc ("op <",eval_equ "#less_"),
30.337 + Calc ("op +", eval_binop "#add_")
30.338 + (*immediately repeated rewrite pushes
30.339 + '+' into precondition !*)
30.340 + ],
30.341 + scr = EmptyScr},
30.342 + srls = Erls, calc = [],
30.343 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
30.344 + Calc ("op +", eval_binop "#add_"),
30.345 + Thm ("nth_Nil_",num_str nth_Nil_),
30.346 + Thm ("tl_Cons",num_str tl_Cons),
30.347 + Thm ("tl_Nil",num_str tl_Nil),
30.348 + Calc ("EqSystem.occur'_exactly'_in",
30.349 + eval_occur_exactly_in
30.350 + "#eval_occur_exactly_in_")
30.351 + ],
30.352 + scr = EmptyScr};
30.353 +
30.354 +ruleset' :=
30.355 +overwritelthy thy
30.356 + (!ruleset',
30.357 +[("simplify_System_parenthesized", prep_rls simplify_System_parenthesized),
30.358 + ("simplify_System", prep_rls simplify_System),
30.359 + ("isolate_bdvs", prep_rls isolate_bdvs),
30.360 + ("isolate_bdvs_4x4", prep_rls isolate_bdvs_4x4),
30.361 + ("order_system", prep_rls order_system),
30.362 + ("order_add_mult_System", prep_rls order_add_mult_System),
30.363 + ("norm_System_noadd_fractions", prep_rls norm_System_noadd_fractions),
30.364 + ("norm_System", prep_rls norm_System)
30.365 + ]);
30.366 +
30.367 +
30.368 +(** problems **)
30.369 +
30.370 +store_pbt
30.371 + (prep_pbt EqSystem.thy "pbl_equsys" [] e_pblID
30.372 + (["system"],
30.373 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.374 + ("#Find" ,["solution ss___"](*___ is copy-named*))
30.375 + ],
30.376 + append_rls "e_rls" e_rls [(*for preds in where_*)],
30.377 + Some "solveSystem es_ vs_",
30.378 + []));
30.379 +store_pbt
30.380 + (prep_pbt EqSystem.thy "pbl_equsys_lin" [] e_pblID
30.381 + (["linear", "system"],
30.382 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.383 + (*TODO.WN050929 check linearity*)
30.384 + ("#Find" ,["solution ss___"])
30.385 + ],
30.386 + append_rls "e_rls" e_rls [(*for preds in where_*)],
30.387 + Some "solveSystem es_ vs_",
30.388 + []));
30.389 +store_pbt
30.390 + (prep_pbt EqSystem.thy "pbl_equsys_lin_2x2" [] e_pblID
30.391 + (["2x2", "linear", "system"],
30.392 + (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
30.393 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.394 + ("#Where" ,["length_ (es_:: bool list) = 2", "length_ vs_ = 2"]),
30.395 + ("#Find" ,["solution ss___"])
30.396 + ],
30.397 + append_rls "prls_2x2_linear_system" e_rls
30.398 + [Thm ("length_Cons_",num_str length_Cons_),
30.399 + Thm ("length_Nil_",num_str length_Nil_),
30.400 + Calc ("op +", eval_binop "#add_"),
30.401 + Calc ("op =",eval_equal "#equal_")
30.402 + ],
30.403 + Some "solveSystem es_ vs_",
30.404 + []));
30.405 +store_pbt
30.406 + (prep_pbt EqSystem.thy "pbl_equsys_lin_2x2_tri" [] e_pblID
30.407 + (["triangular", "2x2", "linear", "system"],
30.408 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.409 + ("#Where" ,
30.410 + ["(tl vs_) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))",
30.411 + " vs_ from_ vs_ occur_exactly_in (nth_ 2 (es_::bool list))"]),
30.412 + ("#Find" ,["solution ss___"])
30.413 + ],
30.414 + prls_triangular,
30.415 + Some "solveSystem es_ vs_",
30.416 + [["EqSystem","top_down_substitution","2x2"]]));
30.417 +store_pbt
30.418 + (prep_pbt EqSystem.thy "pbl_equsys_lin_2x2_norm" [] e_pblID
30.419 + (["normalize", "2x2", "linear", "system"],
30.420 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.421 + ("#Find" ,["solution ss___"])
30.422 + ],
30.423 + append_rls "e_rls" e_rls [(*for preds in where_*)],
30.424 + Some "solveSystem es_ vs_",
30.425 + [["EqSystem","normalize","2x2"]]));
30.426 +store_pbt
30.427 + (prep_pbt EqSystem.thy "pbl_equsys_lin_3x3" [] e_pblID
30.428 + (["3x3", "linear", "system"],
30.429 + (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
30.430 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.431 + ("#Where" ,["length_ (es_:: bool list) = 3", "length_ vs_ = 3"]),
30.432 + ("#Find" ,["solution ss___"])
30.433 + ],
30.434 + append_rls "prls_3x3_linear_system" e_rls
30.435 + [Thm ("length_Cons_",num_str length_Cons_),
30.436 + Thm ("length_Nil_",num_str length_Nil_),
30.437 + Calc ("op +", eval_binop "#add_"),
30.438 + Calc ("op =",eval_equal "#equal_")
30.439 + ],
30.440 + Some "solveSystem es_ vs_",
30.441 + []));
30.442 +store_pbt
30.443 + (prep_pbt EqSystem.thy "pbl_equsys_lin_4x4" [] e_pblID
30.444 + (["4x4", "linear", "system"],
30.445 + (*~~~~~~~~~~~~~~~~~~~~~~~~~*)
30.446 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.447 + ("#Where" ,["length_ (es_:: bool list) = 4", "length_ vs_ = 4"]),
30.448 + ("#Find" ,["solution ss___"])
30.449 + ],
30.450 + append_rls "prls_4x4_linear_system" e_rls
30.451 + [Thm ("length_Cons_",num_str length_Cons_),
30.452 + Thm ("length_Nil_",num_str length_Nil_),
30.453 + Calc ("op +", eval_binop "#add_"),
30.454 + Calc ("op =",eval_equal "#equal_")
30.455 + ],
30.456 + Some "solveSystem es_ vs_",
30.457 + []));
30.458 +store_pbt
30.459 + (prep_pbt EqSystem.thy "pbl_equsys_lin_4x4_tri" [] e_pblID
30.460 + (["triangular", "4x4", "linear", "system"],
30.461 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.462 + ("#Where" , (*accepts missing variables up to diagional form*)
30.463 + ["(nth_ 1 (vs_::real list)) occurs_in (nth_ 1 (es_::bool list))",
30.464 + "(nth_ 2 (vs_::real list)) occurs_in (nth_ 2 (es_::bool list))",
30.465 + "(nth_ 3 (vs_::real list)) occurs_in (nth_ 3 (es_::bool list))",
30.466 + "(nth_ 4 (vs_::real list)) occurs_in (nth_ 4 (es_::bool list))"
30.467 + ]),
30.468 + ("#Find" ,["solution ss___"])
30.469 + ],
30.470 + append_rls "prls_tri_4x4_lin_sys" prls_triangular
30.471 + [Calc ("Atools.occurs'_in",eval_occurs_in "")],
30.472 + Some "solveSystem es_ vs_",
30.473 + [["EqSystem","top_down_substitution","4x4"]]));
30.474 +
30.475 +store_pbt
30.476 + (prep_pbt EqSystem.thy "pbl_equsys_lin_4x4_norm" [] e_pblID
30.477 + (["normalize", "4x4", "linear", "system"],
30.478 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.479 + (*length_ is checked 1 level above*)
30.480 + ("#Find" ,["solution ss___"])
30.481 + ],
30.482 + append_rls "e_rls" e_rls [(*for preds in where_*)],
30.483 + Some "solveSystem es_ vs_",
30.484 + [["EqSystem","normalize","4x4"]]));
30.485 +
30.486 +
30.487 +(* show_ptyps();
30.488 + *)
30.489 +
30.490 +(** methods **)
30.491 +
30.492 +store_met
30.493 + (prep_met EqSystem.thy "met_eqsys" [] e_metID
30.494 + (["EqSystem"],
30.495 + [],
30.496 + {rew_ord'="tless_true", rls' = Erls, calc = [],
30.497 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
30.498 + "empty_script"
30.499 + ));
30.500 +store_met
30.501 + (prep_met EqSystem.thy "met_eqsys_topdown" [] e_metID
30.502 + (["EqSystem","top_down_substitution"],
30.503 + [],
30.504 + {rew_ord'="tless_true", rls' = Erls, calc = [],
30.505 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
30.506 + "empty_script"
30.507 + ));
30.508 +store_met
30.509 + (prep_met EqSystem.thy "met_eqsys_topdown_2x2" [] e_metID
30.510 + (["EqSystem","top_down_substitution","2x2"],
30.511 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.512 + ("#Where" ,
30.513 + ["(tl vs_) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))",
30.514 + " vs_ from_ vs_ occur_exactly_in (nth_ 2 (es_::bool list))"]),
30.515 + ("#Find" ,["solution ss___"])
30.516 + ],
30.517 + {rew_ord'="ord_simplify_System", rls' = Erls, calc = [],
30.518 + srls = append_rls "srls_top_down_2x2" e_rls
30.519 + [Thm ("hd_thm",num_str hd_thm),
30.520 + Thm ("tl_Cons",num_str tl_Cons),
30.521 + Thm ("tl_Nil",num_str tl_Nil)
30.522 + ],
30.523 + prls = prls_triangular, crls = Erls, nrls = Erls},
30.524 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
30.525 +\ (let e1__ = Take (hd es_); \
30.526 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.527 +\ isolate_bdvs False)) @@ \
30.528 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.529 +\ simplify_System False))) e1__; \
30.530 +\ e2__ = Take (hd (tl es_)); \
30.531 +\ e2__ = ((Substitute [e1__]) @@ \
30.532 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.533 +\ simplify_System_parenthesized False)) @@ \
30.534 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.535 +\ isolate_bdvs False)) @@ \
30.536 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.537 +\ simplify_System False))) e2__; \
30.538 +\ es__ = Take [e1__, e2__] \
30.539 +\ in (Try (Rewrite_Set order_system False)) es__)"
30.540 +(*---------------------------------------------------------------------------
30.541 + this script does NOT separate the equations as abolve,
30.542 + but it does not yet work due to preliminary script-interpreter,
30.543 + see eqsystem.sml 'script [EqSystem,top_down_substitution,2x2] Vers.2'
30.544 +
30.545 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
30.546 +\ (let es__ = Take es_; \
30.547 +\ e1__ = hd es__; \
30.548 +\ e2__ = hd (tl es__); \
30.549 +\ es__ = [e1__, Substitute [e1__] e2__] \
30.550 +\ in ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.551 +\ simplify_System_parenthesized False)) @@ \
30.552 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))] \
30.553 +\ isolate_bdvs False)) @@ \
30.554 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.555 +\ simplify_System False))) es__)"
30.556 +---------------------------------------------------------------------------*)
30.557 + ));
30.558 +store_met
30.559 + (prep_met EqSystem.thy "met_eqsys_norm" [] e_metID
30.560 + (["EqSystem","normalize"],
30.561 + [],
30.562 + {rew_ord'="tless_true", rls' = Erls, calc = [],
30.563 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
30.564 + "empty_script"
30.565 + ));
30.566 +store_met
30.567 + (prep_met EqSystem.thy "met_eqsys_norm_2x2" [] e_metID
30.568 + (["EqSystem","normalize","2x2"],
30.569 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.570 + ("#Find" ,["solution ss___"])],
30.571 + {rew_ord'="tless_true", rls' = Erls, calc = [],
30.572 + srls = append_rls "srls_normalize_2x2" e_rls
30.573 + [Thm ("hd_thm",num_str hd_thm),
30.574 + Thm ("tl_Cons",num_str tl_Cons),
30.575 + Thm ("tl_Nil",num_str tl_Nil)
30.576 + ],
30.577 + prls = Erls, crls = Erls, nrls = Erls},
30.578 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
30.579 +\ (let es__ = ((Try (Rewrite_Set norm_Rational False)) @@ \
30.580 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.581 +\ simplify_System_parenthesized False)) @@ \
30.582 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.583 +\ isolate_bdvs False)) @@ \
30.584 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
30.585 +\ simplify_System_parenthesized False)) @@ \
30.586 +\ (Try (Rewrite_Set order_system False))) es_ \
30.587 +\ in (SubProblem (EqSystem_,[linear,system],[no_met]) \
30.588 +\ [bool_list_ es__, real_list_ vs_]))"
30.589 + ));
30.590 +
30.591 +(*this is for nth_ only*)
30.592 +val srls = Rls {id="srls_normalize_4x4",
30.593 + preconds = [],
30.594 + rew_ord = ("termlessI",termlessI),
30.595 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
30.596 + [(*for asm in nth_Cons_ ...*)
30.597 + Calc ("op <",eval_equ "#less_"),
30.598 + (*2nd nth_Cons_ pushes n+-1 into asms*)
30.599 + Calc("op +", eval_binop "#add_")
30.600 + ],
30.601 + srls = Erls, calc = [],
30.602 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
30.603 + Calc("op +", eval_binop "#add_"),
30.604 + Thm ("nth_Nil_",num_str nth_Nil_)],
30.605 + scr = EmptyScr};
30.606 +store_met
30.607 + (prep_met EqSystem.thy "met_eqsys_norm_4x4" [] e_metID
30.608 + (["EqSystem","normalize","4x4"],
30.609 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.610 + ("#Find" ,["solution ss___"])],
30.611 + {rew_ord'="tless_true", rls' = Erls, calc = [],
30.612 + srls = append_rls "srls_normalize_4x4" srls
30.613 + [Thm ("hd_thm",num_str hd_thm),
30.614 + Thm ("tl_Cons",num_str tl_Cons),
30.615 + Thm ("tl_Nil",num_str tl_Nil)
30.616 + ],
30.617 + prls = Erls, crls = Erls, nrls = Erls},
30.618 +(*GOON met ["EqSystem","normalize","4x4"] @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
30.619 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
30.620 +\ (let es__ = \
30.621 +\ ((Try (Rewrite_Set norm_Rational False)) @@ \
30.622 +\ (Repeat (Rewrite commute_0_equality False)) @@ \
30.623 +\ (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), \
30.624 +\ (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] \
30.625 +\ simplify_System_parenthesized False)) @@ \
30.626 +\ (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), \
30.627 +\ (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] \
30.628 +\ isolate_bdvs_4x4 False)) @@ \
30.629 +\ (Try (Rewrite_Set_Inst [(bdv_1, nth_ 1 vs_),(bdv_2, nth_ 2 vs_ ), \
30.630 +\ (bdv_3, nth_ 3 vs_),(bdv_3, nth_ 4 vs_ )] \
30.631 +\ simplify_System_parenthesized False)) @@ \
30.632 +\ (Try (Rewrite_Set order_system False))) es_ \
30.633 +\ in (SubProblem (EqSystem_,[linear,system],[no_met]) \
30.634 +\ [bool_list_ es__, real_list_ vs_]))"
30.635 +));
30.636 +store_met
30.637 +(prep_met EqSystem.thy "met_eqsys_topdown_4x4" [] e_metID
30.638 + (["EqSystem","top_down_substitution","4x4"],
30.639 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
30.640 + ("#Where" , (*accepts missing variables up to diagonal form*)
30.641 + ["(nth_ 1 (vs_::real list)) occurs_in (nth_ 1 (es_::bool list))",
30.642 + "(nth_ 2 (vs_::real list)) occurs_in (nth_ 2 (es_::bool list))",
30.643 + "(nth_ 3 (vs_::real list)) occurs_in (nth_ 3 (es_::bool list))",
30.644 + "(nth_ 4 (vs_::real list)) occurs_in (nth_ 4 (es_::bool list))"
30.645 + ]),
30.646 + ("#Find" ,["solution ss___"])
30.647 + ],
30.648 + {rew_ord'="ord_simplify_System", rls' = Erls, calc = [],
30.649 + srls = append_rls "srls_top_down_4x4" srls [],
30.650 + prls = append_rls "prls_tri_4x4_lin_sys" prls_triangular
30.651 + [Calc ("Atools.occurs'_in",eval_occurs_in "")],
30.652 + crls = Erls, nrls = Erls},
30.653 +(*FIXXXXME.WN060916: this script works ONLY for exp 7.79 @@@@@@@@@@@@@@@@@@@@*)
30.654 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
30.655 +\ (let e1_ = nth_ 1 es_; \
30.656 +\ e2_ = Take (nth_ 2 es_); \
30.657 +\ e2_ = ((Substitute [e1_]) @@ \
30.658 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
30.659 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
30.660 +\ simplify_System_parenthesized False)) @@ \
30.661 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
30.662 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
30.663 +\ isolate_bdvs False)) @@ \
30.664 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
30.665 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
30.666 +\ norm_Rational False))) e2_ \
30.667 +\ in [e1_, e2_, nth_ 3 es_, nth_ 4 es_])"
30.668 +));
30.669 +
30.670 +(* show_mets();
30.671 + *)
30.672 +
30.673 +(*
30.674 +use"IsacKnowledge/EqSystem.ML";
30.675 +use"EqSystem.ML";
30.676 +*)
31.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
31.2 +++ b/src/Pure/isac/IsacKnowledge/EqSystem.thy Wed Jul 21 13:53:39 2010 +0200
31.3 @@ -0,0 +1,72 @@
31.4 +(* equational systems, minimal -- for use in Biegelinie
31.5 + author: Walther Neuper
31.6 + 050826,
31.7 + (c) due to copyright terms
31.8 +
31.9 +remove_thy"EqSystem";
31.10 +use_thy"IsacKnowledge/EqSystem";
31.11 +
31.12 +use_thy_only"IsacKnowledge/EqSystem";
31.13 +
31.14 +remove_thy"Typefix";
31.15 +use_thy"IsacKnowledge/Isac";
31.16 +*)
31.17 +
31.18 +EqSystem = Rational + Root +
31.19 +
31.20 +consts
31.21 +
31.22 + occur'_exactly'_in ::
31.23 + "[real list, real list, 'a] => bool" ("_ from'_ _ occur'_exactly'_in _")
31.24 +
31.25 + (*descriptions in the related problems*)
31.26 + solveForVars :: real list => toreall
31.27 + solution :: bool list => toreall
31.28 +
31.29 + (*the CAS-command, eg. "solveSystem [x+y=1,y=2] [x,y]"*)
31.30 + solveSystem :: "[bool list, real list] => bool list"
31.31 +
31.32 + (*Script-names*)
31.33 + SolveSystemScript :: "[bool list, real list, bool list] \
31.34 + \=> bool list"
31.35 + ("((Script SolveSystemScript (_ _ =))// (_))" 9)
31.36 +
31.37 +rules
31.38 +(*stated as axioms, todo: prove as theorems
31.39 + 'bdv' is a constant handled on the meta-level
31.40 + specifically as a 'bound variable' *)
31.41 +
31.42 + commute_0_equality "(0 = a) = (a = 0)"
31.43 +
31.44 + (*WN0510 see simliar rules 'isolate_' 'separate_' (by RL)
31.45 + [bdv_1,bdv_2,bdv_3,bdv_4] work also for 2 and 3 bdvs, ugly !*)
31.46 + separate_bdvs_add
31.47 + "[| [] from_ [bdv_1,bdv_2,bdv_3,bdv_4] occur_exactly_in a |]\
31.48 + \ ==> (a + b = c) = (b = c + -1*a)"
31.49 + separate_bdvs0
31.50 + "[| some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in b; Not (b=!=0) |]\
31.51 + \ ==> (a = b) = (a + -1*b = 0)"
31.52 + separate_bdvs_add1
31.53 + "[| some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in c |]\
31.54 + \ ==> (a = b + c) = (a + -1*c = b)"
31.55 + separate_bdvs_add2
31.56 + "[| Not (some_of [bdv_1,bdv_2,bdv_3,bdv_4] occur_in a) |]\
31.57 + \ ==> (a + b = c) = (b = -1*a + c)"
31.58 +
31.59 +
31.60 +
31.61 + separate_bdvs_mult
31.62 + "[| [] from_ [bdv_1,bdv_2,bdv_3,bdv_4] occur_exactly_in a; Not (a=!=0) |]\
31.63 + \ ==>(a * b = c) = (b = c / a)"
31.64 +
31.65 + (*requires rew_ord for termination, eg. ord_simplify_Integral;
31.66 + works for lists of any length, interestingly !?!*)
31.67 + order_system_NxN "[a,b] = [b,a]"
31.68 +
31.69 +(*
31.70 +remove_thy"EqSystem";
31.71 +use_thy_only"IsacKnowledge/EqSystem";
31.72 +use_thy"IsacKnowledge/EqSystem";
31.73 +use"IsacKnowledge/EqSystem.ML";
31.74 + *)
31.75 +end
31.76 \ No newline at end of file
32.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
32.2 +++ b/src/Pure/isac/IsacKnowledge/Equation.ML Wed Jul 21 13:53:39 2010 +0200
32.3 @@ -0,0 +1,85 @@
32.4 +(*.(c) by Richard Lang, 2003 .*)
32.5 +(* defines equation and univariate-equation
32.6 + created by: rlang
32.7 + date: 02.09
32.8 + changed by: rlang
32.9 + last change by: rlang
32.10 + date: 02.11.29
32.11 +*)
32.12 +
32.13 +(* use_thy_only"IsacKnowledge/Equation";
32.14 + use_thy"IsacKnowledge/Equation";
32.15 + use"IsacKnowledge/Equation.ML";
32.16 + use"Equation.ML";
32.17 + *)
32.18 +
32.19 +theory' := overwritel (!theory', [("Equation.thy",Equation.thy)]);
32.20 +
32.21 +val univariate_equation_prls =
32.22 + append_rls "univariate_equation_prls" e_rls
32.23 + [Calc ("Tools.matches",eval_matches "")];
32.24 +ruleset' :=
32.25 +overwritelthy thy (!ruleset',
32.26 + [("univariate_equation_prls",
32.27 + prep_rls univariate_equation_prls)]);
32.28 +
32.29 +
32.30 +store_pbt
32.31 + (prep_pbt Equation.thy "pbl_equ" [] e_pblID
32.32 + (["equation"],
32.33 + [("#Given" ,["equality e_","solveFor v_"]),
32.34 + ("#Where" ,["matches (?a = ?b) e_"]),
32.35 + ("#Find" ,["solutions v_i_"])
32.36 + ],
32.37 + append_rls "equation_prls" e_rls
32.38 + [Calc ("Tools.matches",eval_matches "")],
32.39 + Some "solve (e_::bool, v_)",
32.40 + []));
32.41 +
32.42 +store_pbt
32.43 + (prep_pbt Equation.thy "pbl_equ_univ" [] e_pblID
32.44 + (["univariate","equation"],
32.45 + [("#Given" ,["equality e_","solveFor v_"]),
32.46 + ("#Where" ,["matches (?a = ?b) e_"]),
32.47 + ("#Find" ,["solutions v_i_"])
32.48 + ],
32.49 + univariate_equation_prls,Some "solve (e_::bool, v_)",[]));
32.50 +
32.51 +
32.52 +(*.function for handling the cas-input "solve (x+1=2, x)":
32.53 + make a model which is already in ptree-internal format.*)
32.54 +(* val (h,argl) = strip_comb (str2term "solve (x+1=2, x)");
32.55 + val (h,argl) = strip_comb ((term_of o the o (parse thy))
32.56 + "solveTest (x+1=2, x)");
32.57 + *)
32.58 +fun argl2dtss [Const ("Pair", _) $ eq $ bdv] =
32.59 + [((term_of o the o (parse thy)) "equality", [eq]),
32.60 + ((term_of o the o (parse thy)) "solveFor", [bdv]),
32.61 + ((term_of o the o (parse thy)) "solutions",
32.62 + [(term_of o the o (parse thy)) "L"])
32.63 + ]
32.64 + | argl2dtss _ = raise error "Equation.ML: wrong argument for argl2dtss";
32.65 +
32.66 +castab :=
32.67 +overwritel (!castab,
32.68 + [((term_of o the o (parse thy)) "solveTest",
32.69 + (("Test.thy", ["univariate","equation","test"], ["no_met"]),
32.70 + argl2dtss)),
32.71 + ((term_of o the o (parse thy)) "solve",
32.72 + (("Isac.thy", ["univariate","equation"], ["no_met"]),
32.73 + argl2dtss))
32.74 + ]);
32.75 +
32.76 +
32.77 +
32.78 +store_met
32.79 + (prep_met Equation.thy "met_equ" [] e_metID
32.80 + (["Equation"],
32.81 + [],
32.82 + {rew_ord'="tless_true", rls'=Erls, calc = [],
32.83 + srls = e_rls,
32.84 + prls=e_rls,
32.85 + crls = Atools_erls, nrls = e_rls},
32.86 +"empty_script"
32.87 +));
32.88 +
33.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
33.2 +++ b/src/Pure/isac/IsacKnowledge/Equation.thy Wed Jul 21 13:53:39 2010 +0200
33.3 @@ -0,0 +1,29 @@
33.4 +(* equations and functions; functions NOT as lambda-terms
33.5 + author: Walther Neuper 2005, 2006
33.6 + (c) due to copyright terms
33.7 +
33.8 +remove_thy"Equation";
33.9 +use_thy"IsacKnowledge/Equation";
33.10 +use_thy_only"IsacKnowledge/Equation";
33.11 +
33.12 +remove_thy"Equation";
33.13 +use_thy"IsacKnowledge/Isac";
33.14 +*)
33.15 +
33.16 +Equation = Atools +
33.17 +
33.18 +consts
33.19 +
33.20 + (*descriptions in the related problems TODOshift here from Descriptions.thy*)
33.21 + substitution :: bool => una
33.22 +
33.23 + (*the CAS-commands*)
33.24 + solve :: "[bool * 'a] => bool list" (* solve (x+1=2, x) *)
33.25 + solveTest :: "[bool * 'a] => bool list" (* for test collection *)
33.26 +
33.27 + (*Script-names*)
33.28 + Function2Equality :: "[bool, bool, bool] \
33.29 + \=> bool"
33.30 + ("((Script Function2Equality (_ _ =))// (_))" 9)
33.31 +
33.32 +end
33.33 \ No newline at end of file
34.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
34.2 +++ b/src/Pure/isac/IsacKnowledge/Float.ML Wed Jul 21 13:53:39 2010 +0200
34.3 @@ -0,0 +1,95 @@
34.4 +(* use"Float.ML";
34.5 + *)
34.6 +
34.7 +theory' := overwritel (!theory', [("Float.thy",Float.thy)]);
34.8 +
34.9 +(*.used for calculating built in binary operations in Isabelle2002.
34.10 + integer numerals n are ((n,0),(0,0)) i.e. precision is (0,0)*)
34.11 +fun calc "op +" ((a, b), _:int * int) ((c, d), _:int * int) =
34.12 + if b < d
34.13 + then ((a + c * power 10 (d - b), b), (0, 0))(*FIXXXME precision*)
34.14 + else ((a * power 10 (b - d) + c, d), (0, 0))(*FIXXXME precision*)
34.15 + | calc "op -" ((a, 0), _) ((c, 0), _) = (*FIXXXME float + prec.*)
34.16 + ((a - c,0),(0,0))
34.17 + | calc "op *" ((a, b), _) ((c, d), _) = (*FIXXXME precision*)
34.18 + ((a * c, b + d), (0, 0))
34.19 + | calc "HOL.divide" ((a, 0), _) ((c, 0), _) = (*FIXXXME float + prec.*)
34.20 + ((a div c, 0), (0, 0))
34.21 + | calc "Atools.pow" ((a, b), _) ((c, d), _) = (*FIXXXME float + prec.*)
34.22 + ((power a c, 0), (0, 0))
34.23 + | calc op_ ((a, b), (p11, p12)) ((c, d), (p21, p22)) =
34.24 + raise error ("calc: not impl. for Float (("^
34.25 + (string_of_int a )^","^(string_of_int b )^"), ("^
34.26 + (string_of_int p11)^","^(string_of_int p12)^")) "^op_^" (("^
34.27 + (string_of_int c )^","^(string_of_int d )^"), ("^
34.28 + (string_of_int p21)^","^(string_of_int p22)^"))");
34.29 +(*> calc "op +" ((~1,0),(0,0)) ((2,0),(0,0));
34.30 +val it = ((1,0),(0,0))*)
34.31 +
34.32 +(*.toggle the sign of an integer numeral.*)
34.33 +fun minus ((a, b:int), _:int * int) = ((~1 * a, b), (0, 0));
34.34 +
34.35 +(*.convert internal floatingpoint prepresentation to int and float.*)
34.36 +fun term_of_float T ((val1, 0), ( 0, 0)) =
34.37 + term_of_num T val1
34.38 + | term_of_float T ((val1, val2), (precision1, precision2)) =
34.39 + let val pT = pairT T T
34.40 + in Const ("Float.Float", (pairT pT pT) --> T)
34.41 + $ (pairt (pairt (Free (str_of_int val1, T))
34.42 + (Free (str_of_int val2, T)))
34.43 + (pairt (Free (str_of_int precision1, T))
34.44 + (Free (str_of_int precision2, T))))
34.45 + end;
34.46 +(*> val t = str2term "Float ((1,2),(0,0))";
34.47 +> val Const ("Float.Float", fT) $ _ = t;
34.48 +> atomtyp fT;
34.49 +> val ffT = (pairT (pairT HOLogic.realT HOLogic.realT)
34.50 +> (pairT HOLogic.realT HOLogic.realT)) --> HOLogic.realT;
34.51 +> atomtyp ffT;
34.52 +> fT = ffT;
34.53 +val it = true : bool
34.54 +
34.55 +t = float_term_of_num HOLogic.realT ((1,2),(0,0));
34.56 +val it = true : bool*)
34.57 +
34.58 +(*.assoc. convert internal floatingpoint prepresentation to int and float.*)
34.59 +fun var_op_float v op_ optype ntyp ((v1, 0), (0, 0)) =
34.60 + var_op_num v op_ optype ntyp v1
34.61 + | var_op_float v op_ optype T ((v1, v2), (p1, p2)) =
34.62 + let val pT = pairT T T
34.63 + in Const (op_, optype) $ v $
34.64 + (Const ("Float.Float", (pairT pT pT) --> T)
34.65 + $ (pairt (pairt (Free (str_of_int v1, T))
34.66 + (Free (str_of_int v2, T)))
34.67 + (pairt (Free (str_of_int p1, T))
34.68 + (Free (str_of_int p2, T)))))
34.69 + end;
34.70 +(*> val t = str2term "a + b";
34.71 +> val Const ("op +", optype) $ _ $ _ = t;
34.72 +> val t = str2term "v + Float ((11,-1),(0,0))";val v = str2term "v";
34.73 +> t = var_op_float v "op +" optype HOLogic.realT ((11,~1),(0,0));
34.74 +val it = true : bool*)
34.75 +
34.76 +(*.assoc. convert internal floatingpoint prepresentation to int and float.*)
34.77 +fun float_op_var v op_ optype ntyp ((v1, 0), (0, 0)) =
34.78 + num_op_var v op_ optype ntyp v1
34.79 + | float_op_var v op_ optype T ((v1, v2), (p1, p2)) =
34.80 + let val pT = pairT T T
34.81 + in Const (op_,optype) $
34.82 + (Const ("Float.Float", (pairT pT pT) --> T)
34.83 + $ (pairt (pairt (Free (str_of_int v1, T))
34.84 + (Free (str_of_int v2, T)))
34.85 + (pairt (Free (str_of_int p1, T))
34.86 + (Free (str_of_int p2, T))))) $ v
34.87 + end;
34.88 +(*> val t = str2term "a + b";
34.89 +> val Const ("op +", optype) $ _ $ _ = t;
34.90 +> val t = str2term "Float ((11,-1),(0,0)) + v";val v = str2term "v";
34.91 +> t = float_op_var v "op +" optype HOLogic.realT ((11,~1),(0,0));
34.92 +val it = true : bool*)
34.93 +
34.94 +
34.95 +
34.96 +
34.97 +
34.98 +
35.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
35.2 +++ b/src/Pure/isac/IsacKnowledge/Float.thy Wed Jul 21 13:53:39 2010 +0200
35.3 @@ -0,0 +1,12 @@
35.4 +(* use_thy_only"IsacKonwledge/Float";
35.5 + use_thy_only"Float";
35.6 + use_thy"Float";
35.7 + *)
35.8 +
35.9 +Float = Typefix +
35.10 +
35.11 +consts
35.12 +
35.13 + Float :: "((real * real) * (real * real)) => real"
35.14 +
35.15 +end
35.16 \ No newline at end of file
36.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
36.2 +++ b/src/Pure/isac/IsacKnowledge/InsSort.ML Wed Jul 21 13:53:39 2010 +0200
36.3 @@ -0,0 +1,77 @@
36.4 +(* 6.8.02 change to Isabelle2002 caused error -- thy excluded !
36.5 +
36.6 +Proving equations for primrec function(s) "InsSort.foldr" ...
36.7 +GC #1.17.30.54.345.21479: (10 ms)
36.8 +*** Definition of InsSort.ins :: "['a::ord list, 'a::ord] => 'a::ord list"
36.9 +*** imposes additional sort constraints on the declared type of the constant
36.10 +*** The error(s) above occurred in definition "InsSort.ins.ins_list_def"
36.11 +*)
36.12 +
36.13 +(* tools for insertion sort
36.14 + use"IsacKnowledge/InsSort.ML";
36.15 +*)
36.16 +
36.17 +(** interface isabelle -- isac **)
36.18 +
36.19 +theory' := (!theory') @ [("InsSort.thy",InsSort.thy)];
36.20 +
36.21 +(** rule set **)
36.22 +
36.23 +val ins_sort = prep_rls(
36.24 + Rls{preconds = [], rew_ord = ("tless_true",tless_true),
36.25 + rules = [Thm ("foldr_base",(*num_str*) foldr_base),
36.26 + Thm ("foldr_rec",foldr_rec),
36.27 + Thm ("ins_base",ins_base),
36.28 + Thm ("ins_rec",ins_rec),
36.29 + Thm ("sort_def",sort_def),
36.30 +
36.31 + Calc ("op <",eval_equ "#less_"),
36.32 + Thm ("if_True", if_True),
36.33 + Thm ("if_False", if_False)
36.34 + ],
36.35 + scr = Script ((term_of o the o (parse thy))
36.36 + "empty_script")
36.37 + }:rls);
36.38 +
36.39 +(** problem type **)
36.40 +
36.41 +store_pbt
36.42 + (prep_pbt InsSort.thy
36.43 + (["functional"]:pblID,
36.44 + [("#Given" ,["unsorted u_"]),
36.45 + ("#Find" ,["sorted s_"])
36.46 + ],
36.47 + []));
36.48 +
36.49 +store_pbt
36.50 + (prep_pbt InsSort.thy
36.51 + (["inssort","functional"]:pblID,
36.52 + [("#Given" ,["unsorted u_"]),
36.53 + ("#Find" ,["sorted s_"])
36.54 + ],
36.55 + []));
36.56 +
36.57 +(** method,
36.58 + todo: implementation needs extra object-level lists **)
36.59 +
36.60 +store_met
36.61 + (prep_met Diff.thy
36.62 + (["InsSort"],
36.63 + [],
36.64 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
36.65 + crls = Atools_rls, nrls=norm_Rational
36.66 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
36.67 +store_met
36.68 + (prep_met InsSort.thy (*test-version for [#1,#3,#2] only: see *.sml*)
36.69 + (["InsSort""sort"]:metID,
36.70 + [("#Given" ,["unsorted u_"]),
36.71 + ("#Find" ,["sorted s_"])
36.72 + ],
36.73 + {rew_ord'="tless_true",rls'=eval_rls,calc = [], srls = e_rls, prls=e_rls,
36.74 + crls = eval_rls, nrls=norm_Rational(*,asm_rls=[],asm_thm=[]*)},
36.75 + "Script Sort (u_::'a list) = (Rewrite_Set ins_sort False) u_"
36.76 + ));
36.77 +
36.78 +ruleset' := overwritelthy thy (!ruleset',
36.79 + [(*("ins_sort",ins_sort) overwrites a Isa fun!!*)
36.80 + ]:(string * rls) list);
37.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
37.2 +++ b/src/Pure/isac/IsacKnowledge/InsSort.sml Wed Jul 21 13:53:39 2010 +0200
37.3 @@ -0,0 +1,395 @@
37.4 +
37.5 +
37.6 +(*-------------------------from InsSort.thy 8.3.01----------------------*)
37.7 +(*List.thy:
37.8 + foldl :: [['b,'a] => 'b, 'b, 'a list] => 'b
37.9 +primrec
37.10 + foldl_Nil "foldl f a [] = a"
37.11 + foldl_Cons "foldl f a (x#xs) = foldl f (f a x) xs"
37.12 +
37.13 +above in sml:
37.14 +fun foldr f [] a = a
37.15 + | foldr f (x::xs) a = foldr f xs (f a x);
37.16 +(*val fold = fn : ('a -> 'b -> 'a) -> 'b list -> 'a -> 'a*)
37.17 +fun ins [] a = [a]
37.18 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.19 +fun sort xs = foldr ins xs [];
37.20 +*)
37.21 +(*-------------------------from InsSort.thy 8.3.01----------------------*)
37.22 +
37.23 +
37.24 +(*-------------------------from InsSort.ML 8.3.01----------------------*)
37.25 +
37.26 +theory' := (!theory') @ [("InsSort.thy",InsSort.thy)];
37.27 +
37.28 +val ins_sort =
37.29 + Rls{preconds = [], rew_ord = ("tless_true",tless_true),
37.30 + rules = [Thm ("foldr_base",(*num_str*) foldr_base),
37.31 + Thm ("foldr_rec",foldr_rec),
37.32 + Thm ("ins_base",ins_base),
37.33 + Thm ("ins_rec",ins_rec),
37.34 + Thm ("sort_def",sort_def),
37.35 +
37.36 + Calc ("op <",eval_equ "#less_"),
37.37 + Thm ("if_True", if_True),
37.38 + Thm ("if_False", if_False)
37.39 + ],
37.40 + scr = Script ((term_of o the o (parse thy))
37.41 + "empty_script")
37.42 + }:rls;
37.43 +
37.44 +
37.45 +
37.46 +
37.47 +(*
37.48 +> get_pbt ["Script.thy","squareroot","univariate","equation"];
37.49 +> get_met ("Script.thy","max_on_interval_by_calculus");
37.50 +*)
37.51 +pbltypes:= (!pbltypes) @
37.52 +[
37.53 + prep_pbt InsSort.thy
37.54 + (["InsSort.thy","inssort"]:pblID,
37.55 + [("#Given" ,"unsorted u_"),
37.56 + ("#Find" ,"sorted s_")
37.57 + ])
37.58 +];
37.59 +
37.60 +methods:= (!methods) @
37.61 +[
37.62 +(*, -------17.6.00,
37.63 + (("InsSort.thy","inssort"):metID,
37.64 + {ppc = prep_met
37.65 + [("#Given" ,"unsorted u_"),
37.66 + ("#Find" ,"sorted s_")
37.67 + ],
37.68 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
37.69 + scr=Script (((inst_abs (assoc_thm "InsSort.thy"))
37.70 + o term_of o the o (parse thy)) (*for [#1,#3,#2] only*)
37.71 + "Script Ins_sort (u_::'a list) = \
37.72 + \ (let u_ = Rewrite sort_def False u_; \
37.73 + \ u_ = Rewrite foldr_rec False u_; \
37.74 + \ u_ = Rewrite ins_base False u_; \
37.75 + \ u_ = Rewrite foldr_rec False u_; \
37.76 + \ u_ = Rewrite ins_rec False u_; \
37.77 + \ u_ = Calculate le u_; \
37.78 + \ u_ = Rewrite if_True False u_; \
37.79 + \ u_ = Rewrite ins_base False u_; \
37.80 + \ u_ = Rewrite foldr_rec False u_; \
37.81 + \ u_ = Rewrite ins_rec False u_; \
37.82 + \ u_ = Calculate le u_; \
37.83 + \ u_ = Rewrite if_True False u_; \
37.84 + \ u_ = Rewrite ins_rec False u_; \
37.85 + \ u_ = Calculate le u_; \
37.86 + \ u_ = Rewrite if_False False u_; \
37.87 + \ u_ = Rewrite foldr_base False u_ \
37.88 + \ in u_)")
37.89 + } : met),
37.90 +
37.91 + (("InsSort.thy","sort"):metID,
37.92 + {ppc = prep_met
37.93 + [("#Given" ,"unsorted u_"),
37.94 + ("#Find" ,"sorted s_")
37.95 + ],
37.96 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
37.97 + scr=Script ((inst_abs o term_of o the o (parse thy))
37.98 + "Script Sort (u_::'a list) = \
37.99 + \ Rewrite_Set ins_sort False u_")
37.100 + } : met)
37.101 +------- *)
37.102 +(*,
37.103 +
37.104 + (("",""):metID,
37.105 + {ppc = prep_met
37.106 + [("#Given" ,""),
37.107 + ("#Find" ,""),
37.108 + ("#Relate","")
37.109 + ],
37.110 + rew_ord'="tless_true",rls'="eval_rls",asm_rls=[],asm_thm=[],
37.111 + scr=EmptyScr} : met),
37.112 +*)
37.113 +];
37.114 +(*-------------------------from InsSort.ML 8.3.01----------------------*)
37.115 +
37.116 +
37.117 +(*------------------------- nipkow ----------------------*)
37.118 +consts
37.119 + sort :: 'a list => 'a list
37.120 + ins :: ['a,'a list] => 'a list
37.121 +(*foldl :: [['a,'b] => 'a, 'a, 'b list] => 'a
37.122 +*)
37.123 +rules
37.124 + ins_base "ins e [] = [e]"
37.125 + ins_rec "ins e (l#ls) = (if l < e then l#(ins e ls) else e#(l#ls))"
37.126 +
37.127 +rules
37.128 + sort_def "sort ls = (foldl ins ls [])"
37.129 +end
37.130 +
37.131 +
37.132 +(** swp: ..L **)
37.133 +(* fn : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b *)
37.134 +fun foldL f [] e = e
37.135 + | foldL f (l::ls) e = f(l,foldL f ls e);
37.136 +
37.137 +(* fn : int * int list -> int list *)
37.138 +fun insL (e,[]) = [e]
37.139 + | insL (e,l::ls) = if l < e then l::(insL(e,ls)) else e::(l::ls);
37.140 +
37.141 +fun sortL ls = foldL insL ls [];
37.142 +
37.143 +sortL [2,3,1]; (* [1,2,3] *)
37.144 +
37.145 +
37.146 +(** swp, curried: ..LC **)
37.147 +(* fn : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b *)
37.148 +fun foldLC f [] e = e
37.149 + | foldLC f (x::xs) e = f x (foldLC f xs e);
37.150 +
37.151 +(* fn : int * int list -> int list *)
37.152 +fun insLC e [] = [e]
37.153 + | insLC e (l::ls) = if l < e then l::(insLC e ls) else e::(l::ls);
37.154 +
37.155 +fun sortLC ls = foldLC insLC ls [];
37.156 +
37.157 +sortLC [2,3,1]; (* [1,2,3] *)
37.158 +
37.159 +
37.160 +(** sml110: ..l **)
37.161 +(* fn : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b *)
37.162 +foldl;
37.163 +(* fn : ('a * 'a -> 'a) -> 'a * 'b list -> 'a : ANDERS !!!
37.164 +fun foldl f e [] = e
37.165 + | foldl f e (l::ls) = f e (foldl f (e,ls)); 0+...+0+0
37.166 +
37.167 +foldl op+ (0,[100,11,1]);
37.168 +val it = 0 : int ... GEHT NICHT !!! *)
37.169 +
37.170 +fun insl (e,[]) = [e]
37.171 + | insl (e,l::ls) = if l < e then l::(insl(e,ls)) else e::(l::ls);
37.172 +
37.173 +fun sortl ls = foldl insl [] ls;
37.174 +
37.175 +sortl [2,3,1]; (* [1,2,3] *)
37.176 +
37.177 +
37.178 +(** sml110, curried: ..lC **)
37.179 +(* fn : ('a -> 'a -> 'a) -> 'a -> 'b list -> 'a *)
37.180 +fun foldlC f e [] = e
37.181 + | foldlC f e (l::ls) = f e (foldlC f e ls);
37.182 +
37.183 +(* fn : int -> int list -> int list *)
37.184 +fun inslC e [] = [e]
37.185 + | inslC e (l::ls) = if l < e then l::(inslC e ls) else e::(l::ls);
37.186 +
37.187 +fun sortlC ls = foldlC inslC [] ls;
37.188 +
37.189 +sortlC [2,3,1];
37.190 +
37.191 +(*--- 15.6.00 ---*)
37.192 +
37.193 +
37.194 +fun Foldl f a [] = a
37.195 + | Foldl f a (x::xs) = Foldl f (f a x) xs;
37.196 +(*val Foldl = fn : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a*)
37.197 +
37.198 +fun add a b = a+b:int;
37.199 +
37.200 +Foldl add 0 [1,2,3];
37.201 +
37.202 +fun ins0 a [] = [a]
37.203 + | ins0 a (x::xs) = if x < a then x::(ins0 a xs) else a::(x::xs);
37.204 +(*val ins = fn : int -> int list -> int list*)
37.205 +
37.206 +fun ins [] a = [a]
37.207 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.208 +(*val ins = fn : int -> int list -> int list*)
37.209 +
37.210 +ins 3 [1,2,4];
37.211 +
37.212 +fun sort xs = Foldl ins0 xs [];
37.213 +(*operator domain: int -> int list -> int
37.214 + operand: int -> int list -> int list
37.215 + in expression:
37.216 + Foldl ins
37.217 + *)
37.218 +fun sort xs = Foldl ins xs [];
37.219 +
37.220 +
37.221 +
37.222 +(*--- 17.6.00 ---*)
37.223 +
37.224 +
37.225 +fun foldr f [] a = a
37.226 + | foldr f (x::xs) a = foldr f xs (f a x);
37.227 +(*val fold = fn : ('a -> 'b -> 'a) -> 'b list -> 'a -> 'a*)
37.228 +
37.229 +fun add a b = a+b:int;
37.230 +
37.231 +fold add [1,2,3] 0;
37.232 +
37.233 +fun ins [] a = [a]
37.234 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.235 +(*val ins = fn : int list -> int -> int list*)
37.236 +
37.237 +ins [1,2,4] 3;
37.238 +
37.239 +fun sort xs = foldr ins xs [];
37.240 +
37.241 +sort [3,1,4,2];
37.242 +
37.243 +
37.244 +
37.245 +(*--- 17.6.00 II ---*)
37.246 +
37.247 +fun foldl f a [] = a
37.248 + | foldl f a (x::xs) = foldl f (f a x) xs;
37.249 +
37.250 +fun ins [] a = [a]
37.251 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.252 +
37.253 +fun sort xs = foldl ins xs [];
37.254 +
37.255 +sort [3,1,4,2];
37.256 +(*val it = [3,1,4,2] : int list !?!?!?!?!?!?!?!?!?!?!?!?!?!?!?*)
37.257 +
37.258 +(*------------------------- nipkow ----------------------*)
37.259 +consts
37.260 + sort :: 'a list => 'a list
37.261 + ins :: ['a,'a list] => 'a list
37.262 +(*foldl :: [['a,'b] => 'a, 'a, 'b list] => 'a
37.263 +*)
37.264 +rules
37.265 + ins_base "ins e [] = [e]"
37.266 + ins_rec "ins e (l#ls) = (if l < e then l#(ins e ls) else e#(l#ls))"
37.267 +
37.268 +rules
37.269 + sort_def "sort ls = (foldl ins ls [])"
37.270 +end
37.271 +
37.272 +
37.273 +(** swp: ..L **)
37.274 +(* fn : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b *)
37.275 +fun foldL f [] e = e
37.276 + | foldL f (l::ls) e = f(l,foldL f ls e);
37.277 +
37.278 +(* fn : int * int list -> int list *)
37.279 +fun insL (e,[]) = [e]
37.280 + | insL (e,l::ls) = if l < e then l::(insL(e,ls)) else e::(l::ls);
37.281 +
37.282 +fun sortL ls = foldL insL ls [];
37.283 +
37.284 +sortL [2,3,1]; (* [1,2,3] *)
37.285 +
37.286 +
37.287 +(** swp, curried: ..LC **)
37.288 +(* fn : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b *)
37.289 +fun foldLC f [] e = e
37.290 + | foldLC f (x::xs) e = f x (foldLC f xs e);
37.291 +
37.292 +(* fn : int * int list -> int list *)
37.293 +fun insLC e [] = [e]
37.294 + | insLC e (l::ls) = if l < e then l::(insLC e ls) else e::(l::ls);
37.295 +
37.296 +fun sortLC ls = foldLC insLC ls [];
37.297 +
37.298 +sortLC [2,3,1]; (* [1,2,3] *)
37.299 +
37.300 +
37.301 +(** sml110: ..l **)
37.302 +(* fn : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b *)
37.303 +foldl;
37.304 +(* fn : ('a * 'a -> 'a) -> 'a * 'b list -> 'a : ANDERS !!!
37.305 +fun foldl f e [] = e
37.306 + | foldl f e (l::ls) = f e (foldl f (e,ls)); 0+...+0+0
37.307 +
37.308 +foldl op+ (0,[100,11,1]);
37.309 +val it = 0 : int ... GEHT NICHT !!! *)
37.310 +
37.311 +fun insl (e,[]) = [e]
37.312 + | insl (e,l::ls) = if l < e then l::(insl(e,ls)) else e::(l::ls);
37.313 +
37.314 +fun sortl ls = foldl insl [] ls;
37.315 +
37.316 +sortl [2,3,1]; (* [1,2,3] *)
37.317 +
37.318 +
37.319 +(** sml110, curried: ..lC **)
37.320 +(* fn : ('a -> 'a -> 'a) -> 'a -> 'b list -> 'a *)
37.321 +fun foldlC f e [] = e
37.322 + | foldlC f e (l::ls) = f e (foldlC f e ls);
37.323 +
37.324 +(* fn : int -> int list -> int list *)
37.325 +fun inslC e [] = [e]
37.326 + | inslC e (l::ls) = if l < e then l::(inslC e ls) else e::(l::ls);
37.327 +
37.328 +fun sortlC ls = foldlC inslC [] ls;
37.329 +
37.330 +sortlC [2,3,1];
37.331 +
37.332 +(*--- 15.6.00 ---*)
37.333 +
37.334 +
37.335 +fun Foldl f a [] = a
37.336 + | Foldl f a (x::xs) = Foldl f (f a x) xs;
37.337 +(*val Foldl = fn : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a*)
37.338 +
37.339 +fun add a b = a+b:int;
37.340 +
37.341 +Foldl add 0 [1,2,3];
37.342 +
37.343 +fun ins0 a [] = [a]
37.344 + | ins0 a (x::xs) = if x < a then x::(ins0 a xs) else a::(x::xs);
37.345 +(*val ins = fn : int -> int list -> int list*)
37.346 +
37.347 +fun ins [] a = [a]
37.348 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.349 +(*val ins = fn : int -> int list -> int list*)
37.350 +
37.351 +ins 3 [1,2,4];
37.352 +
37.353 +fun sort xs = Foldl ins0 xs [];
37.354 +(*operator domain: int -> int list -> int
37.355 + operand: int -> int list -> int list
37.356 + in expression:
37.357 + Foldl ins
37.358 + *)
37.359 +fun sort xs = Foldl ins xs [];
37.360 +
37.361 +
37.362 +
37.363 +(*--- 17.6.00 ---*)
37.364 +
37.365 +
37.366 +fun foldr f [] a = a
37.367 + | foldr f (x::xs) a = foldr f xs (f a x);
37.368 +(*val fold = fn : ('a -> 'b -> 'a) -> 'b list -> 'a -> 'a*)
37.369 +
37.370 +fun add a b = a+b:int;
37.371 +
37.372 +fold add [1,2,3] 0;
37.373 +
37.374 +fun ins [] a = [a]
37.375 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.376 +(*val ins = fn : int list -> int -> int list*)
37.377 +
37.378 +ins [1,2,4] 3;
37.379 +
37.380 +fun sort xs = foldr ins xs [];
37.381 +
37.382 +sort [3,1,4,2];
37.383 +
37.384 +
37.385 +
37.386 +(*--- 17.6.00 II ---*)
37.387 +
37.388 +fun foldl f a [] = a
37.389 + | foldl f a (x::xs) = foldl f (f a x) xs;
37.390 +
37.391 +fun ins [] a = [a]
37.392 + | ins (x::xs) a = if x < a then x::(ins xs a) else a::(x::xs);
37.393 +
37.394 +fun sort xs = foldl ins xs [];
37.395 +
37.396 +sort [3,1,4,2];
37.397 +(*val it = [3,1,4,2] : int list !?!?!?!?!?!?!?!?!?!?!?!?!?!?!?*)
37.398 +(*------------------------- nipkow ----------------------*)
38.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
38.2 +++ b/src/Pure/isac/IsacKnowledge/InsSort.thy Wed Jul 21 13:53:39 2010 +0200
38.3 @@ -0,0 +1,63 @@
38.4 +(* 6.8.02 change to Isabelle2002 caused error -- thy excluded !
38.5 +
38.6 +Proving equations for primrec function(s) "InsSort.foldr" ...
38.7 +GC #1.17.30.54.345.21479: (10 ms)
38.8 +*** Definition of InsSort.ins :: "['a::ord list, 'a::ord] => 'a::ord list"
38.9 +*** imposes additional sort constraints on the declared type of the constant
38.10 +*** The error(s) above occurred in definition "InsSort.ins.ins_list_def (@@@)"
38.11 +*)
38.12 +
38.13 +(* insertion sort, would need lists different from script-lists WN.11.00
38.14 +WN.7.5.03: -"- started with someList :: 'a list => unl, fun dest_list
38.15 +WN.8.5.03: error (@@@) remained with outcommenting foldr ?!?
38.16 +
38.17 + use_thy_only"IsacKnowledge/InsSort";
38.18 +
38.19 +*)
38.20 +
38.21 +InsSort = Script +
38.22 +
38.23 +consts
38.24 +
38.25 +(*foldr :: [['a,'b] => 'a, 'b list, 'a] => 'a
38.26 +WN.8.5.03: already defined in Isabelle2002 (instantiated by Typefix):
38.27 + "[[real, real] => real, real list, real] => real") : term
38.28 +
38.29 + val t = str2term "foldr";
38.30 +val t =
38.31 + Const
38.32 + ("List.foldr",
38.33 + "[[RealDef.real, RealDef.real] => RealDef.real, RealDef.real List.list,
38.34 + RealDef.real] => RealDef.real") : term
38.35 + *)
38.36 + ins :: ['a list,'a] => 'a list
38.37 + sort :: 'a list => 'a list
38.38 +
38.39 +(*descriptions, script-id*)
38.40 + unsorted :: 'a list => unl
38.41 + sorted :: 'a list => unl
38.42 +
38.43 +(*subproblem and script-name*)
38.44 + Ins'_sort :: "['a list, \
38.45 + \ 'a list] => 'a list"
38.46 + ("((Script Ins'_sort (_ =))// \
38.47 + \ (_))" 9)
38.48 + Sort :: "['a list, \
38.49 + \ 'a list] => 'a list"
38.50 + ("((Script Sort (_ =))// \
38.51 + \ (_))" 9)
38.52 +
38.53 +(*primrec
38.54 + foldr_base "foldr f [] a = a"
38.55 + foldr_rec "foldr f (x#xs) a = foldr f xs (f a x)"
38.56 +*)
38.57 +
38.58 +rules
38.59 +
38.60 +(*primrec .. outcommented analoguous to ListG.thy*)
38.61 + ins_base "ins [] a = [a]"
38.62 + ins_rec "ins (x#xs) a = (if x < a then x#(ins xs a) else a#(x#xs))"
38.63 +
38.64 + sort_def "sort ls = foldr ins ls []"
38.65 +
38.66 +end
39.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
39.2 +++ b/src/Pure/isac/IsacKnowledge/Integrate.ML Wed Jul 21 13:53:39 2010 +0200
39.3 @@ -0,0 +1,357 @@
39.4 +(* tools for integration over the reals
39.5 + author: Walther Neuper 050905, 08:51
39.6 + (c) due to copyright terms
39.7 +
39.8 +use"IsacKnowledge/Integrate.ML";
39.9 +use"Integrate.ML";
39.10 +
39.11 +remove_thy"Integrate";
39.12 +use_thy"IsacKnowledge/Isac";
39.13 +*)
39.14 +
39.15 +(** interface isabelle -- isac **)
39.16 +
39.17 +theory' := overwritel (!theory', [("Integrate.thy",Integrate.thy)]);
39.18 +
39.19 +(** eval functions **)
39.20 +
39.21 +val c = Free ("c", HOLogic.realT);
39.22 +(*.create a new unique variable 'c..' in a term; for use by Calc in a rls;
39.23 + an alternative to do this would be '(Try (Calculate new_c_) (new_c es__))'
39.24 + in the script; this will be possible if currying doesnt take the value
39.25 + from a variable, but the value '(new_c es__)' itself.*)
39.26 +fun new_c term =
39.27 + let fun selc var =
39.28 + case (explode o id_of) var of
39.29 + "c"::[] => true
39.30 + | "c"::"_"::is => (case (int_of_str o implode) is of
39.31 + Some _ => true
39.32 + | None => false)
39.33 + | _ => false;
39.34 + fun get_coeff c = case (explode o id_of) c of
39.35 + "c"::"_"::is => (the o int_of_str o implode) is
39.36 + | _ => 0;
39.37 + val cs = filter selc (vars term);
39.38 + in
39.39 + case cs of
39.40 + [] => c
39.41 + | [c] => Free ("c_2", HOLogic.realT)
39.42 + | cs =>
39.43 + let val max_coeff = maxl (map get_coeff cs)
39.44 + in Free ("c_"^string_of_int (max_coeff + 1), HOLogic.realT) end
39.45 + end;
39.46 +
39.47 +(*WN080222
39.48 +(*("new_c", ("Integrate.new'_c", eval_new_c "#new_c_"))*)
39.49 +fun eval_new_c _ _ (p as (Const ("Integrate.new'_c",_) $ t)) _ =
39.50 + Some ((term2str p) ^ " = " ^ term2str (new_c p),
39.51 + Trueprop $ (mk_equality (p, new_c p)))
39.52 + | eval_new_c _ _ _ _ = None;
39.53 +*)
39.54 +
39.55 +(*WN080222:*)
39.56 +(*("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "#add_new_c_"))
39.57 + add a new c to a term or a fun-equation;
39.58 + this is _not in_ the term, because only applied to _whole_ term*)
39.59 +fun eval_add_new_c (_:string) "Integrate.add'_new'_c" p (_:theory) =
39.60 + let val p' = case p of
39.61 + Const ("op =", T) $ lh $ rh =>
39.62 + Const ("op =", T) $ lh $ mk_add rh (new_c rh)
39.63 + | p => mk_add p (new_c p)
39.64 + in Some ((term2str p) ^ " = " ^ term2str p',
39.65 + Trueprop $ (mk_equality (p, p')))
39.66 + end
39.67 + | eval_add_new_c _ _ _ _ = None;
39.68 +
39.69 +
39.70 +(*("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_x_"))*)
39.71 +fun eval_is_f_x _ _(p as (Const ("Integrate.is'_f'_x", _)
39.72 + $ arg)) _ =
39.73 + if is_f_x arg
39.74 + then Some ((term2str p) ^ " = True",
39.75 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
39.76 + else Some ((term2str p) ^ " = False",
39.77 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
39.78 + | eval_is_f_x _ _ _ _ = None;
39.79 +
39.80 +calclist':= overwritel (!calclist',
39.81 + [(*("new_c", ("Integrate.new'_c", eval_new_c "new_c_")),*)
39.82 + ("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "add_new_c_")),
39.83 + ("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_idextifier_"))
39.84 + ]);
39.85 +
39.86 +
39.87 +(** rulesets **)
39.88 +
39.89 +(*.rulesets for integration.*)
39.90 +val integration_rules =
39.91 + Rls {id="integration_rules", preconds = [],
39.92 + rew_ord = ("termlessI",termlessI),
39.93 + erls = Rls {id="conditions_in_integration_rules",
39.94 + preconds = [],
39.95 + rew_ord = ("termlessI",termlessI),
39.96 + erls = Erls,
39.97 + srls = Erls, calc = [],
39.98 + rules = [(*for rewriting conditions in Thm's*)
39.99 + Calc ("Atools.occurs'_in",
39.100 + eval_occurs_in "#occurs_in_"),
39.101 + Thm ("not_true",num_str not_true),
39.102 + Thm ("not_false",not_false)
39.103 + ],
39.104 + scr = EmptyScr},
39.105 + srls = Erls, calc = [],
39.106 + rules = [
39.107 + Thm ("integral_const",num_str integral_const),
39.108 + Thm ("integral_var",num_str integral_var),
39.109 + Thm ("integral_add",num_str integral_add),
39.110 + Thm ("integral_mult",num_str integral_mult),
39.111 + Thm ("integral_pow",num_str integral_pow),
39.112 + Calc ("op +", eval_binop "#add_")(*for n+1*)
39.113 + ],
39.114 + scr = EmptyScr};
39.115 +val add_new_c =
39.116 + Seq {id="add_new_c", preconds = [],
39.117 + rew_ord = ("termlessI",termlessI),
39.118 + erls = Rls {id="conditions_in_add_new_c",
39.119 + preconds = [],
39.120 + rew_ord = ("termlessI",termlessI),
39.121 + erls = Erls,
39.122 + srls = Erls, calc = [],
39.123 + rules = [Calc ("Tools.matches", eval_matches""),
39.124 + Calc ("Integrate.is'_f'_x",
39.125 + eval_is_f_x "is_f_x_"),
39.126 + Thm ("not_true",num_str not_true),
39.127 + Thm ("not_false",num_str not_false)
39.128 + ],
39.129 + scr = EmptyScr},
39.130 + srls = Erls, calc = [],
39.131 + rules = [ (*Thm ("call_for_new_c", num_str call_for_new_c),*)
39.132 + Cal1 ("Integrate.add'_new'_c", eval_add_new_c "new_c_")
39.133 + ],
39.134 + scr = EmptyScr};
39.135 +
39.136 +(*.rulesets for simplifying Integrals.*)
39.137 +
39.138 +(*.for simplify_Integral adapted from 'norm_Rational_rls'.*)
39.139 +val norm_Rational_rls_noadd_fractions =
39.140 +Rls {id = "norm_Rational_rls_noadd_fractions", preconds = [],
39.141 + rew_ord = ("dummy_ord",dummy_ord),
39.142 + erls = norm_rat_erls, srls = Erls, calc = [],
39.143 + rules = [(*Rls_ common_nominator_p_rls,!!!*)
39.144 + Rls_ (*rat_mult_div_pow original corrected WN051028*)
39.145 + (Rls {id = "rat_mult_div_pow", preconds = [],
39.146 + rew_ord = ("dummy_ord",dummy_ord),
39.147 + erls = (*FIXME.WN051028 e_rls,*)
39.148 + append_rls "e_rls-is_polyexp" e_rls
39.149 + [Calc ("Poly.is'_polyexp",
39.150 + eval_is_polyexp "")],
39.151 + srls = Erls, calc = [],
39.152 + rules = [Thm ("rat_mult",num_str rat_mult),
39.153 + (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
39.154 + Thm ("rat_mult_poly_l",num_str rat_mult_poly_l),
39.155 + (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
39.156 + Thm ("rat_mult_poly_r",num_str rat_mult_poly_r),
39.157 + (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
39.158 +
39.159 + Thm ("real_divide_divide1_mg", real_divide_divide1_mg),
39.160 + (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
39.161 + Thm ("real_divide_divide1_eq", real_divide_divide1_eq),
39.162 + (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
39.163 + Thm ("real_divide_divide2_eq", real_divide_divide2_eq),
39.164 + (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
39.165 + Calc ("HOL.divide" ,eval_cancel "#divide_"),
39.166 +
39.167 + Thm ("rat_power", num_str rat_power)
39.168 + (*"(?a / ?b) ^^^ ?n = ?a ^^^ ?n / ?b ^^^ ?n"*)
39.169 + ],
39.170 + scr = Script ((term_of o the o (parse thy)) "empty_script")
39.171 + }),
39.172 + Rls_ make_rat_poly_with_parentheses,
39.173 + Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
39.174 + Rls_ rat_reduce_1
39.175 + ],
39.176 + scr = Script ((term_of o the o (parse thy)) "empty_script")
39.177 + }:rls;
39.178 +
39.179 +(*.for simplify_Integral adapted from 'norm_Rational'.*)
39.180 +val norm_Rational_noadd_fractions =
39.181 + Seq {id = "norm_Rational_noadd_fractions", preconds = [],
39.182 + rew_ord = ("dummy_ord",dummy_ord),
39.183 + erls = norm_rat_erls, srls = Erls, calc = [],
39.184 + rules = [Rls_ discard_minus_,
39.185 + Rls_ rat_mult_poly,(* removes double fractions like a/b/c *)
39.186 + Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
39.187 + Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
39.188 + Rls_ norm_Rational_rls_noadd_fractions,(* the main rls (#) *)
39.189 + Rls_ discard_parentheses_ (* mult only *)
39.190 + ],
39.191 + scr = Script ((term_of o the o (parse thy)) "empty_script")
39.192 + }:rls;
39.193 +
39.194 +(*.simplify terms before and after Integration such that
39.195 + ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
39.196 + common denominator as done by norm_Rational or make_ratpoly_in.
39.197 + This is a copy from 'make_ratpoly_in' with respective reduction of rules and
39.198 + *1* expand the term, ie. distribute * and / over +
39.199 +.*)
39.200 +val separate_bdv2 =
39.201 + append_rls "separate_bdv2"
39.202 + collect_bdv
39.203 + [Thm ("separate_bdv", num_str separate_bdv),
39.204 + (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
39.205 + Thm ("separate_bdv_n", num_str separate_bdv_n),
39.206 + Thm ("separate_1_bdv", num_str separate_1_bdv),
39.207 + (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
39.208 + Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)(*,
39.209 + (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
39.210 + *****Thm ("real_add_divide_distrib",
39.211 + *****num_str real_add_divide_distrib)
39.212 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)----------*)
39.213 + ];
39.214 +val simplify_Integral =
39.215 + Seq {id = "simplify_Integral", preconds = []:term list,
39.216 + rew_ord = ("dummy_ord", dummy_ord),
39.217 + erls = Atools_erls, srls = Erls,
39.218 + calc = [], (*asm_thm = [],*)
39.219 + rules = [Thm ("real_add_mult_distrib",num_str real_add_mult_distrib),
39.220 + (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
39.221 + Thm ("real_add_divide_distrib",num_str real_add_divide_distrib),
39.222 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
39.223 + (*^^^^^ *1* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
39.224 + Rls_ norm_Rational_noadd_fractions,
39.225 + Rls_ order_add_mult_in,
39.226 + Rls_ discard_parentheses,
39.227 + (*Rls_ collect_bdv, from make_polynomial_in*)
39.228 + Rls_ separate_bdv2,
39.229 + Calc ("HOL.divide" ,eval_cancel "#divide_")
39.230 + ],
39.231 + scr = EmptyScr}:rls;
39.232 +
39.233 +
39.234 +(*simplify terms before and after Integration such that
39.235 + ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
39.236 + common denominator as done by norm_Rational or make_ratpoly_in.
39.237 + This is a copy from 'make_polynomial_in' with insertions from
39.238 + 'make_ratpoly_in'
39.239 +THIS IS KEPT FOR COMPARISON ............................................
39.240 +* val simplify_Integral = prep_rls(
39.241 +* Seq {id = "", preconds = []:term list,
39.242 +* rew_ord = ("dummy_ord", dummy_ord),
39.243 +* erls = Atools_erls, srls = Erls,
39.244 +* calc = [], (*asm_thm = [],*)
39.245 +* rules = [Rls_ expand_poly,
39.246 +* Rls_ order_add_mult_in,
39.247 +* Rls_ simplify_power,
39.248 +* Rls_ collect_numerals,
39.249 +* Rls_ reduce_012,
39.250 +* Thm ("realpow_oneI",num_str realpow_oneI),
39.251 +* Rls_ discard_parentheses,
39.252 +* Rls_ collect_bdv,
39.253 +* (*below inserted from 'make_ratpoly_in'*)
39.254 +* Rls_ (append_rls "separate_bdv"
39.255 +* collect_bdv
39.256 +* [Thm ("separate_bdv", num_str separate_bdv),
39.257 +* (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
39.258 +* Thm ("separate_bdv_n", num_str separate_bdv_n),
39.259 +* Thm ("separate_1_bdv", num_str separate_1_bdv),
39.260 +* (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
39.261 +* Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)(*,
39.262 +* (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
39.263 +* Thm ("real_add_divide_distrib",
39.264 +* num_str real_add_divide_distrib)
39.265 +* (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)*)
39.266 +* ]),
39.267 +* Calc ("HOL.divide" ,eval_cancel "#divide_")
39.268 +* ],
39.269 +* scr = EmptyScr
39.270 +* }:rls);
39.271 +.......................................................................*)
39.272 +
39.273 +val integration =
39.274 + Seq {id="integration", preconds = [],
39.275 + rew_ord = ("termlessI",termlessI),
39.276 + erls = Rls {id="conditions_in_integration",
39.277 + preconds = [],
39.278 + rew_ord = ("termlessI",termlessI),
39.279 + erls = Erls,
39.280 + srls = Erls, calc = [],
39.281 + rules = [],
39.282 + scr = EmptyScr},
39.283 + srls = Erls, calc = [],
39.284 + rules = [ Rls_ integration_rules,
39.285 + Rls_ add_new_c,
39.286 + Rls_ simplify_Integral
39.287 + ],
39.288 + scr = EmptyScr};
39.289 +ruleset' :=
39.290 +overwritelthy thy (!ruleset',
39.291 + [("integration_rules", prep_rls integration_rules),
39.292 + ("add_new_c", prep_rls add_new_c),
39.293 + ("simplify_Integral", prep_rls simplify_Integral),
39.294 + ("integration", prep_rls integration),
39.295 + ("separate_bdv2", separate_bdv2),
39.296 + ("norm_Rational_noadd_fractions", norm_Rational_noadd_fractions),
39.297 + ("norm_Rational_rls_noadd_fractions",
39.298 + norm_Rational_rls_noadd_fractions)
39.299 + ]);
39.300 +
39.301 +(** problems **)
39.302 +
39.303 +store_pbt
39.304 + (prep_pbt Integrate.thy "pbl_fun_integ" [] e_pblID
39.305 + (["integrate","function"],
39.306 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
39.307 + ("#Find" ,["antiDerivative F_"])
39.308 + ],
39.309 + append_rls "e_rls" e_rls [(*for preds in where_*)],
39.310 + Some "Integrate (f_, v_)",
39.311 + [["diff","integration"]]));
39.312 +
39.313 +(*here "named" is used differently from Differentiation"*)
39.314 +store_pbt
39.315 + (prep_pbt Integrate.thy "pbl_fun_integ_nam" [] e_pblID
39.316 + (["named","integrate","function"],
39.317 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
39.318 + ("#Find" ,["antiDerivativeName F_"])
39.319 + ],
39.320 + append_rls "e_rls" e_rls [(*for preds in where_*)],
39.321 + Some "Integrate (f_, v_)",
39.322 + [["diff","integration","named"]]));
39.323 +
39.324 +(** methods **)
39.325 +
39.326 +store_met
39.327 + (prep_met Integrate.thy "met_diffint" [] e_metID
39.328 + (["diff","integration"],
39.329 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
39.330 + ("#Find" ,["antiDerivative F_"])
39.331 + ],
39.332 + {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
39.333 + srls = e_rls,
39.334 + prls=e_rls,
39.335 + crls = Atools_erls, nrls = e_rls},
39.336 +"Script IntegrationScript (f_::real) (v_::real) = \
39.337 +\ (let t_ = Take (Integral f_ D v_) \
39.338 +\ in (Rewrite_Set_Inst [(bdv,v_)] integration False) (t_::real))"
39.339 +));
39.340 +
39.341 +store_met
39.342 + (prep_met Integrate.thy "met_diffint_named" [] e_metID
39.343 + (["diff","integration","named"],
39.344 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
39.345 + ("#Find" ,["antiDerivativeName F_"])
39.346 + ],
39.347 + {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
39.348 + srls = e_rls,
39.349 + prls=e_rls,
39.350 + crls = Atools_erls, nrls = e_rls},
39.351 +"Script NamedIntegrationScript (f_::real) (v_::real) (F_::real=>real) = \
39.352 +\ (let t_ = Take (F_ v_ = Integral f_ D v_) \
39.353 +\ in ((Try (Rewrite_Set_Inst [(bdv,v_)] simplify_Integral False)) @@\
39.354 +\ (Rewrite_Set_Inst [(bdv,v_)] integration False)) t_)"
39.355 +(*
39.356 +"Script NamedIntegrationScript (f_::real) (v_::real) (F_::real=>real) = \
39.357 +\ (let t_ = Take (F_ v_ = Integral f_ D v_) \
39.358 +\ in (Rewrite_Set_Inst [(bdv,v_)] integration False) t_)"
39.359 +*)
39.360 + ));
40.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
40.2 +++ b/src/Pure/isac/IsacKnowledge/Integrate.thy Wed Jul 21 13:53:39 2010 +0200
40.3 @@ -0,0 +1,54 @@
40.4 +(* integration over the reals
40.5 + author: Walther Neuper
40.6 + 050814, 08:51
40.7 + (c) due to copyright terms
40.8 +
40.9 +remove_thy"Integrate";
40.10 +use_thy"IsacKnowledge/Integrate";
40.11 +use_thy_only"IsacKnowledge/Integrate";
40.12 +
40.13 +remove_thy"Typefix";
40.14 +use_thy"IsacKnowledge/Isac";
40.15 +*)
40.16 +
40.17 +Integrate = Diff +
40.18 +
40.19 +consts
40.20 +
40.21 + Integral :: "[real, real]=> real" ("Integral _ D _" 91)
40.22 +(*new'_c :: "real => real" ("new'_c _" 66)*)
40.23 + is'_f'_x :: "real => bool" ("_ is'_f'_x" 10)
40.24 +
40.25 + (*descriptions in the related problems*)
40.26 + integrateBy :: real => una
40.27 + antiDerivative :: real => una
40.28 + antiDerivativeName :: (real => real) => una
40.29 +
40.30 + (*the CAS-command, eg. "Integrate (2*x^^^3, x)"*)
40.31 + Integrate :: "[real * real] => real"
40.32 +
40.33 + (*Script-names*)
40.34 + IntegrationScript :: "[real,real, real] => real"
40.35 + ("((Script IntegrationScript (_ _ =))// (_))" 9)
40.36 + NamedIntegrationScript :: "[real,real, real=>real, bool] => bool"
40.37 + ("((Script NamedIntegrationScript (_ _ _=))// (_))" 9)
40.38 +
40.39 +rules
40.40 +(*stated as axioms, todo: prove as theorems
40.41 + 'bdv' is a constant handled on the meta-level
40.42 + specifically as a 'bound variable' *)
40.43 +
40.44 + integral_const "Not (bdv occurs_in u) ==> Integral u D bdv = u * bdv"
40.45 + integral_var "Integral bdv D bdv = bdv ^^^ 2 / 2"
40.46 +
40.47 + integral_add "Integral (u + v) D bdv = \
40.48 + \(Integral u D bdv) + (Integral v D bdv)"
40.49 + integral_mult "[| Not (bdv occurs_in u); bdv occurs_in v |] ==> \
40.50 + \Integral (u * v) D bdv = u * (Integral v D bdv)"
40.51 +(*WN080222: this goes into sub-terms, too ...
40.52 + call_for_new_c "[| Not (matches (u + new_c v) a); Not (a is_f_x) |] ==> \
40.53 + \a = a + new_c a"
40.54 +*)
40.55 + integral_pow "Integral bdv ^^^ n D bdv = bdv ^^^ (n+1) / (n + 1)"
40.56 +
40.57 +end
40.58 \ No newline at end of file
41.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
41.2 +++ b/src/Pure/isac/IsacKnowledge/Isac.ML Wed Jul 21 13:53:39 2010 +0200
41.3 @@ -0,0 +1,37 @@
41.4 +(* collect all knowledge defined in theories so far
41.5 + author: Walther Neuper 0003
41.6 + (c) isac-team
41.7 +
41.8 +use"IsacKnowledge/Isac.ML";
41.9 +use"Isac.ML";
41.10 + *)
41.11 +
41.12 +
41.13 +theory' := overwritel (!theory', [("Isac.thy",Isac.thy)]);
41.14 +
41.15 +
41.16 +(**.set up a list for getting guh + theID for a thm (defined in isabelle).**)
41.17 +
41.18 +(*.get all theorems used by isac and defined in isabelle.*)
41.19 +local
41.20 + val isacrlsthms = ((gen_distinct eq_thmI) o (map rep_thm_G') o flat o
41.21 + (map (thms_of_rls o #2 o #2))) (!ruleset');
41.22 + val isacthms = (flat o (map (thms_of o #2))) (!theory');
41.23 +in
41.24 + val rlsthmsNOTisac = gen_diff eq_thmI (isacrlsthms, isacthms);
41.25 +end;
41.26 +
41.27 +(*.set up the list using 'val first_isac_thy' (see ListG.ML).*)
41.28 +isab_thm_thy := make_isab rlsthmsNOTisac
41.29 + ((#ancestors o rep_theory) first_isac_thy);
41.30 +
41.31 +
41.32 +(*.create the hierarchy of theory elements from IsacKnowledge
41.33 + including thms from Isabelle used in rls;
41.34 + elements store_*d in any *.ML are not overwritten.*)
41.35 +
41.36 +thehier := the_hier (!thehier) (collect_thydata ());
41.37 +writeln("----------------------------------\n\
41.38 + \*** insert: not found ... IS OK : \n\
41.39 + \comes from fill_parents \n\
41.40 + \----------------------------------\n");
42.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
42.2 +++ b/src/Pure/isac/IsacKnowledge/Isac.thy Wed Jul 21 13:53:39 2010 +0200
42.3 @@ -0,0 +1,21 @@
42.4 +(* theory collecting all knowledge defined so far
42.5 + WN.11.00
42.6 + *)
42.7 +
42.8 +Isac = PolyMinus + PolyEq + Vect + DiffApp + Biegelinie + AlgEin
42.9 + + (*InsSort +*) Test +
42.10 +
42.11 +end
42.12 +
42.13 +(* dependencies alternative to those defined by R.Lang during his thesis:
42.14 +
42.15 + Poly Root
42.16 + |\__________ |
42.17 + | \ |
42.18 + | Rational |
42.19 + | | |
42.20 + PolyEq RatEq RootEq
42.21 + \ / \ /
42.22 + \ / \ /
42.23 + RatPolyEq RatRootEq etc.
42.24 +*)
43.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
43.2 +++ b/src/Pure/isac/IsacKnowledge/LinEq.ML Wed Jul 21 13:53:39 2010 +0200
43.3 @@ -0,0 +1,171 @@
43.4 +(*. (c) by Richard Lang, 2003 .*)
43.5 +(* collecting all knowledge for LinearEquations
43.6 + created by: rlang
43.7 + date: 02.10
43.8 + changed by: rlang
43.9 + last change by: rlang
43.10 + date: 02.11.04
43.11 +*)
43.12 +
43.13 +(* remove_thy"LinEq";
43.14 + use_thy"IsacKnowledge/Isac";
43.15 +
43.16 + use_thy"IsacKnowledge/LinEq";
43.17 +
43.18 + use"ROOT.ML";
43.19 + cd"knowledge";
43.20 +*)
43.21 +
43.22 +"******* LinEq.ML begin *******";
43.23 +
43.24 +(*-------------------- theory -------------------------------------------------*)
43.25 +theory' := overwritel (!theory', [("LinEq.thy",LinEq.thy)]);
43.26 +
43.27 +(*-------------- rules -------------------------------------------------------*)
43.28 +val LinEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
43.29 + append_rls "LinEq_prls" e_rls
43.30 + [Calc ("op =",eval_equal "#equal_"),
43.31 + Calc ("Tools.matches",eval_matches ""),
43.32 + Calc ("Tools.lhs" ,eval_lhs ""),
43.33 + Calc ("Tools.rhs" ,eval_rhs ""),
43.34 + Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),
43.35 + Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
43.36 + Calc ("Atools.occurs'_in",eval_occurs_in ""),
43.37 + Calc ("Atools.ident",eval_ident "#ident_"),
43.38 + Thm ("not_true",num_str not_true),
43.39 + Thm ("not_false",num_str not_false),
43.40 + Thm ("and_true",num_str and_true),
43.41 + Thm ("and_false",num_str and_false),
43.42 + Thm ("or_true",num_str or_true),
43.43 + Thm ("or_false",num_str or_false)
43.44 + ];
43.45 +(* ----- erls ----- *)
43.46 +val LinEq_crls =
43.47 + append_rls "LinEq_crls" poly_crls
43.48 + [Thm ("real_assoc_1",num_str real_assoc_1)
43.49 + (*
43.50 + Don't use
43.51 + Calc ("HOL.divide", eval_cancel "#divide_"),
43.52 + Calc ("Atools.pow" ,eval_binop "#power_"),
43.53 + *)
43.54 + ];
43.55 +
43.56 +(* ----- crls ----- *)
43.57 +val LinEq_erls =
43.58 + append_rls "LinEq_erls" Poly_erls
43.59 + [Thm ("real_assoc_1",num_str real_assoc_1)
43.60 + (*
43.61 + Don't use
43.62 + Calc ("HOL.divide", eval_cancel "#divide_"),
43.63 + Calc ("Atools.pow" ,eval_binop "#power_"),
43.64 + *)
43.65 + ];
43.66 +
43.67 +ruleset' := overwritelthy thy (!ruleset',
43.68 + [("LinEq_erls",LinEq_erls)(*FIXXXME:del with rls.rls'*)
43.69 + ]);
43.70 +
43.71 +val LinPoly_simplify = prep_rls(
43.72 + Rls {id = "LinPoly_simplify", preconds = [],
43.73 + rew_ord = ("termlessI",termlessI),
43.74 + erls = LinEq_erls,
43.75 + srls = Erls,
43.76 + calc = [],
43.77 + (*asm_thm = [],*)
43.78 + rules = [
43.79 + Thm ("real_assoc_1",num_str real_assoc_1),
43.80 + Calc ("op +",eval_binop "#add_"),
43.81 + Calc ("op -",eval_binop "#sub_"),
43.82 + Calc ("op *",eval_binop "#mult_"),
43.83 + (* Dont use
43.84 + Calc ("HOL.divide", eval_cancel "#divide_"),
43.85 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
43.86 + *)
43.87 + Calc ("Atools.pow" ,eval_binop "#power_")
43.88 + ],
43.89 + scr = Script ((term_of o the o (parse thy)) "empty_script")
43.90 + }:rls);
43.91 +ruleset' := overwritelthy thy (!ruleset',
43.92 + [("LinPoly_simplify",LinPoly_simplify)]);
43.93 +
43.94 +(*isolate the bound variable in an linear equation; 'bdv' is a meta-constant*)
43.95 +val LinEq_simplify = prep_rls(
43.96 +Rls {id = "LinEq_simplify", preconds = [],
43.97 + rew_ord = ("e_rew_ord",e_rew_ord),
43.98 + erls = LinEq_erls,
43.99 + srls = Erls,
43.100 + calc = [],
43.101 + (*asm_thm = [("lin_isolate_div","")],*)
43.102 + rules = [
43.103 + Thm("lin_isolate_add1",num_str lin_isolate_add1),
43.104 + (* a+bx=0 -> bx=-a *)
43.105 + Thm("lin_isolate_add2",num_str lin_isolate_add2),
43.106 + (* a+ x=0 -> x=-a *)
43.107 + Thm("lin_isolate_div",num_str lin_isolate_div)
43.108 + (* bx=c -> x=c/b *)
43.109 + ],
43.110 + scr = Script ((term_of o the o (parse thy)) "empty_script")
43.111 + }:rls);
43.112 +ruleset' := overwritelthy thy (!ruleset',
43.113 + [("LinEq_simplify",LinEq_simplify)]);
43.114 +
43.115 +(*----------------------------- problem types --------------------------------*)
43.116 +(*
43.117 +show_ptyps();
43.118 +(get_pbt ["linear","univariate","equation"]);
43.119 +*)
43.120 +(* ---------linear----------- *)
43.121 +store_pbt
43.122 + (prep_pbt LinEq.thy "pbl_equ_univ_lin" [] e_pblID
43.123 + (["linear","univariate","equation"],
43.124 + [("#Given" ,["equality e_","solveFor v_"]),
43.125 + ("#Where" ,["False", (*WN0509 just detected: this pbl can never be used?!?*)
43.126 + "Not( (lhs e_) is_polyrat_in v_)",
43.127 + "Not( (rhs e_) is_polyrat_in v_)",
43.128 + "((lhs e_) has_degree_in v_)=1",
43.129 + "((rhs e_) has_degree_in v_)=1"]),
43.130 + ("#Find" ,["solutions v_i_"])
43.131 + ],
43.132 + LinEq_prls, Some "solve (e_::bool, v_)",
43.133 + [["LinEq","solve_lineq_equation"]]));
43.134 +
43.135 +(*-------------- methods-------------------------------------------------------*)
43.136 +store_met
43.137 + (prep_met LinEq.thy "met_eqlin" [] e_metID
43.138 + (["LinEq"],
43.139 + [],
43.140 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
43.141 + crls=LinEq_crls, nrls=norm_Poly
43.142 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
43.143 +
43.144 +(* ansprechen mit ["LinEq","solve_univar_equation"] *)
43.145 +store_met
43.146 +(prep_met LinEq.thy "met_eq_lin" [] e_metID
43.147 + (["LinEq","solve_lineq_equation"],
43.148 + [("#Given" ,["equality e_","solveFor v_"]),
43.149 + ("#Where" ,["Not( (lhs e_) is_polyrat_in v_)",
43.150 + "( (lhs e_) has_degree_in v_)=1"]),
43.151 + ("#Find" ,["solutions v_i_"])
43.152 + ],
43.153 + {rew_ord'="termlessI",
43.154 + rls'=LinEq_erls,
43.155 + srls=e_rls,
43.156 + prls=LinEq_prls,
43.157 + calc=[],
43.158 + crls=LinEq_crls, nrls=norm_Poly(*,
43.159 + asm_rls=[],
43.160 + asm_thm=[("lin_isolate_div","")]*)},
43.161 + "Script Solve_lineq_equation (e_::bool) (v_::real) = \
43.162 + \(let e_ =((Try (Rewrite all_left False)) @@ \
43.163 + \ (Try (Repeat (Rewrite makex1_x False))) @@ \
43.164 + \ (Try (Rewrite_Set expand_binoms False)) @@ \
43.165 + \ (Try (Repeat (Rewrite_Set_Inst [(bdv,v_::real)] \
43.166 + \ make_ratpoly_in False))) @@ \
43.167 + \ (Try (Repeat (Rewrite_Set LinPoly_simplify False)))) e_;\
43.168 + \ e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
43.169 + \ LinEq_simplify True)) @@ \
43.170 + \ (Repeat(Try (Rewrite_Set LinPoly_simplify False)))) e_ \
43.171 + \ in ((Or_to_List e_)::bool list))"
43.172 + ));
43.173 +"******* LinEq.ML end *******";
43.174 +get_met ["LinEq","solve_lineq_equation"];
44.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
44.2 +++ b/src/Pure/isac/IsacKnowledge/LinEq.thy Wed Jul 21 13:53:39 2010 +0200
44.3 @@ -0,0 +1,50 @@
44.4 +(*. (c) by Richard Lang, 2003 .*)
44.5 +(* theory collecting all knowledge for LinearEquations
44.6 + created by: rlang
44.7 + date: 02.10
44.8 + changed by: rlang
44.9 + last change by: rlang
44.10 + date: 02.10.20
44.11 +*)
44.12 +
44.13 +(*
44.14 + use"knowledge/LinEq.ML";
44.15 + use"LinEq.ML";
44.16 +
44.17 + use"ROOT.ML";
44.18 + cd"knowledge";
44.19 +
44.20 +*)
44.21 +
44.22 +LinEq = Poly + Equation +
44.23 +
44.24 +(*-------------------- consts------------------------------------------------*)
44.25 +consts
44.26 + Solve'_lineq'_equation
44.27 + :: "[bool,real, \
44.28 + \ bool list] => bool list"
44.29 + ("((Script Solve'_lineq'_equation (_ _ =))// \
44.30 + \ (_))" 9)
44.31 +
44.32 +(*-------------------- rules -------------------------------------------------*)
44.33 +rules
44.34 +(*-- normalize --*)
44.35 + (*WN0509 compare PolyEq.all_left "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"*)
44.36 + all_left
44.37 + "[|Not(b=!=0)|] ==> (a=b) = (a+(-1)*b=0)"
44.38 + makex1_x
44.39 + "a^^^1 = a"
44.40 + real_assoc_1
44.41 + "a+(b+c) = a+b+c"
44.42 + real_assoc_2
44.43 + "a*(b*c) = a*b*c"
44.44 +
44.45 +(*-- solve --*)
44.46 + lin_isolate_add1
44.47 + "(a + b*bdv = 0) = (b*bdv = (-1)*a)"
44.48 + lin_isolate_add2
44.49 + "(a + bdv = 0) = ( bdv = (-1)*a)"
44.50 + lin_isolate_div
44.51 + "[|Not(b=0)|] ==> (b*bdv = c) = (bdv = c / b)"
44.52 +end
44.53 +
45.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
45.2 +++ b/src/Pure/isac/IsacKnowledge/LogExp.ML Wed Jul 21 13:53:39 2010 +0200
45.3 @@ -0,0 +1,39 @@
45.4 +(* all outcommented in order to demonstrate authoring:
45.5 + WN071203
45.6 +*)
45.7 +
45.8 +(** interface isabelle -- isac **)
45.9 +theory' := overwritel (!theory', [("LogExp.thy",LogExp.thy)]);
45.10 +
45.11 +(*--------------------------------------------------*)
45.12 +
45.13 +(** problems **)
45.14 +store_pbt
45.15 + (prep_pbt LogExp.thy "pbl_test_equ_univ_log" [] e_pblID
45.16 + (["logarithmic","univariate","equation"],
45.17 + [("#Given",["equality e_","solveFor v_"]),
45.18 + ("#Where",["matches ((?a log ?v_) = ?b) e_"]),
45.19 + ("#Find" ,["solutions v_i_"]),
45.20 + ("#With" ,["||(lhs (Subst (v_i_,v_) e_) - \
45.21 + \ (rhs (Subst (v_i_,v_) e_) || < eps)"])
45.22 + ],
45.23 + PolyEq_prls, Some "solve (e_::bool, v_)",
45.24 + [["Equation","solve_log"]]));
45.25 +
45.26 +(** methods **)
45.27 +store_met
45.28 + (prep_met LogExp.thy "met_equ_log" [] e_metID
45.29 + (["Equation","solve_log"],
45.30 + [("#Given" ,["equality e_","solveFor v_"]),
45.31 + ("#Where" ,["matches ((?a log ?v_) = ?b) e_"]),
45.32 + ("#Find" ,["solutions v_i_"])
45.33 + ],
45.34 + {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
45.35 + calc=[],crls=PolyEq_crls, nrls=norm_Rational},
45.36 + "Script Solve_log (e_::bool) (v_::real) = \
45.37 + \(let e_ = ((Rewrite equality_power False) @@ \
45.38 + \ (Rewrite exp_invers_log False) @@ \
45.39 + \ (Rewrite_Set norm_Poly False)) e_ \
45.40 + \ in [e_])"
45.41 + ));
45.42 +(*--------------------------------------------------*)
46.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
46.2 +++ b/src/Pure/isac/IsacKnowledge/LogExp.thy Wed Jul 21 13:53:39 2010 +0200
46.3 @@ -0,0 +1,30 @@
46.4 +(* all outcommented in order to demonstrate authoring:
46.5 + WN071203
46.6 +remove_thy"LogExp";
46.7 +use_thy_only"IsacKnowledge/LogExp";
46.8 +use_thy_only"IsacKnowledge/Isac";
46.9 +*)
46.10 +LogExp = PolyEq +
46.11 +
46.12 +consts
46.13 +
46.14 + ln :: "real => real"
46.15 + exp :: "real => real" ("E'_ ^^^ _" 80)
46.16 +
46.17 +(*--------------------------------------------------*)
46.18 + alog :: "[real, real] => real" ("_ log _" 90)
46.19 +
46.20 + (*Script-names*)
46.21 + Solve'_log :: "[bool,real, bool list] \
46.22 + \=> bool list"
46.23 + ("((Script Solve'_log (_ _=))//(_))" 9)
46.24 +
46.25 +rules
46.26 +
46.27 + equality_pow "0 < a ==> (l = r) = (a^^^l = a^^^r)"
46.28 + (* this is what students ^^^^^^^... are told to do *)
46.29 + equality_power "((a log b) = c) = (a^^^(a log b) = a^^^c)"
46.30 + exp_invers_log "a^^^(a log b) = b"
46.31 +(*---------------------------------------------------*)
46.32 +
46.33 +end
46.34 \ No newline at end of file
47.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
47.2 +++ b/src/Pure/isac/IsacKnowledge/Poly.ML Wed Jul 21 13:53:39 2010 +0200
47.3 @@ -0,0 +1,1495 @@
47.4 +(*.eval_funs, rulesets, problems and methods concerning polynamials
47.5 + authors: Matthias Goldgruber 2003
47.6 + (c) due to copyright terms
47.7 +
47.8 + use"../IsacKnowledge/Poly.ML";
47.9 + use"IsacKnowledge/Poly.ML";
47.10 + use"Poly.ML";
47.11 +
47.12 + remove_thy"Poly";
47.13 + use_thy"IsacKnowledge/Isac";
47.14 +****************************************************************.*)
47.15 +
47.16 +(*.****************************************************************
47.17 + remark on 'polynomials'
47.18 + WN020919
47.19 + there are 5 kinds of expanded normalforms:
47.20 +[1] 'complete polynomial' (Komplettes Polynom), univariate
47.21 + a_0 + a_1.x^1 +...+ a_n.x^n not (a_n = 0)
47.22 + not (a_n = 0), some a_i may be zero (DON'T disappear),
47.23 + variables in monomials lexicographically ordered and complete,
47.24 + x written as 1*x^1, ...
47.25 +[2] 'polynomial' (Polynom), univariate and multivariate
47.26 + a_0 + a_1.x +...+ a_n.x^n not (a_n = 0)
47.27 + a_0 + a_1.x_1.x_2^n_12...x_m^n_1m +...+ a_n.x_1^n.x_2^n_n2...x_m^n_nm
47.28 + not (a_n = 0), some a_i may be zero (ie. monomials disappear),
47.29 + exponents and coefficients equal 1 are not (WN060904.TODO in cancel_p_)shown,
47.30 + and variables in monomials are lexicographically ordered
47.31 + examples: [1]: "1 + (-10) * x ^^^ 1 + 25 * x ^^^ 2"
47.32 + [1]: "11 + 0 * x ^^^ 1 + 1 * x ^^^ 2"
47.33 + [2]: "x + (-50) * x ^^^ 3"
47.34 + [2]: "(-1) * x * y ^^^ 2 + 7 * x ^^^ 3"
47.35 +
47.36 +[3] 'expanded_term' (Ausmultiplizierter Term):
47.37 + pull out unary minus to binary minus,
47.38 + as frequently exercised in schools; other conditions for [2] hold however
47.39 + examples: "a ^^^ 2 - 2 * a * b + b ^^^ 2"
47.40 + "4 * x ^^^ 2 - 9 * y ^^^ 2"
47.41 +[4] 'polynomial_in' (Polynom in):
47.42 + polynomial in 1 variable with arbitrary coefficients
47.43 + examples: "2 * x + (-50) * x ^^^ 3" (poly in x)
47.44 + "(u + v) + (2 * u ^^^ 2) * a + (-u) * a ^^^ 2 (poly in a)
47.45 +[5] 'expanded_in' (Ausmultiplizierter Termin in):
47.46 + analoguous to [3] with binary minus like [3]
47.47 + examples: "2 * x - 50 * x ^^^ 3" (expanded in x)
47.48 + "(u + v) + (2 * u ^^^ 2) * a - u * a ^^^ 2 (expanded in a)
47.49 +*****************************************************************.*)
47.50 +
47.51 +"******** Poly.ML begin ******************************************";
47.52 +theory' := overwritel (!theory', [("Poly.thy",Poly.thy)]);
47.53 +
47.54 +
47.55 +(* is_polyrat_in becomes true, if no bdv is in the denominator of a fraction*)
47.56 +fun is_polyrat_in t v =
47.57 + let
47.58 + fun coeff_in c v = v mem (vars c);
47.59 + fun finddivide (_ $ _ $ _ $ _) v = raise error("is_polyrat_in:")
47.60 + (* at the moment there is no term like this, but ....*)
47.61 + | finddivide (t as (Const ("HOL.divide",_) $ _ $ b)) v = not(coeff_in b v)
47.62 + | finddivide (_ $ t1 $ t2) v = (finddivide t1 v) orelse (finddivide t2 v)
47.63 + | finddivide (_ $ t1) v = (finddivide t1 v)
47.64 + | finddivide _ _ = false;
47.65 + in
47.66 + finddivide t v
47.67 + end;
47.68 +
47.69 +fun eval_is_polyrat_in _ _ (p as (Const ("Poly.is'_polyrat'_in",_) $ t $ v)) _ =
47.70 + if is_polyrat_in t v then
47.71 + Some ((term2str p) ^ " = True",
47.72 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
47.73 + else Some ((term2str p) ^ " = True",
47.74 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
47.75 + | eval_is_polyrat_in _ _ _ _ = ((*writeln"### nichts matcht";*) None);
47.76 +
47.77 +
47.78 +local
47.79 + (*.a 'c is coefficient of v' if v does NOT occur in c.*)
47.80 + fun coeff_in c v = not (v mem (vars c));
47.81 + (*
47.82 + val v = (term_of o the o (parse thy)) "x";
47.83 + val t = (term_of o the o (parse thy)) "1";
47.84 + coeff_in t v;
47.85 + (*val it = true : bool*)
47.86 + val t = (term_of o the o (parse thy)) "a*b+c";
47.87 + coeff_in t v;
47.88 + (*val it = true : bool*)
47.89 + val t = (term_of o the o (parse thy)) "a*x+c";
47.90 + coeff_in t v;
47.91 + (*val it = false : bool*)
47.92 + *)
47.93 + (*. a 'monomial t in variable v' is a term t with
47.94 + either (1) v NOT existent in t, or (2) v contained in t,
47.95 + if (1) then degree 0
47.96 + if (2) then v is a factor on the very right, ev. with exponent.*)
47.97 + fun factor_right_deg (*case 2*)
47.98 + (t as Const ("op *",_) $ t1 $
47.99 + (Const ("Atools.pow",_) $ vv $ Free (d,_))) v =
47.100 + if ((vv = v) andalso (coeff_in t1 v)) then Some (int_of_str' d) else None
47.101 + | factor_right_deg
47.102 + (t as Const ("Atools.pow",_) $ vv $ Free (d,_)) v =
47.103 + if (vv = v) then Some (int_of_str' d) else None
47.104 + | factor_right_deg (t as Const ("op *",_) $ t1 $ vv) v =
47.105 + if ((vv = v) andalso (coeff_in t1 v))then Some 1 else None
47.106 + | factor_right_deg vv v =
47.107 + if (vv = v) then Some 1 else None;
47.108 + fun mono_deg_in m v =
47.109 + if coeff_in m v then (*case 1*) Some 0
47.110 + else factor_right_deg m v;
47.111 + (*
47.112 + val v = (term_of o the o (parse thy)) "x";
47.113 + val t = (term_of o the o (parse thy)) "(a*b+c)*x^^^7";
47.114 + mono_deg_in t v;
47.115 + (*val it = Some 7*)
47.116 + val t = (term_of o the o (parse thy)) "x^^^7";
47.117 + mono_deg_in t v;
47.118 + (*val it = Some 7*)
47.119 + val t = (term_of o the o (parse thy)) "(a*b+c)*x";
47.120 + mono_deg_in t v;
47.121 + (*val it = Some 1*)
47.122 + val t = (term_of o the o (parse thy)) "(a*b+x)*x";
47.123 + mono_deg_in t v;
47.124 + (*val it = None*)
47.125 + val t = (term_of o the o (parse thy)) "x";
47.126 + mono_deg_in t v;
47.127 + (*val it = Some 1*)
47.128 + val t = (term_of o the o (parse thy)) "(a*b+c)";
47.129 + mono_deg_in t v;
47.130 + (*val it = Some 0*)
47.131 + val t = (term_of o the o (parse thy)) "ab - (a*b)*x";
47.132 + mono_deg_in t v;
47.133 + (*val it = None*)
47.134 + *)
47.135 + fun expand_deg_in t v =
47.136 + let fun edi ~1 ~1 (Const ("op +",_) $ t1 $ t2) =
47.137 + (case mono_deg_in t2 v of (* $ is left associative*)
47.138 + Some d' => edi d' d' t1
47.139 + | None => None)
47.140 + | edi ~1 ~1 (Const ("op -",_) $ t1 $ t2) =
47.141 + (case mono_deg_in t2 v of
47.142 + Some d' => edi d' d' t1
47.143 + | None => None)
47.144 + | edi d dmax (Const ("op -",_) $ t1 $ t2) =
47.145 + (case mono_deg_in t2 v of
47.146 + (*RL orelse ((d=0) andalso (d'=0)) need to handle 3+4-...4 +x*)
47.147 + Some d' => if ((d > d') orelse ((d=0) andalso (d'=0))) then edi d' dmax t1 else None
47.148 + | None => None)
47.149 + | edi d dmax (Const ("op +",_) $ t1 $ t2) =
47.150 + (case mono_deg_in t2 v of
47.151 + (*RL orelse ((d=0) andalso (d'=0)) need to handle 3+4-...4 +x*)
47.152 + Some d' => if ((d > d') orelse ((d=0) andalso (d'=0))) then edi d' dmax t1 else None
47.153 + | None => None)
47.154 + | edi ~1 ~1 t =
47.155 + (case mono_deg_in t v of
47.156 + d as Some _ => d
47.157 + | None => None)
47.158 + | edi d dmax t = (*basecase last*)
47.159 + (case mono_deg_in t v of
47.160 + Some d' => if ((d > d') orelse ((d=0) andalso (d'=0))) then Some dmax else None
47.161 + | None => None)
47.162 + in edi ~1 ~1 t end;
47.163 + (*
47.164 + val v = (term_of o the o (parse thy)) "x";
47.165 + val t = (term_of o the o (parse thy)) "a+b";
47.166 + expand_deg_in t v;
47.167 + (*val it = Some 0*)
47.168 + val t = (term_of o the o (parse thy)) "(a+b)*x";
47.169 + expand_deg_in t v;
47.170 + (*Some 1*)
47.171 + val t = (term_of o the o (parse thy)) "a*b - (a+b)*x";
47.172 + expand_deg_in t v;
47.173 + (*Some 1*)
47.174 + val t = (term_of o the o (parse thy)) "a*b + (a-b)*x";
47.175 + expand_deg_in t v;
47.176 + (*Some 1*)
47.177 + val t = (term_of o the o (parse thy)) "a*b + (a+b)*x + x^^^2";
47.178 + expand_deg_in t v;
47.179 + *)
47.180 + fun poly_deg_in t v =
47.181 + let fun edi ~1 ~1 (Const ("op +",_) $ t1 $ t2) =
47.182 + (case mono_deg_in t2 v of (* $ is left associative*)
47.183 + Some d' => edi d' d' t1
47.184 + | None => None)
47.185 + | edi d dmax (Const ("op +",_) $ t1 $ t2) =
47.186 + (case mono_deg_in t2 v of
47.187 + (*RL orelse ((d=0) andalso (d'=0)) need to handle 3+4-...4 +x*)
47.188 + Some d' => if ((d > d') orelse ((d=0) andalso (d'=0))) then edi d' dmax t1 else None
47.189 + | None => None)
47.190 + | edi ~1 ~1 t =
47.191 + (case mono_deg_in t v of
47.192 + d as Some _ => d
47.193 + | None => None)
47.194 + | edi d dmax t = (*basecase last*)
47.195 + (case mono_deg_in t v of
47.196 + Some d' => if ((d > d') orelse ((d=0) andalso (d'=0))) then Some dmax else None
47.197 + | None => None)
47.198 + in edi ~1 ~1 t end;
47.199 +in
47.200 +
47.201 +fun is_expanded_in t v =
47.202 + case expand_deg_in t v of Some _ => true | None => false;
47.203 +fun is_poly_in t v =
47.204 + case poly_deg_in t v of Some _ => true | None => false;
47.205 +fun has_degree_in t v =
47.206 + case expand_deg_in t v of Some d => d | None => ~1;
47.207 +end;
47.208 +(*
47.209 + val v = (term_of o the o (parse thy)) "x";
47.210 + val t = (term_of o the o (parse thy)) "a*b - (a+b)*x + x^^^2";
47.211 + has_degree_in t v;
47.212 + (*val it = 2*)
47.213 + val t = (term_of o the o (parse thy)) "-8 - 2*x + x^^^2";
47.214 + has_degree_in t v;
47.215 + (*val it = 2*)
47.216 + val t = (term_of o the o (parse thy)) "6 + 13*x + 6*x^^^2";
47.217 + has_degree_in t v;
47.218 + (*val it = 2*)
47.219 +*)
47.220 +
47.221 +(*("is_expanded_in", ("Poly.is'_expanded'_in", eval_is_expanded_in ""))*)
47.222 +fun eval_is_expanded_in _ _
47.223 + (p as (Const ("Poly.is'_expanded'_in",_) $ t $ v)) _ =
47.224 + if is_expanded_in t v
47.225 + then Some ((term2str p) ^ " = True",
47.226 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
47.227 + else Some ((term2str p) ^ " = True",
47.228 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
47.229 + | eval_is_expanded_in _ _ _ _ = None;
47.230 +(*
47.231 + val t = (term_of o the o (parse thy)) "(-8 - 2*x + x^^^2) is_expanded_in x";
47.232 + val Some (id, t') = eval_is_expanded_in 0 0 t 0;
47.233 + (*val id = "Poly.is'_expanded'_in (-8 - 2 * x + x ^^^ 2) x = True"*)
47.234 + term2str t';
47.235 + (*val it = "Poly.is'_expanded'_in (-8 - 2 * x + x ^^^ 2) x = True"*)
47.236 +*)
47.237 +(*("is_poly_in", ("Poly.is'_poly'_in", eval_is_poly_in ""))*)
47.238 +fun eval_is_poly_in _ _
47.239 + (p as (Const ("Poly.is'_poly'_in",_) $ t $ v)) _ =
47.240 + if is_poly_in t v
47.241 + then Some ((term2str p) ^ " = True",
47.242 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
47.243 + else Some ((term2str p) ^ " = True",
47.244 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
47.245 + | eval_is_poly_in _ _ _ _ = None;
47.246 +(*
47.247 + val t = (term_of o the o (parse thy)) "(8 + 2*x + x^^^2) is_poly_in x";
47.248 + val Some (id, t') = eval_is_poly_in 0 0 t 0;
47.249 + (*val id = "Poly.is'_poly'_in (8 + 2 * x + x ^^^ 2) x = True"*)
47.250 + term2str t';
47.251 + (*val it = "Poly.is'_poly'_in (8 + 2 * x + x ^^^ 2) x = True"*)
47.252 +*)
47.253 +
47.254 +(*("has_degree_in", ("Poly.has'_degree'_in", eval_has_degree_in ""))*)
47.255 +fun eval_has_degree_in _ _
47.256 + (p as (Const ("Poly.has'_degree'_in",_) $ t $ v)) _ =
47.257 + let val d = has_degree_in t v
47.258 + val d' = term_of_num HOLogic.realT d
47.259 + in Some ((term2str p) ^ " = " ^ (string_of_int d),
47.260 + Trueprop $ (mk_equality (p, d')))
47.261 + end
47.262 + | eval_has_degree_in _ _ _ _ = None;
47.263 +(*
47.264 +> val t = (term_of o the o (parse thy)) "(-8 - 2*x + x^^^2) has_degree_in x";
47.265 +> val Some (id, t') = eval_has_degree_in 0 0 t 0;
47.266 +val id = "Poly.has'_degree'_in (-8 - 2 * x + x ^^^ 2) x = 2" : string
47.267 +> term2str t';
47.268 +val it = "Poly.has'_degree'_in (-8 - 2 * x + x ^^^ 2) x = 2" : string
47.269 +*)
47.270 +
47.271 +(*..*)
47.272 +val calculate_Poly =
47.273 + append_rls "calculate_PolyFIXXXME.not.impl." e_rls
47.274 + [];
47.275 +
47.276 +(*.for evaluation of conditions in rewrite rules.*)
47.277 +val Poly_erls =
47.278 + append_rls "Poly_erls" Atools_erls
47.279 + [ Calc ("op =",eval_equal "#equal_"),
47.280 + Thm ("real_unari_minus",num_str real_unari_minus),
47.281 + Calc ("op +",eval_binop "#add_"),
47.282 + Calc ("op -",eval_binop "#sub_"),
47.283 + Calc ("op *",eval_binop "#mult_"),
47.284 + Calc ("Atools.pow" ,eval_binop "#power_")
47.285 + ];
47.286 +
47.287 +val poly_crls =
47.288 + append_rls "poly_crls" Atools_crls
47.289 + [ Calc ("op =",eval_equal "#equal_"),
47.290 + Thm ("real_unari_minus",num_str real_unari_minus),
47.291 + Calc ("op +",eval_binop "#add_"),
47.292 + Calc ("op -",eval_binop "#sub_"),
47.293 + Calc ("op *",eval_binop "#mult_"),
47.294 + Calc ("Atools.pow" ,eval_binop "#power_")
47.295 + ];
47.296 +
47.297 +
47.298 +local (*. for make_polynomial .*)
47.299 +
47.300 +open Term; (* for type order = EQUAL | LESS | GREATER *)
47.301 +
47.302 +fun pr_ord EQUAL = "EQUAL"
47.303 + | pr_ord LESS = "LESS"
47.304 + | pr_ord GREATER = "GREATER";
47.305 +
47.306 +fun dest_hd' (Const (a, T)) = (* ~ term.ML *)
47.307 + (case a of
47.308 + "Atools.pow" => ((("|||||||||||||", 0), T), 0) (*WN greatest string*)
47.309 + | _ => (((a, 0), T), 0))
47.310 + | dest_hd' (Free (a, T)) = (((a, 0), T), 1)
47.311 + | dest_hd' (Var v) = (v, 2)
47.312 + | dest_hd' (Bound i) = ((("", i), dummyT), 3)
47.313 + | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
47.314 +
47.315 +fun get_order_pow (t $ (Free(order,_))) = (* RL FIXXXME:geht zufaellig?WN*)
47.316 + (case int_of_str (order) of
47.317 + Some d => d
47.318 + | None => 0)
47.319 + | get_order_pow _ = 0;
47.320 +
47.321 +fun size_of_term' (Const(str,_) $ t) =
47.322 + if "Atools.pow"= str then 1000 + size_of_term' t else 1+size_of_term' t(*WN*)
47.323 + | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
47.324 + | size_of_term' (f$t) = size_of_term' f + size_of_term' t
47.325 + | size_of_term' _ = 1;
47.326 +
47.327 +fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
47.328 + (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
47.329 + | term_ord' pr thy (t, u) =
47.330 + (if pr then
47.331 + let
47.332 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
47.333 + val _=writeln("t= f@ts= \""^
47.334 + ((string_of_cterm o cterm_of (sign_of thy)) f)^"\" @ \"["^
47.335 + (commas(map(string_of_cterm o cterm_of (sign_of thy))ts))^"]\"");
47.336 + val _=writeln("u= g@us= \""^
47.337 + ((string_of_cterm o cterm_of (sign_of thy)) g)^"\" @ \"["^
47.338 + (commas(map(string_of_cterm o cterm_of (sign_of thy))us))^"]\"");
47.339 + val _=writeln("size_of_term(t,u)= ("^
47.340 + (string_of_int(size_of_term' t))^", "^
47.341 + (string_of_int(size_of_term' u))^")");
47.342 + val _=writeln("hd_ord(f,g) = "^((pr_ord o hd_ord)(f,g)));
47.343 + val _=writeln("terms_ord(ts,us) = "^
47.344 + ((pr_ord o terms_ord str false)(ts,us)));
47.345 + val _=writeln("-------");
47.346 + in () end
47.347 + else ();
47.348 + case int_ord (size_of_term' t, size_of_term' u) of
47.349 + EQUAL =>
47.350 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
47.351 + (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
47.352 + | ord => ord)
47.353 + end
47.354 + | ord => ord)
47.355 +and hd_ord (f, g) = (* ~ term.ML *)
47.356 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f, dest_hd' g)
47.357 +and terms_ord str pr (ts, us) =
47.358 + list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
47.359 +in
47.360 +
47.361 +fun ord_make_polynomial (pr:bool) thy (_:subst) tu =
47.362 + (term_ord' pr thy(***) tu = LESS );
47.363 +
47.364 +end;(*local*)
47.365 +
47.366 +
47.367 +rew_ord' := overwritel (!rew_ord',
47.368 +[("termlessI", termlessI),
47.369 + ("ord_make_polynomial", ord_make_polynomial false thy)
47.370 + ]);
47.371 +
47.372 +
47.373 +val expand =
47.374 + Rls{id = "expand", preconds = [],
47.375 + rew_ord = ("dummy_ord", dummy_ord),
47.376 + erls = e_rls,srls = Erls,
47.377 + calc = [],
47.378 + (*asm_thm = [],*)
47.379 + rules = [Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
47.380 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
47.381 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2)
47.382 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
47.383 + ], scr = EmptyScr}:rls;
47.384 +
47.385 +(*----------------- Begin: rulesets for make_polynomial_ -----------------
47.386 + 'rlsIDs' redefined by MG as 'rlsIDs_'
47.387 + ^^^*)
47.388 +
47.389 +val discard_minus_ =
47.390 + Rls{id = "discard_minus_", preconds = [],
47.391 + rew_ord = ("dummy_ord", dummy_ord),
47.392 + erls = e_rls,srls = Erls,
47.393 + calc = [],
47.394 + (*asm_thm = [],*)
47.395 + rules = [Thm ("real_diff_minus",num_str real_diff_minus),
47.396 + (*"a - b = a + -1 * b"*)
47.397 + Thm ("sym_real_mult_minus1",num_str (real_mult_minus1 RS sym))
47.398 + (*- ?z = "-1 * ?z"*)
47.399 + ], scr = EmptyScr}:rls;
47.400 +val expand_poly_ =
47.401 + Rls{id = "expand_poly_", preconds = [],
47.402 + rew_ord = ("dummy_ord", dummy_ord),
47.403 + erls = e_rls,srls = Erls,
47.404 + calc = [],
47.405 + (*asm_thm = [],*)
47.406 + rules = [Thm ("real_plus_binom_pow4",num_str real_plus_binom_pow4),
47.407 + (*"(a + b)^^^4 = ... "*)
47.408 + Thm ("real_plus_binom_pow5",num_str real_plus_binom_pow5),
47.409 + (*"(a + b)^^^5 = ... "*)
47.410 + Thm ("real_plus_binom_pow3",num_str real_plus_binom_pow3),
47.411 + (*"(a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3" *)
47.412 +
47.413 + (*WN071229 changed/removed for Schaerding -----vvv*)
47.414 + (*Thm ("real_plus_binom_pow2",num_str real_plus_binom_pow2),*)
47.415 + (*"(a + b)^^^2 = a^^^2 + 2*a*b + b^^^2"*)
47.416 + Thm ("real_plus_binom_pow2",num_str real_plus_binom_pow2),
47.417 + (*"(a + b)^^^2 = (a + b) * (a + b)"*)
47.418 + (*Thm ("real_plus_minus_binom1_p_p",
47.419 + num_str real_plus_minus_binom1_p_p),*)
47.420 + (*"(a + b)*(a + -1 * b) = a^^^2 + -1*b^^^2"*)
47.421 + (*Thm ("real_plus_minus_binom2_p_p",
47.422 + num_str real_plus_minus_binom2_p_p),*)
47.423 + (*"(a + -1 * b)*(a + b) = a^^^2 + -1*b^^^2"*)
47.424 + (*WN071229 changed/removed for Schaerding -----^^^*)
47.425 +
47.426 + Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
47.427 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
47.428 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
47.429 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
47.430 +
47.431 + Thm ("realpow_multI", num_str realpow_multI),
47.432 + (*"(r * s) ^^^ n = r ^^^ n * s ^^^ n"*)
47.433 + Thm ("realpow_pow",num_str realpow_pow)
47.434 + (*"(a ^^^ b) ^^^ c = a ^^^ (b * c)"*)
47.435 + ], scr = EmptyScr}:rls;
47.436 +
47.437 +(*.the expression contains + - * ^ only ?
47.438 + this is weaker than 'is_polynomial' !.*)
47.439 +fun is_polyexp (Free _) = true
47.440 + | is_polyexp (Const ("op +",_) $ Free _ $ Free _) = true
47.441 + | is_polyexp (Const ("op -",_) $ Free _ $ Free _) = true
47.442 + | is_polyexp (Const ("op *",_) $ Free _ $ Free _) = true
47.443 + | is_polyexp (Const ("Atools.pow",_) $ Free _ $ Free _) = true
47.444 + | is_polyexp (Const ("op +",_) $ t1 $ t2) =
47.445 + ((is_polyexp t1) andalso (is_polyexp t2))
47.446 + | is_polyexp (Const ("op -",_) $ t1 $ t2) =
47.447 + ((is_polyexp t1) andalso (is_polyexp t2))
47.448 + | is_polyexp (Const ("op *",_) $ t1 $ t2) =
47.449 + ((is_polyexp t1) andalso (is_polyexp t2))
47.450 + | is_polyexp (Const ("Atools.pow",_) $ t1 $ t2) =
47.451 + ((is_polyexp t1) andalso (is_polyexp t2))
47.452 + | is_polyexp _ = false;
47.453 +
47.454 +(*("is_polyexp", ("Poly.is'_polyexp", eval_is_polyexp ""))*)
47.455 +fun eval_is_polyexp (thmid:string) _
47.456 + (t as (Const("Poly.is'_polyexp", _) $ arg)) thy =
47.457 + if is_polyexp arg
47.458 + then Some (mk_thmid thmid ""
47.459 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
47.460 + Trueprop $ (mk_equality (t, HOLogic.true_const)))
47.461 + else Some (mk_thmid thmid ""
47.462 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
47.463 + Trueprop $ (mk_equality (t, HOLogic.false_const)))
47.464 + | eval_is_polyexp _ _ _ _ = None;
47.465 +
47.466 +val expand_poly_rat_ =
47.467 + Rls{id = "expand_poly_rat_", preconds = [],
47.468 + rew_ord = ("dummy_ord", dummy_ord),
47.469 + erls = append_rls "e_rls-is_polyexp" e_rls
47.470 + [Calc ("Poly.is'_polyexp", eval_is_polyexp "")
47.471 + ],
47.472 + srls = Erls,
47.473 + calc = [],
47.474 + (*asm_thm = [],*)
47.475 + rules = [Thm ("real_plus_binom_pow4_poly",num_str real_plus_binom_pow4_poly),
47.476 + (*"[| a is_polyexp; b is_polyexp |] ==> (a + b)^^^4 = ... "*)
47.477 + Thm ("real_plus_binom_pow5_poly",num_str real_plus_binom_pow5_poly),
47.478 + (*"[| a is_polyexp; b is_polyexp |] ==> (a + b)^^^5 = ... "*)
47.479 + Thm ("real_plus_binom_pow2_poly",num_str real_plus_binom_pow2_poly),
47.480 + (*"[| a is_polyexp; b is_polyexp |] ==>
47.481 + (a + b)^^^2 = a^^^2 + 2*a*b + b^^^2"*)
47.482 + Thm ("real_plus_binom_pow3_poly",num_str real_plus_binom_pow3_poly),
47.483 + (*"[| a is_polyexp; b is_polyexp |] ==>
47.484 + (a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3" *)
47.485 + Thm ("real_plus_minus_binom1_p_p",num_str real_plus_minus_binom1_p_p),
47.486 + (*"(a + b)*(a + -1 * b) = a^^^2 + -1*b^^^2"*)
47.487 + Thm ("real_plus_minus_binom2_p_p",num_str real_plus_minus_binom2_p_p),
47.488 + (*"(a + -1 * b)*(a + b) = a^^^2 + -1*b^^^2"*)
47.489 +
47.490 + Thm ("real_add_mult_distrib_poly" ,num_str real_add_mult_distrib_poly),
47.491 + (*"w is_polyexp ==> (z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
47.492 + Thm ("real_add_mult_distrib2_poly",num_str real_add_mult_distrib2_poly),
47.493 + (*"w is_polyexp ==> w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
47.494 +
47.495 + Thm ("realpow_multI_poly", num_str realpow_multI_poly),
47.496 + (*"[| r is_polyexp; s is_polyexp |] ==>
47.497 + (r * s) ^^^ n = r ^^^ n * s ^^^ n"*)
47.498 + Thm ("realpow_pow",num_str realpow_pow)
47.499 + (*"(a ^^^ b) ^^^ c = a ^^^ (b * c)"*)
47.500 + ], scr = EmptyScr}:rls;
47.501 +
47.502 +val simplify_power_ =
47.503 + Rls{id = "simplify_power_", preconds = [],
47.504 + rew_ord = ("dummy_ord", dummy_ord),
47.505 + erls = e_rls, srls = Erls,
47.506 + calc = [],
47.507 + (*asm_thm = [],*)
47.508 + rules = [(*MG: Reihenfolge der folgenden 2 Thm muss so bleiben, wegen
47.509 + a*(a*a) --> a*a^^^2 und nicht a*(a*a) --> a^^^2*a *)
47.510 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
47.511 + (*"r * r = r ^^^ 2"*)
47.512 + Thm ("realpow_twoI_assoc_l",num_str realpow_twoI_assoc_l),
47.513 + (*"r * (r * s) = r ^^^ 2 * s"*)
47.514 +
47.515 + Thm ("realpow_plus_1",num_str realpow_plus_1),
47.516 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
47.517 + Thm ("realpow_plus_1_assoc_l", num_str realpow_plus_1_assoc_l),
47.518 + (*"r * (r ^^^ m * s) = r ^^^ (1 + m) * s"*)
47.519 + (*MG 9.7.03: neues Thm wegen a*(a*(a*b)) --> a^^^2*(a*b) *)
47.520 + Thm ("realpow_plus_1_assoc_l2", num_str realpow_plus_1_assoc_l2),
47.521 + (*"r ^^^ m * (r * s) = r ^^^ (1 + m) * s"*)
47.522 +
47.523 + Thm ("sym_realpow_addI",num_str (realpow_addI RS sym)),
47.524 + (*"r ^^^ n * r ^^^ m = r ^^^ (n + m)"*)
47.525 + Thm ("realpow_addI_assoc_l", num_str realpow_addI_assoc_l),
47.526 + (*"r ^^^ n * (r ^^^ m * s) = r ^^^ (n + m) * s"*)
47.527 +
47.528 + (* ist in expand_poly - wird hier aber auch gebraucht, wegen:
47.529 + "r * r = r ^^^ 2" wenn r=a^^^b*)
47.530 + Thm ("realpow_pow",num_str realpow_pow)
47.531 + (*"(a ^^^ b) ^^^ c = a ^^^ (b * c)"*)
47.532 + ], scr = EmptyScr}:rls;
47.533 +
47.534 +val calc_add_mult_pow_ =
47.535 + Rls{id = "calc_add_mult_pow_", preconds = [],
47.536 + rew_ord = ("dummy_ord", dummy_ord),
47.537 + erls = Atools_erls(*erls3.4.03*),srls = Erls,
47.538 + calc = [("plus" , ("op +", eval_binop "#add_")),
47.539 + ("times" , ("op *", eval_binop "#mult_")),
47.540 + ("power_", ("Atools.pow", eval_binop "#power_"))
47.541 + ],
47.542 + (*asm_thm = [],*)
47.543 + rules = [Calc ("op +", eval_binop "#add_"),
47.544 + Calc ("op *", eval_binop "#mult_"),
47.545 + Calc ("Atools.pow", eval_binop "#power_")
47.546 + ], scr = EmptyScr}:rls;
47.547 +
47.548 +val reduce_012_mult_ =
47.549 + Rls{id = "reduce_012_mult_", preconds = [],
47.550 + rew_ord = ("dummy_ord", dummy_ord),
47.551 + erls = e_rls,srls = Erls,
47.552 + calc = [],
47.553 + (*asm_thm = [],*)
47.554 + rules = [(* MG: folgende Thm müssen hier stehen bleiben: *)
47.555 + Thm ("real_mult_1_right",num_str real_mult_1_right),
47.556 + (*"z * 1 = z"*) (*wegen "a * b * b^^^(-1) + a"*)
47.557 + Thm ("realpow_zeroI",num_str realpow_zeroI),
47.558 + (*"r ^^^ 0 = 1"*) (*wegen "a*a^^^(-1)*c + b + c"*)
47.559 + Thm ("realpow_oneI",num_str realpow_oneI),
47.560 + (*"r ^^^ 1 = r"*)
47.561 + Thm ("realpow_eq_oneI",num_str realpow_eq_oneI)
47.562 + (*"1 ^^^ n = 1"*)
47.563 + ], scr = EmptyScr}:rls;
47.564 +
47.565 +val collect_numerals_ =
47.566 + Rls{id = "collect_numerals_", preconds = [],
47.567 + rew_ord = ("dummy_ord", dummy_ord),
47.568 + erls = Atools_erls, srls = Erls,
47.569 + calc = [("plus" , ("op +", eval_binop "#add_"))
47.570 + ],
47.571 + rules = [Thm ("real_num_collect",num_str real_num_collect),
47.572 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
47.573 + Thm ("real_num_collect_assoc_r",num_str real_num_collect_assoc_r),
47.574 + (*"[| l is_const; m is_const |] ==> \
47.575 + \(k + m * n) + l * n = k + (l + m)*n"*)
47.576 + Thm ("real_one_collect",num_str real_one_collect),
47.577 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
47.578 + Thm ("real_one_collect_assoc_r",num_str real_one_collect_assoc_r),
47.579 + (*"m is_const ==> (k + n) + m * n = k + (m + 1) * n"*)
47.580 +
47.581 + Calc ("op +", eval_binop "#add_"),
47.582 +
47.583 + (*MG: Reihenfolge der folgenden 2 Thm muss so bleiben, wegen
47.584 + (a+a)+a --> a + 2*a --> 3*a and not (a+a)+a --> 2*a + a *)
47.585 + Thm ("real_mult_2_assoc_r",num_str real_mult_2_assoc_r),
47.586 + (*"(k + z1) + z1 = k + 2 * z1"*)
47.587 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym))
47.588 + (*"z1 + z1 = 2 * z1"*)
47.589 +
47.590 + ], scr = EmptyScr}:rls;
47.591 +
47.592 +val reduce_012_ =
47.593 + Rls{id = "reduce_012_", preconds = [],
47.594 + rew_ord = ("dummy_ord", dummy_ord),
47.595 + erls = e_rls,srls = Erls,
47.596 + calc = [],
47.597 + (*asm_thm = [],*)
47.598 + rules = [Thm ("real_mult_1",num_str real_mult_1),
47.599 + (*"1 * z = z"*)
47.600 + Thm ("real_mult_0",num_str real_mult_0),
47.601 + (*"0 * z = 0"*)
47.602 + Thm ("real_mult_0_right",num_str real_mult_0_right),
47.603 + (*"z * 0 = 0"*)
47.604 + Thm ("real_add_zero_left",num_str real_add_zero_left),
47.605 + (*"0 + z = z"*)
47.606 + Thm ("real_add_zero_right",num_str real_add_zero_right),
47.607 + (*"z + 0 = z"*) (*wegen a+b-b --> a+(1-1)*b --> a+0 --> a*)
47.608 +
47.609 + (*Thm ("realpow_oneI",num_str realpow_oneI)*)
47.610 + (*"?r ^^^ 1 = ?r"*)
47.611 + Thm ("real_0_divide",num_str real_0_divide)(*WN060914*)
47.612 + (*"0 / ?x = 0"*)
47.613 + ], scr = EmptyScr}:rls;
47.614 +
47.615 +(*ein Hilfs-'ruleset' (benutzt das leere 'ruleset')*)
47.616 +val discard_parentheses_ =
47.617 + append_rls "discard_parentheses_" e_rls
47.618 + [Thm ("sym_real_mult_assoc", num_str (real_mult_assoc RS sym))
47.619 + (*"?z1.1 * (?z2.1 * ?z3.1) = ?z1.1 * ?z2.1 * ?z3.1"*)
47.620 + (*Thm ("sym_real_add_assoc",num_str (real_add_assoc RS sym))*)
47.621 + (*"?z1.1 + (?z2.1 + ?z3.1) = ?z1.1 + ?z2.1 + ?z3.1"*)
47.622 + ];
47.623 +
47.624 +(*----------------- End: rulesets for make_polynomial_ -----------------*)
47.625 +
47.626 +(*MG.0401 ev. for use in rls with ordered rewriting ?
47.627 +val collect_numerals_left =
47.628 + Rls{id = "collect_numerals", preconds = [],
47.629 + rew_ord = ("dummy_ord", dummy_ord),
47.630 + erls = Atools_erls(*erls3.4.03*),srls = Erls,
47.631 + calc = [("plus" , ("op +", eval_binop "#add_")),
47.632 + ("times" , ("op *", eval_binop "#mult_")),
47.633 + ("power_", ("Atools.pow", eval_binop "#power_"))
47.634 + ],
47.635 + (*asm_thm = [],*)
47.636 + rules = [Thm ("real_num_collect",num_str real_num_collect),
47.637 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
47.638 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
47.639 + (*"[| l is_const; m is_const |] ==>
47.640 + l * n + (m * n + k) = (l + m) * n + k"*)
47.641 + Thm ("real_one_collect",num_str real_one_collect),
47.642 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
47.643 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
47.644 + (*"m is_const ==> n + (m * n + k) = (1 + m) * n + k"*)
47.645 +
47.646 + Calc ("op +", eval_binop "#add_"),
47.647 +
47.648 + (*MG am 2.5.03: 2 Theoreme aus reduce_012 hierher verschoben*)
47.649 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
47.650 + (*"z1 + z1 = 2 * z1"*)
47.651 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc)
47.652 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
47.653 + ], scr = EmptyScr}:rls;*)
47.654 +
47.655 +val expand_poly =
47.656 + Rls{id = "expand_poly", preconds = [],
47.657 + rew_ord = ("dummy_ord", dummy_ord),
47.658 + erls = e_rls,srls = Erls,
47.659 + calc = [],
47.660 + (*asm_thm = [],*)
47.661 + rules = [Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
47.662 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
47.663 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
47.664 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
47.665 + (*Thm ("real_add_mult_distrib1",num_str real_add_mult_distrib1),
47.666 + ....... 18.3.03 undefined???*)
47.667 +
47.668 + Thm ("real_plus_binom_pow2",num_str real_plus_binom_pow2),
47.669 + (*"(a + b)^^^2 = a^^^2 + 2*a*b + b^^^2"*)
47.670 + Thm ("real_minus_binom_pow2_p",num_str real_minus_binom_pow2_p),
47.671 + (*"(a - b)^^^2 = a^^^2 + -2*a*b + b^^^2"*)
47.672 + Thm ("real_plus_minus_binom1_p",
47.673 + num_str real_plus_minus_binom1_p),
47.674 + (*"(a + b)*(a - b) = a^^^2 + -1*b^^^2"*)
47.675 + Thm ("real_plus_minus_binom2_p",
47.676 + num_str real_plus_minus_binom2_p),
47.677 + (*"(a - b)*(a + b) = a^^^2 + -1*b^^^2"*)
47.678 +
47.679 + Thm ("real_minus_minus",num_str real_minus_minus),
47.680 + (*"- (- ?z) = ?z"*)
47.681 + Thm ("real_diff_minus",num_str real_diff_minus),
47.682 + (*"a - b = a + -1 * b"*)
47.683 + Thm ("sym_real_mult_minus1",num_str (real_mult_minus1 RS sym))
47.684 + (*- ?z = "-1 * ?z"*)
47.685 +
47.686 + (*Thm ("",num_str ),
47.687 + Thm ("",num_str ),
47.688 + Thm ("",num_str ),*)
47.689 + (*Thm ("real_minus_add_distrib",
47.690 + num_str real_minus_add_distrib),*)
47.691 + (*"- (?x + ?y) = - ?x + - ?y"*)
47.692 + (*Thm ("real_diff_plus",num_str real_diff_plus)*)
47.693 + (*"a - b = a + -b"*)
47.694 + ], scr = EmptyScr}:rls;
47.695 +val simplify_power =
47.696 + Rls{id = "simplify_power", preconds = [],
47.697 + rew_ord = ("dummy_ord", dummy_ord),
47.698 + erls = e_rls, srls = Erls,
47.699 + calc = [],
47.700 + (*asm_thm = [],*)
47.701 + rules = [Thm ("realpow_multI", num_str realpow_multI),
47.702 + (*"(r * s) ^^^ n = r ^^^ n * s ^^^ n"*)
47.703 +
47.704 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
47.705 + (*"r1 * r1 = r1 ^^^ 2"*)
47.706 + Thm ("realpow_plus_1",num_str realpow_plus_1),
47.707 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
47.708 + Thm ("realpow_pow",num_str realpow_pow),
47.709 + (*"(a ^^^ b) ^^^ c = a ^^^ (b * c)"*)
47.710 + Thm ("sym_realpow_addI",num_str (realpow_addI RS sym)),
47.711 + (*"r ^^^ n * r ^^^ m = r ^^^ (n + m)"*)
47.712 + Thm ("realpow_oneI",num_str realpow_oneI),
47.713 + (*"r ^^^ 1 = r"*)
47.714 + Thm ("realpow_eq_oneI",num_str realpow_eq_oneI)
47.715 + (*"1 ^^^ n = 1"*)
47.716 + ], scr = EmptyScr}:rls;
47.717 +(*MG.0401: termorders for multivariate polys dropped due to principal problems:
47.718 + (total-degree-)ordering of monoms NOT possible with size_of_term GIVEN*)
47.719 +val order_add_mult =
47.720 + Rls{id = "order_add_mult", preconds = [],
47.721 + rew_ord = ("ord_make_polynomial",ord_make_polynomial false Poly.thy),
47.722 + erls = e_rls,srls = Erls,
47.723 + calc = [],
47.724 + (*asm_thm = [],*)
47.725 + rules = [Thm ("real_mult_commute",num_str real_mult_commute),
47.726 + (* z * w = w * z *)
47.727 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
47.728 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
47.729 + Thm ("real_mult_assoc",num_str real_mult_assoc),
47.730 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
47.731 + Thm ("real_add_commute",num_str real_add_commute),
47.732 + (*z + w = w + z*)
47.733 + Thm ("real_add_left_commute",num_str real_add_left_commute),
47.734 + (*x + (y + z) = y + (x + z)*)
47.735 + Thm ("real_add_assoc",num_str real_add_assoc)
47.736 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
47.737 + ], scr = EmptyScr}:rls;
47.738 +(*MG.0401: termorders for multivariate polys dropped due to principal problems:
47.739 + (total-degree-)ordering of monoms NOT possible with size_of_term GIVEN*)
47.740 +val order_mult =
47.741 + Rls{id = "order_mult", preconds = [],
47.742 + rew_ord = ("ord_make_polynomial",ord_make_polynomial false Poly.thy),
47.743 + erls = e_rls,srls = Erls,
47.744 + calc = [],
47.745 + (*asm_thm = [],*)
47.746 + rules = [Thm ("real_mult_commute",num_str real_mult_commute),
47.747 + (* z * w = w * z *)
47.748 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
47.749 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
47.750 + Thm ("real_mult_assoc",num_str real_mult_assoc)
47.751 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
47.752 + ], scr = EmptyScr}:rls;
47.753 +val collect_numerals =
47.754 + Rls{id = "collect_numerals", preconds = [],
47.755 + rew_ord = ("dummy_ord", dummy_ord),
47.756 + erls = Atools_erls(*erls3.4.03*),srls = Erls,
47.757 + calc = [("plus" , ("op +", eval_binop "#add_")),
47.758 + ("times" , ("op *", eval_binop "#mult_")),
47.759 + ("power_", ("Atools.pow", eval_binop "#power_"))
47.760 + ],
47.761 + (*asm_thm = [],*)
47.762 + rules = [Thm ("real_num_collect",num_str real_num_collect),
47.763 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
47.764 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
47.765 + (*"[| l is_const; m is_const |] ==>
47.766 + l * n + (m * n + k) = (l + m) * n + k"*)
47.767 + Thm ("real_one_collect",num_str real_one_collect),
47.768 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
47.769 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
47.770 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
47.771 + Calc ("op +", eval_binop "#add_"),
47.772 + Calc ("op *", eval_binop "#mult_"),
47.773 + Calc ("Atools.pow", eval_binop "#power_")
47.774 + ], scr = EmptyScr}:rls;
47.775 +val reduce_012 =
47.776 + Rls{id = "reduce_012", preconds = [],
47.777 + rew_ord = ("dummy_ord", dummy_ord),
47.778 + erls = e_rls,srls = Erls,
47.779 + calc = [],
47.780 + (*asm_thm = [],*)
47.781 + rules = [Thm ("real_mult_1",num_str real_mult_1),
47.782 + (*"1 * z = z"*)
47.783 + (*Thm ("real_mult_minus1",num_str real_mult_minus1),14.3.03*)
47.784 + (*"-1 * z = - z"*)
47.785 + Thm ("sym_real_mult_minus_eq1",
47.786 + num_str (real_mult_minus_eq1 RS sym)),
47.787 + (*- (?x * ?y) = "- ?x * ?y"*)
47.788 + (*Thm ("real_minus_mult_cancel",num_str real_minus_mult_cancel),
47.789 + (*"- ?x * - ?y = ?x * ?y"*)---*)
47.790 + Thm ("real_mult_0",num_str real_mult_0),
47.791 + (*"0 * z = 0"*)
47.792 + Thm ("real_add_zero_left",num_str real_add_zero_left),
47.793 + (*"0 + z = z"*)
47.794 + Thm ("real_add_minus",num_str real_add_minus),
47.795 + (*"?z + - ?z = 0"*)
47.796 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
47.797 + (*"z1 + z1 = 2 * z1"*)
47.798 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc)
47.799 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
47.800 + ], scr = EmptyScr}:rls;
47.801 +(*ein Hilfs-'ruleset' (benutzt das leere 'ruleset')*)
47.802 +val discard_parentheses =
47.803 + append_rls "discard_parentheses" e_rls
47.804 + [Thm ("sym_real_mult_assoc", num_str (real_mult_assoc RS sym)),
47.805 + Thm ("sym_real_add_assoc",num_str (real_add_assoc RS sym))];
47.806 +
47.807 +val scr_make_polynomial =
47.808 +"Script Expand_binoms t_ =\
47.809 +\(Repeat \
47.810 +\((Try (Repeat (Rewrite real_diff_minus False))) @@ \
47.811 +
47.812 +\ (Try (Repeat (Rewrite real_add_mult_distrib False))) @@ \
47.813 +\ (Try (Repeat (Rewrite real_add_mult_distrib2 False))) @@ \
47.814 +\ (Try (Repeat (Rewrite real_diff_mult_distrib False))) @@ \
47.815 +\ (Try (Repeat (Rewrite real_diff_mult_distrib2 False))) @@ \
47.816 +
47.817 +\ (Try (Repeat (Rewrite real_mult_1 False))) @@ \
47.818 +\ (Try (Repeat (Rewrite real_mult_0 False))) @@ \
47.819 +\ (Try (Repeat (Rewrite real_add_zero_left False))) @@ \
47.820 +
47.821 +\ (Try (Repeat (Rewrite real_mult_commute False))) @@ \
47.822 +\ (Try (Repeat (Rewrite real_mult_left_commute False))) @@ \
47.823 +\ (Try (Repeat (Rewrite real_mult_assoc False))) @@ \
47.824 +\ (Try (Repeat (Rewrite real_add_commute False))) @@ \
47.825 +\ (Try (Repeat (Rewrite real_add_left_commute False))) @@ \
47.826 +\ (Try (Repeat (Rewrite real_add_assoc False))) @@ \
47.827 +
47.828 +\ (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ \
47.829 +\ (Try (Repeat (Rewrite realpow_plus_1 False))) @@ \
47.830 +\ (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ \
47.831 +\ (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ \
47.832 +
47.833 +\ (Try (Repeat (Rewrite real_num_collect False))) @@ \
47.834 +\ (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ \
47.835 +
47.836 +\ (Try (Repeat (Rewrite real_one_collect False))) @@ \
47.837 +\ (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ \
47.838 +
47.839 +\ (Try (Repeat (Calculate plus ))) @@ \
47.840 +\ (Try (Repeat (Calculate times ))) @@ \
47.841 +\ (Try (Repeat (Calculate power_)))) \
47.842 +\ t_)";
47.843 +
47.844 +(*version used by MG.02/03, overwritten by version AG in 04 below
47.845 +val make_polynomial = prep_rls(
47.846 + Seq{id = "make_polynomial", preconds = []:term list,
47.847 + rew_ord = ("dummy_ord", dummy_ord),
47.848 + erls = Atools_erls, srls = Erls,
47.849 + calc = [],(*asm_thm = [],*)
47.850 + rules = [Rls_ expand_poly,
47.851 + Rls_ order_add_mult,
47.852 + Rls_ simplify_power, (*realpow_eq_oneI, eg. x^1 --> x *)
47.853 + Rls_ collect_numerals, (*eg. x^(2+ -1) --> x^1 *)
47.854 + Rls_ reduce_012,
47.855 + Thm ("realpow_oneI",num_str realpow_oneI),(*in --^*)
47.856 + Rls_ discard_parentheses
47.857 + ],
47.858 + scr = EmptyScr
47.859 + }:rls); *)
47.860 +
47.861 +val scr_expand_binoms =
47.862 +"Script Expand_binoms t_ =\
47.863 +\(Repeat \
47.864 +\((Try (Repeat (Rewrite real_plus_binom_pow2 False))) @@ \
47.865 +\ (Try (Repeat (Rewrite real_plus_binom_times False))) @@ \
47.866 +\ (Try (Repeat (Rewrite real_minus_binom_pow2 False))) @@ \
47.867 +\ (Try (Repeat (Rewrite real_minus_binom_times False))) @@ \
47.868 +\ (Try (Repeat (Rewrite real_plus_minus_binom1 False))) @@ \
47.869 +\ (Try (Repeat (Rewrite real_plus_minus_binom2 False))) @@ \
47.870 +
47.871 +\ (Try (Repeat (Rewrite real_mult_1 False))) @@ \
47.872 +\ (Try (Repeat (Rewrite real_mult_0 False))) @@ \
47.873 +\ (Try (Repeat (Rewrite real_add_zero_left False))) @@ \
47.874 +
47.875 +\ (Try (Repeat (Calculate plus ))) @@ \
47.876 +\ (Try (Repeat (Calculate times ))) @@ \
47.877 +\ (Try (Repeat (Calculate power_))) @@ \
47.878 +
47.879 +\ (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ \
47.880 +\ (Try (Repeat (Rewrite realpow_plus_1 False))) @@ \
47.881 +\ (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ \
47.882 +\ (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ \
47.883 +
47.884 +\ (Try (Repeat (Rewrite real_num_collect False))) @@ \
47.885 +\ (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ \
47.886 +
47.887 +\ (Try (Repeat (Rewrite real_one_collect False))) @@ \
47.888 +\ (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ \
47.889 +
47.890 +\ (Try (Repeat (Calculate plus ))) @@ \
47.891 +\ (Try (Repeat (Calculate times ))) @@ \
47.892 +\ (Try (Repeat (Calculate power_)))) \
47.893 +\ t_)";
47.894 +
47.895 +val expand_binoms =
47.896 + Rls{id = "expand_binoms", preconds = [], rew_ord = ("termlessI",termlessI),
47.897 + erls = Atools_erls, srls = Erls,
47.898 + calc = [("plus" , ("op +", eval_binop "#add_")),
47.899 + ("times" , ("op *", eval_binop "#mult_")),
47.900 + ("power_", ("Atools.pow", eval_binop "#power_"))
47.901 + ],
47.902 + (*asm_thm = [],*)
47.903 + rules = [Thm ("real_plus_binom_pow2" ,num_str real_plus_binom_pow2),
47.904 + (*"(a + b) ^^^ 2 = a ^^^ 2 + 2 * a * b + b ^^^ 2"*)
47.905 + Thm ("real_plus_binom_times" ,num_str real_plus_binom_times),
47.906 + (*"(a + b)*(a + b) = ...*)
47.907 + Thm ("real_minus_binom_pow2" ,num_str real_minus_binom_pow2),
47.908 + (*"(a - b) ^^^ 2 = a ^^^ 2 - 2 * a * b + b ^^^ 2"*)
47.909 + Thm ("real_minus_binom_times",num_str real_minus_binom_times),
47.910 + (*"(a - b)*(a - b) = ...*)
47.911 + Thm ("real_plus_minus_binom1",num_str real_plus_minus_binom1),
47.912 + (*"(a + b) * (a - b) = a ^^^ 2 - b ^^^ 2"*)
47.913 + Thm ("real_plus_minus_binom2",num_str real_plus_minus_binom2),
47.914 + (*"(a - b) * (a + b) = a ^^^ 2 - b ^^^ 2"*)
47.915 + (*RL 020915*)
47.916 + Thm ("real_pp_binom_times",num_str real_pp_binom_times),
47.917 + (*(a + b)*(c + d) = a*c + a*d + b*c + b*d*)
47.918 + Thm ("real_pm_binom_times",num_str real_pm_binom_times),
47.919 + (*(a + b)*(c - d) = a*c - a*d + b*c - b*d*)
47.920 + Thm ("real_mp_binom_times",num_str real_mp_binom_times),
47.921 + (*(a - b)*(c + d) = a*c + a*d - b*c - b*d*)
47.922 + Thm ("real_mm_binom_times",num_str real_mm_binom_times),
47.923 + (*(a - b)*(c - d) = a*c - a*d - b*c + b*d*)
47.924 + Thm ("realpow_multI",num_str realpow_multI),
47.925 + (*(a*b)^^^n = a^^^n * b^^^n*)
47.926 + Thm ("real_plus_binom_pow3",num_str real_plus_binom_pow3),
47.927 + (* (a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3 *)
47.928 + Thm ("real_minus_binom_pow3",num_str real_minus_binom_pow3),
47.929 + (* (a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3 *)
47.930 +
47.931 +
47.932 + (* Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
47.933 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
47.934 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
47.935 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
47.936 + Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
47.937 + (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
47.938 + Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
47.939 + (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
47.940 + *)
47.941 +
47.942 + Thm ("real_mult_1",num_str real_mult_1), (*"1 * z = z"*)
47.943 + Thm ("real_mult_0",num_str real_mult_0), (*"0 * z = 0"*)
47.944 + Thm ("real_add_zero_left",num_str real_add_zero_left),(*"0 + z = z"*)
47.945 +
47.946 + Calc ("op +", eval_binop "#add_"),
47.947 + Calc ("op *", eval_binop "#mult_"),
47.948 + Calc ("Atools.pow", eval_binop "#power_"),
47.949 + (*
47.950 + Thm ("real_mult_commute",num_str real_mult_commute), (*AC-rewriting*)
47.951 + Thm ("real_mult_left_commute",num_str real_mult_left_commute), (**)
47.952 + Thm ("real_mult_assoc",num_str real_mult_assoc), (**)
47.953 + Thm ("real_add_commute",num_str real_add_commute), (**)
47.954 + Thm ("real_add_left_commute",num_str real_add_left_commute), (**)
47.955 + Thm ("real_add_assoc",num_str real_add_assoc), (**)
47.956 + *)
47.957 +
47.958 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
47.959 + (*"r1 * r1 = r1 ^^^ 2"*)
47.960 + Thm ("realpow_plus_1",num_str realpow_plus_1),
47.961 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
47.962 + (*Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
47.963 + (*"z1 + z1 = 2 * z1"*)*)
47.964 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
47.965 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
47.966 +
47.967 + Thm ("real_num_collect",num_str real_num_collect),
47.968 + (*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
47.969 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
47.970 + (*"[| l is_const; m is_const |] ==> l * n + (m * n + k) = (l + m) * n + k"*)
47.971 + Thm ("real_one_collect",num_str real_one_collect),
47.972 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
47.973 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
47.974 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
47.975 +
47.976 + Calc ("op +", eval_binop "#add_"),
47.977 + Calc ("op *", eval_binop "#mult_"),
47.978 + Calc ("Atools.pow", eval_binop "#power_")
47.979 + ],
47.980 + scr = Script ((term_of o the o (parse thy)) scr_expand_binoms)
47.981 + }:rls;
47.982 +
47.983 +
47.984 +"******* Poly.ML end ******* ...RL";
47.985 +
47.986 +
47.987 +(**. MG.03: make_polynomial_ ... uses SML-fun for ordering .**)
47.988 +
47.989 +(*FIXME.0401: make SML-order local to make_polynomial(_) *)
47.990 +(*FIXME.0401: replace 'make_polynomial'(old) by 'make_polynomial_'(MG) *)
47.991 +(* Polynom --> List von Monomen *)
47.992 +fun poly2list (Const ("op +",_) $ t1 $ t2) =
47.993 + (poly2list t1) @ (poly2list t2)
47.994 + | poly2list t = [t];
47.995 +
47.996 +(* Monom --> Liste von Variablen *)
47.997 +fun monom2list (Const ("op *",_) $ t1 $ t2) =
47.998 + (monom2list t1) @ (monom2list t2)
47.999 + | monom2list t = [t];
47.1000 +
47.1001 +(* liefert Variablenname (String) einer Variablen und Basis bei Potenz *)
47.1002 +fun get_basStr (Const ("Atools.pow",_) $ Free (str, _) $ _) = str
47.1003 + | get_basStr (Free (str, _)) = str
47.1004 + | get_basStr t = "|||"; (* gross gewichtet; für Brüch ect. *)
47.1005 +(*| get_basStr t =
47.1006 + raise error("get_basStr: called with t= "^(term2str t));*)
47.1007 +
47.1008 +(* liefert Hochzahl (String) einer Variablen bzw Gewichtstring (zum Sortieren) *)
47.1009 +fun get_potStr (Const ("Atools.pow",_) $ Free _ $ Free (str, _)) = str
47.1010 + | get_potStr (Const ("Atools.pow",_) $ Free _ $ _ ) = "|||" (* gross gewichtet *)
47.1011 + | get_potStr (Free (str, _)) = "---" (* keine Hochzahl --> kleinst gewichtet *)
47.1012 + | get_potStr t = "||||||"; (* gross gewichtet; für Brüch ect. *)
47.1013 +(*| get_potStr t =
47.1014 + raise error("get_potStr: called with t= "^(term2str t));*)
47.1015 +
47.1016 +(* Umgekehrte string_ord *)
47.1017 +val string_ord_rev = rev_order o string_ord;
47.1018 +
47.1019 + (* Ordnung zum lexikographischen Vergleich zweier Variablen (oder Potenzen)
47.1020 + innerhalb eines Monomes:
47.1021 + - zuerst lexikographisch nach Variablenname
47.1022 + - wenn gleich: nach steigender Potenz *)
47.1023 +fun var_ord (a,b: term) = prod_ord string_ord string_ord
47.1024 + ((get_basStr a, get_potStr a), (get_basStr b, get_potStr b));
47.1025 +
47.1026 +(* Ordnung zum lexikographischen Vergleich zweier Variablen (oder Potenzen);
47.1027 + verwendet zum Sortieren von Monomen mittels Gesamtgradordnung:
47.1028 + - zuerst lexikographisch nach Variablenname
47.1029 + - wenn gleich: nach sinkender Potenz*)
47.1030 +fun var_ord_revPow (a,b: term) = prod_ord string_ord string_ord_rev
47.1031 + ((get_basStr a, get_potStr a), (get_basStr b, get_potStr b));
47.1032 +
47.1033 +
47.1034 +(* Ordnet ein Liste von Variablen (und Potenzen) lexikographisch *)
47.1035 +val sort_varList = sort var_ord;
47.1036 +
47.1037 +(* Entfernet aeussersten Operator (Wurzel) aus einem Term und schreibt
47.1038 + Argumente in eine Liste *)
47.1039 +fun args u : term list =
47.1040 + let fun stripc (f$t, ts) = stripc (f, t::ts)
47.1041 + | stripc (t as Free _, ts) = (t::ts)
47.1042 + | stripc (_, ts) = ts
47.1043 + in stripc (u, []) end;
47.1044 +
47.1045 +(* liefert True, falls der Term (Liste von Termen) nur Zahlen
47.1046 + (keine Variablen) enthaelt *)
47.1047 +fun filter_num [] = true
47.1048 + | filter_num [Free x] = if (is_num (Free x)) then true
47.1049 + else false
47.1050 + | filter_num ((Free _)::_) = false
47.1051 + | filter_num ts =
47.1052 + (filter_num o (filter_out is_num) o flat o (map args)) ts;
47.1053 +
47.1054 +(* liefert True, falls der Term nur Zahlen (keine Variablen) enthaelt
47.1055 + dh. er ist ein numerischer Wert und entspricht einem Koeffizienten *)
47.1056 +fun is_nums t = filter_num [t];
47.1057 +
47.1058 +(* Berechnet den Gesamtgrad eines Monoms *)
47.1059 +local
47.1060 + fun counter (n, []) = n
47.1061 + | counter (n, x :: xs) =
47.1062 + if (is_nums x) then
47.1063 + counter (n, xs)
47.1064 + else
47.1065 + (case x of
47.1066 + (Const ("Atools.pow", _) $ Free (str_b, _) $ Free (str_h, T)) =>
47.1067 + if (is_nums (Free (str_h, T))) then
47.1068 + counter (n + (the (int_of_str str_h)), xs)
47.1069 + else counter (n + 1000, xs) (*FIXME.MG?!*)
47.1070 + | (Const ("Atools.pow", _) $ Free (str_b, _) $ _ ) =>
47.1071 + counter (n + 1000, xs) (*FIXME.MG?!*)
47.1072 + | (Free (str, _)) => counter (n + 1, xs)
47.1073 + (*| _ => raise error("monom_degree: called with factor: "^(term2str x)))*)
47.1074 + | _ => counter (n + 10000, xs)) (*FIXME.MG?! ... Brüche ect.*)
47.1075 +in
47.1076 + fun monom_degree l = counter (0, l)
47.1077 +end;
47.1078 +
47.1079 +(* wie Ordnung dict_ord (lexicographische Ordnung zweier Listen, mit Vergleich
47.1080 + der Listen-Elemente mit elem_ord) - Elemente die Bedingung cond erfuellen,
47.1081 + werden jedoch dabei ignoriert (uebersprungen) *)
47.1082 +fun dict_cond_ord _ _ ([], []) = EQUAL
47.1083 + | dict_cond_ord _ _ ([], _ :: _) = LESS
47.1084 + | dict_cond_ord _ _ (_ :: _, []) = GREATER
47.1085 + | dict_cond_ord elem_ord cond (x :: xs, y :: ys) =
47.1086 + (case (cond x, cond y) of
47.1087 + (false, false) => (case elem_ord (x, y) of
47.1088 + EQUAL => dict_cond_ord elem_ord cond (xs, ys)
47.1089 + | ord => ord)
47.1090 + | (false, true) => dict_cond_ord elem_ord cond (x :: xs, ys)
47.1091 + | (true, false) => dict_cond_ord elem_ord cond (xs, y :: ys)
47.1092 + | (true, true) => dict_cond_ord elem_ord cond (xs, ys) );
47.1093 +
47.1094 +(* Gesamtgradordnung zum Vergleich von Monomen (Liste von Variablen/Potenzen):
47.1095 + zuerst nach Gesamtgrad, bei gleichem Gesamtgrad lexikographisch ordnen -
47.1096 + dabei werden Koeffizienten ignoriert (2*3*a^^^2*4*b gilt wie a^^^2*b) *)
47.1097 +fun degree_ord (xs, ys) =
47.1098 + prod_ord int_ord (dict_cond_ord var_ord_revPow is_nums)
47.1099 + ((monom_degree xs, xs), (monom_degree ys, ys));
47.1100 +
47.1101 +fun hd_str str = substring (str, 0, 1);
47.1102 +fun tl_str str = substring (str, 1, (size str) - 1);
47.1103 +
47.1104 +(* liefert nummerischen Koeffizienten eines Monoms oder None *)
47.1105 +fun get_koeff_of_mon [] = raise error("get_koeff_of_mon: called with l = []")
47.1106 + | get_koeff_of_mon (l as x::xs) = if is_nums x then Some x
47.1107 + else None;
47.1108 +
47.1109 +(* wandelt Koeffizient in (zum sortieren geeigneten) String um *)
47.1110 +fun koeff2ordStr (Some x) = (case x of
47.1111 + (Free (str, T)) =>
47.1112 + if (hd_str str) = "-" then (tl_str str)^"0" (* 3 < -3 *)
47.1113 + else str
47.1114 + | _ => "aaa") (* "num.Ausdruck" --> gross *)
47.1115 + | koeff2ordStr None = "---"; (* "kein Koeff" --> kleinste *)
47.1116 +
47.1117 +(* Order zum Vergleich von Koeffizienten (strings):
47.1118 + "kein Koeff" < "0" < "1" < "-1" < "2" < "-2" < ... < "num.Ausdruck" *)
47.1119 +fun compare_koeff_ord (xs, ys) =
47.1120 + string_ord ((koeff2ordStr o get_koeff_of_mon) xs,
47.1121 + (koeff2ordStr o get_koeff_of_mon) ys);
47.1122 +
47.1123 +(* Gesamtgradordnung degree_ord + Ordnen nach Koeffizienten falls EQUAL *)
47.1124 +fun koeff_degree_ord (xs, ys) =
47.1125 + prod_ord degree_ord compare_koeff_ord ((xs, xs), (ys, ys));
47.1126 +
47.1127 +(* Ordnet ein Liste von Monomen (Monom = Liste von Variablen) mittels
47.1128 + Gesamtgradordnung *)
47.1129 +val sort_monList = sort koeff_degree_ord;
47.1130 +
47.1131 +(* Alternativ zu degree_ord koennte auch die viel einfachere und
47.1132 + kuerzere Ordnung simple_ord verwendet werden - ist aber nicht
47.1133 + fuer unsere Zwecke geeignet!
47.1134 +
47.1135 +fun simple_ord (al,bl: term list) = dict_ord string_ord
47.1136 + (map get_basStr al, map get_basStr bl);
47.1137 +
47.1138 +val sort_monList = sort simple_ord; *)
47.1139 +
47.1140 +(* aus 2 Variablen wird eine Summe bzw ein Produkt erzeugt
47.1141 + (mit gewuenschtem Typen T) *)
47.1142 +fun plus T = Const ("op +", [T,T] ---> T);
47.1143 +fun mult T = Const ("op *", [T,T] ---> T);
47.1144 +fun binop op_ t1 t2 = op_ $ t1 $ t2;
47.1145 +fun create_prod T (a,b) = binop (mult T) a b;
47.1146 +fun create_sum T (a,b) = binop (plus T) a b;
47.1147 +
47.1148 +(* löscht letztes Element einer Liste *)
47.1149 +fun drop_last l = take ((length l)-1,l);
47.1150 +
47.1151 +(* Liste von Variablen --> Monom *)
47.1152 +fun create_monom T vl = foldr (create_prod T) (drop_last vl, last_elem vl);
47.1153 +(* Bemerkung:
47.1154 + foldr bewirkt rechtslastige Klammerung des Monoms - ist notwendig, damit zwei
47.1155 + gleiche Monome zusammengefasst werden können (collect_numerals)!
47.1156 + zB: 2*(x*(y*z)) + 3*(x*(y*z)) --> (2+3)*(x*(y*z))*)
47.1157 +
47.1158 +(* Liste von Monomen --> Polynom *)
47.1159 +fun create_polynom T ml = foldl (create_sum T) (hd ml, tl ml);
47.1160 +(* Bemerkung:
47.1161 + foldl bewirkt linkslastige Klammerung des Polynoms (der Summanten) -
47.1162 + bessere Darstellung, da keine Klammern sichtbar!
47.1163 + (und discard_parentheses in make_polynomial hat weniger zu tun) *)
47.1164 +
47.1165 +(* sorts the variables (faktors) of an expanded polynomial lexicographical *)
47.1166 +fun sort_variables t =
47.1167 + let
47.1168 + val ll = map monom2list (poly2list t);
47.1169 + val lls = map sort_varList ll;
47.1170 + val T = type_of t;
47.1171 + val ls = map (create_monom T) lls;
47.1172 + in create_polynom T ls end;
47.1173 +
47.1174 +(* sorts the monoms of an expanded and variable-sorted polynomial
47.1175 + by total_degree *)
47.1176 +fun sort_monoms t =
47.1177 + let
47.1178 + val ll = map monom2list (poly2list t);
47.1179 + val lls = sort_monList ll;
47.1180 + val T = type_of t;
47.1181 + val ls = map (create_monom T) lls;
47.1182 + in create_polynom T ls end;
47.1183 +
47.1184 +(* auch Klammerung muss übereinstimmen;
47.1185 + sort_variables klammert Produkte rechtslastig*)
47.1186 +fun is_multUnordered t = ((is_polyexp t) andalso not (t = sort_variables t));
47.1187 +
47.1188 +fun eval_is_multUnordered (thmid:string) _
47.1189 + (t as (Const("Poly.is'_multUnordered", _) $ arg)) thy =
47.1190 + if is_multUnordered arg
47.1191 + then Some (mk_thmid thmid ""
47.1192 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
47.1193 + Trueprop $ (mk_equality (t, HOLogic.true_const)))
47.1194 + else Some (mk_thmid thmid ""
47.1195 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
47.1196 + Trueprop $ (mk_equality (t, HOLogic.false_const)))
47.1197 + | eval_is_multUnordered _ _ _ _ = None;
47.1198 +
47.1199 +
47.1200 +fun attach_form (_:rule list list) (_:term) (_:term) = (*still missing*)
47.1201 + []:(rule * (term * term list)) list;
47.1202 +fun init_state (_:term) = e_rrlsstate;
47.1203 +fun locate_rule (_:rule list list) (_:term) (_:rule) =
47.1204 + ([]:(rule * (term * term list)) list);
47.1205 +fun next_rule (_:rule list list) (_:term) = (None:rule option);
47.1206 +fun normal_form t = Some (sort_variables t,[]:term list);
47.1207 +
47.1208 +val order_mult_ =
47.1209 + Rrls {id = "order_mult_",
47.1210 + prepat =
47.1211 + [([(term_of o the o (parse thy)) "p is_multUnordered"],
47.1212 + (term_of o the o (parse thy)) "?p" )],
47.1213 + rew_ord = ("dummy_ord", dummy_ord),
47.1214 + erls = append_rls "e_rls-is_multUnordered" e_rls(*MG: poly_erls*)
47.1215 + [Calc ("Poly.is'_multUnordered", eval_is_multUnordered "")
47.1216 + ],
47.1217 + calc = [("plus" ,("op +" ,eval_binop "#add_")),
47.1218 + ("times" ,("op *" ,eval_binop "#mult_")),
47.1219 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
47.1220 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
47.1221 + (*asm_thm=[],*)
47.1222 + scr=Rfuns {init_state = init_state,
47.1223 + normal_form = normal_form,
47.1224 + locate_rule = locate_rule,
47.1225 + next_rule = next_rule,
47.1226 + attach_form = attach_form}};
47.1227 +
47.1228 +val order_mult_rls_ =
47.1229 + Rls{id = "order_mult_rls_", preconds = [],
47.1230 + rew_ord = ("dummy_ord", dummy_ord),
47.1231 + erls = e_rls,srls = Erls,
47.1232 + calc = [],
47.1233 + (*asm_thm = [],*)
47.1234 + rules = [Rls_ order_mult_
47.1235 + ], scr = EmptyScr}:rls;
47.1236 +
47.1237 +fun is_addUnordered t = ((is_polyexp t) andalso not (t = sort_monoms t));
47.1238 +
47.1239 +(*WN.18.6.03 *)
47.1240 +(*("is_addUnordered", ("Poly.is'_addUnordered", eval_is_addUnordered ""))*)
47.1241 +fun eval_is_addUnordered (thmid:string) _
47.1242 + (t as (Const("Poly.is'_addUnordered", _) $ arg)) thy =
47.1243 + if is_addUnordered arg
47.1244 + then Some (mk_thmid thmid ""
47.1245 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
47.1246 + Trueprop $ (mk_equality (t, HOLogic.true_const)))
47.1247 + else Some (mk_thmid thmid ""
47.1248 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
47.1249 + Trueprop $ (mk_equality (t, HOLogic.false_const)))
47.1250 + | eval_is_addUnordered _ _ _ _ = None;
47.1251 +
47.1252 +fun attach_form (_:rule list list) (_:term) (_:term) = (*still missing*)
47.1253 + []:(rule * (term * term list)) list;
47.1254 +fun init_state (_:term) = e_rrlsstate;
47.1255 +fun locate_rule (_:rule list list) (_:term) (_:rule) =
47.1256 + ([]:(rule * (term * term list)) list);
47.1257 +fun next_rule (_:rule list list) (_:term) = (None:rule option);
47.1258 +fun normal_form t = Some (sort_monoms t,[]:term list);
47.1259 +
47.1260 +val order_add_ =
47.1261 + Rrls {id = "order_add_",
47.1262 + prepat = (*WN.18.6.03 Preconditions und Pattern,
47.1263 + die beide passen muessen, damit das Rrls angewandt wird*)
47.1264 + [([(term_of o the o (parse thy)) "p is_addUnordered"],
47.1265 + (term_of o the o (parse thy)) "?p"
47.1266 + (*WN.18.6.03 also KEIN pattern, dieses erzeugt nur das Environment
47.1267 + fuer die Evaluation der Precondition "p is_addUnordered"*))],
47.1268 + rew_ord = ("dummy_ord", dummy_ord),
47.1269 + erls = append_rls "e_rls-is_addUnordered" e_rls(*MG: poly_erls*)
47.1270 + [Calc ("Poly.is'_addUnordered", eval_is_addUnordered "")
47.1271 + (*WN.18.6.03 definiert in Poly.thy,
47.1272 + evaluiert prepat*)],
47.1273 + calc = [("plus" ,("op +" ,eval_binop "#add_")),
47.1274 + ("times" ,("op *" ,eval_binop "#mult_")),
47.1275 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
47.1276 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
47.1277 + (*asm_thm=[],*)
47.1278 + scr=Rfuns {init_state = init_state,
47.1279 + normal_form = normal_form,
47.1280 + locate_rule = locate_rule,
47.1281 + next_rule = next_rule,
47.1282 + attach_form = attach_form}};
47.1283 +
47.1284 +val order_add_rls_ =
47.1285 + Rls{id = "order_add_rls_", preconds = [],
47.1286 + rew_ord = ("dummy_ord", dummy_ord),
47.1287 + erls = e_rls,srls = Erls,
47.1288 + calc = [],
47.1289 + (*asm_thm = [],*)
47.1290 + rules = [Rls_ order_add_
47.1291 + ], scr = EmptyScr}:rls;
47.1292 +
47.1293 +(*. see MG-DA.p.52ff .*)
47.1294 +val make_polynomial(*MG.03, overwrites version from above,
47.1295 + previously 'make_polynomial_'*) =
47.1296 + Seq {id = "make_polynomial", preconds = []:term list,
47.1297 + rew_ord = ("dummy_ord", dummy_ord),
47.1298 + erls = Atools_erls, srls = Erls,calc = [],
47.1299 + rules = [Rls_ discard_minus_,
47.1300 + Rls_ expand_poly_,
47.1301 + Calc ("op *", eval_binop "#mult_"),
47.1302 + Rls_ order_mult_rls_,
47.1303 + Rls_ simplify_power_,
47.1304 + Rls_ calc_add_mult_pow_,
47.1305 + Rls_ reduce_012_mult_,
47.1306 + Rls_ order_add_rls_,
47.1307 + Rls_ collect_numerals_,
47.1308 + Rls_ reduce_012_,
47.1309 + Rls_ discard_parentheses_
47.1310 + ],
47.1311 + scr = EmptyScr
47.1312 + }:rls;
47.1313 +val norm_Poly(*=make_polynomial*) =
47.1314 + Seq {id = "norm_Poly", preconds = []:term list,
47.1315 + rew_ord = ("dummy_ord", dummy_ord),
47.1316 + erls = Atools_erls, srls = Erls, calc = [],
47.1317 + rules = [Rls_ discard_minus_,
47.1318 + Rls_ expand_poly_,
47.1319 + Calc ("op *", eval_binop "#mult_"),
47.1320 + Rls_ order_mult_rls_,
47.1321 + Rls_ simplify_power_,
47.1322 + Rls_ calc_add_mult_pow_,
47.1323 + Rls_ reduce_012_mult_,
47.1324 + Rls_ order_add_rls_,
47.1325 + Rls_ collect_numerals_,
47.1326 + Rls_ reduce_012_,
47.1327 + Rls_ discard_parentheses_
47.1328 + ],
47.1329 + scr = EmptyScr
47.1330 + }:rls;
47.1331 +
47.1332 +(* MG:03 Like make_polynomial_ but without Rls_ discard_parentheses_
47.1333 + and expand_poly_rat_ instead of expand_poly_, see MG-DA.p.56ff*)
47.1334 +(* MG necessary for termination of norm_Rational(*_mg*) in Rational.ML*)
47.1335 +val make_rat_poly_with_parentheses =
47.1336 + Seq{id = "make_rat_poly_with_parentheses", preconds = []:term list,
47.1337 + rew_ord = ("dummy_ord", dummy_ord),
47.1338 + erls = Atools_erls, srls = Erls, calc = [],
47.1339 + rules = [Rls_ discard_minus_,
47.1340 + Rls_ expand_poly_rat_,(*ignors rationals*)
47.1341 + Calc ("op *", eval_binop "#mult_"),
47.1342 + Rls_ order_mult_rls_,
47.1343 + Rls_ simplify_power_,
47.1344 + Rls_ calc_add_mult_pow_,
47.1345 + Rls_ reduce_012_mult_,
47.1346 + Rls_ order_add_rls_,
47.1347 + Rls_ collect_numerals_,
47.1348 + Rls_ reduce_012_
47.1349 + (*Rls_ discard_parentheses_ *)
47.1350 + ],
47.1351 + scr = EmptyScr
47.1352 + }:rls;
47.1353 +
47.1354 +(*.a minimal ruleset for reverse rewriting of factions [2];
47.1355 + compare expand_binoms.*)
47.1356 +val rev_rew_p =
47.1357 +Seq{id = "reverse_rewriting", preconds = [], rew_ord = ("termlessI",termlessI),
47.1358 + erls = Atools_erls, srls = Erls,
47.1359 + calc = [(*("plus" , ("op +", eval_binop "#add_")),
47.1360 + ("times" , ("op *", eval_binop "#mult_")),
47.1361 + ("power_", ("Atools.pow", eval_binop "#power_"))*)
47.1362 + ],
47.1363 + rules = [Thm ("real_plus_binom_times" ,num_str real_plus_binom_times),
47.1364 + (*"(a + b)*(a + b) = a ^ 2 + 2 * a * b + b ^ 2*)
47.1365 + Thm ("real_plus_binom_times1" ,num_str real_plus_binom_times1),
47.1366 + (*"(a + 1*b)*(a + -1*b) = a^^^2 + -1*b^^^2"*)
47.1367 + Thm ("real_plus_binom_times2" ,num_str real_plus_binom_times2),
47.1368 + (*"(a + -1*b)*(a + 1*b) = a^^^2 + -1*b^^^2"*)
47.1369 +
47.1370 + Thm ("real_mult_1",num_str real_mult_1),(*"1 * z = z"*)
47.1371 +
47.1372 + Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
47.1373 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
47.1374 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
47.1375 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
47.1376 +
47.1377 + Thm ("real_mult_assoc", num_str real_mult_assoc),
47.1378 + (*"?z1.1 * ?z2.1 * ?z3. =1 ?z1.1 * (?z2.1 * ?z3.1)"*)
47.1379 + Rls_ order_mult_rls_,
47.1380 + (*Rls_ order_add_rls_,*)
47.1381 +
47.1382 + Calc ("op +", eval_binop "#add_"),
47.1383 + Calc ("op *", eval_binop "#mult_"),
47.1384 + Calc ("Atools.pow", eval_binop "#power_"),
47.1385 +
47.1386 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
47.1387 + (*"r1 * r1 = r1 ^^^ 2"*)
47.1388 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
47.1389 + (*"z1 + z1 = 2 * z1"*)
47.1390 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
47.1391 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
47.1392 +
47.1393 + Thm ("real_num_collect",num_str real_num_collect),
47.1394 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
47.1395 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
47.1396 + (*"[| l is_const; m is_const |] ==>
47.1397 + l * n + (m * n + k) = (l + m) * n + k"*)
47.1398 + Thm ("real_one_collect",num_str real_one_collect),
47.1399 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
47.1400 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
47.1401 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
47.1402 +
47.1403 + Thm ("realpow_multI", num_str realpow_multI),
47.1404 + (*"(r * s) ^^^ n = r ^^^ n * s ^^^ n"*)
47.1405 +
47.1406 + Calc ("op +", eval_binop "#add_"),
47.1407 + Calc ("op *", eval_binop "#mult_"),
47.1408 + Calc ("Atools.pow", eval_binop "#power_"),
47.1409 +
47.1410 + Thm ("real_mult_1",num_str real_mult_1),(*"1 * z = z"*)
47.1411 + Thm ("real_mult_0",num_str real_mult_0),(*"0 * z = 0"*)
47.1412 + Thm ("real_add_zero_left",num_str real_add_zero_left)(*0 + z = z*)
47.1413 +
47.1414 + (*Rls_ order_add_rls_*)
47.1415 + ],
47.1416 +
47.1417 + scr = EmptyScr}:rls;
47.1418 +
47.1419 +ruleset' :=
47.1420 +overwritelthy thy (!ruleset',
47.1421 + [("norm_Poly", prep_rls norm_Poly),
47.1422 + ("Poly_erls",Poly_erls)(*FIXXXME:del with rls.rls'*),
47.1423 + ("expand", prep_rls expand),
47.1424 + ("expand_poly", prep_rls expand_poly),
47.1425 + ("simplify_power", prep_rls simplify_power),
47.1426 + ("order_add_mult", prep_rls order_add_mult),
47.1427 + ("collect_numerals", prep_rls collect_numerals),
47.1428 + ("collect_numerals_", prep_rls collect_numerals_),
47.1429 + ("reduce_012", prep_rls reduce_012),
47.1430 + ("discard_parentheses", prep_rls discard_parentheses),
47.1431 + ("make_polynomial", prep_rls make_polynomial),
47.1432 + ("expand_binoms", prep_rls expand_binoms),
47.1433 + ("rev_rew_p", prep_rls rev_rew_p),
47.1434 + ("discard_minus_", prep_rls discard_minus_),
47.1435 + ("expand_poly_", prep_rls expand_poly_),
47.1436 + ("expand_poly_rat_", prep_rls expand_poly_rat_),
47.1437 + ("simplify_power_", prep_rls simplify_power_),
47.1438 + ("calc_add_mult_pow_", prep_rls calc_add_mult_pow_),
47.1439 + ("reduce_012_mult_", prep_rls reduce_012_mult_),
47.1440 + ("reduce_012_", prep_rls reduce_012_),
47.1441 + ("discard_parentheses_",prep_rls discard_parentheses_),
47.1442 + ("order_mult_rls_", prep_rls order_mult_rls_),
47.1443 + ("order_add_rls_", prep_rls order_add_rls_),
47.1444 + ("make_rat_poly_with_parentheses",
47.1445 + prep_rls make_rat_poly_with_parentheses)
47.1446 + (*("", prep_rls ),
47.1447 + ("", prep_rls ),
47.1448 + ("", prep_rls )
47.1449 + *)
47.1450 + ]);
47.1451 +
47.1452 +calclist':= overwritel (!calclist',
47.1453 + [("is_polyrat_in", ("Poly.is'_polyrat'_in",
47.1454 + eval_is_polyrat_in "#eval_is_polyrat_in")),
47.1455 + ("is_expanded_in", ("Poly.is'_expanded'_in", eval_is_expanded_in "")),
47.1456 + ("is_poly_in", ("Poly.is'_poly'_in", eval_is_poly_in "")),
47.1457 + ("has_degree_in", ("Poly.has'_degree'_in", eval_has_degree_in "")),
47.1458 + ("is_polyexp", ("Poly.is'_polyexp", eval_is_polyexp "")),
47.1459 + ("is_multUnordered", ("Poly.is'_multUnordered", eval_is_multUnordered"")),
47.1460 + ("is_addUnordered", ("Poly.is'_addUnordered", eval_is_addUnordered ""))
47.1461 + ]);
47.1462 +
47.1463 +
47.1464 +(** problems **)
47.1465 +
47.1466 +store_pbt
47.1467 + (prep_pbt Poly.thy "pbl_simp_poly" [] e_pblID
47.1468 + (["polynomial","simplification"],
47.1469 + [("#Given" ,["term t_"]),
47.1470 + ("#Where" ,["t_ is_polyexp"]),
47.1471 + ("#Find" ,["normalform n_"])
47.1472 + ],
47.1473 + append_rls "e_rls" e_rls [(*for preds in where_*)
47.1474 + Calc ("Poly.is'_polyexp", eval_is_polyexp "")],
47.1475 + Some "Simplify t_",
47.1476 + [["simplification","for_polynomials"]]));
47.1477 +
47.1478 +
47.1479 +(** methods **)
47.1480 +
47.1481 +store_met
47.1482 + (prep_met Poly.thy "met_simp_poly" [] e_metID
47.1483 + (["simplification","for_polynomials"],
47.1484 + [("#Given" ,["term t_"]),
47.1485 + ("#Where" ,["t_ is_polyexp"]),
47.1486 + ("#Find" ,["normalform n_"])
47.1487 + ],
47.1488 + {rew_ord'="tless_true",
47.1489 + rls' = e_rls,
47.1490 + calc = [],
47.1491 + srls = e_rls,
47.1492 + prls = append_rls "simplification_for_polynomials_prls" e_rls
47.1493 + [(*for preds in where_*)
47.1494 + Calc ("Poly.is'_polyexp",eval_is_polyexp"")],
47.1495 + crls = e_rls, nrls = norm_Poly},
47.1496 + "Script SimplifyScript (t_::real) = \
47.1497 + \ ((Rewrite_Set norm_Poly False) t_)"
47.1498 + ));
48.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
48.2 +++ b/src/Pure/isac/IsacKnowledge/Poly.thy Wed Jul 21 13:53:39 2010 +0200
48.3 @@ -0,0 +1,147 @@
48.4 +(* WN.020812: theorems in the Reals,
48.5 + necessary for special rule sets, in addition to Isabelle2002.
48.6 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
48.7 + !!! THIS IS THE _least_ NUMBER OF ADDITIONAL THEOREMS !!!
48.8 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
48.9 + xxxI contain ^^^ instead of ^ in the respective theorem xxx in 2002
48.10 + changed by: Richard Lang 020912
48.11 +*)
48.12 +
48.13 +(*
48.14 + use_thy"IsacKnowledge/Poly";
48.15 + use_thy"Poly";
48.16 + use_thy_only"IsacKnowledge/Poly";
48.17 +
48.18 + remove_thy"Poly";
48.19 + use_thy"IsacKnowledge/Isac";
48.20 +
48.21 +
48.22 + use"ROOT.ML";
48.23 + cd"IsacKnowledge";
48.24 + *)
48.25 +
48.26 +Poly = Simplify +
48.27 +
48.28 +(*-------------------- consts-----------------------------------------------*)
48.29 +consts
48.30 +
48.31 + is'_expanded'_in :: "[real, real] => bool" ("_ is'_expanded'_in _")
48.32 + is'_poly'_in :: "[real, real] => bool" ("_ is'_poly'_in _") (*RL DA *)
48.33 + has'_degree'_in :: "[real, real] => real" ("_ has'_degree'_in _")(*RL DA *)
48.34 + is'_polyrat'_in :: "[real, real] => bool" ("_ is'_polyrat'_in _")(*RL030626*)
48.35 +
48.36 + is'_multUnordered :: "real => bool" ("_ is'_multUnordered")
48.37 + is'_addUnordered :: "real => bool" ("_ is'_addUnordered") (*WN030618*)
48.38 + is'_polyexp :: "real => bool" ("_ is'_polyexp")
48.39 +
48.40 + Expand'_binoms
48.41 + :: "['y, \
48.42 + \ 'y] => 'y"
48.43 + ("((Script Expand'_binoms (_ =))// \
48.44 + \ (_))" 9)
48.45 +
48.46 +(*-------------------- rules------------------------------------------------*)
48.47 +rules (*.not contained in Isabelle2002,
48.48 + stated as axioms, TODO: prove as theorems;
48.49 + theorem-IDs 'xxxI' with ^^^ instead of ^ in 'xxx' in Isabelle2002.*)
48.50 +
48.51 + realpow_pow "(a ^^^ b) ^^^ c = a ^^^ (b * c)"
48.52 + realpow_addI "r ^^^ (n + m) = r ^^^ n * r ^^^ m"
48.53 + realpow_addI_assoc_l "r ^^^ n * (r ^^^ m * s) = r ^^^ (n + m) * s"
48.54 + realpow_addI_assoc_r "s * r ^^^ n * r ^^^ m = s * r ^^^ (n + m)"
48.55 +
48.56 + realpow_oneI "r ^^^ 1 = r"
48.57 + realpow_zeroI "r ^^^ 0 = 1"
48.58 + realpow_eq_oneI "1 ^^^ n = 1"
48.59 + realpow_multI "(r * s) ^^^ n = r ^^^ n * s ^^^ n"
48.60 + realpow_multI_poly "[| r is_polyexp; s is_polyexp |] ==> \
48.61 + \(r * s) ^^^ n = r ^^^ n * s ^^^ n"
48.62 + realpow_minus_oneI "-1 ^^^ (2 * n) = 1"
48.63 +
48.64 + realpow_twoI "r ^^^ 2 = r * r"
48.65 + realpow_twoI_assoc_l "r * (r * s) = r ^^^ 2 * s"
48.66 + realpow_twoI_assoc_r "s * r * r = s * r ^^^ 2"
48.67 + realpow_two_atom "r is_atom ==> r * r = r ^^^ 2"
48.68 + realpow_plus_1 "r * r ^^^ n = r ^^^ (n + 1)"
48.69 + realpow_plus_1_assoc_l "r * (r ^^^ m * s) = r ^^^ (1 + m) * s"
48.70 + realpow_plus_1_assoc_l2 "r ^^^ m * (r * s) = r ^^^ (1 + m) * s"
48.71 + realpow_plus_1_assoc_r "s * r * r ^^^ m = s * r ^^^ (1 + m)"
48.72 + realpow_plus_1_atom "r is_atom ==> r * r ^^^ n = r ^^^ (1 + n)"
48.73 + realpow_def_atom "[| Not (r is_atom); 1 < n |] \
48.74 + \ ==> r ^^^ n = r * r ^^^ (n + -1)"
48.75 + realpow_addI_atom "r is_atom ==> r ^^^ n * r ^^^ m = r ^^^ (n + m)"
48.76 +
48.77 +
48.78 + realpow_minus_even "n is_even ==> (- r) ^^^ n = r ^^^ n"
48.79 + realpow_minus_odd "Not (n is_even) ==> (- r) ^^^ n = -1 * r ^^^ n"
48.80 +
48.81 +
48.82 +(* RL 020914 *)
48.83 + real_pp_binom_times "(a + b)*(c + d) = a*c + a*d + b*c + b*d"
48.84 + real_pm_binom_times "(a + b)*(c - d) = a*c - a*d + b*c - b*d"
48.85 + real_mp_binom_times "(a - b)*(c + d) = a*c + a*d - b*c - b*d"
48.86 + real_mm_binom_times "(a - b)*(c - d) = a*c - a*d - b*c + b*d"
48.87 + real_plus_binom_pow3 "(a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3"
48.88 + real_plus_binom_pow3_poly "[| a is_polyexp; b is_polyexp |] ==> \
48.89 + \(a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3"
48.90 + real_minus_binom_pow3 "(a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3"
48.91 + real_minus_binom_pow3_p "(a + -1 * b)^^^3 = a^^^3 + -3*a^^^2*b + 3*a*b^^^2 + -1*b^^^3"
48.92 +(* real_plus_binom_pow "[| n is_const; 3 < n |] ==> \
48.93 + \(a + b)^^^n = (a + b) * (a + b)^^^(n - 1)" *)
48.94 + real_plus_binom_pow4 "(a + b)^^^4 = (a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3)*(a + b)"
48.95 + real_plus_binom_pow4_poly "[| a is_polyexp; b is_polyexp |] ==> \
48.96 + \(a + b)^^^4 = (a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3)*(a + b)"
48.97 + real_plus_binom_pow5 "(a + b)^^^5 = (a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3)*(a^^^2 + 2*a*b + b^^^2)"
48.98 +
48.99 + real_plus_binom_pow5_poly "[| a is_polyexp; b is_polyexp |] ==> \
48.100 + \(a + b)^^^5 = (a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3)*(a^^^2 + 2*a*b + b^^^2)"
48.101 +
48.102 + real_diff_plus "a - b = a + -b" (*17.3.03: do_NOT_use*)
48.103 + real_diff_minus "a - b = a + -1 * b"
48.104 + real_plus_binom_times "(a + b)*(a + b) = a^^^2 + 2*a*b + b^^^2"
48.105 + real_minus_binom_times "(a - b)*(a - b) = a^^^2 - 2*a*b + b^^^2"
48.106 + (*WN071229 changed for Schaerding -----vvv*)
48.107 + (*real_plus_binom_pow2 "(a + b)^^^2 = a^^^2 + 2*a*b + b^^^2"*)
48.108 + real_plus_binom_pow2 "(a + b)^^^2 = (a + b) * (a + b)"
48.109 + (*WN071229 changed for Schaerding -----^^^*)
48.110 + real_plus_binom_pow2_poly "[| a is_polyexp; b is_polyexp |] ==> \
48.111 + \(a + b)^^^2 = a^^^2 + 2*a*b + b^^^2"
48.112 + real_minus_binom_pow2 "(a - b)^^^2 = a^^^2 - 2*a*b + b^^^2"
48.113 + real_minus_binom_pow2_p "(a - b)^^^2 = a^^^2 + -2*a*b + b^^^2"
48.114 + real_plus_minus_binom1 "(a + b)*(a - b) = a^^^2 - b^^^2"
48.115 + real_plus_minus_binom1_p "(a + b)*(a - b) = a^^^2 + -1*b^^^2"
48.116 + real_plus_minus_binom1_p_p "(a + b)*(a + -1 * b) = a^^^2 + -1*b^^^2"
48.117 + real_plus_minus_binom2 "(a - b)*(a + b) = a^^^2 - b^^^2"
48.118 + real_plus_minus_binom2_p "(a - b)*(a + b) = a^^^2 + -1*b^^^2"
48.119 + real_plus_minus_binom2_p_p "(a + -1 * b)*(a + b) = a^^^2 + -1*b^^^2"
48.120 + real_plus_binom_times1 "(a + 1*b)*(a + -1*b) = a^^^2 + -1*b^^^2"
48.121 + real_plus_binom_times2 "(a + -1*b)*(a + 1*b) = a^^^2 + -1*b^^^2"
48.122 +
48.123 + real_num_collect "[| l is_const; m is_const |] ==> \
48.124 + \l * n + m * n = (l + m) * n"
48.125 +(* FIXME.MG.0401: replace 'real_num_collect_assoc'
48.126 + by 'real_num_collect_assoc_l' ... are equal, introduced by MG ! *)
48.127 + real_num_collect_assoc "[| l is_const; m is_const |] ==> \
48.128 + \l * n + (m * n + k) = (l + m) * n + k"
48.129 + real_num_collect_assoc_l "[| l is_const; m is_const |] ==> \
48.130 + \l * n + (m * n + k) = (l + m)
48.131 + * n + k"
48.132 + real_num_collect_assoc_r "[| l is_const; m is_const |] ==> \
48.133 + \(k + m * n) + l * n = k + (l + m) * n"
48.134 + real_one_collect "m is_const ==> n + m * n = (1 + m) * n"
48.135 +(* FIXME.MG.0401: replace 'real_one_collect_assoc'
48.136 + by 'real_one_collect_assoc_l' ... are equal, introduced by MG ! *)
48.137 + real_one_collect_assoc "m is_const ==> n + (m * n + k) = (1 + m)* n + k"
48.138 +
48.139 + real_one_collect_assoc_l "m is_const ==> n + (m * n + k) = (1 + m) * n + k"
48.140 + real_one_collect_assoc_r "m is_const ==>(k + n) + m * n = k + (1 + m) * n"
48.141 +
48.142 +(* FIXME.MG.0401: replace 'real_mult_2_assoc'
48.143 + by 'real_mult_2_assoc_l' ... are equal, introduced by MG ! *)
48.144 + real_mult_2_assoc "z1 + (z1 + k) = 2 * z1 + k"
48.145 + real_mult_2_assoc_l "z1 + (z1 + k) = 2 * z1 + k"
48.146 + real_mult_2_assoc_r "(k + z1) + z1 = k + 2 * z1"
48.147 +
48.148 + real_add_mult_distrib_poly "w is_polyexp ==> (z1 + z2) * w = z1 * w + z2 * w"
48.149 + real_add_mult_distrib2_poly "w is_polyexp ==> w * (z1 + z2) = w * z1 + w * z2"
48.150 +end
49.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
49.2 +++ b/src/Pure/isac/IsacKnowledge/PolyEq.ML Wed Jul 21 13:53:39 2010 +0200
49.3 @@ -0,0 +1,1162 @@
49.4 +(*. (c) by Richard Lang, 2003 .*)
49.5 +(* collecting all knowledge for PolynomialEquations
49.6 + created by: rlang
49.7 + date: 02.07
49.8 + changed by: rlang
49.9 + last change by: rlang
49.10 + date: 02.11.26
49.11 +*)
49.12 +
49.13 +(* use"IsacKnowledge/PolyEq.ML";
49.14 + use"PolyEq.ML";
49.15 +
49.16 + use"ROOT.ML";
49.17 + cd"IsacKnowledge";
49.18 +
49.19 + remove_thy"PolyEq";
49.20 + use_thy"IsacKnowledge/Isac";
49.21 + *)
49.22 +"******* PolyEq.ML begin *******";
49.23 +
49.24 +theory' := overwritel (!theory', [("PolyEq.thy",PolyEq.thy)]);
49.25 +(*-------------------------functions---------------------*)
49.26 +(* just for try
49.27 +local
49.28 + fun add0 l d d_ = if (d_+1) < d then add0 (str2term"0"::l) d (d_+1) else l;
49.29 + fun poly2list_ (t as (Const ("op +",_) $ t1 $ (Const ("Atools.pow",_) $ v_ $ Free (d_,_)))) v l d =
49.30 + if (v=v_)
49.31 + then poly2list_ t1 v (((str2term("1")))::(add0 l d (int_of_str' d_))) (int_of_str' d_)
49.32 + else t::(add0 l d 0)
49.33 + | poly2list_ (t as (Const ("op +",_) $ t1 $ (Const ("op *",_) $ t11 $
49.34 + (Const ("Atools.pow",_) $ v_ $ Free (d_,_))))) v l d =
49.35 + if (v=v_)
49.36 + then poly2list_ t1 v (((t11))::(add0 l d (int_of_str' d_))) (int_of_str' d_)
49.37 + else t::(add0 l d 0)
49.38 + | poly2list_ (t as (Const ("op +",_) $ t1 $ (Free (v_ , _)) )) v l d =
49.39 + if (v = (str2term v_))
49.40 + then poly2list_ t1 v (((str2term("1")))::(add0 l d 1 )) 1
49.41 + else t::(add0 l d 0)
49.42 + | poly2list_ (t as (Const ("op +",_) $ t1 $ (Const ("op *",_) $ t11 $ (Free (v_,_)) ))) v l d =
49.43 + if (v= (str2term v_))
49.44 + then poly2list_ t1 v ( (t11)::(add0 l d 1 )) 1
49.45 + else t::(add0 l d 0)
49.46 + | poly2list_ (t as (Const ("op +",_) $ _ $ _))_ l d = t::(add0 l d 0)
49.47 + | poly2list_ (t as (Free (_,_))) _ l d = t::(add0 l d 0)
49.48 + | poly2list_ t _ l d = t::(add0 l d 0);
49.49 +
49.50 + fun poly2list t v = poly2list_ t v [] 0;
49.51 + fun diffpolylist_ [] _ = []
49.52 + | diffpolylist_ (x::xs) d = (str2term (if term2str(x)="0"
49.53 + then "0"
49.54 + else term2str(x)^"*"^str_of_int(d)))::diffpolylist_ xs (d+1);
49.55 + fun diffpolylist [] = []
49.56 + | diffpolylist (x::xs) = diffpolylist_ xs 1;
49.57 + (* diffpolylist(poly2list (str2term "1+ x +3*x^^^3") (str2term "x"));*)
49.58 +in
49.59 +
49.60 +end;
49.61 +*)
49.62 +(*-------------------------rulse-------------------------*)
49.63 +val PolyEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
49.64 + append_rls "PolyEq_prls" e_rls
49.65 + [Calc ("Atools.ident",eval_ident "#ident_"),
49.66 + Calc ("Tools.matches",eval_matches ""),
49.67 + Calc ("Tools.lhs" ,eval_lhs ""),
49.68 + Calc ("Tools.rhs" ,eval_rhs ""),
49.69 + Calc ("Poly.is'_expanded'_in",eval_is_expanded_in ""),
49.70 + Calc ("Poly.is'_poly'_in",eval_is_poly_in ""),
49.71 + Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),
49.72 + Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
49.73 + (*Calc ("Atools.occurs'_in",eval_occurs_in ""), *)
49.74 + (*Calc ("Atools.is'_const",eval_const "#is_const_"),*)
49.75 + Calc ("op =",eval_equal "#equal_"),
49.76 + Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
49.77 + Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
49.78 + Thm ("not_true",num_str not_true),
49.79 + Thm ("not_false",num_str not_false),
49.80 + Thm ("and_true",num_str and_true),
49.81 + Thm ("and_false",num_str and_false),
49.82 + Thm ("or_true",num_str or_true),
49.83 + Thm ("or_false",num_str or_false)
49.84 + ];
49.85 +
49.86 +val PolyEq_erls =
49.87 + merge_rls "PolyEq_erls" LinEq_erls
49.88 + (append_rls "ops_preds" calculate_Rational
49.89 + [Calc ("op =",eval_equal "#equal_"),
49.90 + Thm ("plus_leq", num_str plus_leq),
49.91 + Thm ("minus_leq", num_str minus_leq),
49.92 + Thm ("rat_leq1", num_str rat_leq1),
49.93 + Thm ("rat_leq2", num_str rat_leq2),
49.94 + Thm ("rat_leq3", num_str rat_leq3)
49.95 + ]);
49.96 +
49.97 +val PolyEq_crls =
49.98 + merge_rls "PolyEq_crls" LinEq_crls
49.99 + (append_rls "ops_preds" calculate_Rational
49.100 + [Calc ("op =",eval_equal "#equal_"),
49.101 + Thm ("plus_leq", num_str plus_leq),
49.102 + Thm ("minus_leq", num_str minus_leq),
49.103 + Thm ("rat_leq1", num_str rat_leq1),
49.104 + Thm ("rat_leq2", num_str rat_leq2),
49.105 + Thm ("rat_leq3", num_str rat_leq3)
49.106 + ]);
49.107 +(*------
49.108 +val PolyEq_erls =
49.109 + merge_rls "PolyEq_erls"
49.110 + (append_rls "" (Rls {(*asm_thm=[],*)calc=[],
49.111 + erls= Rls {(*asm_thm=[],*)calc=[],
49.112 + erls= Erls,
49.113 + id="e_rls",preconds=[],
49.114 + rew_ord=("dummy_ord",dummy_ord),
49.115 + rules=[Thm ("",
49.116 + num_str ),
49.117 + Thm ("",
49.118 + num_str ),
49.119 + Thm ("",
49.120 + num_str )
49.121 + ],
49.122 + scr=EmptyScr,srls=Erls},
49.123 + id="e_rls",preconds=[],rew_ord=("dummy_ord",
49.124 + dummy_ord),
49.125 + rules=[],scr=EmptyScr,srls=Erls}
49.126 + )
49.127 + ((#rules o rep_rls) LinEq_erls))
49.128 + (append_rls "ops_preds" calculate_Rational
49.129 + [Calc ("op =",eval_equal "#equal_"),
49.130 + Thm ("plus_leq", num_str plus_leq),
49.131 + Thm ("minus_leq", num_str minus_leq),
49.132 + Thm ("rat_leq1", num_str rat_leq1),
49.133 + Thm ("rat_leq2", num_str rat_leq2),
49.134 + Thm ("rat_leq3", num_str rat_leq3)
49.135 + ]);
49.136 +-----*)
49.137 +
49.138 +
49.139 +val cancel_leading_coeff = prep_rls(
49.140 + Rls {id = "cancel_leading_coeff", preconds = [],
49.141 + rew_ord = ("e_rew_ord",e_rew_ord),
49.142 + erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
49.143 + rules = [Thm ("cancel_leading_coeff1",num_str cancel_leading_coeff1),
49.144 + Thm ("cancel_leading_coeff2",num_str cancel_leading_coeff2),
49.145 + Thm ("cancel_leading_coeff3",num_str cancel_leading_coeff3),
49.146 + Thm ("cancel_leading_coeff4",num_str cancel_leading_coeff4),
49.147 + Thm ("cancel_leading_coeff5",num_str cancel_leading_coeff5),
49.148 + Thm ("cancel_leading_coeff6",num_str cancel_leading_coeff6),
49.149 + Thm ("cancel_leading_coeff7",num_str cancel_leading_coeff7),
49.150 + Thm ("cancel_leading_coeff8",num_str cancel_leading_coeff8),
49.151 + Thm ("cancel_leading_coeff9",num_str cancel_leading_coeff9),
49.152 + Thm ("cancel_leading_coeff10",num_str cancel_leading_coeff10),
49.153 + Thm ("cancel_leading_coeff11",num_str cancel_leading_coeff11),
49.154 + Thm ("cancel_leading_coeff12",num_str cancel_leading_coeff12),
49.155 + Thm ("cancel_leading_coeff13",num_str cancel_leading_coeff13)
49.156 + ],
49.157 + scr = Script ((term_of o the o (parse thy))
49.158 + "empty_script")
49.159 + }:rls);
49.160 +val complete_square = prep_rls(
49.161 + Rls {id = "complete_square", preconds = [],
49.162 + rew_ord = ("e_rew_ord",e_rew_ord),
49.163 + erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
49.164 + rules = [Thm ("complete_square1",num_str complete_square1),
49.165 + Thm ("complete_square2",num_str complete_square2),
49.166 + Thm ("complete_square3",num_str complete_square3),
49.167 + Thm ("complete_square4",num_str complete_square4),
49.168 + Thm ("complete_square5",num_str complete_square5)
49.169 + ],
49.170 + scr = Script ((term_of o the o (parse thy))
49.171 + "empty_script")
49.172 + }:rls);
49.173 +ruleset' := overwritelthy thy (!ruleset',
49.174 + [("cancel_leading_coeff",cancel_leading_coeff),
49.175 + ("complete_square",complete_square),
49.176 + ("PolyEq_erls",PolyEq_erls)(*FIXXXME:del with rls.rls'*)
49.177 + ]);
49.178 +val polyeq_simplify = prep_rls(
49.179 + Rls {id = "polyeq_simplify", preconds = [],
49.180 + rew_ord = ("termlessI",termlessI),
49.181 + erls = PolyEq_erls,
49.182 + srls = Erls,
49.183 + calc = [],
49.184 + (*asm_thm = [],*)
49.185 + rules = [Thm ("real_assoc_1",num_str real_assoc_1),
49.186 + Thm ("real_assoc_2",num_str real_assoc_2),
49.187 + Thm ("real_diff_minus",num_str real_diff_minus),
49.188 + Thm ("real_unari_minus",num_str real_unari_minus),
49.189 + Thm ("realpow_multI",num_str realpow_multI),
49.190 + Calc ("op +",eval_binop "#add_"),
49.191 + Calc ("op -",eval_binop "#sub_"),
49.192 + Calc ("op *",eval_binop "#mult_"),
49.193 + Calc ("HOL.divide", eval_cancel "#divide_"),
49.194 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
49.195 + Calc ("Atools.pow" ,eval_binop "#power_"),
49.196 + Rls_ reduce_012
49.197 + ],
49.198 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.199 + }:rls);
49.200 +ruleset' := overwritelthy thy (!ruleset',
49.201 + [("polyeq_simplify",polyeq_simplify)]);
49.202 +
49.203 +
49.204 +(* ------------- polySolve ------------------ *)
49.205 +(* -- d0 -- *)
49.206 +(*isolate the bound variable in an d0 equation; 'bdv' is a meta-constant*)
49.207 +val d0_polyeq_simplify = prep_rls(
49.208 + Rls {id = "d0_polyeq_simplify", preconds = [],
49.209 + rew_ord = ("e_rew_ord",e_rew_ord),
49.210 + erls = PolyEq_erls,
49.211 + srls = Erls,
49.212 + calc = [],
49.213 + (*asm_thm = [],*)
49.214 + rules = [Thm("d0_true",num_str d0_true),
49.215 + Thm("d0_false",num_str d0_false)
49.216 + ],
49.217 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.218 + }:rls);
49.219 +(* -- d1 -- *)
49.220 +(*isolate the bound variable in an d1 equation; 'bdv' is a meta-constant*)
49.221 +val d1_polyeq_simplify = prep_rls(
49.222 + Rls {id = "d1_polyeq_simplify", preconds = [],
49.223 + rew_ord = ("e_rew_ord",e_rew_ord),
49.224 + erls = PolyEq_erls,
49.225 + srls = Erls,
49.226 + calc = [],
49.227 + (*asm_thm = [("d1_isolate_div","")],*)
49.228 + rules = [
49.229 + Thm("d1_isolate_add1",num_str d1_isolate_add1),
49.230 + (* a+bx=0 -> bx=-a *)
49.231 + Thm("d1_isolate_add2",num_str d1_isolate_add2),
49.232 + (* a+ x=0 -> x=-a *)
49.233 + Thm("d1_isolate_div",num_str d1_isolate_div)
49.234 + (* bx=c -> x=c/b *)
49.235 + ],
49.236 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.237 + }:rls);
49.238 +(* -- d2 -- *)
49.239 +(*isolate the bound variable in an d2 equation with bdv only; 'bdv' is a meta-constant*)
49.240 +val d2_polyeq_bdv_only_simplify = prep_rls(
49.241 + Rls {id = "d2_polyeq_bdv_only_simplify", preconds = [],
49.242 + rew_ord = ("e_rew_ord",e_rew_ord),
49.243 + erls = PolyEq_erls,
49.244 + srls = Erls,
49.245 + calc = [],
49.246 + (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
49.247 + ("d2_isolate_div","")],*)
49.248 + rules = [
49.249 + Thm("d2_prescind1",num_str d2_prescind1), (* ax+bx^2=0 -> x(a+bx)=0 *)
49.250 + Thm("d2_prescind2",num_str d2_prescind2), (* ax+ x^2=0 -> x(a+ x)=0 *)
49.251 + Thm("d2_prescind3",num_str d2_prescind3), (* x+bx^2=0 -> x(1+bx)=0 *)
49.252 + Thm("d2_prescind4",num_str d2_prescind4), (* x+ x^2=0 -> x(1+ x)=0 *)
49.253 + Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1), (* x^2=c -> x=+-sqrt(c)*)
49.254 + Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg), (* [0<c] x^2=c -> [] *)
49.255 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2), (* x^2=0 -> x=0 *)
49.256 + Thm("d2_reduce_equation1",num_str d2_reduce_equation1),(* x(a+bx)=0 -> x=0 | a+bx=0*)
49.257 + Thm("d2_reduce_equation2",num_str d2_reduce_equation2),(* x(a+ x)=0 -> x=0 | a+ x=0*)
49.258 + Thm("d2_isolate_div",num_str d2_isolate_div) (* bx^2=c -> x^2=c/b*)
49.259 + ],
49.260 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.261 + }:rls);
49.262 +(*isolate the bound variable in an d2 equation with sqrt only; 'bdv' is a meta-constant*)
49.263 +val d2_polyeq_sq_only_simplify = prep_rls(
49.264 + Rls {id = "d2_polyeq_sq_only_simplify", preconds = [],
49.265 + rew_ord = ("e_rew_ord",e_rew_ord),
49.266 + erls = PolyEq_erls,
49.267 + srls = Erls,
49.268 + calc = [],
49.269 + (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
49.270 + ("d2_isolate_div","")],*)
49.271 + rules = [
49.272 + Thm("d2_isolate_add1",num_str d2_isolate_add1), (* a+ bx^2=0 -> bx^2=(-1)a*)
49.273 + Thm("d2_isolate_add2",num_str d2_isolate_add2), (* a+ x^2=0 -> x^2=(-1)a*)
49.274 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2), (* x^2=0 -> x=0 *)
49.275 + Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1), (* x^2=c -> x=+-sqrt(c)*)
49.276 + Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),(* [c<0] x^2=c -> x=[] *)
49.277 + Thm("d2_isolate_div",num_str d2_isolate_div) (* bx^2=c -> x^2=c/b*)
49.278 + ],
49.279 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.280 + }:rls);
49.281 +(*isolate the bound variable in an d2 equation with pqFormula; 'bdv' is a meta-constant*)
49.282 +val d2_polyeq_pqFormula_simplify = prep_rls(
49.283 + Rls {id = "d2_polyeq_pqFormula_simplify", preconds = [],
49.284 + rew_ord = ("e_rew_ord",e_rew_ord),
49.285 + erls = PolyEq_erls,
49.286 + srls = Erls,
49.287 + calc = [],
49.288 + (*asm_thm = [("d2_pqformula1",""),("d2_pqformula2",""),("d2_pqformula3",""),("d2_pqformula4",""),
49.289 + ("d2_pqformula5",""),("d2_pqformula6",""),("d2_pqformula7",""),("d2_pqformula8",""),
49.290 + ("d2_pqformula9",""),("d2_pqformula10",""),
49.291 + ("d2_pqformula1_neg",""),("d2_pqformula2_neg",""),("d2_pqformula3_neg",""),
49.292 + ("d2_pqformula4_neg",""),("d2_pqformula9_neg",""),("d2_pqformula10_neg","")],*)
49.293 + rules = [
49.294 + Thm("d2_pqformula1",num_str d2_pqformula1), (* q+px+ x^2=0 *)
49.295 + Thm("d2_pqformula1_neg",num_str d2_pqformula1_neg), (* q+px+ x^2=0 *)
49.296 + Thm("d2_pqformula2",num_str d2_pqformula2), (* q+px+1x^2=0 *)
49.297 + Thm("d2_pqformula2_neg",num_str d2_pqformula2_neg), (* q+px+1x^2=0 *)
49.298 + Thm("d2_pqformula3",num_str d2_pqformula3), (* q+ x+ x^2=0 *)
49.299 + Thm("d2_pqformula3_neg",num_str d2_pqformula3_neg), (* q+ x+ x^2=0 *)
49.300 + Thm("d2_pqformula4",num_str d2_pqformula4), (* q+ x+1x^2=0 *)
49.301 + Thm("d2_pqformula4_neg",num_str d2_pqformula4_neg), (* q+ x+1x^2=0 *)
49.302 + Thm("d2_pqformula5",num_str d2_pqformula5), (* qx+ x^2=0 *)
49.303 + Thm("d2_pqformula6",num_str d2_pqformula6), (* qx+1x^2=0 *)
49.304 + Thm("d2_pqformula7",num_str d2_pqformula7), (* x+ x^2=0 *)
49.305 + Thm("d2_pqformula8",num_str d2_pqformula8), (* x+1x^2=0 *)
49.306 + Thm("d2_pqformula9",num_str d2_pqformula9), (* q +1x^2=0 *)
49.307 + Thm("d2_pqformula9_neg",num_str d2_pqformula9_neg), (* q +1x^2=0 *)
49.308 + Thm("d2_pqformula10",num_str d2_pqformula10), (* q + x^2=0 *)
49.309 + Thm("d2_pqformula10_neg",num_str d2_pqformula10_neg), (* q + x^2=0 *)
49.310 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2), (* x^2=0 *)
49.311 + Thm("d2_sqrt_equation3",num_str d2_sqrt_equation3) (* 1x^2=0 *)
49.312 + ],
49.313 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.314 + }:rls);
49.315 +(*isolate the bound variable in an d2 equation with abcFormula; 'bdv' is a meta-constant*)
49.316 +val d2_polyeq_abcFormula_simplify = prep_rls(
49.317 + Rls {id = "d2_polyeq_abcFormula_simplify", preconds = [],
49.318 + rew_ord = ("e_rew_ord",e_rew_ord),
49.319 + erls = PolyEq_erls,
49.320 + srls = Erls,
49.321 + calc = [],
49.322 + (*asm_thm = [("d2_abcformula1",""),("d2_abcformula2",""),("d2_abcformula3",""),
49.323 + ("d2_abcformula4",""),("d2_abcformula5",""),("d2_abcformula6",""),
49.324 + ("d2_abcformula7",""),("d2_abcformula8",""),("d2_abcformula9",""),
49.325 + ("d2_abcformula10",""),("d2_abcformula1_neg",""),("d2_abcformula2_neg",""),
49.326 + ("d2_abcformula3_neg",""),("d2_abcformula4_neg",""),("d2_abcformula5_neg",""),
49.327 + ("d2_abcformula6_neg","")],*)
49.328 + rules = [
49.329 + Thm("d2_abcformula1",num_str d2_abcformula1), (*c+bx+cx^2=0 *)
49.330 + Thm("d2_abcformula1_neg",num_str d2_abcformula1_neg), (*c+bx+cx^2=0 *)
49.331 + Thm("d2_abcformula2",num_str d2_abcformula2), (*c+ x+cx^2=0 *)
49.332 + Thm("d2_abcformula2_neg",num_str d2_abcformula2_neg), (*c+ x+cx^2=0 *)
49.333 + Thm("d2_abcformula3",num_str d2_abcformula3), (*c+bx+ x^2=0 *)
49.334 + Thm("d2_abcformula3_neg",num_str d2_abcformula3_neg), (*c+bx+ x^2=0 *)
49.335 + Thm("d2_abcformula4",num_str d2_abcformula4), (*c+ x+ x^2=0 *)
49.336 + Thm("d2_abcformula4_neg",num_str d2_abcformula4_neg), (*c+ x+ x^2=0 *)
49.337 + Thm("d2_abcformula5",num_str d2_abcformula5), (*c+ cx^2=0 *)
49.338 + Thm("d2_abcformula5_neg",num_str d2_abcformula5_neg), (*c+ cx^2=0 *)
49.339 + Thm("d2_abcformula6",num_str d2_abcformula6), (*c+ x^2=0 *)
49.340 + Thm("d2_abcformula6_neg",num_str d2_abcformula6_neg), (*c+ x^2=0 *)
49.341 + Thm("d2_abcformula7",num_str d2_abcformula7), (* bx+ax^2=0 *)
49.342 + Thm("d2_abcformula8",num_str d2_abcformula8), (* bx+ x^2=0 *)
49.343 + Thm("d2_abcformula9",num_str d2_abcformula9), (* x+ax^2=0 *)
49.344 + Thm("d2_abcformula10",num_str d2_abcformula10), (* x+ x^2=0 *)
49.345 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2), (* x^2=0 *)
49.346 + Thm("d2_sqrt_equation3",num_str d2_sqrt_equation3) (* bx^2=0 *)
49.347 + ],
49.348 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.349 + }:rls);
49.350 +(*isolate the bound variable in an d2 equation; 'bdv' is a meta-constant*)
49.351 +val d2_polyeq_simplify = prep_rls(
49.352 + Rls {id = "d2_polyeq_simplify", preconds = [],
49.353 + rew_ord = ("e_rew_ord",e_rew_ord),
49.354 + erls = PolyEq_erls,
49.355 + srls = Erls,
49.356 + calc = [],
49.357 + (*asm_thm = [("d2_pqformula1",""),("d2_pqformula2",""),("d2_pqformula3",""),("d2_pqformula4",""),
49.358 + ("d2_pqformula1_neg",""),("d2_pqformula2_neg",""),("d2_pqformula3_neg",""),
49.359 + ("d2_pqformula4_neg",""),
49.360 + ("d2_abcformula1",""),("d2_abcformula2",""),("d2_abcformula1_neg",""),
49.361 + ("d2_abcformula2_neg",""), ("d2_sqrt_equation1",""),
49.362 + ("d2_sqrt_equation1_neg",""),("d2_isolate_div","")],*)
49.363 + rules = [
49.364 + Thm("d2_pqformula1",num_str d2_pqformula1), (* p+qx+ x^2=0 *)
49.365 + Thm("d2_pqformula1_neg",num_str d2_pqformula1_neg), (* p+qx+ x^2=0 *)
49.366 + Thm("d2_pqformula2",num_str d2_pqformula2), (* p+qx+1x^2=0 *)
49.367 + Thm("d2_pqformula2_neg",num_str d2_pqformula2_neg), (* p+qx+1x^2=0 *)
49.368 + Thm("d2_pqformula3",num_str d2_pqformula3), (* p+ x+ x^2=0 *)
49.369 + Thm("d2_pqformula3_neg",num_str d2_pqformula3_neg), (* p+ x+ x^2=0 *)
49.370 + Thm("d2_pqformula4",num_str d2_pqformula4), (* p+ x+1x^2=0 *)
49.371 + Thm("d2_pqformula4_neg",num_str d2_pqformula4_neg), (* p+ x+1x^2=0 *)
49.372 + Thm("d2_abcformula1",num_str d2_abcformula1), (* c+bx+cx^2=0 *)
49.373 + Thm("d2_abcformula1_neg",num_str d2_abcformula1_neg), (* c+bx+cx^2=0 *)
49.374 + Thm("d2_abcformula2",num_str d2_abcformula2), (* c+ x+cx^2=0 *)
49.375 + Thm("d2_abcformula2_neg",num_str d2_abcformula2_neg), (* c+ x+cx^2=0 *)
49.376 + Thm("d2_prescind1",num_str d2_prescind1), (* ax+bx^2=0 -> x(a+bx)=0 *)
49.377 + Thm("d2_prescind2",num_str d2_prescind2), (* ax+ x^2=0 -> x(a+ x)=0 *)
49.378 + Thm("d2_prescind3",num_str d2_prescind3), (* x+bx^2=0 -> x(1+bx)=0 *)
49.379 + Thm("d2_prescind4",num_str d2_prescind4), (* x+ x^2=0 -> x(1+ x)=0 *)
49.380 + Thm("d2_isolate_add1",num_str d2_isolate_add1), (* a+ bx^2=0 -> bx^2=(-1)a*)
49.381 + Thm("d2_isolate_add2",num_str d2_isolate_add2), (* a+ x^2=0 -> x^2=(-1)a*)
49.382 + Thm("d2_sqrt_equation1",num_str d2_sqrt_equation1), (* x^2=c -> x=+-sqrt(c)*)
49.383 + Thm("d2_sqrt_equation1_neg",num_str d2_sqrt_equation1_neg),(* [c<0] x^2=c -> x=[]*)
49.384 + Thm("d2_sqrt_equation2",num_str d2_sqrt_equation2), (* x^2=0 -> x=0 *)
49.385 + Thm("d2_reduce_equation1",num_str d2_reduce_equation1),(* x(a+bx)=0 -> x=0 | a+bx=0*)
49.386 + Thm("d2_reduce_equation2",num_str d2_reduce_equation2),(* x(a+ x)=0 -> x=0 | a+ x=0*)
49.387 + Thm("d2_isolate_div",num_str d2_isolate_div) (* bx^2=c -> x^2=c/b*)
49.388 + ],
49.389 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.390 + }:rls);
49.391 +(* -- d3 -- *)
49.392 +(*isolate the bound variable in an d3 equation; 'bdv' is a meta-constant*)
49.393 +val d3_polyeq_simplify = prep_rls(
49.394 + Rls {id = "d3_polyeq_simplify", preconds = [],
49.395 + rew_ord = ("e_rew_ord",e_rew_ord),
49.396 + erls = PolyEq_erls,
49.397 + srls = Erls,
49.398 + calc = [],
49.399 + (*asm_thm = [("d3_isolate_div","")],*)
49.400 + rules = [
49.401 + Thm("d3_reduce_equation1",num_str d3_reduce_equation1),
49.402 + (*a*bdv + b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (a + b*bdv + c*bdv^^^2=0)*)
49.403 + Thm("d3_reduce_equation2",num_str d3_reduce_equation2),
49.404 + (* bdv + b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (1 + b*bdv + c*bdv^^^2=0)*)
49.405 + Thm("d3_reduce_equation3",num_str d3_reduce_equation3),
49.406 + (*a*bdv + bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (a + bdv + c*bdv^^^2=0)*)
49.407 + Thm("d3_reduce_equation4",num_str d3_reduce_equation4),
49.408 + (* bdv + bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (1 + bdv + c*bdv^^^2=0)*)
49.409 + Thm("d3_reduce_equation5",num_str d3_reduce_equation5),
49.410 + (*a*bdv + b*bdv^^^2 + bdv^^^3=0) = (bdv=0 | (a + b*bdv + bdv^^^2=0)*)
49.411 + Thm("d3_reduce_equation6",num_str d3_reduce_equation6),
49.412 + (* bdv + b*bdv^^^2 + bdv^^^3=0) = (bdv=0 | (1 + b*bdv + bdv^^^2=0)*)
49.413 + Thm("d3_reduce_equation7",num_str d3_reduce_equation7),
49.414 + (*a*bdv + bdv^^^2 + bdv^^^3=0) = (bdv=0 | (1 + bdv + bdv^^^2=0)*)
49.415 + Thm("d3_reduce_equation8",num_str d3_reduce_equation8),
49.416 + (* bdv + bdv^^^2 + bdv^^^3=0) = (bdv=0 | (1 + bdv + bdv^^^2=0)*)
49.417 + Thm("d3_reduce_equation9",num_str d3_reduce_equation9),
49.418 + (*a*bdv + c*bdv^^^3=0) = (bdv=0 | (a + c*bdv^^^2=0)*)
49.419 + Thm("d3_reduce_equation10",num_str d3_reduce_equation10),
49.420 + (* bdv + c*bdv^^^3=0) = (bdv=0 | (1 + c*bdv^^^2=0)*)
49.421 + Thm("d3_reduce_equation11",num_str d3_reduce_equation11),
49.422 + (*a*bdv + bdv^^^3=0) = (bdv=0 | (a + bdv^^^2=0)*)
49.423 + Thm("d3_reduce_equation12",num_str d3_reduce_equation12),
49.424 + (* bdv + bdv^^^3=0) = (bdv=0 | (1 + bdv^^^2=0)*)
49.425 + Thm("d3_reduce_equation13",num_str d3_reduce_equation13),
49.426 + (* b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | ( b*bdv + c*bdv^^^2=0)*)
49.427 + Thm("d3_reduce_equation14",num_str d3_reduce_equation14),
49.428 + (* bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | ( bdv + c*bdv^^^2=0)*)
49.429 + Thm("d3_reduce_equation15",num_str d3_reduce_equation15),
49.430 + (* b*bdv^^^2 + bdv^^^3=0) = (bdv=0 | ( b*bdv + bdv^^^2=0)*)
49.431 + Thm("d3_reduce_equation16",num_str d3_reduce_equation16),
49.432 + (* bdv^^^2 + bdv^^^3=0) = (bdv=0 | ( bdv + bdv^^^2=0)*)
49.433 + Thm("d3_isolate_add1",num_str d3_isolate_add1),
49.434 + (*[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^3=0) = (bdv=0 | (b*bdv^^^3=a)*)
49.435 + Thm("d3_isolate_add2",num_str d3_isolate_add2),
49.436 + (*[|Not(bdv occurs_in a)|] ==> (a + bdv^^^3=0) = (bdv=0 | ( bdv^^^3=a)*)
49.437 + Thm("d3_isolate_div",num_str d3_isolate_div),
49.438 + (*[|Not(b=0)|] ==> (b*bdv^^^3=c) = (bdv^^^3=c/b*)
49.439 + Thm("d3_root_equation2",num_str d3_root_equation2),
49.440 + (*(bdv^^^3=0) = (bdv=0) *)
49.441 + Thm("d3_root_equation1",num_str d3_root_equation1)
49.442 + (*bdv^^^3=c) = (bdv = nroot 3 c*)
49.443 + ],
49.444 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.445 + }:rls);
49.446 +(* -- d4 -- *)
49.447 +(*isolate the bound variable in an d4 equation; 'bdv' is a meta-constant*)
49.448 +val d4_polyeq_simplify = prep_rls(
49.449 + Rls {id = "d4_polyeq_simplify", preconds = [],
49.450 + rew_ord = ("e_rew_ord",e_rew_ord),
49.451 + erls = PolyEq_erls,
49.452 + srls = Erls,
49.453 + calc = [],
49.454 + (*asm_thm = [],*)
49.455 + rules = [Thm("d4_sub_u1",num_str d4_sub_u1)
49.456 + (* ax^4+bx^2+c=0 -> x=+-sqrt(ax^2+bx^+c) *)
49.457 + ],
49.458 + scr = Script ((term_of o the o (parse thy)) "empty_script")
49.459 + }:rls);
49.460 +
49.461 +ruleset' := overwritelthy thy (!ruleset',
49.462 + [("d0_polyeq_simplify", d0_polyeq_simplify),
49.463 + ("d1_polyeq_simplify", d1_polyeq_simplify),
49.464 + ("d2_polyeq_simplify", d2_polyeq_simplify),
49.465 + ("d2_polyeq_bdv_only_simplify", d2_polyeq_bdv_only_simplify),
49.466 + ("d2_polyeq_sq_only_simplify", d2_polyeq_sq_only_simplify),
49.467 + ("d2_polyeq_pqFormula_simplify", d2_polyeq_pqFormula_simplify),
49.468 + ("d2_polyeq_abcFormula_simplify", d2_polyeq_abcFormula_simplify),
49.469 + ("d3_polyeq_simplify", d3_polyeq_simplify),
49.470 + ("d4_polyeq_simplify", d4_polyeq_simplify)
49.471 + ]);
49.472 +
49.473 +(*------------------------problems------------------------*)
49.474 +(*
49.475 +(get_pbt ["degree_2","polynomial","univariate","equation"]);
49.476 +show_ptyps();
49.477 +*)
49.478 +
49.479 +(*-------------------------poly-----------------------*)
49.480 +store_pbt
49.481 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly" [] e_pblID
49.482 + (["polynomial","univariate","equation"],
49.483 + [("#Given" ,["equality e_","solveFor v_"]),
49.484 + ("#Where" ,["~((e_::bool) is_ratequation_in (v_::real))",
49.485 + "~((lhs e_) is_rootTerm_in (v_::real))",
49.486 + "~((rhs e_) is_rootTerm_in (v_::real))"]),
49.487 + ("#Find" ,["solutions v_i_"])
49.488 + ],
49.489 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.490 + []));
49.491 +(*--- d0 ---*)
49.492 +store_pbt
49.493 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg0" [] e_pblID
49.494 + (["degree_0","polynomial","univariate","equation"],
49.495 + [("#Given" ,["equality e_","solveFor v_"]),
49.496 + ("#Where" ,["matches (?a = 0) e_",
49.497 + "(lhs e_) is_poly_in v_",
49.498 + "((lhs e_) has_degree_in v_ ) = 0"
49.499 + ]),
49.500 + ("#Find" ,["solutions v_i_"])
49.501 + ],
49.502 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.503 + [["PolyEq","solve_d0_polyeq_equation"]]));
49.504 +
49.505 +(*--- d1 ---*)
49.506 +store_pbt
49.507 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg1" [] e_pblID
49.508 + (["degree_1","polynomial","univariate","equation"],
49.509 + [("#Given" ,["equality e_","solveFor v_"]),
49.510 + ("#Where" ,["matches (?a = 0) e_",
49.511 + "(lhs e_) is_poly_in v_",
49.512 + "((lhs e_) has_degree_in v_ ) = 1"
49.513 + ]),
49.514 + ("#Find" ,["solutions v_i_"])
49.515 + ],
49.516 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.517 + [["PolyEq","solve_d1_polyeq_equation"]]));
49.518 +
49.519 +(*--- d2 ---*)
49.520 +store_pbt
49.521 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg2" [] e_pblID
49.522 + (["degree_2","polynomial","univariate","equation"],
49.523 + [("#Given" ,["equality e_","solveFor v_"]),
49.524 + ("#Where" ,["matches (?a = 0) e_",
49.525 + "(lhs e_) is_poly_in v_ ",
49.526 + "((lhs e_) has_degree_in v_ ) = 2"]),
49.527 + ("#Find" ,["solutions v_i_"])
49.528 + ],
49.529 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.530 + [["PolyEq","solve_d2_polyeq_equation"]]));
49.531 +
49.532 + store_pbt
49.533 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg2_sqonly" [] e_pblID
49.534 + (["sq_only","degree_2","polynomial","univariate","equation"],
49.535 + [("#Given" ,["equality e_","solveFor v_"]),
49.536 + ("#Where" ,["matches ( ?a + ?v_^^^2 = 0) e_ | \
49.537 + \matches ( ?a + ?b*?v_^^^2 = 0) e_ | \
49.538 + \matches ( ?v_^^^2 = 0) e_ | \
49.539 + \matches ( ?b*?v_^^^2 = 0) e_" ,
49.540 + "Not (matches (?a + ?v_ + ?v_^^^2 = 0) e_) &\
49.541 + \Not (matches (?a + ?b*?v_ + ?v_^^^2 = 0) e_) &\
49.542 + \Not (matches (?a + ?v_ + ?c*?v_^^^2 = 0) e_) &\
49.543 + \Not (matches (?a + ?b*?v_ + ?c*?v_^^^2 = 0) e_) &\
49.544 + \Not (matches ( ?v_ + ?v_^^^2 = 0) e_) &\
49.545 + \Not (matches ( ?b*?v_ + ?v_^^^2 = 0) e_) &\
49.546 + \Not (matches ( ?v_ + ?c*?v_^^^2 = 0) e_) &\
49.547 + \Not (matches ( ?b*?v_ + ?c*?v_^^^2 = 0) e_)"]),
49.548 + ("#Find" ,["solutions v_i_"])
49.549 + ],
49.550 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.551 + [["PolyEq","solve_d2_polyeq_sqonly_equation"]]));
49.552 +
49.553 +store_pbt
49.554 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg2_bdvonly" [] e_pblID
49.555 + (["bdv_only","degree_2","polynomial","univariate","equation"],
49.556 + [("#Given" ,["equality e_","solveFor v_"]),
49.557 + ("#Where" ,["matches (?a*?v_ + ?v_^^^2 = 0) e_ | \
49.558 + \matches ( ?v_ + ?v_^^^2 = 0) e_ | \
49.559 + \matches ( ?v_ + ?b*?v_^^^2 = 0) e_ | \
49.560 + \matches (?a*?v_ + ?b*?v_^^^2 = 0) e_ | \
49.561 + \matches ( ?v_^^^2 = 0) e_ | \
49.562 + \matches ( ?b*?v_^^^2 = 0) e_ "]),
49.563 + ("#Find" ,["solutions v_i_"])
49.564 + ],
49.565 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.566 + [["PolyEq","solve_d2_polyeq_bdvonly_equation"]]));
49.567 +
49.568 +store_pbt
49.569 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg2_pq" [] e_pblID
49.570 + (["pqFormula","degree_2","polynomial","univariate","equation"],
49.571 + [("#Given" ,["equality e_","solveFor v_"]),
49.572 + ("#Where" ,["matches (?a + 1*?v_^^^2 = 0) e_ | \
49.573 + \matches (?a + ?v_^^^2 = 0) e_"]),
49.574 + ("#Find" ,["solutions v_i_"])
49.575 + ],
49.576 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.577 + [["PolyEq","solve_d2_polyeq_pq_equation"]]));
49.578 +
49.579 +store_pbt
49.580 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg2_abc" [] e_pblID
49.581 + (["abcFormula","degree_2","polynomial","univariate","equation"],
49.582 + [("#Given" ,["equality e_","solveFor v_"]),
49.583 + ("#Where" ,["matches (?a + ?v_^^^2 = 0) e_ | \
49.584 + \matches (?a + ?b*?v_^^^2 = 0) e_"]),
49.585 + ("#Find" ,["solutions v_i_"])
49.586 + ],
49.587 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.588 + [["PolyEq","solve_d2_polyeq_abc_equation"]]));
49.589 +
49.590 +(*--- d3 ---*)
49.591 +store_pbt
49.592 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg3" [] e_pblID
49.593 + (["degree_3","polynomial","univariate","equation"],
49.594 + [("#Given" ,["equality e_","solveFor v_"]),
49.595 + ("#Where" ,["matches (?a = 0) e_",
49.596 + "(lhs e_) is_poly_in v_ ",
49.597 + "((lhs e_) has_degree_in v_) = 3"]),
49.598 + ("#Find" ,["solutions v_i_"])
49.599 + ],
49.600 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.601 + [["PolyEq","solve_d3_polyeq_equation"]]));
49.602 +
49.603 +(*--- d4 ---*)
49.604 +store_pbt
49.605 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_deg4" [] e_pblID
49.606 + (["degree_4","polynomial","univariate","equation"],
49.607 + [("#Given" ,["equality e_","solveFor v_"]),
49.608 + ("#Where" ,["matches (?a = 0) e_",
49.609 + "(lhs e_) is_poly_in v_ ",
49.610 + "((lhs e_) has_degree_in v_) = 4"]),
49.611 + ("#Find" ,["solutions v_i_"])
49.612 + ],
49.613 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.614 + [(*["PolyEq","solve_d4_polyeq_equation"]*)]));
49.615 +
49.616 +(*--- normalize ---*)
49.617 +store_pbt
49.618 + (prep_pbt PolyEq.thy "pbl_equ_univ_poly_norm" [] e_pblID
49.619 + (["normalize","polynomial","univariate","equation"],
49.620 + [("#Given" ,["equality e_","solveFor v_"]),
49.621 + ("#Where" ,["(Not((matches (?a = 0 ) e_ ))) |\
49.622 + \(Not(((lhs e_) is_poly_in v_)))"]),
49.623 + ("#Find" ,["solutions v_i_"])
49.624 + ],
49.625 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.626 + [["PolyEq","normalize_poly"]]));
49.627 +(*-------------------------expanded-----------------------*)
49.628 +store_pbt
49.629 + (prep_pbt PolyEq.thy "pbl_equ_univ_expand" [] e_pblID
49.630 + (["expanded","univariate","equation"],
49.631 + [("#Given" ,["equality e_","solveFor v_"]),
49.632 + ("#Where" ,["matches (?a = 0) e_",
49.633 + "(lhs e_) is_expanded_in v_ "]),
49.634 + ("#Find" ,["solutions v_i_"])
49.635 + ],
49.636 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.637 + []));
49.638 +
49.639 +(*--- d2 ---*)
49.640 +store_pbt
49.641 + (prep_pbt PolyEq.thy "pbl_equ_univ_expand_deg2" [] e_pblID
49.642 + (["degree_2","expanded","univariate","equation"],
49.643 + [("#Given" ,["equality e_","solveFor v_"]),
49.644 + ("#Where" ,["((lhs e_) has_degree_in v_) = 2"]),
49.645 + ("#Find" ,["solutions v_i_"])
49.646 + ],
49.647 + PolyEq_prls, Some "solve (e_::bool, v_)",
49.648 + [["PolyEq","complete_square"]]));
49.649 +
49.650 +
49.651 +"-------------------------methods-----------------------";
49.652 +store_met
49.653 + (prep_met PolyEq.thy "met_polyeq" [] e_metID
49.654 + (["PolyEq"],
49.655 + [],
49.656 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
49.657 + crls=PolyEq_crls, nrls=norm_Rational
49.658 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
49.659 +
49.660 +store_met
49.661 + (prep_met PolyEq.thy "met_polyeq_norm" [] e_metID
49.662 + (["PolyEq","normalize_poly"],
49.663 + [("#Given" ,["equality e_","solveFor v_"]),
49.664 + ("#Where" ,["(Not((matches (?a = 0 ) e_ ))) |\
49.665 + \(Not(((lhs e_) is_poly_in v_)))"]),
49.666 + ("#Find" ,["solutions v_i_"])
49.667 + ],
49.668 + {rew_ord'="termlessI",
49.669 + rls'=PolyEq_erls,
49.670 + srls=e_rls,
49.671 + prls=PolyEq_prls,
49.672 + calc=[],
49.673 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.674 + asm_rls=[],
49.675 + asm_thm=[]*)},
49.676 + (*RL: Ratpoly loest Brueche ohne bdv*)
49.677 + "Script Normalize_poly (e_::bool) (v_::real) = \
49.678 + \(let e_ =((Try (Rewrite all_left False)) @@ \
49.679 + \ (Try (Repeat (Rewrite makex1_x False))) @@ \
49.680 + \ (Try (Repeat (Rewrite_Set expand_binoms False))) @@ \
49.681 + \ (Try (Repeat (Rewrite_Set_Inst [(bdv,v_::real)] \
49.682 + \ make_ratpoly_in False))) @@ \
49.683 + \ (Try (Repeat (Rewrite_Set polyeq_simplify False)))) e_ \
49.684 + \ in (SubProblem (PolyEq_,[polynomial,univariate,equation], \
49.685 + \ [no_met]) [bool_ e_, real_ v_]))"
49.686 + ));
49.687 +
49.688 +store_met
49.689 + (prep_met PolyEq.thy "met_polyeq_d0" [] e_metID
49.690 + (["PolyEq","solve_d0_polyeq_equation"],
49.691 + [("#Given" ,["equality e_","solveFor v_"]),
49.692 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.693 + "((lhs e_) has_degree_in v_) = 0"]),
49.694 + ("#Find" ,["solutions v_i_"])
49.695 + ],
49.696 + {rew_ord'="termlessI",
49.697 + rls'=PolyEq_erls,
49.698 + srls=e_rls,
49.699 + prls=PolyEq_prls,
49.700 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.701 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.702 + asm_rls=[],
49.703 + asm_thm=[]*)},
49.704 + "Script Solve_d0_polyeq_equation (e_::bool) (v_::real) = \
49.705 + \(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.706 + \ d0_polyeq_simplify False))) e_ \
49.707 + \ in ((Or_to_List e_)::bool list))"
49.708 + ));
49.709 +
49.710 +store_met
49.711 + (prep_met PolyEq.thy "met_polyeq_d1" [] e_metID
49.712 + (["PolyEq","solve_d1_polyeq_equation"],
49.713 + [("#Given" ,["equality e_","solveFor v_"]),
49.714 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.715 + "((lhs e_) has_degree_in v_) = 1"]),
49.716 + ("#Find" ,["solutions v_i_"])
49.717 + ],
49.718 + {rew_ord'="termlessI",
49.719 + rls'=PolyEq_erls,
49.720 + srls=e_rls,
49.721 + prls=PolyEq_prls,
49.722 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.723 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.724 + (* asm_rls=["d1_polyeq_simplify"],*)
49.725 + asm_rls=[],
49.726 + asm_thm=[("d1_isolate_div","")]*)},
49.727 + "Script Solve_d1_polyeq_equation (e_::bool) (v_::real) = \
49.728 + \(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.729 + \ d1_polyeq_simplify True)) @@ \
49.730 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.731 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;\
49.732 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.733 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.734 + ));
49.735 +
49.736 +store_met
49.737 + (prep_met PolyEq.thy "met_polyeq_d22" [] e_metID
49.738 + (["PolyEq","solve_d2_polyeq_equation"],
49.739 + [("#Given" ,["equality e_","solveFor v_"]),
49.740 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.741 + "((lhs e_) has_degree_in v_) = 2"]),
49.742 + ("#Find" ,["solutions v_i_"])
49.743 + ],
49.744 + {rew_ord'="termlessI",
49.745 + rls'=PolyEq_erls,
49.746 + srls=e_rls,
49.747 + prls=PolyEq_prls,
49.748 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.749 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.750 + (*asm_rls=["d2_polyeq_simplify","d1_polyeq_simplify"],*)
49.751 + asm_rls=[],
49.752 + asm_thm = [("d1_isolate_div",""),("d2_pqformula1",""),("d2_pqformula2",""),
49.753 + ("d2_pqformula3",""),("d2_pqformula4",""),("d2_pqformula1_neg",""),
49.754 + ("d2_pqformula2_neg",""),("d2_pqformula3_neg",""),("d2_pqformula4_neg",""),
49.755 + ("d2_abcformula1",""),("d2_abcformula2",""),("d2_abcformula1_neg",""),
49.756 + ("d2_abcformula2_neg",""), ("d2_sqrt_equation1",""),
49.757 + ("d2_sqrt_equation1_neg",""), ("d2_isolate_div","")]*)},
49.758 + "Script Solve_d2_polyeq_equation (e_::bool) (v_::real) = \
49.759 + \ (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.760 + \ d2_polyeq_simplify True)) @@ \
49.761 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.762 + \ (Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.763 + \ d1_polyeq_simplify True)) @@ \
49.764 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.765 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;\
49.766 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.767 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.768 + ));
49.769 +
49.770 +store_met
49.771 + (prep_met PolyEq.thy "met_polyeq_d2_bdvonly" [] e_metID
49.772 + (["PolyEq","solve_d2_polyeq_bdvonly_equation"],
49.773 + [("#Given" ,["equality e_","solveFor v_"]),
49.774 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.775 + "((lhs e_) has_degree_in v_) = 2"]),
49.776 + ("#Find" ,["solutions v_i_"])
49.777 + ],
49.778 + {rew_ord'="termlessI",
49.779 + rls'=PolyEq_erls,
49.780 + srls=e_rls,
49.781 + prls=PolyEq_prls,
49.782 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.783 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.784 + (*asm_rls=["d2_polyeq_bdv_only_simplify","d1_polyeq_simplify "],*)
49.785 + asm_rls=[],
49.786 + asm_thm=[("d1_isolate_div",""),("d2_isolate_div",""),
49.787 + ("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg","")]*)},
49.788 + "Script Solve_d2_polyeq_bdvonly_equation (e_::bool) (v_::real) =\
49.789 + \ (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.790 + \ d2_polyeq_bdv_only_simplify True)) @@ \
49.791 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.792 + \ (Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.793 + \ d1_polyeq_simplify True)) @@ \
49.794 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.795 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;\
49.796 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.797 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.798 + ));
49.799 +
49.800 +store_met
49.801 + (prep_met PolyEq.thy "met_polyeq_d2_sqonly" [] e_metID
49.802 + (["PolyEq","solve_d2_polyeq_sqonly_equation"],
49.803 + [("#Given" ,["equality e_","solveFor v_"]),
49.804 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.805 + "((lhs e_) has_degree_in v_) = 2"]),
49.806 + ("#Find" ,["solutions v_i_"])
49.807 + ],
49.808 + {rew_ord'="termlessI",
49.809 + rls'=PolyEq_erls,
49.810 + srls=e_rls,
49.811 + prls=PolyEq_prls,
49.812 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.813 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.814 + (*asm_rls=["d2_polyeq_sq_only_simplify"],*)
49.815 + asm_rls=[],
49.816 + asm_thm=[("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
49.817 + ("d2_isolate_div","")]*)},
49.818 + "Script Solve_d2_polyeq_sqonly_equation (e_::bool) (v_::real) =\
49.819 + \ (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.820 + \ d2_polyeq_sq_only_simplify True)) @@ \
49.821 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.822 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_; \
49.823 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.824 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.825 + ));
49.826 +
49.827 +store_met
49.828 + (prep_met PolyEq.thy "met_polyeq_d2_pq" [] e_metID
49.829 + (["PolyEq","solve_d2_polyeq_pq_equation"],
49.830 + [("#Given" ,["equality e_","solveFor v_"]),
49.831 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.832 + "((lhs e_) has_degree_in v_) = 2"]),
49.833 + ("#Find" ,["solutions v_i_"])
49.834 + ],
49.835 + {rew_ord'="termlessI",
49.836 + rls'=PolyEq_erls,
49.837 + srls=e_rls,
49.838 + prls=PolyEq_prls,
49.839 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.840 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.841 + (*asm_rls=["d2_polyeq_pqFormula_simplify"],*)
49.842 + asm_rls=[],
49.843 + asm_thm=[("d2_pqformula1",""),("d2_pqformula2",""),("d2_pqformula3",""),
49.844 + ("d2_pqformula4",""),("d2_pqformula5",""),("d2_pqformula6",""),
49.845 + ("d2_pqformula7",""),("d2_pqformula8",""),("d2_pqformula9",""),
49.846 + ("d2_pqformula10",""),("d2_pqformula1_neg",""),("d2_pqformula2_neg",""),
49.847 + ("d2_pqformula3_neg",""), ("d2_pqformula4_neg",""),("d2_pqformula9_neg",""),
49.848 + ("d2_pqformula10_neg","")]*)},
49.849 + "Script Solve_d2_polyeq_pq_equation (e_::bool) (v_::real) = \
49.850 + \ (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.851 + \ d2_polyeq_pqFormula_simplify True)) @@ \
49.852 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.853 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;\
49.854 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.855 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.856 + ));
49.857 +
49.858 +store_met
49.859 + (prep_met PolyEq.thy "met_polyeq_d2_abc" [] e_metID
49.860 + (["PolyEq","solve_d2_polyeq_abc_equation"],
49.861 + [("#Given" ,["equality e_","solveFor v_"]),
49.862 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.863 + "((lhs e_) has_degree_in v_) = 2"]),
49.864 + ("#Find" ,["solutions v_i_"])
49.865 + ],
49.866 + {rew_ord'="termlessI",
49.867 + rls'=PolyEq_erls,
49.868 + srls=e_rls,
49.869 + prls=PolyEq_prls,
49.870 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.871 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.872 + (*asm_rls=["d2_polyeq_abcFormula_simplify"],*)
49.873 + asm_rls=[],
49.874 + asm_thm=[("d2_abcformula1",""),("d2_abcformula2",""),("d2_abcformula3",""),
49.875 + ("d2_abcformula4",""),("d2_abcformula5",""),("d2_abcformula6",""),
49.876 + ("d2_abcformula7",""),("d2_abcformula8",""),("d2_abcformula9",""),
49.877 + ("d2_abcformula10",""),("d2_abcformula1_neg",""),("d2_abcformula2_neg",""),
49.878 + ("d2_abcformula3_neg",""), ("d2_abcformula4_neg",""),("d2_abcformula5_neg",""),
49.879 + ("d2_abcformula6_neg","")]*)},
49.880 + "Script Solve_d2_polyeq_abc_equation (e_::bool) (v_::real) = \
49.881 + \ (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.882 + \ d2_polyeq_abcFormula_simplify True)) @@ \
49.883 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.884 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;\
49.885 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.886 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.887 + ));
49.888 +
49.889 +store_met
49.890 + (prep_met PolyEq.thy "met_polyeq_d3" [] e_metID
49.891 + (["PolyEq","solve_d3_polyeq_equation"],
49.892 + [("#Given" ,["equality e_","solveFor v_"]),
49.893 + ("#Where" ,["(lhs e_) is_poly_in v_ ",
49.894 + "((lhs e_) has_degree_in v_) = 3"]),
49.895 + ("#Find" ,["solutions v_i_"])
49.896 + ],
49.897 + {rew_ord'="termlessI",
49.898 + rls'=PolyEq_erls,
49.899 + srls=e_rls,
49.900 + prls=PolyEq_prls,
49.901 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.902 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.903 + (* asm_rls=["d1_polyeq_simplify","d2_polyeq_simplify","d1_polyeq_simplify"],*)
49.904 + asm_rls=[],
49.905 + asm_thm=[("d3_isolate_div",""),("d1_isolate_div",""),("d2_pqformula1",""),
49.906 + ("d2_pqformula2",""),("d2_pqformula3",""),("d2_pqformula4",""),
49.907 + ("d2_pqformula1_neg",""), ("d2_pqformula2_neg",""),("d2_pqformula3_neg",""),
49.908 + ("d2_pqformula4_neg",""), ("d2_abcformula1",""),("d2_abcformula2",""),
49.909 + ("d2_abcformula1_neg",""),("d2_abcformula2_neg",""),
49.910 + ("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""), ("d2_isolate_div","")]*)},
49.911 + "Script Solve_d3_polyeq_equation (e_::bool) (v_::real) = \
49.912 + \ (let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.913 + \ d3_polyeq_simplify True)) @@ \
49.914 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.915 + \ (Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.916 + \ d2_polyeq_simplify True)) @@ \
49.917 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.918 + \ (Try (Rewrite_Set_Inst [(bdv,v_::real)] \
49.919 + \ d1_polyeq_simplify True)) @@ \
49.920 + \ (Try (Rewrite_Set polyeq_simplify False)) @@ \
49.921 + \ (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;\
49.922 + \ (L_::bool list) = ((Or_to_List e_)::bool list) \
49.923 + \ in Check_elementwise L_ {(v_::real). Assumptions} )"
49.924 + ));
49.925 +
49.926 + (*.solves all expanded (ie. normalized) terms of degree 2.*)
49.927 + (*Oct.02 restriction: 'eval_true 0 =< discriminant' ony for integer values
49.928 + by 'PolyEq_erls'; restricted until Float.thy is implemented*)
49.929 +store_met
49.930 + (prep_met PolyEq.thy "met_polyeq_complsq" [] e_metID
49.931 + (["PolyEq","complete_square"],
49.932 + [("#Given" ,["equality e_","solveFor v_"]),
49.933 + ("#Where" ,["matches (?a = 0) e_",
49.934 + "((lhs e_) has_degree_in v_) = 2"]),
49.935 + ("#Find" ,["solutions v_i_"])
49.936 + ],
49.937 + {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
49.938 + calc=[("sqrt", ("Root.sqrt", eval_sqrt "#sqrt_"))],
49.939 + crls=PolyEq_crls, nrls=norm_Rational(*,
49.940 + asm_rls=[],
49.941 + asm_thm=[("root_plus_minus","")]*)},
49.942 + "Script Complete_square (e_::bool) (v_::real) = \
49.943 + \(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_)] cancel_leading_coeff True))\
49.944 + \ @@ (Try (Rewrite_Set_Inst [(bdv,v_)] complete_square True)) \
49.945 + \ @@ (Try (Rewrite square_explicit1 False)) \
49.946 + \ @@ (Try (Rewrite square_explicit2 False)) \
49.947 + \ @@ (Rewrite root_plus_minus True) \
49.948 + \ @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit1 False))) \
49.949 + \ @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit2 False))) \
49.950 + \ @@ (Try (Repeat \
49.951 + \ (Rewrite_Inst [(bdv,v_)] bdv_explicit3 False))) \
49.952 + \ @@ (Try (Rewrite_Set calculate_RootRat False)) \
49.953 + \ @@ (Try (Repeat (Calculate sqrt_)))) e_ \
49.954 + \ in ((Or_to_List e_)::bool list))"
49.955 + ));
49.956 +(*6.10.02: x^2=64: root_plus_minus -/-/->
49.957 + "Script Complete_square (e_::bool) (v_::real) = \
49.958 + \(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_)] cancel_leading_coeff True))\
49.959 + \ @@ (Try (Rewrite_Set_Inst [(bdv,v_)] complete_square True)) \
49.960 + \ @@ (Try ((Rewrite square_explicit1 False) \
49.961 + \ Or (Rewrite square_explicit2 False))) \
49.962 + \ @@ (Rewrite root_plus_minus True) \
49.963 + \ @@ ((Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit1 False)) \
49.964 + \ Or (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit2 False))) \
49.965 + \ @@ (Try (Repeat \
49.966 + \ (Rewrite_Inst [(bdv,v_)] bdv_explicit3 False))) \
49.967 + \ @@ (Try (Rewrite_Set calculate_RootRat False)) \
49.968 + \ @@ (Try (Repeat (Calculate sqrt_)))) e_ \
49.969 + \ in ((Or_to_List e_)::bool list))"*)
49.970 +
49.971 +"******* PolyEq.ML end *******";
49.972 +
49.973 +(*eine gehackte termorder*)
49.974 +local (*. for make_polynomial_in .*)
49.975 +
49.976 +open Term; (* for type order = EQUAL | LESS | GREATER *)
49.977 +
49.978 +fun pr_ord EQUAL = "EQUAL"
49.979 + | pr_ord LESS = "LESS"
49.980 + | pr_ord GREATER = "GREATER";
49.981 +
49.982 +fun dest_hd' x (Const (a, T)) = (((a, 0), T), 0)
49.983 + | dest_hd' x (t as Free (a, T)) =
49.984 + if x = t then ((("|||||||||||||", 0), T), 0) (*WN*)
49.985 + else (((a, 0), T), 1)
49.986 + | dest_hd' x (Var v) = (v, 2)
49.987 + | dest_hd' x (Bound i) = ((("", i), dummyT), 3)
49.988 + | dest_hd' x (Abs (_, T, _)) = ((("", 0), T), 4);
49.989 +
49.990 +fun size_of_term' x (Const ("Atools.pow",_) $ Free (var,_) $ Free (pot,_)) =
49.991 + (case x of (*WN*)
49.992 + (Free (xstr,_)) =>
49.993 + (if xstr = var then 1000*(the (int_of_str pot)) else 3)
49.994 + | _ => raise error ("size_of_term' called with subst = "^
49.995 + (term2str x)))
49.996 + | size_of_term' x (Free (subst,_)) =
49.997 + (case x of
49.998 + (Free (xstr,_)) => (if xstr = subst then 1000 else 1)
49.999 + | _ => raise error ("size_of_term' called with subst = "^
49.1000 + (term2str x)))
49.1001 + | size_of_term' x (Abs (_,_,body)) = 1 + size_of_term' x body
49.1002 + | size_of_term' x (f$t) = size_of_term' x f + size_of_term' x t
49.1003 + | size_of_term' x _ = 1;
49.1004 +
49.1005 +
49.1006 +fun term_ord' x pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
49.1007 + (case term_ord' x pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
49.1008 + | term_ord' x pr thy (t, u) =
49.1009 + (if pr then
49.1010 + let
49.1011 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
49.1012 + val _=writeln("t= f@ts= \""^
49.1013 + ((string_of_cterm o cterm_of (sign_of thy)) f)^"\" @ \"["^
49.1014 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
49.1015 + val _=writeln("u= g@us= \""^
49.1016 + ((string_of_cterm o cterm_of (sign_of thy)) g)^"\" @ \"["^
49.1017 + (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
49.1018 + val _=writeln("size_of_term(t,u)= ("^
49.1019 + (string_of_int(size_of_term' x t))^", "^
49.1020 + (string_of_int(size_of_term' x u))^")");
49.1021 + val _=writeln("hd_ord(f,g) = "^((pr_ord o (hd_ord x))(f,g)));
49.1022 + val _=writeln("terms_ord(ts,us) = "^
49.1023 + ((pr_ord o (terms_ord x) str false)(ts,us)));
49.1024 + val _=writeln("-------");
49.1025 + in () end
49.1026 + else ();
49.1027 + case int_ord (size_of_term' x t, size_of_term' x u) of
49.1028 + EQUAL =>
49.1029 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
49.1030 + (case hd_ord x (f, g) of EQUAL => (terms_ord x str pr) (ts, us)
49.1031 + | ord => ord)
49.1032 + end
49.1033 + | ord => ord)
49.1034 +and hd_ord x (f, g) = (* ~ term.ML *)
49.1035 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' x f,
49.1036 + dest_hd' x g)
49.1037 +and terms_ord x str pr (ts, us) =
49.1038 + list_ord (term_ord' x pr (assoc_thy "Isac.thy"))(ts, us);
49.1039 +(*val x = (term_of o the o (parse thy)) "x"; (*FIXXXXXXME*)
49.1040 +*)
49.1041 +
49.1042 +in
49.1043 +
49.1044 +fun ord_make_polynomial_in (pr:bool) thy subst tu =
49.1045 + let
49.1046 + (* val _=writeln("*** subs variable is: "^(subst2str subst)); *)
49.1047 + in
49.1048 + case subst of
49.1049 + (_,x)::_ => (term_ord' x pr thy tu = LESS)
49.1050 + | _ => raise error ("ord_make_polynomial_in called with subst = "^
49.1051 + (subst2str subst))
49.1052 + end;
49.1053 +end;
49.1054 +
49.1055 +val order_add_mult_in = prep_rls(
49.1056 + Rls{id = "order_add_mult_in", preconds = [],
49.1057 + rew_ord = ("ord_make_polynomial_in",
49.1058 + ord_make_polynomial_in false Poly.thy),
49.1059 + erls = e_rls,srls = Erls,
49.1060 + calc = [],
49.1061 + (*asm_thm = [],*)
49.1062 + rules = [Thm ("real_mult_commute",num_str real_mult_commute),
49.1063 + (* z * w = w * z *)
49.1064 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
49.1065 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
49.1066 + Thm ("real_mult_assoc",num_str real_mult_assoc),
49.1067 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
49.1068 + Thm ("real_add_commute",num_str real_add_commute),
49.1069 + (*z + w = w + z*)
49.1070 + Thm ("real_add_left_commute",num_str real_add_left_commute),
49.1071 + (*x + (y + z) = y + (x + z)*)
49.1072 + Thm ("real_add_assoc",num_str real_add_assoc)
49.1073 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
49.1074 + ], scr = EmptyScr}:rls);
49.1075 +
49.1076 +val collect_bdv = prep_rls(
49.1077 + Rls{id = "collect_bdv", preconds = [],
49.1078 + rew_ord = ("dummy_ord", dummy_ord),
49.1079 + erls = e_rls,srls = Erls,
49.1080 + calc = [],
49.1081 + (*asm_thm = [],*)
49.1082 + rules = [Thm ("bdv_collect_1",num_str bdv_collect_1),
49.1083 + Thm ("bdv_collect_2",num_str bdv_collect_2),
49.1084 + Thm ("bdv_collect_3",num_str bdv_collect_3),
49.1085 +
49.1086 + Thm ("bdv_collect_assoc1_1",num_str bdv_collect_assoc1_1),
49.1087 + Thm ("bdv_collect_assoc1_2",num_str bdv_collect_assoc1_2),
49.1088 + Thm ("bdv_collect_assoc1_3",num_str bdv_collect_assoc1_3),
49.1089 +
49.1090 + Thm ("bdv_collect_assoc2_1",num_str bdv_collect_assoc2_1),
49.1091 + Thm ("bdv_collect_assoc2_2",num_str bdv_collect_assoc2_2),
49.1092 + Thm ("bdv_collect_assoc2_3",num_str bdv_collect_assoc2_3),
49.1093 +
49.1094 +
49.1095 + Thm ("bdv_n_collect_1",num_str bdv_n_collect_1),
49.1096 + Thm ("bdv_n_collect_2",num_str bdv_n_collect_2),
49.1097 + Thm ("bdv_n_collect_3",num_str bdv_n_collect_3),
49.1098 +
49.1099 + Thm ("bdv_n_collect_assoc1_1",num_str bdv_n_collect_assoc1_1),
49.1100 + Thm ("bdv_n_collect_assoc1_2",num_str bdv_n_collect_assoc1_2),
49.1101 + Thm ("bdv_n_collect_assoc1_3",num_str bdv_n_collect_assoc1_3),
49.1102 +
49.1103 + Thm ("bdv_n_collect_assoc2_1",num_str bdv_n_collect_assoc2_1),
49.1104 + Thm ("bdv_n_collect_assoc2_2",num_str bdv_n_collect_assoc2_2),
49.1105 + Thm ("bdv_n_collect_assoc2_3",num_str bdv_n_collect_assoc2_3)
49.1106 + ], scr = EmptyScr}:rls);
49.1107 +
49.1108 +(*.transforms an arbitrary term without roots to a polynomial [4]
49.1109 + according to knowledge/Poly.sml.*)
49.1110 +val make_polynomial_in = prep_rls(
49.1111 + Seq {id = "make_polynomial_in", preconds = []:term list,
49.1112 + rew_ord = ("dummy_ord", dummy_ord),
49.1113 + erls = Atools_erls, srls = Erls,
49.1114 + calc = [], (*asm_thm = [],*)
49.1115 + rules = [Rls_ expand_poly,
49.1116 + Rls_ order_add_mult_in,
49.1117 + Rls_ simplify_power,
49.1118 + Rls_ collect_numerals,
49.1119 + Rls_ reduce_012,
49.1120 + Thm ("realpow_oneI",num_str realpow_oneI),
49.1121 + Rls_ discard_parentheses,
49.1122 + Rls_ collect_bdv
49.1123 + ],
49.1124 + scr = EmptyScr
49.1125 + }:rls);
49.1126 +
49.1127 +val separate_bdvs =
49.1128 + append_rls "separate_bdvs"
49.1129 + collect_bdv
49.1130 + [Thm ("separate_bdv", num_str separate_bdv),
49.1131 + (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
49.1132 + Thm ("separate_bdv_n", num_str separate_bdv_n),
49.1133 + Thm ("separate_1_bdv", num_str separate_1_bdv),
49.1134 + (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
49.1135 + Thm ("separate_1_bdv_n", num_str separate_1_bdv_n),
49.1136 + (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
49.1137 + Thm ("real_add_divide_distrib",
49.1138 + num_str real_add_divide_distrib)
49.1139 + (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"
49.1140 + WN051031 DOES NOT BELONG TO HERE*)
49.1141 + ];
49.1142 +val make_ratpoly_in = prep_rls(
49.1143 + Seq {id = "make_ratpoly_in", preconds = []:term list,
49.1144 + rew_ord = ("dummy_ord", dummy_ord),
49.1145 + erls = Atools_erls, srls = Erls,
49.1146 + calc = [], (*asm_thm = [],*)
49.1147 + rules = [Rls_ norm_Rational,
49.1148 + Rls_ order_add_mult_in,
49.1149 + Rls_ discard_parentheses,
49.1150 + Rls_ separate_bdvs,
49.1151 + (* Rls_ rearrange_assoc, WN060916 why does cancel_p not work?*)
49.1152 + Rls_ cancel_p
49.1153 + (*Calc ("HOL.divide" ,eval_cancel "#divide_") too weak!*)
49.1154 + ],
49.1155 + scr = EmptyScr}:rls);
49.1156 +
49.1157 +
49.1158 +ruleset' := overwritelthy thy (!ruleset',
49.1159 + [("order_add_mult_in", order_add_mult_in),
49.1160 + ("collect_bdv", collect_bdv),
49.1161 + ("make_polynomial_in", make_polynomial_in),
49.1162 + ("make_ratpoly_in", make_ratpoly_in),
49.1163 + ("separate_bdvs", separate_bdvs)
49.1164 + ]);
49.1165 +
50.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
50.2 +++ b/src/Pure/isac/IsacKnowledge/PolyEq.thy Wed Jul 21 13:53:39 2010 +0200
50.3 @@ -0,0 +1,407 @@
50.4 +(*.(c) by Richard Lang, 2003 .*)
50.5 +(* theory collecting all knowledge
50.6 + (predicates 'is_rootEq_in', 'is_sqrt_in', 'is_ratEq_in')
50.7 + for PolynomialEquations.
50.8 + alternative dependencies see Isac.thy
50.9 + created by: rlang
50.10 + date: 02.07
50.11 + changed by: rlang
50.12 + last change by: rlang
50.13 + date: 03.06.03
50.14 +*)
50.15 +
50.16 +(* remove_thy"PolyEq";
50.17 + use_thy"IsacKnowledge/Isac";
50.18 + use_thy"IsacKnowledge/PolyEq";
50.19 +
50.20 + remove_thy"PolyEq";
50.21 + use_thy"Isac";
50.22 +
50.23 + use"ROOT.ML";
50.24 + cd"knowledge";
50.25 + *)
50.26 +
50.27 +PolyEq = LinEq + RootRatEq +
50.28 +(*-------------------- consts ------------------------------------------------*)
50.29 +consts
50.30 +
50.31 +(*---------scripts--------------------------*)
50.32 + Complete'_square
50.33 + :: "[bool,real, \
50.34 + \ bool list] => bool list"
50.35 + ("((Script Complete'_square (_ _ =))// \
50.36 + \ (_))" 9)
50.37 + (*----- poly ----- *)
50.38 + Normalize'_poly
50.39 + :: "[bool,real, \
50.40 + \ bool list] => bool list"
50.41 + ("((Script Normalize'_poly (_ _=))// \
50.42 + \ (_))" 9)
50.43 + Solve'_d0'_polyeq'_equation
50.44 + :: "[bool,real, \
50.45 + \ bool list] => bool list"
50.46 + ("((Script Solve'_d0'_polyeq'_equation (_ _ =))// \
50.47 + \ (_))" 9)
50.48 + Solve'_d1'_polyeq'_equation
50.49 + :: "[bool,real, \
50.50 + \ bool list] => bool list"
50.51 + ("((Script Solve'_d1'_polyeq'_equation (_ _ =))// \
50.52 + \ (_))" 9)
50.53 + Solve'_d2'_polyeq'_equation
50.54 + :: "[bool,real, \
50.55 + \ bool list] => bool list"
50.56 + ("((Script Solve'_d2'_polyeq'_equation (_ _ =))// \
50.57 + \ (_))" 9)
50.58 + Solve'_d2'_polyeq'_sqonly'_equation
50.59 + :: "[bool,real, \
50.60 + \ bool list] => bool list"
50.61 + ("((Script Solve'_d2'_polyeq'_sqonly'_equation (_ _ =))// \
50.62 + \ (_))" 9)
50.63 + Solve'_d2'_polyeq'_bdvonly'_equation
50.64 + :: "[bool,real, \
50.65 + \ bool list] => bool list"
50.66 + ("((Script Solve'_d2'_polyeq'_bdvonly'_equation (_ _ =))// \
50.67 + \ (_))" 9)
50.68 + Solve'_d2'_polyeq'_pq'_equation
50.69 + :: "[bool,real, \
50.70 + \ bool list] => bool list"
50.71 + ("((Script Solve'_d2'_polyeq'_pq'_equation (_ _ =))// \
50.72 + \ (_))" 9)
50.73 + Solve'_d2'_polyeq'_abc'_equation
50.74 + :: "[bool,real, \
50.75 + \ bool list] => bool list"
50.76 + ("((Script Solve'_d2'_polyeq'_abc'_equation (_ _ =))// \
50.77 + \ (_))" 9)
50.78 + Solve'_d3'_polyeq'_equation
50.79 + :: "[bool,real, \
50.80 + \ bool list] => bool list"
50.81 + ("((Script Solve'_d3'_polyeq'_equation (_ _ =))// \
50.82 + \ (_))" 9)
50.83 + Solve'_d4'_polyeq'_equation
50.84 + :: "[bool,real, \
50.85 + \ bool list] => bool list"
50.86 + ("((Script Solve'_d4'_polyeq'_equation (_ _ =))// \
50.87 + \ (_))" 9)
50.88 + Biquadrat'_poly
50.89 + :: "[bool,real, \
50.90 + \ bool list] => bool list"
50.91 + ("((Script Biquadrat'_poly (_ _=))// \
50.92 + \ (_))" 9)
50.93 +
50.94 +(*-------------------- rules -------------------------------------------------*)
50.95 +rules
50.96 +
50.97 + cancel_leading_coeff1 "Not (c =!= 0) ==> (a + b*bdv + c*bdv^^^2 = 0) = \
50.98 + \ (a/c + b/c*bdv + bdv^^^2 = 0)"
50.99 + cancel_leading_coeff2 "Not (c =!= 0) ==> (a - b*bdv + c*bdv^^^2 = 0) = \
50.100 + \ (a/c - b/c*bdv + bdv^^^2 = 0)"
50.101 + cancel_leading_coeff3 "Not (c =!= 0) ==> (a + b*bdv - c*bdv^^^2 = 0) = \
50.102 + \ (a/c + b/c*bdv - bdv^^^2 = 0)"
50.103 +
50.104 + cancel_leading_coeff4 "Not (c =!= 0) ==> (a + bdv + c*bdv^^^2 = 0) = \
50.105 + \ (a/c + 1/c*bdv + bdv^^^2 = 0)"
50.106 + cancel_leading_coeff5 "Not (c =!= 0) ==> (a - bdv + c*bdv^^^2 = 0) = \
50.107 + \ (a/c - 1/c*bdv + bdv^^^2 = 0)"
50.108 + cancel_leading_coeff6 "Not (c =!= 0) ==> (a + bdv - c*bdv^^^2 = 0) = \
50.109 + \ (a/c + 1/c*bdv - bdv^^^2 = 0)"
50.110 +
50.111 + cancel_leading_coeff7 "Not (c =!= 0) ==> ( b*bdv + c*bdv^^^2 = 0) = \
50.112 + \ ( b/c*bdv + bdv^^^2 = 0)"
50.113 + cancel_leading_coeff8 "Not (c =!= 0) ==> ( b*bdv - c*bdv^^^2 = 0) = \
50.114 + \ ( b/c*bdv - bdv^^^2 = 0)"
50.115 +
50.116 + cancel_leading_coeff9 "Not (c =!= 0) ==> ( bdv + c*bdv^^^2 = 0) = \
50.117 + \ ( 1/c*bdv + bdv^^^2 = 0)"
50.118 + cancel_leading_coeff10"Not (c =!= 0) ==> ( bdv - c*bdv^^^2 = 0) = \
50.119 + \ ( 1/c*bdv - bdv^^^2 = 0)"
50.120 +
50.121 + cancel_leading_coeff11"Not (c =!= 0) ==> (a + b*bdv^^^2 = 0) = \
50.122 + \ (a/b + bdv^^^2 = 0)"
50.123 + cancel_leading_coeff12"Not (c =!= 0) ==> (a - b*bdv^^^2 = 0) = \
50.124 + \ (a/b - bdv^^^2 = 0)"
50.125 + cancel_leading_coeff13"Not (c =!= 0) ==> ( b*bdv^^^2 = 0) = \
50.126 + \ ( bdv^^^2 = 0/b)"
50.127 +
50.128 + complete_square1 "(q + p*bdv + bdv^^^2 = 0) = \
50.129 + \(q + (p/2 + bdv)^^^2 = (p/2)^^^2)"
50.130 + complete_square2 "( p*bdv + bdv^^^2 = 0) = \
50.131 + \( (p/2 + bdv)^^^2 = (p/2)^^^2)"
50.132 + complete_square3 "( bdv + bdv^^^2 = 0) = \
50.133 + \( (1/2 + bdv)^^^2 = (1/2)^^^2)"
50.134 +
50.135 + complete_square4 "(q - p*bdv + bdv^^^2 = 0) = \
50.136 + \(q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
50.137 + complete_square5 "(q + p*bdv - bdv^^^2 = 0) = \
50.138 + \(q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
50.139 +
50.140 + square_explicit1 "(a + b^^^2 = c) = ( b^^^2 = c - a)"
50.141 + square_explicit2 "(a - b^^^2 = c) = (-(b^^^2) = c - a)"
50.142 +
50.143 + bdv_explicit1 "(a + bdv = b) = (bdv = - a + b)"
50.144 + bdv_explicit2 "(a - bdv = b) = ((-1)*bdv = - a + b)"
50.145 + bdv_explicit3 "((-1)*bdv = b) = (bdv = (-1)*b)"
50.146 +
50.147 + plus_leq "(0 <= a + b) = ((-1)*b <= a)"(*Isa?*)
50.148 + minus_leq "(0 <= a - b) = ( b <= a)"(*Isa?*)
50.149 +
50.150 +(*-- normalize --*)
50.151 + (*WN0509 compare LinEq.all_left "[|Not(b=!=0)|] ==> (a=b) = (a+(-1)*b=0)"*)
50.152 + all_left
50.153 + "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"
50.154 + makex1_x
50.155 + "a^^^1 = a"
50.156 + real_assoc_1
50.157 + "a+(b+c) = a+b+c"
50.158 + real_assoc_2
50.159 + "a*(b*c) = a*b*c"
50.160 +
50.161 +(* ---- degree 0 ----*)
50.162 + d0_true
50.163 + "(0=0) = True"
50.164 + d0_false
50.165 + "[|Not(bdv occurs_in a);Not(a=0)|] ==> (a=0) = False"
50.166 +(* ---- degree 1 ----*)
50.167 + d1_isolate_add1
50.168 + "[|Not(bdv occurs_in a)|] ==> (a + b*bdv = 0) = (b*bdv = (-1)*a)"
50.169 + d1_isolate_add2
50.170 + "[|Not(bdv occurs_in a)|] ==> (a + bdv = 0) = ( bdv = (-1)*a)"
50.171 + d1_isolate_div
50.172 + "[|Not(b=0);Not(bdv occurs_in c)|] ==> (b*bdv = c) = (bdv = c/b)"
50.173 +(* ---- degree 2 ----*)
50.174 + d2_isolate_add1
50.175 + "[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^2=0) = (b*bdv^^^2= (-1)*a)"
50.176 + d2_isolate_add2
50.177 + "[|Not(bdv occurs_in a)|] ==> (a + bdv^^^2=0) = ( bdv^^^2= (-1)*a)"
50.178 + d2_isolate_div
50.179 + "[|Not(b=0);Not(bdv occurs_in c)|] ==> (b*bdv^^^2=c) = (bdv^^^2=c/b)"
50.180 + d2_prescind1
50.181 + "(a*bdv + b*bdv^^^2 = 0) = (bdv*(a +b*bdv)=0)"
50.182 + d2_prescind2
50.183 + "(a*bdv + bdv^^^2 = 0) = (bdv*(a + bdv)=0)"
50.184 + d2_prescind3
50.185 + "( bdv + b*bdv^^^2 = 0) = (bdv*(1+b*bdv)=0)"
50.186 + d2_prescind4
50.187 + "( bdv + bdv^^^2 = 0) = (bdv*(1+ bdv)=0)"
50.188 + (* eliminate degree 2 *)
50.189 + (* thm for neg arguments in sqroot have postfix _neg *)
50.190 + d2_sqrt_equation1
50.191 + "[|(0<=c);Not(bdv occurs_in c)|] ==> (bdv^^^2=c) = ((bdv=sqrt c) | (bdv=(-1)*sqrt c ))"
50.192 + d2_sqrt_equation1_neg
50.193 + "[|(c<0);Not(bdv occurs_in c)|] ==> (bdv^^^2=c) = False"
50.194 + d2_sqrt_equation2
50.195 + "(bdv^^^2=0) = (bdv=0)"
50.196 + d2_sqrt_equation3
50.197 + "(b*bdv^^^2=0) = (bdv=0)"
50.198 + d2_reduce_equation1
50.199 + "(bdv*(a +b*bdv)=0) = ((bdv=0)|(a+b*bdv=0))"
50.200 + d2_reduce_equation2
50.201 + "(bdv*(a + bdv)=0) = ((bdv=0)|(a+ bdv=0))"
50.202 + d2_pqformula1
50.203 + "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+ bdv^^^2=0) =
50.204 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2)
50.205 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
50.206 + d2_pqformula1_neg
50.207 + "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+ bdv^^^2=0) = False"
50.208 + d2_pqformula2
50.209 + "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+1*bdv^^^2=0) =
50.210 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2)
50.211 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
50.212 + d2_pqformula2_neg
50.213 + "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+1*bdv^^^2=0) = False"
50.214 + d2_pqformula3
50.215 + "[|0<=1 - 4*q|] ==> (q+ bdv+ bdv^^^2=0) =
50.216 + ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2)
50.217 + | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
50.218 + d2_pqformula3_neg
50.219 + "[|1 - 4*q<0|] ==> (q+ bdv+ bdv^^^2=0) = False"
50.220 + d2_pqformula4
50.221 + "[|0<=1 - 4*q|] ==> (q+ bdv+1*bdv^^^2=0) =
50.222 + ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2)
50.223 + | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
50.224 + d2_pqformula4_neg
50.225 + "[|1 - 4*q<0|] ==> (q+ bdv+1*bdv^^^2=0) = False"
50.226 + d2_pqformula5
50.227 + "[|0<=p^^^2 - 0|] ==> ( p*bdv+ bdv^^^2=0) =
50.228 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2)
50.229 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
50.230 + (* d2_pqformula5_neg not need p^2 never less zero in R *)
50.231 + d2_pqformula6
50.232 + "[|0<=p^^^2 - 0|] ==> ( p*bdv+1*bdv^^^2=0) =
50.233 + ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2)
50.234 + | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
50.235 + (* d2_pqformula6_neg not need p^2 never less zero in R *)
50.236 + d2_pqformula7
50.237 + "[|0<=1 - 0|] ==> ( bdv+ bdv^^^2=0) =
50.238 + ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2)
50.239 + | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
50.240 + (* d2_pqformula7_neg not need, because 1<0 ==> False*)
50.241 + d2_pqformula8
50.242 + "[|0<=1 - 0|] ==> ( bdv+1*bdv^^^2=0) =
50.243 + ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2)
50.244 + | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
50.245 + (* d2_pqformula8_neg not need, because 1<0 ==> False*)
50.246 + d2_pqformula9
50.247 + "[|Not(bdv occurs_in q); 0<= (-1)*4*q|] ==> (q+ 1*bdv^^^2=0) =
50.248 + ((bdv= 0 + sqrt(0 - 4*q)/2)
50.249 + | (bdv= 0 - sqrt(0 - 4*q)/2))"
50.250 + d2_pqformula9_neg
50.251 + "[|Not(bdv occurs_in q); (-1)*4*q<0|] ==> (q+ 1*bdv^^^2=0) = False"
50.252 + d2_pqformula10
50.253 + "[|Not(bdv occurs_in q); 0<= (-1)*4*q|] ==> (q+ bdv^^^2=0) =
50.254 + ((bdv= 0 + sqrt(0 - 4*q)/2)
50.255 + | (bdv= 0 - sqrt(0 - 4*q)/2))"
50.256 + d2_pqformula10_neg
50.257 + "[|Not(bdv occurs_in q); (-1)*4*q<0|] ==> (q+ bdv^^^2=0) = False"
50.258 + d2_abcformula1
50.259 + "[|0<=b^^^2 - 4*a*c|] ==> (c + b*bdv+a*bdv^^^2=0) =
50.260 + ((bdv=( -b + sqrt(b^^^2 - 4*a*c))/(2*a))
50.261 + | (bdv=( -b - sqrt(b^^^2 - 4*a*c))/(2*a)))"
50.262 + d2_abcformula1_neg
50.263 + "[|b^^^2 - 4*a*c<0|] ==> (c + b*bdv+a*bdv^^^2=0) = False"
50.264 + d2_abcformula2
50.265 + "[|0<=1 - 4*a*c|] ==> (c+ bdv+a*bdv^^^2=0) =
50.266 + ((bdv=( -1 + sqrt(1 - 4*a*c))/(2*a))
50.267 + | (bdv=( -1 - sqrt(1 - 4*a*c))/(2*a)))"
50.268 + d2_abcformula2_neg
50.269 + "[|1 - 4*a*c<0|] ==> (c+ bdv+a*bdv^^^2=0) = False"
50.270 + d2_abcformula3
50.271 + "[|0<=b^^^2 - 4*1*c|] ==> (c + b*bdv+ bdv^^^2=0) =
50.272 + ((bdv=( -b + sqrt(b^^^2 - 4*1*c))/(2*1))
50.273 + | (bdv=( -b - sqrt(b^^^2 - 4*1*c))/(2*1)))"
50.274 + d2_abcformula3_neg
50.275 + "[|b^^^2 - 4*1*c<0|] ==> (c + b*bdv+ bdv^^^2=0) = False"
50.276 + d2_abcformula4
50.277 + "[|0<=1 - 4*1*c|] ==> (c + bdv+ bdv^^^2=0) =
50.278 + ((bdv=( -1 + sqrt(1 - 4*1*c))/(2*1))
50.279 + | (bdv=( -1 - sqrt(1 - 4*1*c))/(2*1)))"
50.280 + d2_abcformula4_neg
50.281 + "[|1 - 4*1*c<0|] ==> (c + bdv+ bdv^^^2=0) = False"
50.282 + d2_abcformula5
50.283 + "[|Not(bdv occurs_in c); 0<=0 - 4*a*c|] ==> (c + a*bdv^^^2=0) =
50.284 + ((bdv=( 0 + sqrt(0 - 4*a*c))/(2*a))
50.285 + | (bdv=( 0 - sqrt(0 - 4*a*c))/(2*a)))"
50.286 + d2_abcformula5_neg
50.287 + "[|Not(bdv occurs_in c); 0 - 4*a*c<0|] ==> (c + a*bdv^^^2=0) = False"
50.288 + d2_abcformula6
50.289 + "[|Not(bdv occurs_in c); 0<=0 - 4*1*c|] ==> (c+ bdv^^^2=0) =
50.290 + ((bdv=( 0 + sqrt(0 - 4*1*c))/(2*1))
50.291 + | (bdv=( 0 - sqrt(0 - 4*1*c))/(2*1)))"
50.292 + d2_abcformula6_neg
50.293 + "[|Not(bdv occurs_in c); 0 - 4*1*c<0|] ==> (c+ bdv^^^2=0) = False"
50.294 + d2_abcformula7
50.295 + "[|0<=b^^^2 - 0|] ==> ( b*bdv+a*bdv^^^2=0) =
50.296 + ((bdv=( -b + sqrt(b^^^2 - 0))/(2*a))
50.297 + | (bdv=( -b - sqrt(b^^^2 - 0))/(2*a)))"
50.298 + (* d2_abcformula7_neg not need b^2 never less zero in R *)
50.299 + d2_abcformula8
50.300 + "[|0<=b^^^2 - 0|] ==> ( b*bdv+ bdv^^^2=0) =
50.301 + ((bdv=( -b + sqrt(b^^^2 - 0))/(2*1))
50.302 + | (bdv=( -b - sqrt(b^^^2 - 0))/(2*1)))"
50.303 + (* d2_abcformula8_neg not need b^2 never less zero in R *)
50.304 + d2_abcformula9
50.305 + "[|0<=1 - 0|] ==> ( bdv+a*bdv^^^2=0) =
50.306 + ((bdv=( -1 + sqrt(1 - 0))/(2*a))
50.307 + | (bdv=( -1 - sqrt(1 - 0))/(2*a)))"
50.308 + (* d2_abcformula9_neg not need, because 1<0 ==> False*)
50.309 + d2_abcformula10
50.310 + "[|0<=1 - 0|] ==> ( bdv+ bdv^^^2=0) =
50.311 + ((bdv=( -1 + sqrt(1 - 0))/(2*1))
50.312 + | (bdv=( -1 - sqrt(1 - 0))/(2*1)))"
50.313 + (* d2_abcformula10_neg not need, because 1<0 ==> False*)
50.314 +
50.315 +(* ---- degree 3 ----*)
50.316 + d3_reduce_equation1
50.317 + "(a*bdv + b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (a + b*bdv + c*bdv^^^2=0))"
50.318 + d3_reduce_equation2
50.319 + "( bdv + b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (1 + b*bdv + c*bdv^^^2=0))"
50.320 + d3_reduce_equation3
50.321 + "(a*bdv + bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (a + bdv + c*bdv^^^2=0))"
50.322 + d3_reduce_equation4
50.323 + "( bdv + bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (1 + bdv + c*bdv^^^2=0))"
50.324 + d3_reduce_equation5
50.325 + "(a*bdv + b*bdv^^^2 + bdv^^^3=0) = (bdv=0 | (a + b*bdv + bdv^^^2=0))"
50.326 + d3_reduce_equation6
50.327 + "( bdv + b*bdv^^^2 + bdv^^^3=0) = (bdv=0 | (1 + b*bdv + bdv^^^2=0))"
50.328 + d3_reduce_equation7
50.329 + "(a*bdv + bdv^^^2 + bdv^^^3=0) = (bdv=0 | (1 + bdv + bdv^^^2=0))"
50.330 + d3_reduce_equation8
50.331 + "( bdv + bdv^^^2 + bdv^^^3=0) = (bdv=0 | (1 + bdv + bdv^^^2=0))"
50.332 + d3_reduce_equation9
50.333 + "(a*bdv + c*bdv^^^3=0) = (bdv=0 | (a + c*bdv^^^2=0))"
50.334 + d3_reduce_equation10
50.335 + "( bdv + c*bdv^^^3=0) = (bdv=0 | (1 + c*bdv^^^2=0))"
50.336 + d3_reduce_equation11
50.337 + "(a*bdv + bdv^^^3=0) = (bdv=0 | (a + bdv^^^2=0))"
50.338 + d3_reduce_equation12
50.339 + "( bdv + bdv^^^3=0) = (bdv=0 | (1 + bdv^^^2=0))"
50.340 + d3_reduce_equation13
50.341 + "( b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | ( b*bdv + c*bdv^^^2=0))"
50.342 + d3_reduce_equation14
50.343 + "( bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | ( bdv + c*bdv^^^2=0))"
50.344 + d3_reduce_equation15
50.345 + "( b*bdv^^^2 + bdv^^^3=0) = (bdv=0 | ( b*bdv + bdv^^^2=0))"
50.346 + d3_reduce_equation16
50.347 + "( bdv^^^2 + bdv^^^3=0) = (bdv=0 | ( bdv + bdv^^^2=0))"
50.348 + d3_isolate_add1
50.349 + "[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^3=0) = (b*bdv^^^3= (-1)*a)"
50.350 + d3_isolate_add2
50.351 + "[|Not(bdv occurs_in a)|] ==> (a + bdv^^^3=0) = ( bdv^^^3= (-1)*a)"
50.352 + d3_isolate_div
50.353 + "[|Not(b=0);Not(bdv occurs_in a)|] ==> (b*bdv^^^3=c) = (bdv^^^3=c/b)"
50.354 + d3_root_equation2
50.355 + "(bdv^^^3=0) = (bdv=0)"
50.356 + d3_root_equation1
50.357 + "(bdv^^^3=c) = (bdv = nroot 3 c)"
50.358 +
50.359 +(* ---- degree 4 ----*)
50.360 + (* RL03.FIXME es wir nicht getestet ob u>0 *)
50.361 + d4_sub_u1
50.362 + "(c+b*bdv^^^2+a*bdv^^^4=0) =
50.363 + ((a*u^^^2+b*u+c=0) & (bdv^^^2=u))"
50.364 +
50.365 +(* ---- 7.3.02 von Termorder ---- *)
50.366 +
50.367 + bdv_collect_1 "l * bdv + m * bdv = (l + m) * bdv"
50.368 + bdv_collect_2 "bdv + m * bdv = (1 + m) * bdv"
50.369 + bdv_collect_3 "l * bdv + bdv = (l + 1) * bdv"
50.370 +
50.371 +(* bdv_collect_assoc0_1 "l * bdv + m * bdv + k = (l + m) * bdv + k"
50.372 + bdv_collect_assoc0_2 "bdv + m * bdv + k = (1 + m) * bdv + k"
50.373 + bdv_collect_assoc0_3 "l * bdv + bdv + k = (l + 1) * bdv + k"
50.374 +*)
50.375 + bdv_collect_assoc1_1 "l * bdv + (m * bdv + k) = (l + m) * bdv + k"
50.376 + bdv_collect_assoc1_2 "bdv + (m * bdv + k) = (1 + m) * bdv + k"
50.377 + bdv_collect_assoc1_3 "l * bdv + (bdv + k) = (l + 1) * bdv + k"
50.378 +
50.379 + bdv_collect_assoc2_1 "k + l * bdv + m * bdv = k + (l + m) * bdv"
50.380 + bdv_collect_assoc2_2 "k + bdv + m * bdv = k + (1 + m) * bdv"
50.381 + bdv_collect_assoc2_3 "k + l * bdv + bdv = k + (l + 1) * bdv"
50.382 +
50.383 +
50.384 + bdv_n_collect_1 "l * bdv^^^n + m * bdv^^^n = (l + m) * bdv^^^n"
50.385 + bdv_n_collect_2 " bdv^^^n + m * bdv^^^n = (1 + m) * bdv^^^n"
50.386 + bdv_n_collect_3 "l * bdv^^^n + bdv^^^n = (l + 1) * bdv^^^n" (*order!*)
50.387 +
50.388 + bdv_n_collect_assoc1_1 "l * bdv^^^n + (m * bdv^^^n + k) = (l + m) * bdv^^^n + k"
50.389 + bdv_n_collect_assoc1_2 "bdv^^^n + (m * bdv^^^n + k) = (1 + m) * bdv^^^n + k"
50.390 + bdv_n_collect_assoc1_3 "l * bdv^^^n + (bdv^^^n + k) = (l + 1) * bdv^^^n + k"
50.391 +
50.392 + bdv_n_collect_assoc2_1 "k + l * bdv^^^n + m * bdv^^^n = k + (l + m) * bdv^^^n"
50.393 + bdv_n_collect_assoc2_2 "k + bdv^^^n + m * bdv^^^n = k + (1 + m) * bdv^^^n"
50.394 + bdv_n_collect_assoc2_3 "k + l * bdv^^^n + bdv^^^n = k + (l + 1) * bdv^^^n"
50.395 +
50.396 +(*WN.14.3.03*)
50.397 + real_minus_div "- (a / b) = (-1 * a) / b"
50.398 +
50.399 + separate_bdv "(a * bdv) / b = (a / b) * bdv"
50.400 + separate_bdv_n "(a * bdv ^^^ n) / b = (a / b) * bdv ^^^ n"
50.401 + separate_1_bdv "bdv / b = (1 / b) * bdv"
50.402 + separate_1_bdv_n "bdv ^^^ n / b = (1 / b) * bdv ^^^ n"
50.403 +
50.404 +end
50.405 +
50.406 +
50.407 +
50.408 +
50.409 +
50.410 +
51.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
51.2 +++ b/src/Pure/isac/IsacKnowledge/PolyMinus.ML Wed Jul 21 13:53:39 2010 +0200
51.3 @@ -0,0 +1,521 @@
51.4 +(* questionable attempts to perserve binary minus as wanted by teachers
51.5 + WN071207
51.6 + (c) due to copyright terms
51.7 +remove_thy"PolyMinus";
51.8 +use_thy"IsacKnowledge/PolyMinus";
51.9 +
51.10 +use_thy"IsacKnowledge/Isac";
51.11 +use"IsacKnowledge/PolyMinus.ML";
51.12 +*)
51.13 +
51.14 +(** interface isabelle -- isac **)
51.15 +theory' := overwritel (!theory', [("PolyMinus.thy",PolyMinus.thy)]);
51.16 +
51.17 +(** eval functions **)
51.18 +
51.19 +(*. get the identifier from specific monomials; see fun ist_monom .*)
51.20 +(*HACK.WN080107*)
51.21 +fun increase str =
51.22 + let val s::ss = explode str
51.23 + in implode ((chr (ord s + 1))::ss) end;
51.24 +fun identifier (Free (id,_)) = id (* 2, a *)
51.25 + | identifier (Const ("op *", _) $ Free (num, _) $ Free (id, _)) =
51.26 + id (* 2*a, a*b *)
51.27 + | identifier (Const ("op *", _) $ (* 3*a*b *)
51.28 + (Const ("op *", _) $
51.29 + Free (num, _) $ Free _) $ Free (id, _)) =
51.30 + if is_numeral num then id
51.31 + else "|||||||||||||"
51.32 + | identifier (Const ("Atools.pow", _) $ Free (base, _) $ Free (exp, _)) =
51.33 + if is_numeral base then "|||||||||||||" (* a^2 *)
51.34 + else (*increase*) base
51.35 + | identifier (Const ("op *", _) $ Free (num, _) $ (* 3*a^2 *)
51.36 + (Const ("Atools.pow", _) $
51.37 + Free (base, _) $ Free (exp, _))) =
51.38 + if is_numeral num andalso not (is_numeral base) then (*increase*) base
51.39 + else "|||||||||||||"
51.40 + | identifier _ = "|||||||||||||"(*the "largest" string*);
51.41 +
51.42 +(*("kleiner", ("PolyMinus.kleiner", eval_kleiner ""))*)
51.43 +(* order "by alphabet" w.r.t. var: num < (var | num*var) > (var*var | ..) *)
51.44 +fun eval_kleiner _ _ (p as (Const ("PolyMinus.kleiner",_) $ a $ b)) _ =
51.45 + if is_num b then
51.46 + if is_num a then (*123 kleiner 32 = True !!!*)
51.47 + if int_of_Free a < int_of_Free b then
51.48 + Some ((term2str p) ^ " = True",
51.49 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
51.50 + else Some ((term2str p) ^ " = False",
51.51 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
51.52 + else (* -1 * -2 kleiner 0 *)
51.53 + Some ((term2str p) ^ " = False",
51.54 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
51.55 + else
51.56 + if identifier a < identifier b then
51.57 + Some ((term2str p) ^ " = True",
51.58 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
51.59 + else Some ((term2str p) ^ " = False",
51.60 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
51.61 + | eval_kleiner _ _ _ _ = None;
51.62 +
51.63 +fun ist_monom (Free (id,_)) = true
51.64 + | ist_monom (Const ("op *", _) $ Free (num, _) $ Free (id, _)) =
51.65 + if is_numeral num then true else false
51.66 + | ist_monom _ = false;
51.67 +(*. this function only accepts the most simple monoms vvvvvvvvvv .*)
51.68 +fun ist_monom (Free (id,_)) = true (* 2, a *)
51.69 + | ist_monom (Const ("op *", _) $ Free _ $ Free (id, _)) = (* 2*a, a*b *)
51.70 + if is_numeral id then false else true
51.71 + | ist_monom (Const ("op *", _) $ (* 3*a*b *)
51.72 + (Const ("op *", _) $
51.73 + Free (num, _) $ Free _) $ Free (id, _)) =
51.74 + if is_numeral num andalso not (is_numeral id) then true else false
51.75 + | ist_monom (Const ("Atools.pow", _) $ Free (base, _) $ Free (exp, _)) =
51.76 + true (* a^2 *)
51.77 + | ist_monom (Const ("op *", _) $ Free (num, _) $ (* 3*a^2 *)
51.78 + (Const ("Atools.pow", _) $
51.79 + Free (base, _) $ Free (exp, _))) =
51.80 + if is_numeral num then true else false
51.81 + | ist_monom _ = false;
51.82 +
51.83 +(* is this a univariate monomial ? *)
51.84 +(*("ist_monom", ("PolyMinus.ist'_monom", eval_ist_monom ""))*)
51.85 +fun eval_ist_monom _ _ (p as (Const ("PolyMinus.ist'_monom",_) $ a)) _ =
51.86 + if ist_monom a then
51.87 + Some ((term2str p) ^ " = True",
51.88 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
51.89 + else Some ((term2str p) ^ " = False",
51.90 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
51.91 + | eval_ist_monom _ _ _ _ = None;
51.92 +
51.93 +
51.94 +(** rewrite order **)
51.95 +
51.96 +(** rulesets **)
51.97 +
51.98 +val erls_ordne_alphabetisch =
51.99 + append_rls "erls_ordne_alphabetisch" e_rls
51.100 + [Calc ("PolyMinus.kleiner", eval_kleiner ""),
51.101 + Calc ("PolyMinus.ist'_monom", eval_ist_monom "")
51.102 + ];
51.103 +
51.104 +val ordne_alphabetisch =
51.105 + Rls{id = "ordne_alphabetisch", preconds = [],
51.106 + rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [],
51.107 + erls = erls_ordne_alphabetisch,
51.108 + rules = [Thm ("tausche_plus",num_str tausche_plus),
51.109 + (*"b kleiner a ==> (b + a) = (a + b)"*)
51.110 + Thm ("tausche_minus",num_str tausche_minus),
51.111 + (*"b kleiner a ==> (b - a) = (-a + b)"*)
51.112 + Thm ("tausche_vor_plus",num_str tausche_vor_plus),
51.113 + (*"[| b ist_monom; a kleiner b |] ==> (- b + a) = (a - b)"*)
51.114 + Thm ("tausche_vor_minus",num_str tausche_vor_minus),
51.115 + (*"[| b ist_monom; a kleiner b |] ==> (- b - a) = (-a - b)"*)
51.116 + Thm ("tausche_plus_plus",num_str tausche_plus_plus),
51.117 + (*"c kleiner b ==> (a + c + b) = (a + b + c)"*)
51.118 + Thm ("tausche_plus_minus",num_str tausche_plus_minus),
51.119 + (*"c kleiner b ==> (a + c - b) = (a - b + c)"*)
51.120 + Thm ("tausche_minus_plus",num_str tausche_minus_plus),
51.121 + (*"c kleiner b ==> (a - c + b) = (a + b - c)"*)
51.122 + Thm ("tausche_minus_minus",num_str tausche_minus_minus)
51.123 + (*"c kleiner b ==> (a - c - b) = (a - b - c)"*)
51.124 + ], scr = EmptyScr}:rls;
51.125 +
51.126 +val fasse_zusammen =
51.127 + Rls{id = "fasse_zusammen", preconds = [],
51.128 + rew_ord = ("dummy_ord", dummy_ord),
51.129 + erls = append_rls "erls_fasse_zusammen" e_rls
51.130 + [Calc ("Atools.is'_const",eval_const "#is_const_")],
51.131 + srls = Erls, calc = [],
51.132 + rules =
51.133 + [Thm ("real_num_collect",num_str real_num_collect),
51.134 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
51.135 + Thm ("real_num_collect_assoc_r",num_str real_num_collect_assoc_r),
51.136 + (*"[| l is_const; m..|] ==> (k + m * n) + l * n = k + (l + m)*n"*)
51.137 + Thm ("real_one_collect",num_str real_one_collect),
51.138 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
51.139 + Thm ("real_one_collect_assoc_r",num_str real_one_collect_assoc_r),
51.140 + (*"m is_const ==> (k + n) + m * n = k + (m + 1) * n"*)
51.141 +
51.142 +
51.143 + Thm ("subtrahiere",num_str subtrahiere),
51.144 + (*"[| l is_const; m is_const |] ==> m * v - l * v = (m - l) * v"*)
51.145 + Thm ("subtrahiere_von_1",num_str subtrahiere_von_1),
51.146 + (*"[| l is_const |] ==> v - l * v = (1 - l) * v"*)
51.147 + Thm ("subtrahiere_1",num_str subtrahiere_1),
51.148 + (*"[| l is_const; m is_const |] ==> m * v - v = (m - 1) * v"*)
51.149 +
51.150 + Thm ("subtrahiere_x_plus_minus",num_str subtrahiere_x_plus_minus),
51.151 + (*"[| l is_const; m..|] ==> (k + m * n) - l * n = k + ( m - l) * n"*)
51.152 + Thm ("subtrahiere_x_plus1_minus",num_str subtrahiere_x_plus1_minus),
51.153 + (*"[| l is_const |] ==> (x + v) - l * v = x + (1 - l) * v"*)
51.154 + Thm ("subtrahiere_x_plus_minus1",num_str subtrahiere_x_plus_minus1),
51.155 + (*"[| m is_const |] ==> (x + m * v) - v = x + (m - 1) * v"*)
51.156 +
51.157 + Thm ("subtrahiere_x_minus_plus",num_str subtrahiere_x_minus_plus),
51.158 + (*"[| l is_const; m..|] ==> (k - m * n) + l * n = k + (-m + l) * n"*)
51.159 + Thm ("subtrahiere_x_minus1_plus",num_str subtrahiere_x_minus1_plus),
51.160 + (*"[| l is_const |] ==> (x - v) + l * v = x + (-1 + l) * v"*)
51.161 + Thm ("subtrahiere_x_minus_plus1",num_str subtrahiere_x_minus_plus1),
51.162 + (*"[| m is_const |] ==> (x - m * v) + v = x + (-m + 1) * v"*)
51.163 +
51.164 + Thm ("subtrahiere_x_minus_minus",num_str subtrahiere_x_minus_minus),
51.165 + (*"[| l is_const; m..|] ==> (k - m * n) - l * n = k + (-m - l) * n"*)
51.166 + Thm ("subtrahiere_x_minus1_minus",num_str subtrahiere_x_minus1_minus),
51.167 + (*"[| l is_const |] ==> (x - v) - l * v = x + (-1 - l) * v"*)
51.168 + Thm ("subtrahiere_x_minus_minus1",num_str subtrahiere_x_minus_minus1),
51.169 + (*"[| m is_const |] ==> (x - m * v) - v = x + (-m - 1) * v"*)
51.170 +
51.171 + Calc ("op +", eval_binop "#add_"),
51.172 + Calc ("op -", eval_binop "#subtr_"),
51.173 +
51.174 + (*MG: Reihenfolge der folgenden 2 Thm muss so bleiben, wegen
51.175 + (a+a)+a --> a + 2*a --> 3*a and not (a+a)+a --> 2*a + a *)
51.176 + Thm ("real_mult_2_assoc_r",num_str real_mult_2_assoc_r),
51.177 + (*"(k + z1) + z1 = k + 2 * z1"*)
51.178 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
51.179 + (*"z1 + z1 = 2 * z1"*)
51.180 +
51.181 + Thm ("addiere_vor_minus",num_str addiere_vor_minus),
51.182 + (*"[| l is_const; m is_const |] ==> -(l * v) + m * v = (-l + m) *v"*)
51.183 + Thm ("addiere_eins_vor_minus",num_str addiere_eins_vor_minus),
51.184 + (*"[| m is_const |] ==> - v + m * v = (-1 + m) * v"*)
51.185 + Thm ("subtrahiere_vor_minus",num_str subtrahiere_vor_minus),
51.186 + (*"[| l is_const; m is_const |] ==> -(l * v) - m * v = (-l - m) *v"*)
51.187 + Thm ("subtrahiere_eins_vor_minus",num_str subtrahiere_eins_vor_minus)
51.188 + (*"[| m is_const |] ==> - v - m * v = (-1 - m) * v"*)
51.189 +
51.190 + ], scr = EmptyScr}:rls;
51.191 +
51.192 +val verschoenere =
51.193 + Rls{id = "verschoenere", preconds = [],
51.194 + rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [],
51.195 + erls = append_rls "erls_verschoenere" e_rls
51.196 + [Calc ("PolyMinus.kleiner", eval_kleiner "")],
51.197 + rules = [Thm ("vorzeichen_minus_weg1",num_str vorzeichen_minus_weg1),
51.198 + (*"l kleiner 0 ==> a + l * b = a - -l * b"*)
51.199 + Thm ("vorzeichen_minus_weg2",num_str vorzeichen_minus_weg2),
51.200 + (*"l kleiner 0 ==> a - l * b = a + -l * b"*)
51.201 + Thm ("vorzeichen_minus_weg3",num_str vorzeichen_minus_weg3),
51.202 + (*"l kleiner 0 ==> k + a - l * b = k + a + -l * b"*)
51.203 + Thm ("vorzeichen_minus_weg4",num_str vorzeichen_minus_weg4),
51.204 + (*"l kleiner 0 ==> k - a - l * b = k - a + -l * b"*)
51.205 +
51.206 + Calc ("op *", eval_binop "#mult_"),
51.207 +
51.208 + Thm ("real_mult_0",num_str real_mult_0),
51.209 + (*"0 * z = 0"*)
51.210 + Thm ("real_mult_1",num_str real_mult_1),
51.211 + (*"1 * z = z"*)
51.212 + Thm ("real_add_zero_left",num_str real_add_zero_left),
51.213 + (*"0 + z = z"*)
51.214 + Thm ("null_minus",num_str null_minus),
51.215 + (*"0 - a = -a"*)
51.216 + Thm ("vor_minus_mal",num_str vor_minus_mal)
51.217 + (*"- a * b = (-a) * b"*)
51.218 +
51.219 + (*Thm ("",num_str ),*)
51.220 + (**)
51.221 + ], scr = EmptyScr}:rls (*end verschoenere*);
51.222 +
51.223 +val klammern_aufloesen =
51.224 + Rls{id = "klammern_aufloesen", preconds = [],
51.225 + rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [], erls = Erls,
51.226 + rules = [Thm ("sym_real_add_assoc",num_str (real_add_assoc RS sym)),
51.227 + (*"a + (b + c) = (a + b) + c"*)
51.228 + Thm ("klammer_plus_minus",num_str klammer_plus_minus),
51.229 + (*"a + (b - c) = (a + b) - c"*)
51.230 + Thm ("klammer_minus_plus",num_str klammer_minus_plus),
51.231 + (*"a - (b + c) = (a - b) - c"*)
51.232 + Thm ("klammer_minus_minus",num_str klammer_minus_minus)
51.233 + (*"a - (b - c) = (a - b) + c"*)
51.234 + ], scr = EmptyScr}:rls;
51.235 +
51.236 +val klammern_ausmultiplizieren =
51.237 + Rls{id = "klammern_ausmultiplizieren", preconds = [],
51.238 + rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [], erls = Erls,
51.239 + rules = [Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
51.240 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
51.241 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
51.242 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
51.243 +
51.244 + Thm ("klammer_mult_minus",num_str klammer_mult_minus),
51.245 + (*"a * (b - c) = a * b - a * c"*)
51.246 + Thm ("klammer_minus_mult",num_str klammer_minus_mult)
51.247 + (*"(b - c) * a = b * a - c * a"*)
51.248 +
51.249 + (*Thm ("",num_str ),
51.250 + (*""*)*)
51.251 + ], scr = EmptyScr}:rls;
51.252 +
51.253 +val ordne_monome =
51.254 + Rls{id = "ordne_monome", preconds = [],
51.255 + rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [],
51.256 + erls = append_rls "erls_ordne_monome" e_rls
51.257 + [Calc ("PolyMinus.kleiner", eval_kleiner ""),
51.258 + Calc ("Atools.is'_atom", eval_is_atom "")
51.259 + ],
51.260 + rules = [Thm ("tausche_mal",num_str tausche_mal),
51.261 + (*"[| b is_atom; a kleiner b |] ==> (b * a) = (a * b)"*)
51.262 + Thm ("tausche_vor_mal",num_str tausche_vor_mal),
51.263 + (*"[| b is_atom; a kleiner b |] ==> (-b * a) = (-a * b)"*)
51.264 + Thm ("tausche_mal_mal",num_str tausche_mal_mal),
51.265 + (*"[| c is_atom; b kleiner c |] ==> (a * c * b) = (a * b *c)"*)
51.266 + Thm ("x_quadrat",num_str x_quadrat)
51.267 + (*"(x * a) * a = x * a ^^^ 2"*)
51.268 +
51.269 + (*Thm ("",num_str ),
51.270 + (*""*)*)
51.271 + ], scr = EmptyScr}:rls;
51.272 +
51.273 +
51.274 +val rls_p_33 =
51.275 + append_rls "rls_p_33" e_rls
51.276 + [Rls_ ordne_alphabetisch,
51.277 + Rls_ fasse_zusammen,
51.278 + Rls_ verschoenere
51.279 + ];
51.280 +val rls_p_34 =
51.281 + append_rls "rls_p_34" e_rls
51.282 + [Rls_ klammern_aufloesen,
51.283 + Rls_ ordne_alphabetisch,
51.284 + Rls_ fasse_zusammen,
51.285 + Rls_ verschoenere
51.286 + ];
51.287 +val rechnen =
51.288 + append_rls "rechnen" e_rls
51.289 + [Calc ("op *", eval_binop "#mult_"),
51.290 + Calc ("op +", eval_binop "#add_"),
51.291 + Calc ("op -", eval_binop "#subtr_")
51.292 + ];
51.293 +
51.294 +ruleset' :=
51.295 +overwritelthy thy (!ruleset',
51.296 + [("ordne_alphabetisch", prep_rls ordne_alphabetisch),
51.297 + ("fasse_zusammen", prep_rls fasse_zusammen),
51.298 + ("verschoenere", prep_rls verschoenere),
51.299 + ("ordne_monome", prep_rls ordne_monome),
51.300 + ("klammern_aufloesen", prep_rls klammern_aufloesen),
51.301 + ("klammern_ausmultiplizieren",
51.302 + prep_rls klammern_ausmultiplizieren)
51.303 + ]);
51.304 +
51.305 +(** problems **)
51.306 +
51.307 +store_pbt
51.308 + (prep_pbt PolyMinus.thy "pbl_vereinf_poly" [] e_pblID
51.309 + (["polynom","vereinfachen"],
51.310 + [], Erls, None, []));
51.311 +
51.312 +store_pbt
51.313 + (prep_pbt PolyMinus.thy "pbl_vereinf_poly_minus" [] e_pblID
51.314 + (["plus_minus","polynom","vereinfachen"],
51.315 + [("#Given" ,["term t_"]),
51.316 + ("#Where" ,["t_ is_polyexp",
51.317 + "Not (matchsub (?a + (?b + ?c)) t_ | \
51.318 + \ matchsub (?a + (?b - ?c)) t_ | \
51.319 + \ matchsub (?a - (?b + ?c)) t_ | \
51.320 + \ matchsub (?a + (?b - ?c)) t_ )",
51.321 + "Not (matchsub (?a * (?b + ?c)) t_ | \
51.322 + \ matchsub (?a * (?b - ?c)) t_ | \
51.323 + \ matchsub ((?b + ?c) * ?a) t_ | \
51.324 + \ matchsub ((?b - ?c) * ?a) t_ )"]),
51.325 + ("#Find" ,["normalform n_"])
51.326 + ],
51.327 + append_rls "prls_pbl_vereinf_poly" e_rls
51.328 + [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
51.329 + Calc ("Tools.matchsub", eval_matchsub ""),
51.330 + Thm ("or_true",or_true),
51.331 + (*"(?a | True) = True"*)
51.332 + Thm ("or_false",or_false),
51.333 + (*"(?a | False) = ?a"*)
51.334 + Thm ("not_true",num_str not_true),
51.335 + (*"(~ True) = False"*)
51.336 + Thm ("not_false",num_str not_false)
51.337 + (*"(~ False) = True"*)],
51.338 + Some "Vereinfache t_",
51.339 + [["simplification","for_polynomials","with_minus"]]));
51.340 +
51.341 +store_pbt
51.342 + (prep_pbt PolyMinus.thy "pbl_vereinf_poly_klammer" [] e_pblID
51.343 + (["klammer","polynom","vereinfachen"],
51.344 + [("#Given" ,["term t_"]),
51.345 + ("#Where" ,["t_ is_polyexp",
51.346 + "Not (matchsub (?a * (?b + ?c)) t_ | \
51.347 + \ matchsub (?a * (?b - ?c)) t_ | \
51.348 + \ matchsub ((?b + ?c) * ?a) t_ | \
51.349 + \ matchsub ((?b - ?c) * ?a) t_ )"]),
51.350 + ("#Find" ,["normalform n_"])
51.351 + ],
51.352 + append_rls "prls_pbl_vereinf_poly_klammer" e_rls [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
51.353 + Calc ("Tools.matchsub", eval_matchsub ""),
51.354 + Thm ("or_true",or_true),
51.355 + (*"(?a | True) = True"*)
51.356 + Thm ("or_false",or_false),
51.357 + (*"(?a | False) = ?a"*)
51.358 + Thm ("not_true",num_str not_true),
51.359 + (*"(~ True) = False"*)
51.360 + Thm ("not_false",num_str not_false)
51.361 + (*"(~ False) = True"*)],
51.362 + Some "Vereinfache t_",
51.363 + [["simplification","for_polynomials","with_parentheses"]]));
51.364 +
51.365 +store_pbt
51.366 + (prep_pbt PolyMinus.thy "pbl_vereinf_poly_klammer_mal" [] e_pblID
51.367 + (["binom_klammer","polynom","vereinfachen"],
51.368 + [("#Given" ,["term t_"]),
51.369 + ("#Where" ,["t_ is_polyexp"]),
51.370 + ("#Find" ,["normalform n_"])
51.371 + ],
51.372 + append_rls "e_rls" e_rls [(*for preds in where_*)
51.373 + Calc ("Poly.is'_polyexp", eval_is_polyexp "")],
51.374 + Some "Vereinfache t_",
51.375 + [["simplification","for_polynomials","with_parentheses_mult"]]));
51.376 +
51.377 +store_pbt
51.378 + (prep_pbt PolyMinus.thy "pbl_probe" [] e_pblID
51.379 + (["probe"],
51.380 + [], Erls, None, []));
51.381 +
51.382 +store_pbt
51.383 + (prep_pbt PolyMinus.thy "pbl_probe_poly" [] e_pblID
51.384 + (["polynom","probe"],
51.385 + [("#Given" ,["Pruefe e_", "mitWert ws_"]),
51.386 + ("#Where" ,["e_ is_polyexp"]),
51.387 + ("#Find" ,["Geprueft p_"])
51.388 + ],
51.389 + append_rls "prls_pbl_probe_poly"
51.390 + e_rls [(*for preds in where_*)
51.391 + Calc ("Poly.is'_polyexp", eval_is_polyexp "")],
51.392 + Some "Probe e_ ws_",
51.393 + [["probe","fuer_polynom"]]));
51.394 +
51.395 +store_pbt
51.396 + (prep_pbt PolyMinus.thy "pbl_probe_bruch" [] e_pblID
51.397 + (["bruch","probe"],
51.398 + [("#Given" ,["Pruefe e_", "mitWert ws_"]),
51.399 + ("#Where" ,["e_ is_ratpolyexp"]),
51.400 + ("#Find" ,["Geprueft p_"])
51.401 + ],
51.402 + append_rls "prls_pbl_probe_bruch"
51.403 + e_rls [(*for preds in where_*)
51.404 + Calc ("Rational.is'_ratpolyexp", eval_is_ratpolyexp "")],
51.405 + Some "Probe e_ ws_",
51.406 + [["probe","fuer_bruch"]]));
51.407 +
51.408 +
51.409 +(** methods **)
51.410 +
51.411 +store_met
51.412 + (prep_met PolyMinus.thy "met_simp_poly_minus" [] e_metID
51.413 + (["simplification","for_polynomials","with_minus"],
51.414 + [("#Given" ,["term t_"]),
51.415 + ("#Where" ,["t_ is_polyexp",
51.416 + "Not (matchsub (?a + (?b + ?c)) t_ | \
51.417 + \ matchsub (?a + (?b - ?c)) t_ | \
51.418 + \ matchsub (?a - (?b + ?c)) t_ | \
51.419 + \ matchsub (?a + (?b - ?c)) t_ )"]),
51.420 + ("#Find" ,["normalform n_"])
51.421 + ],
51.422 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls,
51.423 + prls = append_rls "prls_met_simp_poly_minus" e_rls
51.424 + [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
51.425 + Calc ("Tools.matchsub", eval_matchsub ""),
51.426 + Thm ("and_true",and_true),
51.427 + (*"(?a & True) = ?a"*)
51.428 + Thm ("and_false",and_false),
51.429 + (*"(?a & False) = False"*)
51.430 + Thm ("not_true",num_str not_true),
51.431 + (*"(~ True) = False"*)
51.432 + Thm ("not_false",num_str not_false)
51.433 + (*"(~ False) = True"*)],
51.434 + crls = e_rls, nrls = rls_p_33},
51.435 +"Script SimplifyScript (t_::real) = \
51.436 +\ ((Repeat((Try (Rewrite_Set ordne_alphabetisch False)) @@ \
51.437 +\ (Try (Rewrite_Set fasse_zusammen False)) @@ \
51.438 +\ (Try (Rewrite_Set verschoenere False)))) t_)"
51.439 + ));
51.440 +
51.441 +store_met
51.442 + (prep_met PolyMinus.thy "met_simp_poly_parenth" [] e_metID
51.443 + (["simplification","for_polynomials","with_parentheses"],
51.444 + [("#Given" ,["term t_"]),
51.445 + ("#Where" ,["t_ is_polyexp"]),
51.446 + ("#Find" ,["normalform n_"])
51.447 + ],
51.448 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls,
51.449 + prls = append_rls "simplification_for_polynomials_prls" e_rls
51.450 + [(*for preds in where_*)
51.451 + Calc("Poly.is'_polyexp",eval_is_polyexp"")],
51.452 + crls = e_rls, nrls = rls_p_34},
51.453 +"Script SimplifyScript (t_::real) = \
51.454 +\ ((Repeat((Try (Rewrite_Set klammern_aufloesen False)) @@ \
51.455 +\ (Try (Rewrite_Set ordne_alphabetisch False)) @@ \
51.456 +\ (Try (Rewrite_Set fasse_zusammen False)) @@ \
51.457 +\ (Try (Rewrite_Set verschoenere False)))) t_)"
51.458 + ));
51.459 +
51.460 +store_met
51.461 + (prep_met PolyMinus.thy "met_simp_poly_parenth_mult" [] e_metID
51.462 + (["simplification","for_polynomials","with_parentheses_mult"],
51.463 + [("#Given" ,["term t_"]),
51.464 + ("#Where" ,["t_ is_polyexp"]),
51.465 + ("#Find" ,["normalform n_"])
51.466 + ],
51.467 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls,
51.468 + prls = append_rls "simplification_for_polynomials_prls" e_rls
51.469 + [(*for preds in where_*)
51.470 + Calc("Poly.is'_polyexp",eval_is_polyexp"")],
51.471 + crls = e_rls, nrls = rls_p_34},
51.472 +"Script SimplifyScript (t_::real) = \
51.473 +\ ((Repeat((Try (Rewrite_Set klammern_ausmultiplizieren False)) @@ \
51.474 +\ (Try (Rewrite_Set discard_parentheses False)) @@ \
51.475 +\ (Try (Rewrite_Set ordne_monome False)) @@ \
51.476 +\ (Try (Rewrite_Set klammern_aufloesen False)) @@ \
51.477 +\ (Try (Rewrite_Set ordne_alphabetisch False)) @@ \
51.478 +\ (Try (Rewrite_Set fasse_zusammen False)) @@ \
51.479 +\ (Try (Rewrite_Set verschoenere False)))) t_)"
51.480 + ));
51.481 +
51.482 +store_met
51.483 + (prep_met PolyMinus.thy "met_probe" [] e_metID
51.484 + (["probe"],
51.485 + [],
51.486 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls,
51.487 + prls = Erls, crls = e_rls, nrls = Erls},
51.488 + "empty_script"));
51.489 +
51.490 +store_met
51.491 + (prep_met PolyMinus.thy "met_probe_poly" [] e_metID
51.492 + (["probe","fuer_polynom"],
51.493 + [("#Given" ,["Pruefe e_", "mitWert ws_"]),
51.494 + ("#Where" ,["e_ is_polyexp"]),
51.495 + ("#Find" ,["Geprueft p_"])
51.496 + ],
51.497 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls,
51.498 + prls = append_rls "prls_met_probe_bruch"
51.499 + e_rls [(*for preds in where_*)
51.500 + Calc ("Rational.is'_ratpolyexp",
51.501 + eval_is_ratpolyexp "")],
51.502 + crls = e_rls, nrls = rechnen},
51.503 +"Script ProbeScript (e_::bool) (ws_::bool list) = \
51.504 +\ (let e_ = Take e_; \
51.505 +\ e_ = Substitute ws_ e_ \
51.506 +\ in (Repeat((Try (Repeat (Calculate times))) @@ \
51.507 +\ (Try (Repeat (Calculate plus ))) @@ \
51.508 +\ (Try (Repeat (Calculate minus))))) e_)"
51.509 +));
51.510 +
51.511 +store_met
51.512 + (prep_met PolyMinus.thy "met_probe_bruch" [] e_metID
51.513 + (["probe","fuer_bruch"],
51.514 + [("#Given" ,["Pruefe e_", "mitWert ws_"]),
51.515 + ("#Where" ,["e_ is_ratpolyexp"]),
51.516 + ("#Find" ,["Geprueft p_"])
51.517 + ],
51.518 + {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls,
51.519 + prls = append_rls "prls_met_probe_bruch"
51.520 + e_rls [(*for preds in where_*)
51.521 + Calc ("Rational.is'_ratpolyexp",
51.522 + eval_is_ratpolyexp "")],
51.523 + crls = e_rls, nrls = Erls},
51.524 + "empty_script"));
52.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
52.2 +++ b/src/Pure/isac/IsacKnowledge/PolyMinus.thy Wed Jul 21 13:53:39 2010 +0200
52.3 @@ -0,0 +1,114 @@
52.4 +(* attempts to perserve binary minus as wanted by Austrian teachers
52.5 + WN071207
52.6 + (c) due to copyright terms
52.7 +remove_thy"PolyMinus";
52.8 +use_thy_only"IsacKnowledge/PolyMinus";
52.9 +use_thy"IsacKnowledge/Isac";
52.10 +*)
52.11 +
52.12 +PolyMinus = (*Poly// due to "is_ratpolyexp" in...*) Rational +
52.13 +
52.14 +consts
52.15 +
52.16 + (*predicates for conditions in rewriting*)
52.17 + kleiner :: "['a, 'a] => bool" ("_ kleiner _")
52.18 + ist'_monom :: "'a => bool" ("_ ist'_monom")
52.19 +
52.20 + (*the CAS-command*)
52.21 + Probe :: "[bool, bool list] => bool"
52.22 + (*"Probe (3*a+2*b+a = 4*a+2*b) [a=1,b=2]"*)
52.23 +
52.24 + (*descriptions for the pbl and met*)
52.25 + Pruefe :: bool => una
52.26 + mitWert :: bool list => tobooll
52.27 + Geprueft :: bool => una
52.28 +
52.29 + (*Script-name*)
52.30 + ProbeScript :: "[bool, bool list, bool] \
52.31 + \=> bool"
52.32 + ("((Script ProbeScript (_ _ =))// (_))" 9)
52.33 +
52.34 +rules
52.35 +
52.36 + null_minus "0 - a = -a"
52.37 + vor_minus_mal "- a * b = (-a) * b"
52.38 +
52.39 + (*commute with invariant (a.b).c -association*)
52.40 + tausche_plus "[| b ist_monom; a kleiner b |] ==> \
52.41 + \(b + a) = (a + b)"
52.42 + tausche_minus "[| b ist_monom; a kleiner b |] ==> \
52.43 + \(b - a) = (-a + b)"
52.44 + tausche_vor_plus "[| b ist_monom; a kleiner b |] ==> \
52.45 + \(- b + a) = (a - b)"
52.46 + tausche_vor_minus "[| b ist_monom; a kleiner b |] ==> \
52.47 + \(- b - a) = (-a - b)"
52.48 + tausche_plus_plus "b kleiner c ==> (a + c + b) = (a + b + c)"
52.49 + tausche_plus_minus "b kleiner c ==> (a + c - b) = (a - b + c)"
52.50 + tausche_minus_plus "b kleiner c ==> (a - c + b) = (a + b - c)"
52.51 + tausche_minus_minus "b kleiner c ==> (a - c - b) = (a - b - c)"
52.52 +
52.53 + (*commute with invariant (a.b).c -association*)
52.54 + tausche_mal "[| b is_atom; a kleiner b |] ==> \
52.55 + \(b * a) = (a * b)"
52.56 + tausche_vor_mal "[| b is_atom; a kleiner b |] ==> \
52.57 + \(-b * a) = (-a * b)"
52.58 + tausche_mal_mal "[| c is_atom; b kleiner c |] ==> \
52.59 + \(x * c * b) = (x * b * c)"
52.60 + x_quadrat "(x * a) * a = x * a ^^^ 2"
52.61 +
52.62 +
52.63 + subtrahiere "[| l is_const; m is_const |] ==> \
52.64 + \m * v - l * v = (m - l) * v"
52.65 + subtrahiere_von_1 "[| l is_const |] ==> \
52.66 + \v - l * v = (1 - l) * v"
52.67 + subtrahiere_1 "[| l is_const; m is_const |] ==> \
52.68 + \m * v - v = (m - 1) * v"
52.69 +
52.70 + subtrahiere_x_plus_minus "[| l is_const; m is_const |] ==> \
52.71 + \(x + m * v) - l * v = x + (m - l) * v"
52.72 + subtrahiere_x_plus1_minus "[| l is_const |] ==> \
52.73 + \(x + v) - l * v = x + (1 - l) * v"
52.74 + subtrahiere_x_plus_minus1 "[| m is_const |] ==> \
52.75 + \(x + m * v) - v = x + (m - 1) * v"
52.76 +
52.77 + subtrahiere_x_minus_plus "[| l is_const; m is_const |] ==> \
52.78 + \(x - m * v) + l * v = x + (-m + l) * v"
52.79 + subtrahiere_x_minus1_plus "[| l is_const |] ==> \
52.80 + \(x - v) + l * v = x + (-1 + l) * v"
52.81 + subtrahiere_x_minus_plus1 "[| m is_const |] ==> \
52.82 + \(x - m * v) + v = x + (-m + 1) * v"
52.83 +
52.84 + subtrahiere_x_minus_minus "[| l is_const; m is_const |] ==> \
52.85 + \(x - m * v) - l * v = x + (-m - l) * v"
52.86 + subtrahiere_x_minus1_minus"[| l is_const |] ==> \
52.87 + \(x - v) - l * v = x + (-1 - l) * v"
52.88 + subtrahiere_x_minus_minus1"[| m is_const |] ==> \
52.89 + \(x - m * v) - v = x + (-m - 1) * v"
52.90 +
52.91 +
52.92 + addiere_vor_minus "[| l is_const; m is_const |] ==> \
52.93 + \- (l * v) + m * v = (-l + m) * v"
52.94 + addiere_eins_vor_minus "[| m is_const |] ==> \
52.95 + \- v + m * v = (-1 + m) * v"
52.96 + subtrahiere_vor_minus "[| l is_const; m is_const |] ==> \
52.97 + \- (l * v) - m * v = (-l - m) * v"
52.98 + subtrahiere_eins_vor_minus"[| m is_const |] ==> \
52.99 + \- v - m * v = (-1 - m) * v"
52.100 +
52.101 + vorzeichen_minus_weg1 "l kleiner 0 ==> a + l * b = a - -1*l * b"
52.102 + vorzeichen_minus_weg2 "l kleiner 0 ==> a - l * b = a + -1*l * b"
52.103 + vorzeichen_minus_weg3 "l kleiner 0 ==> k + a - l * b = k + a + -1*l * b"
52.104 + vorzeichen_minus_weg4 "l kleiner 0 ==> k - a - l * b = k - a + -1*l * b"
52.105 +
52.106 + (*klammer_plus_plus = (real_add_assoc RS sym)*)
52.107 + klammer_plus_minus "a + (b - c) = (a + b) - c"
52.108 + klammer_minus_plus "a - (b + c) = (a - b) - c"
52.109 + klammer_minus_minus "a - (b - c) = (a - b) + c"
52.110 +
52.111 + klammer_mult_minus "a * (b - c) = a * b - a * c"
52.112 + klammer_minus_mult "(b - c) * a = b * a - c * a"
52.113 +
52.114 +
52.115 +
52.116 +end
52.117 +
53.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
53.2 +++ b/src/Pure/isac/IsacKnowledge/RatEq.ML Wed Jul 21 13:53:39 2010 +0200
53.3 @@ -0,0 +1,202 @@
53.4 +(*.(c) by Richard Lang, 2003 .*)
53.5 +(* collecting all knowledge for RationalEquations
53.6 + created by: rlang
53.7 + date: 02.09
53.8 + changed by: rlang
53.9 + last change by: rlang
53.10 + date: 02.11.29
53.11 +*)
53.12 +
53.13 +(* use"IsacKnowledge/RatEq.ML";
53.14 + use"RatEq.ML";
53.15 + remove_thy"RatEq";
53.16 + use_thy"Isac";
53.17 +
53.18 + use"ROOT.ML";
53.19 + cd"IsacKnowledge";
53.20 + *)
53.21 +"******* RatEq.ML begin *******";
53.22 +
53.23 +theory' := overwritel (!theory', [("RatEq.thy",RatEq.thy)]);
53.24 +
53.25 +(*-------------------------functions-----------------------*)
53.26 +(* is_rateqation_in becomes true, if a bdv is in the denominator of a fraction*)
53.27 +fun is_rateqation_in t v =
53.28 + let
53.29 + fun coeff_in c v = v mem (vars c);
53.30 + fun finddivide (_ $ _ $ _ $ _) v = raise error("is_rateqation_in:")
53.31 + (* at the moment there is no term like this, but ....*)
53.32 + | finddivide (t as (Const ("HOL.divide",_) $ _ $ b)) v = coeff_in b v
53.33 + | finddivide (_ $ t1 $ t2) v = (finddivide t1 v) orelse (finddivide t2 v)
53.34 + | finddivide (_ $ t1) v = (finddivide t1 v)
53.35 + | finddivide _ _ = false;
53.36 + in
53.37 + finddivide t v
53.38 + end;
53.39 +
53.40 +fun eval_is_ratequation_in _ _ (p as (Const ("RatEq.is'_ratequation'_in",_) $ t $ v)) _ =
53.41 + if is_rateqation_in t v then
53.42 + Some ((term2str p) ^ " = True",
53.43 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
53.44 + else Some ((term2str p) ^ " = True",
53.45 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
53.46 + | eval_is_ratequation_in _ _ _ _ = ((*writeln"### nichts matcht";*) None);
53.47 +
53.48 +(*-------------------------rulse-----------------------*)
53.49 +val RatEq_prls = (*15.10.02:just the following order due to subterm evaluation*)
53.50 + append_rls "RatEq_prls" e_rls
53.51 + [Calc ("Atools.ident",eval_ident "#ident_"),
53.52 + Calc ("Tools.matches",eval_matches ""),
53.53 + Calc ("Tools.lhs" ,eval_lhs ""),
53.54 + Calc ("Tools.rhs" ,eval_rhs ""),
53.55 + Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
53.56 + Calc ("op =",eval_equal "#equal_"),
53.57 + Thm ("not_true",num_str not_true),
53.58 + Thm ("not_false",num_str not_false),
53.59 + Thm ("and_true",num_str and_true),
53.60 + Thm ("and_false",num_str and_false),
53.61 + Thm ("or_true",num_str or_true),
53.62 + Thm ("or_false",num_str or_false)
53.63 + ];
53.64 +
53.65 +
53.66 +(*rls = merge_rls erls Poly_erls *)
53.67 +val rateq_erls =
53.68 + remove_rls "rateq_erls" (*WN: ein Hack*)
53.69 + (merge_rls "is_ratequation_in" calculate_Rational
53.70 + (append_rls "is_ratequation_in"
53.71 + Poly_erls
53.72 + [(*Calc ("HOL.divide", eval_cancel "#divide_"),*)
53.73 + Calc ("RatEq.is'_ratequation'_in",
53.74 + eval_is_ratequation_in "")
53.75 +
53.76 + ]))
53.77 + [Thm ("and_commute",num_str and_commute), (*WN: ein Hack*)
53.78 + Thm ("or_commute",num_str or_commute) (*WN: ein Hack*)
53.79 + ];
53.80 +ruleset' := overwritelthy thy (!ruleset',
53.81 + [("rateq_erls",rateq_erls)(*FIXXXME:del with rls.rls'*)
53.82 + ]);
53.83 +
53.84 +
53.85 +val RatEq_crls =
53.86 + remove_rls "RatEq_crls" (*WN: ein Hack*)
53.87 + (merge_rls "is_ratequation_in" calculate_Rational
53.88 + (append_rls "is_ratequation_in"
53.89 + Poly_erls
53.90 + [(*Calc ("HOL.divide", eval_cancel "#divide_"),*)
53.91 + Calc ("RatEq.is'_ratequation'_in",
53.92 + eval_is_ratequation_in "")
53.93 + ]))
53.94 + [Thm ("and_commute",num_str and_commute), (*WN: ein Hack*)
53.95 + Thm ("or_commute",num_str or_commute) (*WN: ein Hack*)
53.96 + ];
53.97 +
53.98 +val RatEq_eliminate = prep_rls(
53.99 + Rls {id = "RatEq_eliminate", preconds = [], rew_ord = ("termlessI",termlessI),
53.100 + erls = rateq_erls, srls = Erls, calc = [],
53.101 + (*asm_thm = [("rat_mult_denominator_both",""),("rat_mult_denominator_left",""),
53.102 + ("rat_mult_denominator_right","")],*)
53.103 + rules = [
53.104 + Thm("rat_mult_denominator_both",num_str rat_mult_denominator_both),
53.105 + (* a/b=c/d -> ad=cb *)
53.106 + Thm("rat_mult_denominator_left",num_str rat_mult_denominator_left),
53.107 + (* a =c/d -> ad=c *)
53.108 + Thm("rat_mult_denominator_right",num_str rat_mult_denominator_right)
53.109 + (* a/b=c -> a=cb *)
53.110 + ],
53.111 + scr = Script ((term_of o the o (parse thy)) "empty_script")
53.112 + }:rls);
53.113 +ruleset' := overwritelthy thy (!ruleset',
53.114 + [("RatEq_eliminate",RatEq_eliminate)
53.115 + ]);
53.116 +
53.117 +
53.118 +
53.119 +
53.120 +val RatEq_simplify = prep_rls(
53.121 + Rls {id = "RatEq_simplify", preconds = [], rew_ord = ("termlessI",termlessI),
53.122 + erls = rateq_erls, srls = Erls, calc = [],
53.123 + (*asm_thm = [("rat_double_rat_1",""),("rat_double_rat_2",""),
53.124 + ("rat_double_rat_3","")],*)
53.125 + rules = [
53.126 + Thm("real_rat_mult_1",num_str real_rat_mult_1),
53.127 + (*a*(b/c) = (a*b)/c*)
53.128 + Thm("real_rat_mult_2",num_str real_rat_mult_2),
53.129 + (*(a/b)*(c/d) = (a*c)/(b*d)*)
53.130 + Thm("real_rat_mult_3",num_str real_rat_mult_3),
53.131 + (* (a/b)*c = (a*c)/b*)
53.132 + Thm("real_rat_pow",num_str real_rat_pow),
53.133 + (*(a/b)^^^2 = a^^^2/b^^^2*)
53.134 + Thm("real_diff_minus",num_str real_diff_minus),
53.135 + (* a - b = a + (-1) * b *)
53.136 + Thm("rat_double_rat_1",num_str rat_double_rat_1),
53.137 + (* (a / (c/d) = (a*d) / c) *)
53.138 + Thm("rat_double_rat_2",num_str rat_double_rat_2),
53.139 + (* ((a/b) / (c/d) = (a*d) / (b*c)) *)
53.140 + Thm("rat_double_rat_3",num_str rat_double_rat_3)
53.141 + (* ((a/b) / c = a / (b*c) ) *)
53.142 + ],
53.143 + scr = Script ((term_of o the o (parse thy)) "empty_script")
53.144 + }:rls);
53.145 +ruleset' := overwritelthy thy (!ruleset',
53.146 + [("RatEq_simplify",RatEq_simplify)
53.147 + ]);
53.148 +
53.149 +(*-------------------------Problem-----------------------*)
53.150 +(*
53.151 +(get_pbt ["rational","univariate","equation"]);
53.152 +show_ptyps();
53.153 +*)
53.154 +store_pbt
53.155 + (prep_pbt RatEq.thy "pbl_equ_univ_rat" [] e_pblID
53.156 + (["rational","univariate","equation"],
53.157 + [("#Given" ,["equality e_","solveFor v_"]),
53.158 + ("#Where" ,["(e_::bool) is_ratequation_in (v_::real)"]),
53.159 + ("#Find" ,["solutions v_i_"])
53.160 + ],
53.161 +
53.162 + RatEq_prls, Some "solve (e_::bool, v_)",
53.163 + [["RatEq","solve_rat_equation"]]));
53.164 +
53.165 +
53.166 +(*-------------------------methods-----------------------*)
53.167 +store_met
53.168 + (prep_met RatEq.thy "met_rateq" [] e_metID
53.169 + (["RatEq"],
53.170 + [],
53.171 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
53.172 + crls=RatEq_crls, nrls=norm_Rational
53.173 + (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
53.174 +store_met
53.175 + (prep_met RatEq.thy "met_rat_eq" [] e_metID
53.176 + (["RatEq","solve_rat_equation"],
53.177 + [("#Given" ,["equality e_","solveFor v_"]),
53.178 + ("#Where" ,["(e_::bool) is_ratequation_in (v_::real)"]),
53.179 + ("#Find" ,["solutions v_i_"])
53.180 + ],
53.181 + {rew_ord'="termlessI",
53.182 + rls'=rateq_erls,
53.183 + srls=e_rls,
53.184 + prls=RatEq_prls,
53.185 + calc=[],
53.186 + crls=RatEq_crls, nrls=norm_Rational(*,
53.187 + asm_rls=[],
53.188 + asm_thm=[("rat_double_rat_1",""),("rat_double_rat_2",""),("rat_double_rat_3",""),
53.189 + ("rat_mult_denominator_both",""),("rat_mult_denominator_left",""),
53.190 + ("rat_mult_denominator_right","")]*)},
53.191 + "Script Solve_rat_equation (e_::bool) (v_::real) = \
53.192 + \(let e_ = ((Repeat(Try (Rewrite_Set RatEq_simplify True))) @@ \
53.193 + \ (Repeat(Try (Rewrite_Set norm_Rational False))) @@ \
53.194 + \ (Repeat(Try (Rewrite_Set common_nominator_p False))) @@ \
53.195 + \ (Repeat(Try (Rewrite_Set RatEq_eliminate True)))) e_;\
53.196 + \ (L_::bool list) = (SubProblem (RatEq_,[univariate,equation], \
53.197 + \ [no_met]) [bool_ e_, real_ v_]) \
53.198 + \ in Check_elementwise L_ {(v_::real). Assumptions})"
53.199 + ));
53.200 +
53.201 +calclist':= overwritel (!calclist',
53.202 + [("is_ratequation_in", ("RatEq.is_ratequation_in",
53.203 + eval_is_ratequation_in ""))
53.204 + ]);
53.205 +"******* RatEq.ML end *******";
54.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
54.2 +++ b/src/Pure/isac/IsacKnowledge/RatEq.thy Wed Jul 21 13:53:39 2010 +0200
54.3 @@ -0,0 +1,67 @@
54.4 +(*.(c) by Richard Lang, 2003 .*)
54.5 +(* theory collecting all knowledge for RationalEquations
54.6 + created by: rlang
54.7 + date: 02.08.12
54.8 + changed by: rlang
54.9 + last change by: rlang
54.10 + date: 02.11.28
54.11 +*)
54.12 +
54.13 +(*
54.14 + RL.020812
54.15 + use_thy"knowledge/RatEq";
54.16 + use_thy"RatEq";
54.17 + use_thy_only"RatEq";
54.18 +
54.19 + remove_thy"RatEq";
54.20 + use_thy"Isac";
54.21 +
54.22 + use"ROOT.ML";
54.23 + cd"knowledge";
54.24 + *)
54.25 +RatEq = Rational +
54.26 +
54.27 +(*-------------------- consts------------------------------------------------*)
54.28 +consts
54.29 +
54.30 + is'_ratequation'_in :: "[bool, real] => bool" ("_ is'_ratequation'_in _")
54.31 +
54.32 + (*----------------------scripts-----------------------*)
54.33 + Solve'_rat'_equation
54.34 + :: "[bool,real, \
54.35 + \ bool list] => bool list"
54.36 + ("((Script Solve'_rat'_equation (_ _ =))// \
54.37 + \ (_))" 9)
54.38 +
54.39 +(*-------------------- rules------------------------------------------------*)
54.40 +rules
54.41 + (* FIXME also in Poly.thy def. --> FIXED*)
54.42 + (*real_diff_minus
54.43 + "a - b = a + (-1) * b"*)
54.44 + real_rat_mult_1
54.45 + "a*(b/c) = (a*b)/c"
54.46 + real_rat_mult_2
54.47 + "(a/b)*(c/d) = (a*c)/(b*d)"
54.48 + real_rat_mult_3
54.49 + "(a/b)*c = (a*c)/b"
54.50 + real_rat_pow
54.51 + "(a/b)^^^2 = a^^^2/b^^^2"
54.52 +
54.53 + rat_double_rat_1
54.54 + "[|Not(c=0); Not(d=0)|] ==> (a / (c/d) = (a*d) / c)"
54.55 + rat_double_rat_2
54.56 + "[|Not(b=0);Not(c=0); Not(d=0)|] ==> ((a/b) / (c/d) = (a*d) / (b*c))"
54.57 + rat_double_rat_3
54.58 + "[|Not(b=0);Not(c=0)|] ==> ((a/b) / c = a / (b*c))"
54.59 +
54.60 +
54.61 + (* equation to same denominator *)
54.62 + rat_mult_denominator_both
54.63 + "[|Not(b=0); Not(d=0)|] ==> ((a::real) / b = c / d) = (a*d = c*b)"
54.64 + rat_mult_denominator_left
54.65 + "[|Not(d=0)|] ==> ((a::real) = c / d) = (a*d = c)"
54.66 + rat_mult_denominator_right
54.67 + "[|Not(b=0)|] ==> ((a::real) / b = c) = (a = c*b)"
54.68 +
54.69 +
54.70 +end
55.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
55.2 +++ b/src/Pure/isac/IsacKnowledge/Rational-WN.sml Wed Jul 21 13:53:39 2010 +0200
55.3 @@ -0,0 +1,257 @@
55.4 +(*Stefan K.*)
55.5 +
55.6 +(*protokoll 14.3.02 --------------------------------------------------
55.7 +val ct = parse thy "(a + #1)//(#2*a^^^#2 - #2)";
55.8 +val t = (term_of o the) ct;
55.9 +atomt t;
55.10 +val ct = parse thy "not (#1+a)"; (*HOL.thy ?*)
55.11 +val t = (term_of o the) ct;
55.12 +atomt t;
55.13 +val ct = parse thy "x"; (*momentan ist alles 'real'*)
55.14 +val t = (term_of o the) ct;
55.15 +atomty t;
55.16 +val ct = parse thy "(x::int)"; (* !!! *)
55.17 +val t = (term_of o the) ct;
55.18 +atomty t;
55.19 +
55.20 +val ct = parse thy "(x::int)*(y::real)"; (*momentan ist alles 'real'*)
55.21 +
55.22 +val Const ("RatArith.cancel",_) $ zaehler $ nenner = t;
55.23 +---------------------------------------------------------------------*)
55.24 +
55.25 +
55.26 +(*diese vvv funktionen kommen nach src/Isa99/term_G.sml -------------*)
55.27 +fun term2str t =
55.28 + let fun ato (Const(a,T)) n =
55.29 + "\n"^indent n^"Const ( "^a^")"
55.30 + | ato (Free (a,T)) n =
55.31 + "\n"^indent n^"Free ( "^a^", "^")"
55.32 + | ato (Var ((a,ix),T)) n =
55.33 + "\n"^indent n^"Var (("^a^", "^string_of_int ix^"), "^")"
55.34 + | ato (Bound ix) n =
55.35 + "\n"^indent n^"Bound "^string_of_int ix
55.36 + | ato (Abs(a,T,body)) n =
55.37 + "\n"^indent n^"Abs( "^a^",.."^ato body (n+1)
55.38 + | ato (f$t') n = ato f n^ato t' (n+1)
55.39 + in "\n-------------"^ato t 0^"\n" end;
55.40 +fun free2int (t as Free (s, _)) = (((the o int_of_str) s)
55.41 + handle _ => raise error ("free2int: "^term2str t))
55.42 + | free2int t = raise error ("free2int: "^term2str t);
55.43 +(*diese ^^^ funktionen kommen nach src/Isa99/term_G.sml -------------*)
55.44 +
55.45 +
55.46 +(* remark on exceptions: 'error' is implemented by Isabelle
55.47 + as the typical system error *)
55.48 +
55.49 +
55.50 +type poly = int list;
55.51 +
55.52 +(* transform a Isabelle-term t into internal polynomial format
55.53 + preconditions for t:
55.54 + a-b -> a+(-b)
55.55 + x^1 -> x
55.56 + term ordered ascending
55.57 + parentheses right side (caused by 'ordered rewriting')
55.58 + variable as power (not as product) *)
55.59 +
55.60 +fun mono (Const ("RatArith.pow",_) $ t1 $ t2) v g =
55.61 + if t1 = v then ((replicate ((free2int t2) - g) 0) @ [1]) : poly
55.62 + else raise error ("term2poly.1 "^term2str t1)
55.63 + | mono (t as Const ("op *",_) $ t1 $
55.64 + (Const ("RatArith.pow",_) $ t2 $ t3)) v g =
55.65 + if t2 = v then (replicate ((free2int t3) - g) 0) @ [free2int t1]
55.66 + else raise error ("term2poly.2 "^term2str t)
55.67 + | mono t _ _ = raise error ("term2poly.3 "^term2str t);
55.68 +
55.69 +fun poly (Const ("op +",_) $ t1 $ t2) v g =
55.70 + let val l = mono t1 v g
55.71 + in (l @ (poly t2 v ((length l) + g))) end
55.72 + | poly t v g = mono t v g;
55.73 +
55.74 +fun term2poly (t as Free (s, _)) v =
55.75 + if t = v then Some ([0,1] : poly) else (Some [(the o int_of_str) s]
55.76 + handle _ => None)
55.77 + | term2poly (Const ("op *",_) $ (Free (s1,_)) $ (t as Free (s2,_))) v =
55.78 + if t = v then Some [0, (the o int_of_str) s1] else None
55.79 + | term2poly (Const ("op +",_) $ (Free (s1,_)) $ t) v =
55.80 + Some ([(the o int_of_str) s1] @ (poly t v 1))
55.81 + | term2poly t v =
55.82 + Some (poly t v 0) handle _ => None;
55.83 +
55.84 +(*tests*)
55.85 +val v = (term_of o the o (parse thy)) "x::real";
55.86 +val t = (term_of o the o (parse thy)) "#-1::real";
55.87 +term2poly t v;
55.88 +val t = (term_of o the o (parse thy)) "x::real";
55.89 +term2poly t v;
55.90 +val t = (term_of o the o (parse thy)) "#1 * x::real"; (*FIXME: drop it*)
55.91 +term2poly t v;
55.92 +val t = (term_of o the o (parse thy)) "x^^^#1"; (*FIXME: drop it*)
55.93 +term2poly t v;
55.94 +val t = (term_of o the o (parse thy)) "x^^^#3";
55.95 +term2poly t v;
55.96 +val t = (term_of o the o (parse thy)) "#3 * x^^^#3";
55.97 +term2poly t v;
55.98 +val t = (term_of o the o (parse thy)) "#-1 + #3 * x^^^#3";
55.99 +term2poly t v;
55.100 +val t = (term_of o the o (parse thy)) "#-1 + (#3 * x^^^#3 + #5 * x^^^#5)";
55.101 +term2poly t v;
55.102 +val t = (term_of o the o (parse thy))
55.103 + "#-1 + (#3 * x^^^#3 + (#5 * x^^^#5 + #7 * x^^^#7))";
55.104 +term2poly t v;
55.105 +val t = (term_of o the o (parse thy))
55.106 + "#3 * x^^^#3 + (#5 * x^^^#5 + #7 * x^^^#7)";
55.107 +term2poly t v;
55.108 +
55.109 +
55.110 +fun is_polynomial_in t v =
55.111 + case term2poly t v of Some _ => true | None => false;
55.112 +
55.113 +(* transform the internal polynomial p into an Isabelle term t
55.114 + where t meets the preconditions of term2poly
55.115 +val mk_mono =
55.116 + fn : typ -> of the coefficients
55.117 + typ -> of the unknown
55.118 + typ -> of the monomial and polynomial
55.119 + typ -> of the exponent of the unknown
55.120 + int -> the coefficient <> 0
55.121 + string -> the unknown
55.122 + int -> the degree, i.e. the value of the exponent
55.123 + term
55.124 +remark: all the typs above are "RealDef.real" due to the typs of * + ^
55.125 +which may change in the future
55.126 +*)
55.127 +fun mk_mono cT vT pT eT c v g =
55.128 + case g of
55.129 + 0 => Free (str_of_int c, cT) (*will cause problems with diff.typs*)
55.130 + | 1 => if c = 1 then Free (v, vT)
55.131 + else Const ("op *", [cT, vT]--->pT) $
55.132 + Free (str_of_int c, cT) $ Free (v, vT)
55.133 + | n => if c = 1 then (Const ("RatArith.pow", [vT, eT]--->pT) $
55.134 + Free (v, vT) $ Free (str_of_int g, eT))
55.135 + else Const ("op *", [cT, vT]--->pT) $
55.136 + Free (str_of_int c, cT) $
55.137 + (Const ("RatArith.pow", [vT, eT]--->pT) $
55.138 + Free (v, vT) $ Free (str_of_int g, eT));
55.139 +(*tests*)
55.140 +val cT = HOLogic.realT; val vT = HOLogic.realT; val pT = HOLogic.realT;
55.141 +val eT = HOLogic.realT;
55.142 +val t = mk_mono cT vT pT eT ~5 "x" 5;
55.143 +cterm_of (sign_of thy) t;
55.144 +val t = mk_mono cT vT pT eT ~1 "x" 0;
55.145 +cterm_of (sign_of thy) t;
55.146 +val t = mk_mono cT vT pT eT 1 "x" 1;
55.147 +cterm_of (sign_of thy) t;
55.148 +
55.149 +
55.150 +fun mk_sum pT t1 t2 = Const ("op +", [pT, pT]--->pT) $ t1 $ t2;
55.151 +
55.152 +
55.153 +fun poly2term cT vT pT eT ([p]:poly) v = mk_mono cT vT pT eT p v 0
55.154 + | poly2term cT vT pT eT (p:poly) v =
55.155 + let
55.156 + fun mk_poly cT vT pT eT [] t v g = t
55.157 + | mk_poly cT vT pT eT [p] t v g =
55.158 + if p = 0 then t
55.159 + else mk_sum pT (mk_mono cT vT pT eT p v g) t
55.160 + | mk_poly cT vT pT eT (p::ps) t v g =
55.161 + if p = 0 then mk_poly cT vT pT eT ps t v (g-1)
55.162 + else mk_poly cT vT pT eT ps
55.163 + (mk_sum pT (mk_mono cT vT pT eT p v g) t) v (g-1)
55.164 + val (p'::ps') = rev p
55.165 + val g = (length p) - 1
55.166 + in mk_poly cT vT pT eT ps' (mk_mono cT vT pT eT p' v g) v (g-1) end;
55.167 +
55.168 +(*tests*)
55.169 +val t = poly2term cT vT pT eT [~1] "x";
55.170 +cterm_of (sign_of thy) t;
55.171 +val t = poly2term cT vT pT eT [0,1] "x";
55.172 +cterm_of (sign_of thy) t;
55.173 +val t = poly2term cT vT pT eT [0,0,0,1] "x";
55.174 +cterm_of (sign_of thy) t;
55.175 +val t = poly2term cT vT pT eT [0,0,0,3] "x";
55.176 +cterm_of (sign_of thy) t;
55.177 +val t = poly2term cT vT pT eT [~1,0,0,3] "x";
55.178 +cterm_of (sign_of thy) t;
55.179 +val t = poly2term cT vT pT eT [~1,0,0,3,0,5] "x";
55.180 +cterm_of (sign_of thy) t;
55.181 +val t = poly2term cT vT pT eT [~1,0,0,3,0,5,0,7] "x";
55.182 +cterm_of (sign_of thy) t;
55.183 +val t = poly2term cT vT pT eT [0,0,0,3,0,5,0,7] "x";
55.184 +cterm_of (sign_of thy) t;
55.185 +
55.186 +"***************************************************************************";
55.187 +"* reverse-rewriting 12.8.02 *";
55.188 +"***************************************************************************";
55.189 +fun rewrite_set_' thy rls put_asm ruless ct =
55.190 + case ruless of
55.191 + Rrls _ => raise error "rewrite_set_' not for Rrls"
55.192 + | Rls _ =>
55.193 + let
55.194 + datatype switch = Appl | Noap;
55.195 + fun rew_once ruls asm ct Noap [] = (ct,asm)
55.196 + | rew_once ruls asm ct Appl [] = rew_once ruls asm ct Noap ruls
55.197 + | rew_once ruls asm ct apno (rul::thms) =
55.198 + case rul of
55.199 + Thm (thmid, thm) =>
55.200 + (case rewrite_ thy ((snd o #rew_ord o rep_rls) ruless)
55.201 + rls put_asm (thm_of_thm rul) ct of
55.202 + None => rew_once ruls asm ct apno thms
55.203 + | Some (ct',asm') =>
55.204 + rew_once ruls (asm union asm') ct' Appl (rul::thms))
55.205 + | Calc (cc as (op_,_)) =>
55.206 + (case get_calculation_ thy cc ct of
55.207 + None => rew_once ruls asm ct apno thms
55.208 + | Some (thmid, thm') =>
55.209 + let
55.210 + val pairopt =
55.211 + rewrite_ thy ((snd o #rew_ord o rep_rls) ruless)
55.212 + rls put_asm thm' ct;
55.213 + val _ = if pairopt <> None then ()
55.214 + else raise error("rewrite_set_, rewrite_ \""^
55.215 + (string_of_thmI thm')^"\" \""^
55.216 + (Sign.string_of_term (sign_of thy) ct)^"\" = None")
55.217 + in rew_once ruls asm ((fst o the) pairopt) Appl(rul::thms) end);
55.218 + val ruls = (#rules o rep_rls) ruless;
55.219 + val (ct',asm') = rew_once ruls [] ct Noap ruls;
55.220 + in if ct = ct' then None else Some (ct',asm') end;
55.221 +
55.222 +(*
55.223 +fun reverse_rewrite t1 t2 rls =
55.224 +*)
55.225 +fun rewrite_set_' thy rls put_asm ruless ct =
55.226 + case ruless of
55.227 + Rrls _ => raise error "rewrite_set_' not for Rrls"
55.228 + | Rls _ =>
55.229 + let
55.230 + datatype switch = Appl | Noap;
55.231 + fun rew_once ruls asm ct Noap [] = (ct,asm)
55.232 + | rew_once ruls asm ct Appl [] = rew_once ruls asm ct Noap ruls
55.233 + | rew_once ruls asm ct apno (rul::thms) =
55.234 + case rul of
55.235 + Thm (thmid, thm) =>
55.236 + (case rewrite_ thy ((snd o #rew_ord o rep_rls) ruless)
55.237 + rls put_asm (thm_of_thm rul) ct of
55.238 + None => rew_once ruls asm ct apno thms
55.239 + | Some (ct',asm') =>
55.240 + rew_once ruls (asm union asm') ct' Appl (rul::thms))
55.241 + | Calc (cc as (op_,_)) =>
55.242 + (case get_calculation_ thy cc ct of
55.243 + None => rew_once ruls asm ct apno thms
55.244 + | Some (thmid, thm') =>
55.245 + let
55.246 + val pairopt =
55.247 + rewrite_ thy ((snd o #rew_ord o rep_rls) ruless)
55.248 + rls put_asm thm' ct;
55.249 + val _ = if pairopt <> None then ()
55.250 + else raise error("rewrite_set_, rewrite_ \""^
55.251 + (string_of_thmI thm')^"\" \""^
55.252 + (Sign.string_of_term (sign_of thy) ct)^"\" = None")
55.253 + in rew_once ruls asm ((fst o the) pairopt) Appl(rul::thms) end);
55.254 + val ruls = (#rules o rep_rls) ruless;
55.255 + val (ct',asm') = rew_once ruls [] ct Noap ruls;
55.256 + in if ct = ct' then None else Some (ct',asm') end;
55.257 +
55.258 + realpow_two;
55.259 + real_mult_div_cancel1;
55.260 +
56.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
56.2 +++ b/src/Pure/isac/IsacKnowledge/Rational.ML Wed Jul 21 13:53:39 2010 +0200
56.3 @@ -0,0 +1,3778 @@
56.4 +(*.calculate in rationals: gcd, lcm, etc.
56.5 + (c) Stefan Karnel 2002
56.6 + Institute for Mathematics D and Institute for Software Technology,
56.7 + TU-Graz SS 2002
56.8 + Use is subject to license terms.
56.9 +
56.10 +use"IsacKnowledge/Rational.ML";
56.11 +use"Rational.ML";
56.12 +
56.13 +remove_thy"Rational";
56.14 +use_thy"IsacKnowledge/Isac";
56.15 +****************************************************************.*)
56.16 +
56.17 +(*.*****************************************************************
56.18 + Remark on notions in the documentation below:
56.19 + referring to the remark on 'polynomials' in Poly.sml we use
56.20 + [2] 'polynomial' normalform (Polynom)
56.21 + [3] 'expanded_term' normalform (Ausmultiplizierter Term),
56.22 + where normalform [2] is a special case of [3], i.e. [3] implies [2].
56.23 + Instead of
56.24 + 'fraction with numerator and nominator both in normalform [2]'
56.25 + 'fraction with numerator and nominator both in normalform [3]'
56.26 + we say:
56.27 + 'fraction in normalform [2]'
56.28 + 'fraction in normalform [3]'
56.29 + or
56.30 + 'fraction [2]'
56.31 + 'fraction [3]'.
56.32 + a 'simple fraction' is a term with '/' as outmost operator and
56.33 + numerator and nominator in normalform [2] or [3].
56.34 +****************************************************************.*)
56.35 +
56.36 +signature RATIONALI =
56.37 +sig
56.38 + type mv_monom
56.39 + type mv_poly
56.40 + val add_fraction_ : theory -> term -> (term * term list) option
56.41 + val add_fraction_p_ : theory -> term -> (term * term list) option
56.42 + val calculate_Rational : rls
56.43 + val calc_rat_erls:rls
56.44 + val cancel : rls
56.45 + val cancel_ : theory -> term -> (term * term list) option
56.46 + val cancel_p : rls
56.47 + val cancel_p_ : theory -> term -> (term * term list) option
56.48 + val common_nominator : rls
56.49 + val common_nominator_ : theory -> term -> (term * term list) option
56.50 + val common_nominator_p : rls
56.51 + val common_nominator_p_ : theory -> term -> (term * term list) option
56.52 + val eval_is_expanded : string -> 'a -> term -> theory ->
56.53 + (string * term) option
56.54 + val expanded2polynomial : term -> term option
56.55 + val factout_ : theory -> term -> (term * term list) option
56.56 + val factout_p_ : theory -> term -> (term * term list) option
56.57 + val is_expanded : term -> bool
56.58 + val is_polynomial : term -> bool
56.59 +
56.60 + val mv_gcd : (int * int list) list -> mv_poly -> mv_poly
56.61 + val mv_lcm : mv_poly -> mv_poly -> mv_poly
56.62 +
56.63 + val norm_expanded_rat_ : theory -> term -> (term * term list) option
56.64 +(*WN0602.2.6.pull into struct !!!
56.65 + val norm_Rational : rls(*.normalizes an arbitrary rational term without
56.66 + roots into a simple and canceled fraction
56.67 + with normalform [2].*)
56.68 +*)
56.69 +(*val norm_rational_p : 19.10.02 missing FIXXXXXXXXXXXXME
56.70 + rls (*.normalizes an rational term [2] without
56.71 + roots into a simple and canceled fraction
56.72 + with normalform [2].*)
56.73 +*)
56.74 + val norm_rational_ : theory -> term -> (term * term list) option
56.75 + val polynomial2expanded : term -> term option
56.76 + val rational_erls :
56.77 + rls (*.evaluates an arbitrary rational term with numerals.*)
56.78 +
56.79 +(*WN0210???SK: fehlen Funktionen, die exportiert werden sollen ? *)
56.80 +end
56.81 +
56.82 +(*.**************************************************************************
56.83 +survey on the functions
56.84 +~~~~~~~~~~~~~~~~~~~~~~~
56.85 + [2] 'polynomial' :rls | [3]'expanded_term':rls
56.86 +--------------------:------------------+-------------------:-----------------
56.87 + factout_p_ : | factout_ :
56.88 + cancel_p_ : | cancel_ :
56.89 + :cancel_p | :cancel
56.90 +--------------------:------------------+-------------------:-----------------
56.91 + common_nominator_p_: | common_nominator_ :
56.92 + :common_nominator_p| :common_nominator
56.93 + add_fraction_p_ : | add_fraction_ :
56.94 +--------------------:------------------+-------------------:-----------------
56.95 +???SK :norm_rational_p | :norm_rational
56.96 +
56.97 +This survey shows only the principal functions for reuse, and the identifiers
56.98 +of the rls exported. The list below shows some more useful functions.
56.99 +
56.100 +
56.101 +conversion from Isabelle-term to internal representation
56.102 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56.103 +
56.104 +... BITTE FORTSETZEN ...
56.105 +
56.106 +polynomial2expanded = ...
56.107 +expanded2polynomial = ...
56.108 +
56.109 +remark: polynomial2expanded o expanded2polynomial = I,
56.110 + where 'o' is function chaining, and 'I' is identity WN0210???SK
56.111 +
56.112 +functions for greatest common divisor and canceling
56.113 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56.114 +mv_gcd
56.115 +factout_
56.116 +factout_p_
56.117 +cancel_
56.118 +cancel_p_
56.119 +
56.120 +functions for least common multiple and addition of fractions
56.121 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56.122 +mv_lcm
56.123 +common_nominator_
56.124 +common_nominator_p_
56.125 +add_fraction_ (*.add 2 or more fractions.*)
56.126 +add_fraction_p_ (*.add 2 or more fractions.*)
56.127 +
56.128 +functions for normalform of rationals
56.129 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56.130 +WN0210???SK interne Funktionen f"ur norm_rational:
56.131 + schaffen diese SML-Funktionen wirklich ganz allgemeine Terme ?
56.132 +
56.133 +norm_rational_
56.134 +norm_expanded_rat_
56.135 +
56.136 +**************************************************************************.*)
56.137 +
56.138 +
56.139 +(*##*)
56.140 +structure RationalI : RATIONALI =
56.141 +struct
56.142 +(*##*)
56.143 +
56.144 +(*. gcd of integers .*)
56.145 +(* die gcd Funktion von Isabelle funktioniert nicht richtig !!! *)
56.146 +fun gcd_int a b = if b=0 then a
56.147 + else gcd_int b (a mod b);
56.148 +
56.149 +(*. univariate polynomials (uv) .*)
56.150 +(*. univariate polynomials are represented as a list of the coefficent in reverse maximum degree order .*)
56.151 +(*. 5 * x^5 + 4 * x^3 + 2 * x^2 + x + 19 => [19,1,2,4,0,5] .*)
56.152 +type uv_poly = int list;
56.153 +
56.154 +(*. adds two uv polynomials .*)
56.155 +fun uv_mod_add_poly ([]:uv_poly,p2:uv_poly) = p2:uv_poly
56.156 + | uv_mod_add_poly (p1,[]) = p1
56.157 + | uv_mod_add_poly (x::p1,y::p2) = (x+y)::(uv_mod_add_poly(p1,p2));
56.158 +
56.159 +(*. multiplies a uv polynomial with a skalar s .*)
56.160 +fun uv_mod_smul_poly ([]:uv_poly,s:int) = []:uv_poly
56.161 + | uv_mod_smul_poly (x::p,s) = (x*s)::(uv_mod_smul_poly(p,s));
56.162 +
56.163 +(*. calculates the remainder of a polynomial divided by a skalar s .*)
56.164 +fun uv_mod_rem_poly ([]:uv_poly,s) = []:uv_poly
56.165 + | uv_mod_rem_poly (x::p,s) = (x mod s)::(uv_mod_smul_poly(p,s));
56.166 +
56.167 +(*. calculates the degree of a uv polynomial .*)
56.168 +fun uv_mod_deg ([]:uv_poly) = 0
56.169 + | uv_mod_deg p = length(p)-1;
56.170 +
56.171 +(*. calculates the remainder of x/p and represents it as value between -p/2 and p/2 .*)
56.172 +fun uv_mod_mod2(x,p)=
56.173 + let
56.174 + val y=(x mod p);
56.175 + in
56.176 + if (y)>(p div 2) then (y)-p else
56.177 + (
56.178 + if (y)<(~p div 2) then p+(y) else (y)
56.179 + )
56.180 + end;
56.181 +
56.182 +(*.calculates the remainder for each element of a integer list divided by p.*)
56.183 +fun uv_mod_list_modp [] p = []
56.184 + | uv_mod_list_modp (x::xs) p = (uv_mod_mod2(x,p))::(uv_mod_list_modp xs p);
56.185 +
56.186 +(*. appends an integer at the end of a integer list .*)
56.187 +fun uv_mod_null (p1:int list,0) = p1
56.188 + | uv_mod_null (p1:int list,n1:int) = uv_mod_null(p1,n1-1) @ [0];
56.189 +
56.190 +(*. uv polynomial division, result is (quotient, remainder) .*)
56.191 +(*. only for uv_mod_divides .*)
56.192 +(* FIXME: Division von x^9+x^5+1 durch x-1000 funktioniert nicht integer zu klein *)
56.193 +fun uv_mod_pdiv (p1:uv_poly) ([]:uv_poly) = raise error ("RATIONALS_UV_MOD_PDIV_EXCEPTION: division by zero")
56.194 + | uv_mod_pdiv p1 [x] =
56.195 + let
56.196 + val xs=ref [];
56.197 + in
56.198 + if x<>0 then
56.199 + (
56.200 + xs:=(uv_mod_rem_poly(p1,x));
56.201 + while length(!xs)>0 andalso hd(!xs)=0 do xs:=tl(!xs)
56.202 + )
56.203 + else raise error ("RATIONALS_UV_MOD_PDIV_EXCEPTION: division by zero");
56.204 + ([]:uv_poly,!xs:uv_poly)
56.205 + end
56.206 + | uv_mod_pdiv p1 p2 =
56.207 + let
56.208 + val n= uv_mod_deg(p2);
56.209 + val m= ref (uv_mod_deg(p1));
56.210 + val p1'=ref (rev(p1));
56.211 + val p2'=(rev(p2));
56.212 + val lc2=hd(p2');
56.213 + val q=ref [];
56.214 + val c=ref 0;
56.215 + val output=ref ([],[]);
56.216 + in
56.217 + (
56.218 + if (!m)=0 orelse p2=[0] then raise error ("RATIONALS_UV_MOD_PDIV_EXCEPTION: Division by zero")
56.219 + else
56.220 + (
56.221 + if (!m)<n then
56.222 + (
56.223 + output:=([0],p1)
56.224 + )
56.225 + else
56.226 + (
56.227 + while (!m)>=n do
56.228 + (
56.229 + c:=hd(!p1') div hd(p2');
56.230 + if !c<>0 then
56.231 + (
56.232 + p1':=uv_mod_add_poly(!p1',uv_mod_null(uv_mod_smul_poly(p2',~(!c)),!m-n));
56.233 + while length(!p1')>0 andalso hd(!p1')=0 do p1':= tl(!p1');
56.234 + m:=uv_mod_deg(!p1')
56.235 + )
56.236 + else m:=0
56.237 + );
56.238 + output:=(rev(!q),rev(!p1'))
56.239 + )
56.240 + );
56.241 + !output
56.242 + )
56.243 + end;
56.244 +
56.245 +(*. divides p1 by p2 in Zp .*)
56.246 +fun uv_mod_pdivp (p1:uv_poly) (p2:uv_poly) p =
56.247 + let
56.248 + val n=uv_mod_deg(p2);
56.249 + val m=ref (uv_mod_deg(uv_mod_list_modp p1 p));
56.250 + val p1'=ref (rev(p1));
56.251 + val p2'=(rev(uv_mod_list_modp p2 p));
56.252 + val lc2=hd(p2');
56.253 + val q=ref [];
56.254 + val c=ref 0;
56.255 + val output=ref ([],[]);
56.256 + in
56.257 + (
56.258 + if (!m)=0 orelse p2=[0] then raise error ("RATIONALS_UV_MOD_PDIVP_EXCEPTION: Division by zero")
56.259 + else
56.260 + (
56.261 + if (!m)<n then
56.262 + (
56.263 + output:=([0],p1)
56.264 + )
56.265 + else
56.266 + (
56.267 + while (!m)>=n do
56.268 + (
56.269 + c:=uv_mod_mod2(hd(!p1')*(power lc2 1), p);
56.270 + q:=(!c)::(!q);
56.271 + p1':=uv_mod_list_modp(tl(uv_mod_add_poly(uv_mod_smul_poly(!p1',lc2),
56.272 + uv_mod_smul_poly(uv_mod_smul_poly(p2',hd(!p1')),~1)))) p;
56.273 + m:=(!m)-1
56.274 + );
56.275 +
56.276 + while !p1'<>[] andalso hd(!p1')=0 do
56.277 + (
56.278 + p1':=tl(!p1')
56.279 + );
56.280 +
56.281 + output:=(rev(uv_mod_list_modp (!q) (p)),rev(!p1'))
56.282 + )
56.283 + );
56.284 + !output:uv_poly * uv_poly
56.285 + )
56.286 + end;
56.287 +
56.288 +(*. calculates the remainder of p1/p2 .*)
56.289 +fun uv_mod_prest (p1:uv_poly) ([]:uv_poly) = raise error("UV_MOD_PREST_EXCEPTION: Division by zero")
56.290 + | uv_mod_prest [] p2 = []:uv_poly
56.291 + | uv_mod_prest p1 p2 = (#2(uv_mod_pdiv p1 p2));
56.292 +
56.293 +(*. calculates the remainder of p1/p2 in Zp .*)
56.294 +fun uv_mod_prestp (p1:uv_poly) ([]:uv_poly) p= raise error("UV_MOD_PRESTP_EXCEPTION: Division by zero")
56.295 + | uv_mod_prestp [] p2 p= []:uv_poly
56.296 + | uv_mod_prestp p1 p2 p = #2(uv_mod_pdivp p1 p2 p);
56.297 +
56.298 +(*. calculates the content of a uv polynomial .*)
56.299 +fun uv_mod_cont ([]:uv_poly) = 0
56.300 + | uv_mod_cont (x::p)= gcd_int x (uv_mod_cont(p));
56.301 +
56.302 +(*. divides each coefficient of a uv polynomial by y .*)
56.303 +fun uv_mod_div_list (p:uv_poly,0) = raise error("UV_MOD_DIV_LIST_EXCEPTION: Division by zero")
56.304 + | uv_mod_div_list ([],y) = []:uv_poly
56.305 + | uv_mod_div_list (x::p,y) = (x div y)::uv_mod_div_list(p,y);
56.306 +
56.307 +(*. calculates the primitiv part of a uv polynomial .*)
56.308 +fun uv_mod_pp ([]:uv_poly) = []:uv_poly
56.309 + | uv_mod_pp p =
56.310 + let
56.311 + val c=ref 0;
56.312 + in
56.313 + (
56.314 + c:=uv_mod_cont(p);
56.315 +
56.316 + if !c=0 then raise error ("RATIONALS_UV_MOD_PP_EXCEPTION: content is 0")
56.317 + else uv_mod_div_list(p,!c)
56.318 + )
56.319 + end;
56.320 +
56.321 +(*. gets the leading coefficient of a uv polynomial .*)
56.322 +fun uv_mod_lc ([]:uv_poly) = 0
56.323 + | uv_mod_lc p = hd(rev(p));
56.324 +
56.325 +(*. calculates the euklidean polynomial remainder sequence in Zp .*)
56.326 +fun uv_mod_prs_euklid_p(p1:uv_poly,p2:uv_poly,p)=
56.327 + let
56.328 + val f =ref [];
56.329 + val f'=ref p2;
56.330 + val fi=ref [];
56.331 + in
56.332 + (
56.333 + f:=p2::p1::[];
56.334 + while uv_mod_deg(!f')>0 do
56.335 + (
56.336 + f':=uv_mod_prestp (hd(tl(!f))) (hd(!f)) p;
56.337 + if (!f')<>[] then
56.338 + (
56.339 + fi:=(!f');
56.340 + f:=(!fi)::(!f)
56.341 + )
56.342 + else ()
56.343 + );
56.344 + (!f)
56.345 +
56.346 + )
56.347 + end;
56.348 +
56.349 +(*. calculates the gcd of p1 and p2 in Zp .*)
56.350 +fun uv_mod_gcd_modp ([]:uv_poly) (p2:uv_poly) p = p2:uv_poly
56.351 + | uv_mod_gcd_modp p1 [] p= p1
56.352 + | uv_mod_gcd_modp p1 p2 p=
56.353 + let
56.354 + val p1'=ref[];
56.355 + val p2'=ref[];
56.356 + val pc=ref[];
56.357 + val g=ref [];
56.358 + val d=ref 0;
56.359 + val prs=ref [];
56.360 + in
56.361 + (
56.362 + if uv_mod_deg(p1)>=uv_mod_deg(p2) then
56.363 + (
56.364 + p1':=uv_mod_list_modp (uv_mod_pp(p1)) p;
56.365 + p2':=uv_mod_list_modp (uv_mod_pp(p2)) p
56.366 + )
56.367 + else
56.368 + (
56.369 + p1':=uv_mod_list_modp (uv_mod_pp(p2)) p;
56.370 + p2':=uv_mod_list_modp (uv_mod_pp(p1)) p
56.371 + );
56.372 + d:=uv_mod_mod2((gcd_int (uv_mod_cont(p1))) (uv_mod_cont(p2)), p) ;
56.373 + if !d>(p div 2) then d:=(!d)-p else ();
56.374 +
56.375 + prs:=uv_mod_prs_euklid_p(!p1',!p2',p);
56.376 +
56.377 + if hd(!prs)=[] then pc:=hd(tl(!prs))
56.378 + else pc:=hd(!prs);
56.379 +
56.380 + g:=uv_mod_smul_poly(uv_mod_pp(!pc),!d);
56.381 + !g
56.382 + )
56.383 + end;
56.384 +
56.385 +(*. calculates the minimum of two real values x and y .*)
56.386 +fun uv_mod_r_min(x,y):BasisLibrary.Real.real = if x>y then y else x;
56.387 +
56.388 +(*. calculates the minimum of two integer values x and y .*)
56.389 +fun uv_mod_min(x,y) = if x>y then y else x;
56.390 +
56.391 +(*. adds the squared values of a integer list .*)
56.392 +fun uv_mod_add_qu [] = 0.0
56.393 + | uv_mod_add_qu (x::p) = BasisLibrary.Real.fromInt(x)*BasisLibrary.Real.fromInt(x) + uv_mod_add_qu p;
56.394 +
56.395 +(*. calculates the euklidean norm .*)
56.396 +fun uv_mod_norm ([]:uv_poly) = 0.0
56.397 + | uv_mod_norm p = Math.sqrt(uv_mod_add_qu(p));
56.398 +
56.399 +(*. multipies two values a and b .*)
56.400 +fun uv_mod_multi a b = a * b;
56.401 +
56.402 +(*. decides if x is a prim, the list contains all primes which are lower then x .*)
56.403 +fun uv_mod_prim(x,[])= false
56.404 + | uv_mod_prim(x,[y])=if ((x mod y) <> 0) then true
56.405 + else false
56.406 + | uv_mod_prim(x,y::ys) = if uv_mod_prim(x,[y])
56.407 + then
56.408 + if uv_mod_prim(x,ys) then true
56.409 + else false
56.410 + else false;
56.411 +
56.412 +(*. gets the first prime, which is greater than p and does not divide g .*)
56.413 +fun uv_mod_nextprime(g,p)=
56.414 + let
56.415 + val list=ref [2];
56.416 + val exit=ref 0;
56.417 + val i = ref 2
56.418 + in
56.419 + while (!i<p) do (* calculates the primes lower then p *)
56.420 + (
56.421 + if uv_mod_prim(!i,!list) then
56.422 + (
56.423 + if (p mod !i <> 0)
56.424 + then
56.425 + (
56.426 + list:= (!i)::(!list);
56.427 + i:= (!i)+1
56.428 + )
56.429 + else i:=(!i)+1
56.430 + )
56.431 + else i:= (!i)+1
56.432 + );
56.433 + i:=(p+1);
56.434 + while (!exit=0) do (* calculate next prime which does not divide g *)
56.435 + (
56.436 + if uv_mod_prim(!i,!list) then
56.437 + (
56.438 + if (g mod !i <> 0)
56.439 + then
56.440 + (
56.441 + list:= (!i)::(!list);
56.442 + exit:= (!i)
56.443 + )
56.444 + else i:=(!i)+1
56.445 + )
56.446 + else i:= (!i)+1
56.447 + );
56.448 + !exit
56.449 + end;
56.450 +
56.451 +(*. decides if p1 is a factor of p2 in Zp .*)
56.452 +fun uv_mod_dividesp ([]:uv_poly) (p2:uv_poly) p= raise error("UV_MOD_DIVIDESP: Division by zero")
56.453 + | uv_mod_dividesp p1 p2 p= if uv_mod_prestp p2 p1 p = [] then true else false;
56.454 +
56.455 +(*. decides if p1 is a factor of p2 .*)
56.456 +fun uv_mod_divides ([]:uv_poly) (p2:uv_poly) = raise error("UV_MOD_DIVIDES: Division by zero")
56.457 + | uv_mod_divides p1 p2 = if uv_mod_prest p2 p1 = [] then true else false;
56.458 +
56.459 +(*. chinese remainder algorithm .*)
56.460 +fun uv_mod_cra2(r1,r2,m1,m2)=
56.461 + let
56.462 + val c=ref 0;
56.463 + val r1'=ref 0;
56.464 + val d=ref 0;
56.465 + val a=ref 0;
56.466 + in
56.467 + (
56.468 + while (uv_mod_mod2((!c)*m1,m2))<>1 do
56.469 + (
56.470 + c:=(!c)+1
56.471 + );
56.472 + r1':= uv_mod_mod2(r1,m1);
56.473 + d:=uv_mod_mod2(((r2-(!r1'))*(!c)),m2);
56.474 + !r1'+(!d)*m1
56.475 + )
56.476 + end;
56.477 +
56.478 +(*. applies the chinese remainder algorithmen to the coefficients of x1 and x2 .*)
56.479 +fun uv_mod_cra_2 ([],[],m1,m2) = []
56.480 + | uv_mod_cra_2 ([],x2,m1,m2) = raise error("UV_MOD_CRA_2_EXCEPTION: invalid call x1")
56.481 + | uv_mod_cra_2 (x1,[],m1,m2) = raise error("UV_MOD_CRA_2_EXCEPTION: invalid call x2")
56.482 + | uv_mod_cra_2 (x1::x1s,x2::x2s,m1,m2) = (uv_mod_cra2(x1,x2,m1,m2))::(uv_mod_cra_2(x1s,x2s,m1,m2));
56.483 +
56.484 +(*. calculates the gcd of two uv polynomials p1' and p2' with the modular algorithm .*)
56.485 +fun uv_mod_gcd (p1':uv_poly) (p2':uv_poly) =
56.486 + let
56.487 + val p1=ref (uv_mod_pp(p1'));
56.488 + val p2=ref (uv_mod_pp(p2'));
56.489 + val c=gcd_int (uv_mod_cont(p1')) (uv_mod_cont(p2'));
56.490 + val temp=ref [];
56.491 + val cp=ref [];
56.492 + val qp=ref [];
56.493 + val q=ref[];
56.494 + val pn=ref 0;
56.495 + val d=ref 0;
56.496 + val g1=ref 0;
56.497 + val p=ref 0;
56.498 + val m=ref 0;
56.499 + val exit=ref 0;
56.500 + val i=ref 1;
56.501 + in
56.502 + if length(!p1)>length(!p2) then ()
56.503 + else
56.504 + (
56.505 + temp:= !p1;
56.506 + p1:= !p2;
56.507 + p2:= !temp
56.508 + );
56.509 +
56.510 +
56.511 + d:=gcd_int (uv_mod_lc(!p1)) (uv_mod_lc(!p2));
56.512 + g1:=uv_mod_lc(!p1)*uv_mod_lc(!p2);
56.513 + p:=4;
56.514 +
56.515 + m:=BasisLibrary.Real.ceil(2.0 *
56.516 + BasisLibrary.Real.fromInt(!d) *
56.517 + BasisLibrary.Real.fromInt(power 2 (uv_mod_min(uv_mod_deg(!p2),uv_mod_deg(!p1)))) *
56.518 + BasisLibrary.Real.fromInt(!d) *
56.519 + uv_mod_r_min(uv_mod_norm(!p1) / BasisLibrary.Real.fromInt(abs(uv_mod_lc(!p1))),
56.520 + uv_mod_norm(!p2) / BasisLibrary.Real.fromInt(abs(uv_mod_lc(!p2)))));
56.521 +
56.522 + while (!exit=0) do
56.523 + (
56.524 + p:=uv_mod_nextprime(!d,!p);
56.525 + cp:=(uv_mod_gcd_modp (uv_mod_list_modp(!p1) (!p)) (uv_mod_list_modp(!p2) (!p)) (!p)) ;
56.526 + if abs(uv_mod_lc(!cp))<>1 then (* leading coefficient = 1 ? *)
56.527 + (
56.528 + i:=1;
56.529 + while (!i)<(!p) andalso (abs(uv_mod_mod2((uv_mod_lc(!cp)*(!i)),(!p)))<>1) do
56.530 + (
56.531 + i:=(!i)+1
56.532 + );
56.533 + cp:=uv_mod_list_modp (map (uv_mod_multi (!i)) (!cp)) (!p)
56.534 + )
56.535 + else ();
56.536 +
56.537 + qp:= ((map (uv_mod_multi (uv_mod_mod2(!d,!p)))) (!cp));
56.538 +
56.539 + if uv_mod_deg(!qp)=0 then (q:=[1]; exit:=1) else ();
56.540 +
56.541 + pn:=(!p);
56.542 + q:=(!qp);
56.543 +
56.544 + while !pn<= !m andalso !m>(!p) andalso !exit=0 do
56.545 + (
56.546 + p:=uv_mod_nextprime(!d,!p);
56.547 + cp:=(uv_mod_gcd_modp (uv_mod_list_modp(!p1) (!p)) (uv_mod_list_modp(!p2) (!p)) (!p));
56.548 + if uv_mod_lc(!cp)<>1 then (* leading coefficient = 1 ? *)
56.549 + (
56.550 + i:=1;
56.551 + while (!i)<(!p) andalso ((uv_mod_mod2((uv_mod_lc(!q)*(!i)),(!p)))<>1) do
56.552 + (
56.553 + i:=(!i)+1
56.554 + );
56.555 + cp:=uv_mod_list_modp (map (uv_mod_multi (!i)) (!cp)) (!p)
56.556 + )
56.557 + else ();
56.558 +
56.559 + qp:=uv_mod_list_modp ((map (uv_mod_multi (uv_mod_mod2(!d,!p)))) (!cp) ) (!p);
56.560 + if uv_mod_deg(!qp)>uv_mod_deg(!q) then
56.561 + (
56.562 + (*print("degree to high!!!\n")*)
56.563 + )
56.564 + else
56.565 + (
56.566 + if uv_mod_deg(!qp)=uv_mod_deg(!q) then
56.567 + (
56.568 + q:=uv_mod_cra_2(!q,!qp,!pn,!p);
56.569 + pn:=(!pn) * !p;
56.570 + q:=uv_mod_pp(uv_mod_list_modp (!q) (!pn)); (* found already gcd ? *)
56.571 + if (uv_mod_divides (!q) (p1')) andalso (uv_mod_divides (!q) (p2')) then (exit:=1) else ()
56.572 + )
56.573 + else
56.574 + (
56.575 + if uv_mod_deg(!qp)<uv_mod_deg(!q) then
56.576 + (
56.577 + pn:= !p;
56.578 + q:= !qp
56.579 + )
56.580 + else ()
56.581 + )
56.582 + )
56.583 + );
56.584 + q:=uv_mod_pp(uv_mod_list_modp (!q) (!pn));
56.585 + if (uv_mod_divides (!q) (p1')) andalso (uv_mod_divides (!q) (p2')) then exit:=1 else ()
56.586 + );
56.587 + uv_mod_smul_poly(!q,c):uv_poly
56.588 + end;
56.589 +
56.590 +(*. multivariate polynomials .*)
56.591 +(*. multivariate polynomials are represented as a list of the pairs,
56.592 + first is the coefficent and the second is a list of the exponents .*)
56.593 +(*. 5 * x^5 * y^3 + 4 * x^3 * z^2 + 2 * x^2 * y * z^3 - z - 19
56.594 + => [(5,[5,3,0]),(4,[3,0,2]),(2,[2,1,3]),(~1,[0,0,1]),(~19,[0,0,0])] .*)
56.595 +
56.596 +(*. global variables .*)
56.597 +(*. order indicators .*)
56.598 +val LEX_=0; (* lexicographical term order *)
56.599 +val GGO_=1; (* greatest degree order *)
56.600 +
56.601 +(*. datatypes for internal representation.*)
56.602 +type mv_monom = (int * (*.coefficient or the monom.*)
56.603 + int list); (*.list of exponents) .*)
56.604 +fun mv_monom2str (i, is) = "("^ int2str i^"," ^ ints2str' is ^ ")";
56.605 +
56.606 +type mv_poly = mv_monom list;
56.607 +fun mv_poly2str p = (strs2str' o (map mv_monom2str)) p;
56.608 +
56.609 +(*. help function for monom_greater and geq .*)
56.610 +fun mv_mg_hlp([]) = EQUAL
56.611 + | mv_mg_hlp(x::list)=if x<0 then LESS
56.612 + else if x>0 then GREATER
56.613 + else mv_mg_hlp(list);
56.614 +
56.615 +(*. adds a list of values .*)
56.616 +fun mv_addlist([]) = 0
56.617 + | mv_addlist(p1) = hd(p1)+mv_addlist(tl(p1));
56.618 +
56.619 +(*. tests if the monomial M1 is greater as the monomial M2 and returns a boolean value .*)
56.620 +(*. 2 orders are implemented LEX_/GGO_ (lexigraphical/greatest degree order) .*)
56.621 +fun mv_monom_greater((M1x,M1l):mv_monom,(M2x,M2l):mv_monom,order)=
56.622 + if order=LEX_ then
56.623 + (
56.624 + if length(M1l)<>length(M2l) then raise error ("RATIONALS_MV_MONOM_GREATER_EXCEPTION: Order error")
56.625 + else if (mv_mg_hlp((map op- (M1l~~M2l)))<>GREATER) then false else true
56.626 + )
56.627 + else
56.628 + if order=GGO_ then
56.629 + (
56.630 + if length(M1l)<>length(M2l) then raise error ("RATIONALS_MV_MONOM_GREATER_EXCEPTION: Order error")
56.631 + else
56.632 + if mv_addlist(M1l)=mv_addlist(M2l) then if (mv_mg_hlp((map op- (M1l~~M2l)))<>GREATER) then false else true
56.633 + else if mv_addlist(M1l)>mv_addlist(M2l) then true else false
56.634 + )
56.635 + else raise error ("RATIONALS_MV_MONOM_GREATER_EXCEPTION: Wrong Order");
56.636 +
56.637 +(*. tests if the monomial X is greater as the monomial Y and returns a order value (GREATER,EQUAL,LESS) .*)
56.638 +(*. 2 orders are implemented LEX_/GGO_ (lexigraphical/greatest degree order) .*)
56.639 +fun mv_geq order ((x1,x):mv_monom,(x2,y):mv_monom) =
56.640 +let
56.641 + val temp=ref EQUAL;
56.642 +in
56.643 + if order=LEX_ then
56.644 + (
56.645 + if length(x)<>length(y) then
56.646 + raise error ("RATIONALS_MV_GEQ_EXCEPTION: Order error")
56.647 + else
56.648 + (
56.649 + temp:=mv_mg_hlp((map op- (x~~y)));
56.650 + if !temp=EQUAL then
56.651 + ( if x1=x2 then EQUAL
56.652 + else if x1>x2 then GREATER
56.653 + else LESS
56.654 + )
56.655 + else (!temp)
56.656 + )
56.657 + )
56.658 + else
56.659 + if order=GGO_ then
56.660 + (
56.661 + if length(x)<>length(y) then
56.662 + raise error ("RATIONALS_MV_GEQ_EXCEPTION: Order error")
56.663 + else
56.664 + if mv_addlist(x)=mv_addlist(y) then
56.665 + (mv_mg_hlp((map op- (x~~y))))
56.666 + else if mv_addlist(x)>mv_addlist(y) then GREATER else LESS
56.667 + )
56.668 + else raise error ("RATIONALS_MV_GEQ_EXCEPTION: Wrong Order")
56.669 +end;
56.670 +
56.671 +(*. cuts the first variable from a polynomial .*)
56.672 +fun mv_cut([]:mv_poly)=[]:mv_poly
56.673 + | mv_cut((x,[])::list) = raise error ("RATIONALS_MV_CUT_EXCEPTION: Invalid list ")
56.674 + | mv_cut((x,y::ys)::list)=(x,ys)::mv_cut(list);
56.675 +
56.676 +(*. leading power product .*)
56.677 +fun mv_lpp([]:mv_poly,order) = []
56.678 + | mv_lpp([(x,y)],order) = y
56.679 + | mv_lpp(p1,order) = #2(hd(rev(sort (mv_geq order) p1)));
56.680 +
56.681 +(*. leading monomial .*)
56.682 +fun mv_lm([]:mv_poly,order) = (0,[]):mv_monom
56.683 + | mv_lm([x],order) = x
56.684 + | mv_lm(p1,order) = hd(rev(sort (mv_geq order) p1));
56.685 +
56.686 +(*. leading coefficient in term order .*)
56.687 +fun mv_lc2([]:mv_poly,order) = 0
56.688 + | mv_lc2([(x,y)],order) = x
56.689 + | mv_lc2(p1,order) = #1(hd(rev(sort (mv_geq order) p1)));
56.690 +
56.691 +
56.692 +(*. reverse the coefficients in mv polynomial .*)
56.693 +fun mv_rev_to([]:mv_poly) = []:mv_poly
56.694 + | mv_rev_to((c,e)::xs) = (c,rev(e))::mv_rev_to(xs);
56.695 +
56.696 +(*. leading coefficient in reverse term order .*)
56.697 +fun mv_lc([]:mv_poly,order) = []:mv_poly
56.698 + | mv_lc([(x,y)],order) = mv_rev_to(mv_cut(mv_rev_to([(x,y)])))
56.699 + | mv_lc(p1,order) =
56.700 + let
56.701 + val p1o=ref (rev(sort (mv_geq order) (mv_rev_to(p1))));
56.702 + val lp=hd(#2(hd(!p1o)));
56.703 + val lc=ref [];
56.704 + in
56.705 + (
56.706 + while (length(!p1o)>0 andalso hd(#2(hd(!p1o)))=lp) do
56.707 + (
56.708 + lc:=hd(mv_cut([hd(!p1o)]))::(!lc);
56.709 + p1o:=tl(!p1o)
56.710 + );
56.711 + if !lc=[] then raise error ("RATIONALS_MV_LC_EXCEPTION: lc is empty") else ();
56.712 + mv_rev_to(!lc)
56.713 + )
56.714 + end;
56.715 +
56.716 +(*. compares two powerproducts .*)
56.717 +fun mv_monom_equal((_,xlist):mv_monom,(_,ylist):mv_monom) = (foldr and_) (((map op=) (xlist~~ylist)),true);
56.718 +
56.719 +(*. help function for mv_add .*)
56.720 +fun mv_madd([]:mv_poly,[]:mv_poly,order) = []:mv_poly
56.721 + | mv_madd([(0,_)],p2,order) = p2
56.722 + | mv_madd(p1,[(0,_)],order) = p1
56.723 + | mv_madd([],p2,order) = p2
56.724 + | mv_madd(p1,[],order) = p1
56.725 + | mv_madd(p1,p2,order) =
56.726 + (
56.727 + if mv_monom_greater(hd(p1),hd(p2),order)
56.728 + then hd(p1)::mv_madd(tl(p1),p2,order)
56.729 + else if mv_monom_equal(hd(p1),hd(p2))
56.730 + then if mv_lc2(p1,order)+mv_lc2(p2,order)<>0
56.731 + then (mv_lc2(p1,order)+mv_lc2(p2,order),mv_lpp(p1,order))::mv_madd(tl(p1),tl(p2),order)
56.732 + else mv_madd(tl(p1),tl(p2),order)
56.733 + else hd(p2)::mv_madd(p1,tl(p2),order)
56.734 + )
56.735 +
56.736 +(*. adds two multivariate polynomials .*)
56.737 +fun mv_add([]:mv_poly,p2:mv_poly,order) = p2
56.738 + | mv_add(p1,[],order) = p1
56.739 + | mv_add(p1,p2,order) = mv_madd(rev(sort (mv_geq order) p1),rev(sort (mv_geq order) p2), order);
56.740 +
56.741 +(*. monom multiplication .*)
56.742 +fun mv_mmul((x1,y1):mv_monom,(x2,y2):mv_monom)=(x1*x2,(map op+) (y1~~y2)):mv_monom;
56.743 +
56.744 +(*. deletes all monomials with coefficient 0 .*)
56.745 +fun mv_shorten([]:mv_poly,order) = []:mv_poly
56.746 + | mv_shorten(x::xs,order)=mv_madd([x],mv_shorten(xs,order),order);
56.747 +
56.748 +(*. zeros a list .*)
56.749 +fun mv_null2([])=[]
56.750 + | mv_null2(x::l)=0::mv_null2(l);
56.751 +
56.752 +(*. multiplies two multivariate polynomials .*)
56.753 +fun mv_mul([]:mv_poly,[]:mv_poly,_) = []:mv_poly
56.754 + | mv_mul([],y::p2,_) = [(0,mv_null2(#2(y)))]
56.755 + | mv_mul(x::p1,[],_) = [(0,mv_null2(#2(x)))]
56.756 + | mv_mul(x::p1,y::p2,order) = mv_shorten(rev(sort (mv_geq order) (mv_mmul(x,y) :: (mv_mul(p1,y::p2,order) @
56.757 + mv_mul([x],p2,order)))),order);
56.758 +
56.759 +(*. gets the maximum value of a list .*)
56.760 +fun mv_getmax([])=0
56.761 + | mv_getmax(x::p1)= let
56.762 + val m=mv_getmax(p1);
56.763 + in
56.764 + if m>x then m
56.765 + else x
56.766 + end;
56.767 +(*. calculates the maximum degree of an multivariate polynomial .*)
56.768 +fun mv_grad([]:mv_poly) = 0
56.769 + | mv_grad(p1:mv_poly)= mv_getmax((map mv_addlist) ((map #2) p1));
56.770 +
56.771 +(*. converts the sign of a value .*)
56.772 +fun mv_minus(x)=(~1) * x;
56.773 +
56.774 +(*. converts the sign of all coefficients of a polynomial .*)
56.775 +fun mv_minus2([]:mv_poly)=[]:mv_poly
56.776 + | mv_minus2(p1)=(mv_minus(#1(hd(p1))),#2(hd(p1)))::(mv_minus2(tl(p1)));
56.777 +
56.778 +(*. searches for a negativ value in a list .*)
56.779 +fun mv_is_negativ([])=false
56.780 + | mv_is_negativ(x::xs)=if x<0 then true else mv_is_negativ(xs);
56.781 +
56.782 +(*. division of monomials .*)
56.783 +fun mv_mdiv((0,[]):mv_monom,_:mv_monom)=(0,[]):mv_monom
56.784 + | mv_mdiv(_,(0,[]))= raise error ("RATIONALS_MV_MDIV_EXCEPTION Division by 0 ")
56.785 + | mv_mdiv(p1:mv_monom,p2:mv_monom)=
56.786 + let
56.787 + val c=ref (#1(p2));
56.788 + val pp=ref [];
56.789 + in
56.790 + (
56.791 + if !c=0 then raise error("MV_MDIV_EXCEPTION Dividing by zero")
56.792 + else c:=(#1(p1) div #1(p2));
56.793 + if #1(p2)<>0 then
56.794 + (
56.795 + pp:=(#2(mv_mmul((1,#2(p1)),(1,(map mv_minus) (#2(p2))))));
56.796 + if mv_is_negativ(!pp) then (0,!pp)
56.797 + else (!c,!pp)
56.798 + )
56.799 + else raise error("MV_MDIV_EXCEPTION Dividing by empty Polynom")
56.800 + )
56.801 + end;
56.802 +
56.803 +(*. prints a polynom for (internal use only) .*)
56.804 +fun mv_print_poly([]:mv_poly)=print("[]\n")
56.805 + | mv_print_poly((x,y)::[])= print("("^BasisLibrary.Int.toString(x)^","^ints2str(y)^")\n")
56.806 + | mv_print_poly((x,y)::p1) = (print("("^BasisLibrary.Int.toString(x)^","^ints2str(y)^"),");mv_print_poly(p1));
56.807 +
56.808 +
56.809 +(*. division of two multivariate polynomials .*)
56.810 +fun mv_division([]:mv_poly,g:mv_poly,order)=([]:mv_poly,[]:mv_poly)
56.811 + | mv_division(f,[],order)= raise error ("RATIONALS_MV_DIVISION_EXCEPTION Division by zero")
56.812 + | mv_division(f,g,order)=
56.813 + let
56.814 + val r=ref [];
56.815 + val q=ref [];
56.816 + val g'=ref [];
56.817 + val k=ref 0;
56.818 + val m=ref (0,[0]);
56.819 + val exit=ref 0;
56.820 + in
56.821 + r := rev(sort (mv_geq order) (mv_shorten(f,order)));
56.822 + g':= rev(sort (mv_geq order) (mv_shorten(g,order)));
56.823 + if #1(hd(!g'))=0 then raise error("RATIONALS_MV_DIVISION_EXCEPTION: Dividing by zero") else ();
56.824 + if (mv_monom_greater (hd(!g'),hd(!r),order)) then ([(0,mv_null2(#2(hd(f))))],(!r))
56.825 + else
56.826 + (
56.827 + exit:=0;
56.828 + while (if (!exit)=0 then not(mv_monom_greater (hd(!g'),hd(!r),order)) else false) do
56.829 + (
56.830 + if (#1(mv_lm(!g',order)))<>0 then m:=mv_mdiv(mv_lm(!r,order),mv_lm(!g',order))
56.831 + else raise error ("RATIONALS_MV_DIVISION_EXCEPTION: Dividing by zero");
56.832 + if #1(!m)<>0 then
56.833 + (
56.834 + q:=(!m)::(!q);
56.835 + r:=mv_add((!r),mv_minus2(mv_mul(!g',[!m],order)),order)
56.836 + )
56.837 + else exit:=1;
56.838 + if (if length(!r)<>0 then length(!g')<>0 else false) then ()
56.839 + else (exit:=1)
56.840 + );
56.841 + (rev(!q),!r)
56.842 + )
56.843 + end;
56.844 +
56.845 +(*. multiplies a polynomial with an integer .*)
56.846 +fun mv_skalar_mul([]:mv_poly,c) = []:mv_poly
56.847 + | mv_skalar_mul((x,y)::p1,c) = ((x * c),y)::mv_skalar_mul(p1,c);
56.848 +
56.849 +(*. inserts the a first variable into an polynomial with exponent v .*)
56.850 +fun mv_correct([]:mv_poly,v:int)=[]:mv_poly
56.851 + | mv_correct((x,y)::list,v:int)=(x,v::y)::mv_correct(list,v);
56.852 +
56.853 +(*. multivariate case .*)
56.854 +
56.855 +(*. decides if x is a factor of y .*)
56.856 +fun mv_divides([]:mv_poly,[]:mv_poly)= raise error("RATIONALS_MV_DIVIDES_EXCEPTION: division by zero")
56.857 + | mv_divides(x,[]) = raise error("RATIONALS_MV_DIVIDES_EXCEPTION: division by zero")
56.858 + | mv_divides(x:mv_poly,y:mv_poly) = #2(mv_division(y,x,LEX_))=[];
56.859 +
56.860 +(*. gets the maximum of a and b .*)
56.861 +fun mv_max(a,b) = if a>b then a else b;
56.862 +
56.863 +(*. gets the maximum exponent of a mv polynomial in the lexicographic term order .*)
56.864 +fun mv_deg([]:mv_poly) = 0
56.865 + | mv_deg(p1)=
56.866 + let
56.867 + val p1'=mv_shorten(p1,LEX_);
56.868 + in
56.869 + if length(p1')=0 then 0
56.870 + else mv_max(hd(#2(hd(p1'))),mv_deg(tl(p1')))
56.871 + end;
56.872 +
56.873 +(*. gets the maximum exponent of a mv polynomial in the reverse lexicographic term order .*)
56.874 +fun mv_deg2([]:mv_poly) = 0
56.875 + | mv_deg2(p1)=
56.876 + let
56.877 + val p1'=mv_shorten(p1,LEX_);
56.878 + in
56.879 + if length(p1')=0 then 0
56.880 + else mv_max(hd(rev(#2(hd(p1')))),mv_deg2(tl(p1')))
56.881 + end;
56.882 +
56.883 +(*. evaluates the mv polynomial at the value v of the main variable .*)
56.884 +fun mv_subs([]:mv_poly,v) = []:mv_poly
56.885 + | mv_subs((c,e)::p1:mv_poly,v) = mv_skalar_mul(mv_cut([(c,e)]),power v (hd(e))) @ mv_subs(p1,v);
56.886 +
56.887 +(*. calculates the content of a uv-polynomial in mv-representation .*)
56.888 +fun uv_content2([]:mv_poly) = 0
56.889 + | uv_content2((c,e)::p1) = (gcd_int c (uv_content2(p1)));
56.890 +
56.891 +(*. converts a uv-polynomial from mv-representation to uv-representation .*)
56.892 +fun uv_to_list ([]:mv_poly)=[]:uv_poly
56.893 + | uv_to_list ((c1,e1)::others) =
56.894 + let
56.895 + val count=ref 0;
56.896 + val max=mv_grad((c1,e1)::others);
56.897 + val help=ref ((c1,e1)::others);
56.898 + val list=ref [];
56.899 + in
56.900 + if length(e1)>1 then raise error ("RATIONALS_TO_LIST_EXCEPTION: not univariate")
56.901 + else if length(e1)=0 then [c1]
56.902 + else
56.903 + (
56.904 + count:=0;
56.905 + while (!count)<=max do
56.906 + (
56.907 + if length(!help)>0 andalso hd(#2(hd(!help)))=max-(!count) then
56.908 + (
56.909 + list:=(#1(hd(!help)))::(!list);
56.910 + help:=tl(!help)
56.911 + )
56.912 + else
56.913 + (
56.914 + list:= 0::(!list)
56.915 + );
56.916 + count := (!count) + 1
56.917 + );
56.918 + (!list)
56.919 + )
56.920 + end;
56.921 +
56.922 +(*. converts a uv-polynomial from uv-representation to mv-representation .*)
56.923 +fun uv_to_poly ([]:uv_poly) = []:mv_poly
56.924 + | uv_to_poly p1 =
56.925 + let
56.926 + val count=ref 0;
56.927 + val help=ref p1;
56.928 + val list=ref [];
56.929 + in
56.930 + while length(!help)>0 do
56.931 + (
56.932 + if hd(!help)=0 then ()
56.933 + else list:=(hd(!help),[!count])::(!list);
56.934 + count:=(!count)+1;
56.935 + help:=tl(!help)
56.936 + );
56.937 + (!list)
56.938 + end;
56.939 +
56.940 +(*. univariate gcd calculation from polynomials in multivariate representation .*)
56.941 +fun uv_gcd ([]:mv_poly) p2 = p2
56.942 + | uv_gcd p1 ([]:mv_poly) = p1
56.943 + | uv_gcd p1 [(c,[e])] =
56.944 + let
56.945 + val list=ref (rev(sort (mv_geq LEX_) (mv_shorten(p1,LEX_))));
56.946 + val min=uv_mod_min(e,(hd(#2(hd(rev(!list))))));
56.947 + in
56.948 + [(gcd_int (uv_content2(p1)) c,[min])]
56.949 + end
56.950 + | uv_gcd [(c,[e])] p2 =
56.951 + let
56.952 + val list=ref (rev(sort (mv_geq LEX_) (mv_shorten(p2,LEX_))));
56.953 + val min=uv_mod_min(e,(hd(#2(hd(rev(!list))))));
56.954 + in
56.955 + [(gcd_int (uv_content2(p2)) c,[min])]
56.956 + end
56.957 + | uv_gcd p11 p22 = uv_to_poly(uv_mod_gcd (uv_to_list(mv_shorten(p11,LEX_))) (uv_to_list(mv_shorten(p22,LEX_))));
56.958 +
56.959 +(*. help function for the newton interpolation .*)
56.960 +fun mv_newton_help ([]:mv_poly list,k:int) = []:mv_poly list
56.961 + | mv_newton_help (pl:mv_poly list,k) =
56.962 + let
56.963 + val x=ref (rev(pl));
56.964 + val t=ref [];
56.965 + val y=ref [];
56.966 + val n=ref 1;
56.967 + val n1=ref[];
56.968 + in
56.969 + (
56.970 + while length(!x)>1 do
56.971 + (
56.972 + if length(hd(!x))>0 then n1:=mv_null2(#2(hd(hd(!x))))
56.973 + else if length(hd(tl(!x)))>0 then n1:=mv_null2(#2(hd(hd(tl(!x)))))
56.974 + else n1:=[];
56.975 + t:= #1(mv_division(mv_add(hd(!x),mv_skalar_mul(hd(tl(!x)),~1),LEX_),[(k,!n1)],LEX_));
56.976 + y:=(!t)::(!y);
56.977 + x:=tl(!x)
56.978 + );
56.979 + (!y)
56.980 + )
56.981 + end;
56.982 +
56.983 +(*. help function for the newton interpolation .*)
56.984 +fun mv_newton_add ([]:mv_poly list) t = []:mv_poly
56.985 + | mv_newton_add [x:mv_poly] t = x
56.986 + | mv_newton_add (pl:mv_poly list) t =
56.987 + let
56.988 + val expos=ref [];
56.989 + val pll=ref pl;
56.990 + in
56.991 + (
56.992 +
56.993 + while length(!pll)>0 andalso hd(!pll)=[] do
56.994 + (
56.995 + pll:=tl(!pll)
56.996 + );
56.997 + if length(!pll)>0 then expos:= #2(hd(hd(!pll))) else expos:=[];
56.998 + mv_add(hd(pl),
56.999 + mv_mul(
56.1000 + mv_add(mv_correct(mv_cut([(1,mv_null2(!expos))]),1),[(~t,mv_null2(!expos))],LEX_),
56.1001 + mv_newton_add (tl(pl)) (t+1),
56.1002 + LEX_
56.1003 + ),
56.1004 + LEX_)
56.1005 + )
56.1006 + end;
56.1007 +
56.1008 +(*. calculates the newton interpolation with polynomial coefficients .*)
56.1009 +(*. step-depth is 1 and if the result is not an integerpolynomial .*)
56.1010 +(*. this function returns [] .*)
56.1011 +fun mv_newton ([]:(mv_poly) list) = []:mv_poly
56.1012 + | mv_newton ([mp]:(mv_poly) list) = mp:mv_poly
56.1013 + | mv_newton pl =
56.1014 + let
56.1015 + val c=ref pl;
56.1016 + val c1=ref [];
56.1017 + val n=length(pl);
56.1018 + val k=ref 1;
56.1019 + val i=ref n;
56.1020 + val ppl=ref [];
56.1021 + in
56.1022 + c1:=hd(pl)::[];
56.1023 + c:=mv_newton_help(!c,!k);
56.1024 + c1:=(hd(!c))::(!c1);
56.1025 + while(length(!c)>1 andalso !k<n) do
56.1026 + (
56.1027 + k:=(!k)+1;
56.1028 + while length(!c)>0 andalso hd(!c)=[] do c:=tl(!c);
56.1029 + if !c=[] then () else c:=mv_newton_help(!c,!k);
56.1030 + ppl:= !c;
56.1031 + if !c=[] then () else c1:=(hd(!c))::(!c1)
56.1032 + );
56.1033 + while hd(!c1)=[] do c1:=tl(!c1);
56.1034 + c1:=rev(!c1);
56.1035 + ppl:= !c1;
56.1036 + mv_newton_add (!c1) 1
56.1037 + end;
56.1038 +
56.1039 +(*. sets the exponents of the first variable to zero .*)
56.1040 +fun mv_null3([]:mv_poly) = []:mv_poly
56.1041 + | mv_null3((x,y)::xs) = (x,0::tl(y))::mv_null3(xs);
56.1042 +
56.1043 +(*. calculates the minimum exponents of a multivariate polynomial .*)
56.1044 +fun mv_min_pp([]:mv_poly)=[]
56.1045 + | mv_min_pp((c,e)::xs)=
56.1046 + let
56.1047 + val y=ref xs;
56.1048 + val x=ref [];
56.1049 + in
56.1050 + (
56.1051 + x:=e;
56.1052 + while length(!y)>0 do
56.1053 + (
56.1054 + x:=(map uv_mod_min) ((!x) ~~ (#2(hd(!y))));
56.1055 + y:=tl(!y)
56.1056 + );
56.1057 + !x
56.1058 + )
56.1059 + end;
56.1060 +
56.1061 +(*. checks if all elements of the list have value zero .*)
56.1062 +fun list_is_null [] = true
56.1063 + | list_is_null (x::xs) = (x=0 andalso list_is_null(xs));
56.1064 +
56.1065 +(* check if main variable is zero*)
56.1066 +fun main_zero (ms : mv_poly) = (list_is_null o (map (hd o #2))) ms;
56.1067 +
56.1068 +(*. calculates the content of an polynomial .*)
56.1069 +fun mv_content([]:mv_poly) = []:mv_poly
56.1070 + | mv_content(p1) =
56.1071 + let
56.1072 + val list=ref (rev(sort (mv_geq LEX_) (mv_shorten(p1,LEX_))));
56.1073 + val test=ref (hd(#2(hd(!list))));
56.1074 + val result=ref [];
56.1075 + val min=(hd(#2(hd(rev(!list)))));
56.1076 + in
56.1077 + (
56.1078 + if length(!list)>1 then
56.1079 + (
56.1080 + while (if length(!list)>0 then (hd(#2(hd(!list)))=(!test)) else false) do
56.1081 + (
56.1082 + result:=(#1(hd(!list)),tl(#2(hd(!list))))::(!result);
56.1083 +
56.1084 + if length(!list)<1 then list:=[]
56.1085 + else list:=tl(!list)
56.1086 +
56.1087 + );
56.1088 + if length(!list)>0 then
56.1089 + (
56.1090 + list:=mv_gcd (!result) (mv_cut(mv_content(!list)))
56.1091 + )
56.1092 + else list:=(!result);
56.1093 + list:=mv_correct(!list,0);
56.1094 + (!list)
56.1095 + )
56.1096 + else
56.1097 + (
56.1098 + mv_null3(!list)
56.1099 + )
56.1100 + )
56.1101 + end
56.1102 +
56.1103 +(*. calculates the primitiv part of a polynomial .*)
56.1104 +and mv_pp([]:mv_poly) = []:mv_poly
56.1105 + | mv_pp(p1) = let
56.1106 + val cont=ref [];
56.1107 + val pp=ref[];
56.1108 + in
56.1109 + cont:=mv_content(p1);
56.1110 + pp:=(#1(mv_division(p1,!cont,LEX_)));
56.1111 + if !pp=[]
56.1112 + then raise error("RATIONALS_MV_PP_EXCEPTION: Invalid Content ")
56.1113 + else (!pp)
56.1114 + end
56.1115 +
56.1116 +(*. calculates the gcd of two multivariate polynomials with a modular approach .*)
56.1117 +and mv_gcd ([]:mv_poly) ([]:mv_poly) :mv_poly= []:mv_poly
56.1118 + | mv_gcd ([]:mv_poly) (p2) :mv_poly= p2:mv_poly
56.1119 + | mv_gcd (p1:mv_poly) ([]) :mv_poly= p1:mv_poly
56.1120 + | mv_gcd ([(x,xs)]:mv_poly) ([(y,ys)]):mv_poly =
56.1121 + let
56.1122 + val xpoly:mv_poly = [(x,xs)];
56.1123 + val ypoly:mv_poly = [(y,ys)];
56.1124 + in
56.1125 + (
56.1126 + if xs=ys then [((gcd_int x y),xs)]
56.1127 + else [((gcd_int x y),(map uv_mod_min)(xs~~ys))]:mv_poly
56.1128 + )
56.1129 + end
56.1130 + | mv_gcd (p1:mv_poly) ([(y,ys)]) :mv_poly=
56.1131 + (
56.1132 + [(gcd_int (uv_content2(p1)) (y),(map uv_mod_min)(mv_min_pp(p1)~~ys))]:mv_poly
56.1133 + )
56.1134 + | mv_gcd ([(y,ys)]:mv_poly) (p2):mv_poly =
56.1135 + (
56.1136 + [(gcd_int (uv_content2(p2)) (y),(map uv_mod_min)(mv_min_pp(p2)~~ys))]:mv_poly
56.1137 + )
56.1138 + | mv_gcd (p1':mv_poly) (p2':mv_poly):mv_poly=
56.1139 + let
56.1140 + val vc=length(#2(hd(p1')));
56.1141 + val cont =
56.1142 + (
56.1143 + if main_zero(mv_content(p1')) andalso
56.1144 + (main_zero(mv_content(p2'))) then
56.1145 + mv_correct((mv_gcd (mv_cut(mv_content(p1'))) (mv_cut(mv_content(p2')))),0)
56.1146 + else
56.1147 + mv_gcd (mv_content(p1')) (mv_content(p2'))
56.1148 + );
56.1149 + val p1= #1(mv_division(p1',mv_content(p1'),LEX_));
56.1150 + val p2= #1(mv_division(p2',mv_content(p2'),LEX_));
56.1151 + val gcd=ref [];
56.1152 + val candidate=ref [];
56.1153 + val interpolation_list=ref [];
56.1154 + val delta=ref [];
56.1155 + val p1r = ref [];
56.1156 + val p2r = ref [];
56.1157 + val p1r' = ref [];
56.1158 + val p2r' = ref [];
56.1159 + val factor=ref [];
56.1160 + val r=ref 0;
56.1161 + val gcd_r=ref [];
56.1162 + val d=ref 0;
56.1163 + val exit=ref 0;
56.1164 + val current_degree=ref 99999; (*. FIXME: unlimited ! .*)
56.1165 + in
56.1166 + (
56.1167 + if vc<2 then (* areUnivariate(p1',p2') *)
56.1168 + (
56.1169 + gcd:=uv_gcd (mv_shorten(p1',LEX_)) (mv_shorten(p2',LEX_))
56.1170 + )
56.1171 + else
56.1172 + (
56.1173 + while !exit=0 do
56.1174 + (
56.1175 + r:=(!r)+1;
56.1176 + p1r := mv_lc(p1,LEX_);
56.1177 + p2r := mv_lc(p2,LEX_);
56.1178 + if main_zero(!p1r) andalso
56.1179 + main_zero(!p2r)
56.1180 + then
56.1181 + (
56.1182 + delta := mv_correct((mv_gcd (mv_cut (!p1r)) (mv_cut (!p2r))),0)
56.1183 + )
56.1184 + else
56.1185 + (
56.1186 + delta := mv_gcd (!p1r) (!p2r)
56.1187 + );
56.1188 + (*if mv_shorten(mv_subs(!p1r,!r),LEX_)=[] andalso
56.1189 + mv_shorten(mv_subs(!p2r,!r),LEX_)=[] *)
56.1190 + if mv_lc2(mv_shorten(mv_subs(!p1r,!r),LEX_),LEX_)=0 andalso
56.1191 + mv_lc2(mv_shorten(mv_subs(!p2r,!r),LEX_),LEX_)=0
56.1192 + then
56.1193 + (
56.1194 + )
56.1195 + else
56.1196 + (
56.1197 + gcd_r:=mv_shorten(mv_gcd (mv_shorten(mv_subs(p1,!r),LEX_))
56.1198 + (mv_shorten(mv_subs(p2,!r),LEX_)) ,LEX_);
56.1199 + gcd_r:= #1(mv_division(mv_mul(mv_correct(mv_subs(!delta,!r),0),!gcd_r,LEX_),
56.1200 + mv_correct(mv_lc(!gcd_r,LEX_),0),LEX_));
56.1201 + d:=mv_deg2(!gcd_r); (* deg(gcd_r,z) *)
56.1202 + if (!d < !current_degree) then
56.1203 + (
56.1204 + current_degree:= !d;
56.1205 + interpolation_list:=mv_correct(!gcd_r,0)::(!interpolation_list)
56.1206 + )
56.1207 + else
56.1208 + (
56.1209 + if (!d = !current_degree) then
56.1210 + (
56.1211 + interpolation_list:=mv_correct(!gcd_r,0)::(!interpolation_list)
56.1212 + )
56.1213 + else ()
56.1214 + )
56.1215 + );
56.1216 + if length(!interpolation_list)> uv_mod_min(mv_deg(p1),mv_deg(p2)) then
56.1217 + (
56.1218 + candidate := mv_newton(rev(!interpolation_list));
56.1219 + if !candidate=[] then ()
56.1220 + else
56.1221 + (
56.1222 + candidate:=mv_pp(!candidate);
56.1223 + if mv_divides(!candidate,p1) andalso mv_divides(!candidate,p2) then
56.1224 + (
56.1225 + gcd:= mv_mul(!candidate,cont,LEX_);
56.1226 + exit:=1
56.1227 + )
56.1228 + else ()
56.1229 + );
56.1230 + interpolation_list:=[mv_correct(!gcd_r,0)]
56.1231 + )
56.1232 + else ()
56.1233 + )
56.1234 + );
56.1235 + (!gcd):mv_poly
56.1236 + )
56.1237 + end;
56.1238 +
56.1239 +
56.1240 +(*. calculates the least common divisor of two polynomials .*)
56.1241 +fun mv_lcm (p1:mv_poly) (p2:mv_poly) :mv_poly =
56.1242 + (
56.1243 + #1(mv_division(mv_mul(p1,p2,LEX_),mv_gcd p1 p2,LEX_))
56.1244 + );
56.1245 +
56.1246 +(*. gets the variables (strings) of a term .*)
56.1247 +fun get_vars(term1) = (map free2str) (vars term1); (*["a","b","c"]; *)
56.1248 +
56.1249 +(*. counts the negative coefficents in a polynomial .*)
56.1250 +fun count_neg ([]:mv_poly) = 0
56.1251 + | count_neg ((c,e)::xs) = if c<0 then 1+count_neg xs
56.1252 + else count_neg xs;
56.1253 +
56.1254 +(*. help function for is_polynomial
56.1255 + checks the order of the operators .*)
56.1256 +fun test_polynomial (Const ("uminus",_) $ Free (str,_)) _ = true (*WN.13.3.03*)
56.1257 + | test_polynomial (t as Free(str,_)) v = true
56.1258 + | test_polynomial (t as Const ("op *",_) $ t1 $ t2) v = if v="^" then false
56.1259 + else (test_polynomial t1 "*") andalso (test_polynomial t2 "*")
56.1260 + | test_polynomial (t as Const ("op +",_) $ t1 $ t2) v = if v="*" orelse v="^" then false
56.1261 + else (test_polynomial t1 " ") andalso (test_polynomial t2 " ")
56.1262 + | test_polynomial (t as Const ("Atools.pow",_) $ t1 $ t2) v = (test_polynomial t1 "^") andalso (test_polynomial t2 "^")
56.1263 + | test_polynomial _ v = false;
56.1264 +
56.1265 +(*. tests if a term is a polynomial .*)
56.1266 +fun is_polynomial t = test_polynomial t " ";
56.1267 +
56.1268 +(*. help function for is_expanded
56.1269 + checks the order of the operators .*)
56.1270 +fun test_exp (t as Free(str,_)) v = true
56.1271 + | test_exp (t as Const ("op *",_) $ t1 $ t2) v = if v="^" then false
56.1272 + else (test_exp t1 "*") andalso (test_exp t2 "*")
56.1273 + | test_exp (t as Const ("op +",_) $ t1 $ t2) v = if v="*" orelse v="^" then false
56.1274 + else (test_exp t1 " ") andalso (test_exp t2 " ")
56.1275 + | test_exp (t as Const ("op -",_) $ t1 $ t2) v = if v="*" orelse v="^" then false
56.1276 + else (test_exp t1 " ") andalso (test_exp t2 " ")
56.1277 + | test_exp (t as Const ("Atools.pow",_) $ t1 $ t2) v = (test_exp t1 "^") andalso (test_exp t2 "^")
56.1278 + | test_exp _ v = false;
56.1279 +
56.1280 +
56.1281 +(*. help function for check_coeff:
56.1282 + converts the term to a list of coefficients .*)
56.1283 +fun term2coef' (t as Free(str,_(*typ*))) v :mv_poly option =
56.1284 + let
56.1285 + val x=ref None;
56.1286 + val len=ref 0;
56.1287 + val vl=ref [];
56.1288 + val vh=ref [];
56.1289 + val i=ref 0;
56.1290 + in
56.1291 + if is_numeral str then
56.1292 + (
56.1293 + Some [(((the o int_of_str) str),mv_null2(v))] handle _ => None
56.1294 + )
56.1295 + else (* variable *)
56.1296 + (
56.1297 + len:=length(v);
56.1298 + vh:=v;
56.1299 + while ((!len)>(!i)) do
56.1300 + (
56.1301 + if str=hd((!vh)) then
56.1302 + (
56.1303 + vl:=1::(!vl)
56.1304 + )
56.1305 + else
56.1306 + (
56.1307 + vl:=0::(!vl)
56.1308 + );
56.1309 + vh:=tl(!vh);
56.1310 + i:=(!i)+1
56.1311 + );
56.1312 + Some [(1,rev(!vl))] handle _ => None
56.1313 + )
56.1314 + end
56.1315 + | term2coef' (Const ("op *",_) $ t1 $ t2) v :mv_poly option=
56.1316 + let
56.1317 + val t1pp=ref [];
56.1318 + val t2pp=ref [];
56.1319 + val t1c=ref 0;
56.1320 + val t2c=ref 0;
56.1321 + in
56.1322 + (
56.1323 + t1pp:=(#2(hd(the(term2coef' t1 v))));
56.1324 + t2pp:=(#2(hd(the(term2coef' t2 v))));
56.1325 + t1c:=(#1(hd(the(term2coef' t1 v))));
56.1326 + t2c:=(#1(hd(the(term2coef' t2 v))));
56.1327 +
56.1328 + Some [( (!t1c)*(!t2c) ,( (map op+) ((!t1pp)~~(!t2pp)) ) )] handle _ => None
56.1329 +
56.1330 + )
56.1331 + end
56.1332 + | term2coef' (Const ("Atools.pow",_) $ (t1 as Free (str1,_)) $ (t2 as Free (str2,_))) v :mv_poly option=
56.1333 + let
56.1334 + val x=ref None;
56.1335 + val len=ref 0;
56.1336 + val vl=ref [];
56.1337 + val vh=ref [];
56.1338 + val vtemp=ref [];
56.1339 + val i=ref 0;
56.1340 + in
56.1341 + (
56.1342 + if (not o is_numeral) str1 andalso is_numeral str2 then
56.1343 + (
56.1344 + len:=length(v);
56.1345 + vh:=v;
56.1346 +
56.1347 + while ((!len)>(!i)) do
56.1348 + (
56.1349 + if str1=hd((!vh)) then
56.1350 + (
56.1351 + vl:=((the o int_of_str) str2)::(!vl)
56.1352 + )
56.1353 + else
56.1354 + (
56.1355 + vl:=0::(!vl)
56.1356 + );
56.1357 + vh:=tl(!vh);
56.1358 + i:=(!i)+1
56.1359 + );
56.1360 + Some [(1,rev(!vl))] handle _ => None
56.1361 + )
56.1362 + else raise error ("RATIONALS_TERM2COEF_EXCEPTION 1: Invalid term")
56.1363 + )
56.1364 + end
56.1365 + | term2coef' (Const ("op +",_) $ t1 $ t2) v :mv_poly option=
56.1366 + (
56.1367 + Some ((the(term2coef' t1 v)) @ (the(term2coef' t2 v))) handle _ => None
56.1368 + )
56.1369 + | term2coef' (Const ("op -",_) $ t1 $ t2) v :mv_poly option=
56.1370 + (
56.1371 + Some ((the(term2coef' t1 v)) @ mv_skalar_mul((the(term2coef' t2 v)),1)) handle _ => None
56.1372 + )
56.1373 + | term2coef' (term) v = raise error ("RATIONALS_TERM2COEF_EXCEPTION 2: Invalid term");
56.1374 +
56.1375 +(*. checks if all coefficients of a polynomial are positiv (except the first) .*)
56.1376 +fun check_coeff t = (* erste Koeffizient kann <0 sein !!! *)
56.1377 + if count_neg(tl(the(term2coef' t (get_vars(t)))))=0 then true
56.1378 + else false;
56.1379 +
56.1380 +(*. checks for expanded term [3] .*)
56.1381 +fun is_expanded t = test_exp t " " andalso check_coeff(t);
56.1382 +
56.1383 +(*WN.7.3.03 Hilfsfunktion f"ur term2poly'*)
56.1384 +fun mk_monom v' p vs =
56.1385 + let fun conv p (v: string) = if v'= v then p else 0
56.1386 + in map (conv p) vs end;
56.1387 +(* mk_monom "y" 5 ["a","b","x","y","z"];
56.1388 +val it = [0,0,0,5,0] : int list*)
56.1389 +
56.1390 +(*. this function converts the term representation into the internal representation mv_poly .*)
56.1391 +fun term2poly' (Const ("uminus",_) $ Free (str,_)) v = (*WN.7.3.03*)
56.1392 + if is_numeral str
56.1393 + then Some [((the o int_of_str) ("-"^str), mk_monom "#" 0 v)]
56.1394 + else Some [(~1, mk_monom str 1 v)]
56.1395 +
56.1396 + | term2poly' (Free(str,_)) v :mv_poly option =
56.1397 + let
56.1398 + val x=ref None;
56.1399 + val len=ref 0;
56.1400 + val vl=ref [];
56.1401 + val vh=ref [];
56.1402 + val i=ref 0;
56.1403 + in
56.1404 + if is_numeral str then
56.1405 + (
56.1406 + Some [(((the o int_of_str) str),mv_null2 v)] handle _ => None
56.1407 + )
56.1408 + else (* variable *)
56.1409 + (
56.1410 + len:=length v;
56.1411 + vh:= v;
56.1412 + while ((!len)>(!i)) do
56.1413 + (
56.1414 + if str=hd((!vh)) then
56.1415 + (
56.1416 + vl:=1::(!vl)
56.1417 + )
56.1418 + else
56.1419 + (
56.1420 + vl:=0::(!vl)
56.1421 + );
56.1422 + vh:=tl(!vh);
56.1423 + i:=(!i)+1
56.1424 + );
56.1425 + Some [(1,rev(!vl))] handle _ => None
56.1426 + )
56.1427 + end
56.1428 + | term2poly' (Const ("op *",_) $ t1 $ t2) v :mv_poly option=
56.1429 + let
56.1430 + val t1pp=ref [];
56.1431 + val t2pp=ref [];
56.1432 + val t1c=ref 0;
56.1433 + val t2c=ref 0;
56.1434 + in
56.1435 + (
56.1436 + t1pp:=(#2(hd(the(term2poly' t1 v))));
56.1437 + t2pp:=(#2(hd(the(term2poly' t2 v))));
56.1438 + t1c:=(#1(hd(the(term2poly' t1 v))));
56.1439 + t2c:=(#1(hd(the(term2poly' t2 v))));
56.1440 +
56.1441 + Some [( (!t1c)*(!t2c) ,( (map op+) ((!t1pp)~~(!t2pp)) ) )]
56.1442 + handle _ => None
56.1443 +
56.1444 + )
56.1445 + end
56.1446 + | term2poly' (Const ("Atools.pow",_) $ (t1 as Free (str1,_)) $
56.1447 + (t2 as Free (str2,_))) v :mv_poly option=
56.1448 + let
56.1449 + val x=ref None;
56.1450 + val len=ref 0;
56.1451 + val vl=ref [];
56.1452 + val vh=ref [];
56.1453 + val vtemp=ref [];
56.1454 + val i=ref 0;
56.1455 + in
56.1456 + (
56.1457 + if (not o is_numeral) str1 andalso is_numeral str2 then
56.1458 + (
56.1459 + len:=length(v);
56.1460 + vh:=v;
56.1461 +
56.1462 + while ((!len)>(!i)) do
56.1463 + (
56.1464 + if str1=hd((!vh)) then
56.1465 + (
56.1466 + vl:=((the o int_of_str) str2)::(!vl)
56.1467 + )
56.1468 + else
56.1469 + (
56.1470 + vl:=0::(!vl)
56.1471 + );
56.1472 + vh:=tl(!vh);
56.1473 + i:=(!i)+1
56.1474 + );
56.1475 + Some [(1,rev(!vl))] handle _ => None
56.1476 + )
56.1477 + else raise error ("RATIONALS_TERM2POLY_EXCEPTION 1: Invalid term")
56.1478 + )
56.1479 + end
56.1480 + | term2poly' (Const ("op +",_) $ t1 $ t2) v :mv_poly option =
56.1481 + (
56.1482 + Some ((the(term2poly' t1 v)) @ (the(term2poly' t2 v))) handle _ => None
56.1483 + )
56.1484 + | term2poly' (Const ("op -",_) $ t1 $ t2) v :mv_poly option =
56.1485 + (
56.1486 + Some ((the(term2poly' t1 v)) @ mv_skalar_mul((the(term2poly' t2 v)),~1)) handle _ => None
56.1487 + )
56.1488 + | term2poly' (term) v = raise error ("RATIONALS_TERM2POLY_EXCEPTION 2: Invalid term");
56.1489 +
56.1490 +(*. translates an Isabelle term into internal representation.
56.1491 + term2poly
56.1492 + fn : term -> (*normalform [2] *)
56.1493 + string list -> (*for ...!!! BITTE DIE ERKLÄRUNG,
56.1494 + DIE DU MIR LETZTES MAL GEGEBEN HAST*)
56.1495 + mv_monom list (*internal representation *)
56.1496 + option (*the translation may fail with None*)
56.1497 +.*)
56.1498 +fun term2poly (t:term) v =
56.1499 + if is_polynomial t then term2poly' t v
56.1500 + else raise error ("term2poly: invalid = "^(term2str t));
56.1501 +
56.1502 +(*. same as term2poly with automatic detection of the variables .*)
56.1503 +fun term2polyx t = term2poly t (((map free2str) o vars) t);
56.1504 +
56.1505 +(*. checks if the term is in expanded polynomial form and converts it into the internal representation .*)
56.1506 +fun expanded2poly (t:term) v =
56.1507 + (*if is_expanded t then*) term2poly' t v
56.1508 + (*else raise error ("RATIONALS_EXPANDED2POLY_EXCEPTION: Invalid Polynomial")*);
56.1509 +
56.1510 +(*. same as expanded2poly with automatic detection of the variables .*)
56.1511 +fun expanded2polyx t = expanded2poly t (((map free2str) o vars) t);
56.1512 +
56.1513 +(*. converts a powerproduct into term representation .*)
56.1514 +fun powerproduct2term(xs,v) =
56.1515 + let
56.1516 + val xss=ref xs;
56.1517 + val vv=ref v;
56.1518 + in
56.1519 + (
56.1520 + while hd(!xss)=0 do
56.1521 + (
56.1522 + xss:=tl(!xss);
56.1523 + vv:=tl(!vv)
56.1524 + );
56.1525 +
56.1526 + if list_is_null(tl(!xss)) then
56.1527 + (
56.1528 + if hd(!xss)=1 then Free(hd(!vv), HOLogic.realT)
56.1529 + else
56.1530 + (
56.1531 + Const("Atools.pow",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1532 + Free(hd(!vv), HOLogic.realT) $ Free(str_of_int (hd(!xss)),HOLogic.realT)
56.1533 + )
56.1534 + )
56.1535 + else
56.1536 + (
56.1537 + if hd(!xss)=1 then
56.1538 + (
56.1539 + Const("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1540 + Free(hd(!vv), HOLogic.realT) $
56.1541 + powerproduct2term(tl(!xss),tl(!vv))
56.1542 + )
56.1543 + else
56.1544 + (
56.1545 + Const("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1546 + (
56.1547 + Const("Atools.pow",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1548 + Free(hd(!vv), HOLogic.realT) $ Free(str_of_int (hd(!xss)),HOLogic.realT)
56.1549 + ) $
56.1550 + powerproduct2term(tl(!xss),tl(!vv))
56.1551 + )
56.1552 + )
56.1553 + )
56.1554 + end;
56.1555 +
56.1556 +(*. converts a monom into term representation .*)
56.1557 +(*fun monom2term ((c,e):mv_monom, v:string list) =
56.1558 + if c=0 then Free(str_of_int 0,HOLogic.realT)
56.1559 + else
56.1560 + (
56.1561 + if list_is_null(e) then
56.1562 + (
56.1563 + Free(str_of_int c,HOLogic.realT)
56.1564 + )
56.1565 + else
56.1566 + (
56.1567 + if c=1 then
56.1568 + (
56.1569 + powerproduct2term(e,v)
56.1570 + )
56.1571 + else
56.1572 + (
56.1573 + Const("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1574 + Free(str_of_int c,HOLogic.realT) $
56.1575 + powerproduct2term(e,v)
56.1576 + )
56.1577 + )
56.1578 + );*)
56.1579 +
56.1580 +
56.1581 +(*fun monom2term ((i, is):mv_monom, v) =
56.1582 + if list_is_null is
56.1583 + then
56.1584 + if i >= 0
56.1585 + then Free (str_of_int i, HOLogic.realT)
56.1586 + else Const ("uminus", HOLogic.realT --> HOLogic.realT) $
56.1587 + Free ((str_of_int o abs) i, HOLogic.realT)
56.1588 + else
56.1589 + if i > 0
56.1590 + then Const ("op *", [HOLogic.realT,HOLogic.realT]---> HOLogic.realT) $
56.1591 + (Free (str_of_int i, HOLogic.realT)) $
56.1592 + powerproduct2term(is, v)
56.1593 + else Const ("op *", [HOLogic.realT,HOLogic.realT]---> HOLogic.realT) $
56.1594 + (Const ("uminus", HOLogic.realT --> HOLogic.realT) $
56.1595 + Free ((str_of_int o abs) i, HOLogic.realT)) $
56.1596 + powerproduct2term(is, vs);---------------------------*)
56.1597 +fun monom2term ((i, is) : mv_monom, vs) =
56.1598 + if list_is_null is
56.1599 + then Free (str_of_int i, HOLogic.realT)
56.1600 + else if i = 1
56.1601 + then powerproduct2term (is, vs)
56.1602 + else Const ("op *", [HOLogic.realT, HOLogic.realT] ---> HOLogic.realT) $
56.1603 + (Free (str_of_int i, HOLogic.realT)) $
56.1604 + powerproduct2term (is, vs);
56.1605 +
56.1606 +(*. converts the internal polynomial representation into an Isabelle term.*)
56.1607 +fun poly2term' ([] : mv_poly, vs) = Free(str_of_int 0, HOLogic.realT)
56.1608 + | poly2term' ([(c, e) : mv_monom], vs) = monom2term ((c, e), vs)
56.1609 + | poly2term' ((c, e) :: ces, vs) =
56.1610 + Const("op +", [HOLogic.realT, HOLogic.realT] ---> HOLogic.realT) $
56.1611 + poly2term (ces, vs) $ monom2term ((c, e), vs)
56.1612 +and poly2term (xs, vs) = poly2term' (rev (sort (mv_geq LEX_) (xs)), vs);
56.1613 +
56.1614 +
56.1615 +(*. converts a monom into term representation .*)
56.1616 +(*. ignores the sign of the coefficients => use only for exp-poly functions .*)
56.1617 +fun monom2term2((c,e):mv_monom, v:string list) =
56.1618 + if c=0 then Free(str_of_int 0,HOLogic.realT)
56.1619 + else
56.1620 + (
56.1621 + if list_is_null(e) then
56.1622 + (
56.1623 + Free(str_of_int (abs(c)),HOLogic.realT)
56.1624 + )
56.1625 + else
56.1626 + (
56.1627 + if abs(c)=1 then
56.1628 + (
56.1629 + powerproduct2term(e,v)
56.1630 + )
56.1631 + else
56.1632 + (
56.1633 + Const("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1634 + Free(str_of_int (abs(c)),HOLogic.realT) $
56.1635 + powerproduct2term(e,v)
56.1636 + )
56.1637 + )
56.1638 + );
56.1639 +
56.1640 +(*. converts the expanded polynomial representation into the term representation .*)
56.1641 +fun exp2term' ([]:mv_poly,vars) = Free(str_of_int 0,HOLogic.realT)
56.1642 + | exp2term' ([(c,e)],vars) = monom2term((c,e),vars)
56.1643 + | exp2term' ((c1,e1)::others,vars) =
56.1644 + if c1<0 then
56.1645 + Const("op -",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1646 + exp2term'(others,vars) $
56.1647 + (
56.1648 + monom2term2((c1,e1),vars)
56.1649 + )
56.1650 + else
56.1651 + Const("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1652 + exp2term'(others,vars) $
56.1653 + (
56.1654 + monom2term2((c1,e1),vars)
56.1655 + );
56.1656 +
56.1657 +(*. sorts the powerproduct by lexicographic termorder and converts them into
56.1658 + a term in polynomial representation .*)
56.1659 +fun poly2expanded (xs,vars) = exp2term'(rev(sort (mv_geq LEX_) (xs)),vars);
56.1660 +
56.1661 +(*. converts a polynomial into expanded form .*)
56.1662 +fun polynomial2expanded t =
56.1663 + (let
56.1664 + val vars=(((map free2str) o vars) t);
56.1665 + in
56.1666 + Some (poly2expanded (the (term2poly t vars), vars))
56.1667 + end) handle _ => None;
56.1668 +
56.1669 +(*. converts a polynomial into polynomial form .*)
56.1670 +fun expanded2polynomial t =
56.1671 + (let
56.1672 + val vars=(((map free2str) o vars) t);
56.1673 + in
56.1674 + Some (poly2term (the (expanded2poly t vars), vars))
56.1675 + end) handle _ => None;
56.1676 +
56.1677 +
56.1678 +(*. calculates the greatest common divisor of numerator and denominator and seperates it from each .*)
56.1679 +fun step_cancel (t as Const ("HOL.divide",_) $ p1 $ p2) =
56.1680 + let
56.1681 + val p1' = ref [];
56.1682 + val p2' = ref [];
56.1683 + val p3 = ref []
56.1684 + val vars = rev(get_vars(p1) union get_vars(p2));
56.1685 + in
56.1686 + (
56.1687 + p1':= sort (mv_geq LEX_) (the (term2poly p1 vars ));
56.1688 + p2':= sort (mv_geq LEX_) (the (term2poly p2 vars ));
56.1689 + p3:= sort (mv_geq LEX_) (mv_gcd (!p1') (!p2'));
56.1690 + if (!p3)=[(1,mv_null2(vars))] then
56.1691 + (
56.1692 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $ p1 $ p2
56.1693 + )
56.1694 + else
56.1695 + (
56.1696 +
56.1697 + p1':=sort (mv_geq LEX_) (#1(mv_division((!p1'),(!p3),LEX_)));
56.1698 + p2':=sort (mv_geq LEX_) (#1(mv_division((!p2'),(!p3),LEX_)));
56.1699 +
56.1700 + if #1(hd(sort (mv_geq LEX_) (!p2'))) (*mv_lc2(!p2',LEX_)*)>0 then
56.1701 + (
56.1702 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1703 + $
56.1704 + (
56.1705 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1706 + poly2term(!p1',vars) $
56.1707 + poly2term(!p3,vars)
56.1708 + )
56.1709 + $
56.1710 + (
56.1711 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1712 + poly2term(!p2',vars) $
56.1713 + poly2term(!p3,vars)
56.1714 + )
56.1715 + )
56.1716 + else
56.1717 + (
56.1718 + p1':=mv_skalar_mul(!p1',~1);
56.1719 + p2':=mv_skalar_mul(!p2',~1);
56.1720 + p3:=mv_skalar_mul(!p3,~1);
56.1721 + (
56.1722 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1723 + $
56.1724 + (
56.1725 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1726 + poly2term(!p1',vars) $
56.1727 + poly2term(!p3,vars)
56.1728 + )
56.1729 + $
56.1730 + (
56.1731 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1732 + poly2term(!p2',vars) $
56.1733 + poly2term(!p3,vars)
56.1734 + )
56.1735 + )
56.1736 + )
56.1737 + )
56.1738 + )
56.1739 + end
56.1740 +| step_cancel _ = raise error ("RATIONALS_STEP_CANCEL_EXCEPTION: Invalid fraction");
56.1741 +
56.1742 +
56.1743 +(*. same as step_cancel, this time for expanded forms (input+output) .*)
56.1744 +fun step_cancel_expanded (t as Const ("HOL.divide",_) $ p1 $ p2) =
56.1745 + let
56.1746 + val p1' = ref [];
56.1747 + val p2' = ref [];
56.1748 + val p3 = ref []
56.1749 + val vars = rev(get_vars(p1) union get_vars(p2));
56.1750 + in
56.1751 + (
56.1752 + p1':= sort (mv_geq LEX_) (the (expanded2poly p1 vars ));
56.1753 + p2':= sort (mv_geq LEX_) (the (expanded2poly p2 vars ));
56.1754 + p3:= sort (mv_geq LEX_) (mv_gcd (!p1') (!p2'));
56.1755 + if (!p3)=[(1,mv_null2(vars))] then
56.1756 + (
56.1757 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $ p1 $ p2
56.1758 + )
56.1759 + else
56.1760 + (
56.1761 +
56.1762 + p1':=sort (mv_geq LEX_) (#1(mv_division((!p1'),(!p3),LEX_)));
56.1763 + p2':=sort (mv_geq LEX_) (#1(mv_division((!p2'),(!p3),LEX_)));
56.1764 +
56.1765 + if #1(hd(sort (mv_geq LEX_) (!p2')))(* mv_lc2(!p2',LEX_)*)>0 then
56.1766 + (
56.1767 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1768 + $
56.1769 + (
56.1770 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1771 + poly2expanded(!p1',vars) $
56.1772 + poly2expanded(!p3,vars)
56.1773 + )
56.1774 + $
56.1775 + (
56.1776 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1777 + poly2expanded(!p2',vars) $
56.1778 + poly2expanded(!p3,vars)
56.1779 + )
56.1780 + )
56.1781 + else
56.1782 + (
56.1783 + p1':=mv_skalar_mul(!p1',~1);
56.1784 + p2':=mv_skalar_mul(!p2',~1);
56.1785 + p3:=mv_skalar_mul(!p3,~1);
56.1786 + (
56.1787 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1788 + $
56.1789 + (
56.1790 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1791 + poly2expanded(!p1',vars) $
56.1792 + poly2expanded(!p3,vars)
56.1793 + )
56.1794 + $
56.1795 + (
56.1796 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.1797 + poly2expanded(!p2',vars) $
56.1798 + poly2expanded(!p3,vars)
56.1799 + )
56.1800 + )
56.1801 + )
56.1802 + )
56.1803 + )
56.1804 + end
56.1805 +| step_cancel_expanded _ = raise error ("RATIONALS_STEP_CANCEL_EXCEPTION: Invalid fraction");
56.1806 +
56.1807 +(*. calculates the greatest common divisor of numerator and denominator and divides each through it .*)
56.1808 +fun direct_cancel (t as Const ("HOL.divide",_) $ p1 $ p2) =
56.1809 + let
56.1810 + val p1' = ref [];
56.1811 + val p2' = ref [];
56.1812 + val p3 = ref []
56.1813 + val vars = rev(get_vars(p1) union get_vars(p2));
56.1814 + in
56.1815 + (
56.1816 + p1':=sort (mv_geq LEX_) (mv_shorten((the (term2poly p1 vars )),LEX_));
56.1817 + p2':=sort (mv_geq LEX_) (mv_shorten((the (term2poly p2 vars )),LEX_));
56.1818 + p3 :=sort (mv_geq LEX_) (mv_gcd (!p1') (!p2'));
56.1819 +
56.1820 + if (!p3)=[(1,mv_null2(vars))] then
56.1821 + (
56.1822 + (Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $ p1 $ p2,[])
56.1823 + )
56.1824 + else
56.1825 + (
56.1826 + p1':=sort (mv_geq LEX_) (#1(mv_division((!p1'),(!p3),LEX_)));
56.1827 + p2':=sort (mv_geq LEX_) (#1(mv_division((!p2'),(!p3),LEX_)));
56.1828 + if #1(hd(sort (mv_geq LEX_) (!p2'))) (*mv_lc2(!p2',LEX_)*)>0 then
56.1829 + (
56.1830 + (
56.1831 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1832 + $
56.1833 + (
56.1834 + poly2term((!p1'),vars)
56.1835 + )
56.1836 + $
56.1837 + (
56.1838 + poly2term((!p2'),vars)
56.1839 + )
56.1840 + )
56.1841 + ,
56.1842 + if mv_grad(!p3)>0 then
56.1843 + [
56.1844 + (
56.1845 + Const ("Not",[bool]--->bool) $
56.1846 + (
56.1847 + Const("op =",[HOLogic.realT,HOLogic.realT]--->bool) $
56.1848 + poly2term((!p3),vars) $
56.1849 + Free("0",HOLogic.realT)
56.1850 + )
56.1851 + )
56.1852 + ]
56.1853 + else
56.1854 + []
56.1855 + )
56.1856 + else
56.1857 + (
56.1858 + p1':=mv_skalar_mul(!p1',~1);
56.1859 + p2':=mv_skalar_mul(!p2',~1);
56.1860 + if length(!p3)> 2*(count_neg(!p3)) then () else p3 :=mv_skalar_mul(!p3,~1);
56.1861 + (
56.1862 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1863 + $
56.1864 + (
56.1865 + poly2term((!p1'),vars)
56.1866 + )
56.1867 + $
56.1868 + (
56.1869 + poly2term((!p2'),vars)
56.1870 + )
56.1871 + ,
56.1872 + if mv_grad(!p3)>0 then
56.1873 + [
56.1874 + (
56.1875 + Const ("Not",[bool]--->bool) $
56.1876 + (
56.1877 + Const("op =",[HOLogic.realT,HOLogic.realT]--->bool) $
56.1878 + poly2term((!p3),vars) $
56.1879 + Free("0",HOLogic.realT)
56.1880 + )
56.1881 + )
56.1882 + ]
56.1883 + else
56.1884 + []
56.1885 + )
56.1886 + )
56.1887 + )
56.1888 + )
56.1889 + end
56.1890 + | direct_cancel _ = raise error ("RATIONALS_DIRECT_CANCEL_EXCEPTION: Invalid fraction");
56.1891 +
56.1892 +(*. same es direct_cancel, this time for expanded forms (input+output).*)
56.1893 +fun direct_cancel_expanded (t as Const ("HOL.divide",_) $ p1 $ p2) =
56.1894 + let
56.1895 + val p1' = ref [];
56.1896 + val p2' = ref [];
56.1897 + val p3 = ref []
56.1898 + val vars = rev(get_vars(p1) union get_vars(p2));
56.1899 + in
56.1900 + (
56.1901 + p1':=sort (mv_geq LEX_) (mv_shorten((the (expanded2poly p1 vars )),LEX_));
56.1902 + p2':=sort (mv_geq LEX_) (mv_shorten((the (expanded2poly p2 vars )),LEX_));
56.1903 + p3 :=sort (mv_geq LEX_) (mv_gcd (!p1') (!p2'));
56.1904 +
56.1905 + if (!p3)=[(1,mv_null2(vars))] then
56.1906 + (
56.1907 + (Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $ p1 $ p2,[])
56.1908 + )
56.1909 + else
56.1910 + (
56.1911 + p1':=sort (mv_geq LEX_) (#1(mv_division((!p1'),(!p3),LEX_)));
56.1912 + p2':=sort (mv_geq LEX_) (#1(mv_division((!p2'),(!p3),LEX_)));
56.1913 + if #1(hd(sort (mv_geq LEX_) (!p2'))) (*mv_lc2(!p2',LEX_)*)>0 then
56.1914 + (
56.1915 + (
56.1916 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1917 + $
56.1918 + (
56.1919 + poly2expanded((!p1'),vars)
56.1920 + )
56.1921 + $
56.1922 + (
56.1923 + poly2expanded((!p2'),vars)
56.1924 + )
56.1925 + )
56.1926 + ,
56.1927 + if mv_grad(!p3)>0 then
56.1928 + [
56.1929 + (
56.1930 + Const ("Not",[bool]--->bool) $
56.1931 + (
56.1932 + Const("op =",[HOLogic.realT,HOLogic.realT]--->bool) $
56.1933 + poly2expanded((!p3),vars) $
56.1934 + Free("0",HOLogic.realT)
56.1935 + )
56.1936 + )
56.1937 + ]
56.1938 + else
56.1939 + []
56.1940 + )
56.1941 + else
56.1942 + (
56.1943 + p1':=mv_skalar_mul(!p1',~1);
56.1944 + p2':=mv_skalar_mul(!p2',~1);
56.1945 + if length(!p3)> 2*(count_neg(!p3)) then () else p3 :=mv_skalar_mul(!p3,~1);
56.1946 + (
56.1947 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.1948 + $
56.1949 + (
56.1950 + poly2expanded((!p1'),vars)
56.1951 + )
56.1952 + $
56.1953 + (
56.1954 + poly2expanded((!p2'),vars)
56.1955 + )
56.1956 + ,
56.1957 + if mv_grad(!p3)>0 then
56.1958 + [
56.1959 + (
56.1960 + Const ("Not",[bool]--->bool) $
56.1961 + (
56.1962 + Const("op =",[HOLogic.realT,HOLogic.realT]--->bool) $
56.1963 + poly2expanded((!p3),vars) $
56.1964 + Free("0",HOLogic.realT)
56.1965 + )
56.1966 + )
56.1967 + ]
56.1968 + else
56.1969 + []
56.1970 + )
56.1971 + )
56.1972 + )
56.1973 + )
56.1974 + end
56.1975 + | direct_cancel_expanded _ = raise error ("RATIONALS_DIRECT_CANCEL_EXCEPTION: Invalid fraction");
56.1976 +
56.1977 +
56.1978 +(*. adds two fractions .*)
56.1979 +fun add_fract ((Const("HOL.divide",_) $ t11 $ t12),(Const("HOL.divide",_) $ t21 $ t22)) =
56.1980 + let
56.1981 + val vars=get_vars(t11) union get_vars(t12) union get_vars(t21) union get_vars(t22);
56.1982 + val t11'=ref (the(term2poly t11 vars));
56.1983 +val _= writeln"### add_fract: done t11"
56.1984 + val t12'=ref (the(term2poly t12 vars));
56.1985 +val _= writeln"### add_fract: done t12"
56.1986 + val t21'=ref (the(term2poly t21 vars));
56.1987 +val _= writeln"### add_fract: done t21"
56.1988 + val t22'=ref (the(term2poly t22 vars));
56.1989 +val _= writeln"### add_fract: done t22"
56.1990 + val den=ref [];
56.1991 + val nom=ref [];
56.1992 + val m1=ref [];
56.1993 + val m2=ref [];
56.1994 + in
56.1995 +
56.1996 + (
56.1997 + den :=sort (mv_geq LEX_) (mv_lcm (!t12') (!t22'));
56.1998 +writeln"### add_fract: done sort mv_lcm";
56.1999 + m1 :=sort (mv_geq LEX_) (#1(mv_division(!den,!t12',LEX_)));
56.2000 +writeln"### add_fract: done sort mv_division t12";
56.2001 + m2 :=sort (mv_geq LEX_) (#1(mv_division(!den,!t22',LEX_)));
56.2002 +writeln"### add_fract: done sort mv_division t22";
56.2003 + nom :=sort (mv_geq LEX_)
56.2004 + (mv_shorten(mv_add(mv_mul(!t11',!m1,LEX_),
56.2005 + mv_mul(!t21',!m2,LEX_),
56.2006 + LEX_),
56.2007 + LEX_));
56.2008 +writeln"### add_fract: done sort mv_add";
56.2009 + (
56.2010 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2011 + $
56.2012 + (
56.2013 + poly2term((!nom),vars)
56.2014 + )
56.2015 + $
56.2016 + (
56.2017 + poly2term((!den),vars)
56.2018 + )
56.2019 + )
56.2020 + )
56.2021 + end
56.2022 + | add_fract (_,_) = raise error ("RATIONALS_ADD_FRACTION_EXCEPTION: Invalid add_fraction call");
56.2023 +
56.2024 +(*. adds two expanded fractions .*)
56.2025 +fun add_fract_exp ((Const("HOL.divide",_) $ t11 $ t12),(Const("HOL.divide",_) $ t21 $ t22)) =
56.2026 + let
56.2027 + val vars=get_vars(t11) union get_vars(t12) union get_vars(t21) union get_vars(t22);
56.2028 + val t11'=ref (the(expanded2poly t11 vars));
56.2029 + val t12'=ref (the(expanded2poly t12 vars));
56.2030 + val t21'=ref (the(expanded2poly t21 vars));
56.2031 + val t22'=ref (the(expanded2poly t22 vars));
56.2032 + val den=ref [];
56.2033 + val nom=ref [];
56.2034 + val m1=ref [];
56.2035 + val m2=ref [];
56.2036 + in
56.2037 +
56.2038 + (
56.2039 + den :=sort (mv_geq LEX_) (mv_lcm (!t12') (!t22'));
56.2040 + m1 :=sort (mv_geq LEX_) (#1(mv_division(!den,!t12',LEX_)));
56.2041 + m2 :=sort (mv_geq LEX_) (#1(mv_division(!den,!t22',LEX_)));
56.2042 + nom :=sort (mv_geq LEX_) (mv_shorten(mv_add(mv_mul(!t11',!m1,LEX_),mv_mul(!t21',!m2,LEX_),LEX_),LEX_));
56.2043 + (
56.2044 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2045 + $
56.2046 + (
56.2047 + poly2expanded((!nom),vars)
56.2048 + )
56.2049 + $
56.2050 + (
56.2051 + poly2expanded((!den),vars)
56.2052 + )
56.2053 + )
56.2054 + )
56.2055 + end
56.2056 + | add_fract_exp (_,_) = raise error ("RATIONALS_ADD_FRACTION_EXP_EXCEPTION: Invalid add_fraction call");
56.2057 +
56.2058 +(*. adds a list of terms .*)
56.2059 +fun add_list_of_fractions []= (Free("0",HOLogic.realT),[])
56.2060 + | add_list_of_fractions [x]= direct_cancel x
56.2061 + | add_list_of_fractions (x::y::xs) =
56.2062 + let
56.2063 + val (t1a,rest1)=direct_cancel(x);
56.2064 +val _= writeln"### add_list_of_fractions xs: has done direct_cancel(x)";
56.2065 + val (t2a,rest2)=direct_cancel(y);
56.2066 +val _= writeln"### add_list_of_fractions xs: has done direct_cancel(y)";
56.2067 + val (t3a,rest3)=(add_list_of_fractions (add_fract(t1a,t2a)::xs));
56.2068 +val _= writeln"### add_list_of_fractions xs: has done add_list_of_fraction xs";
56.2069 + val (t4a,rest4)=direct_cancel(t3a);
56.2070 +val _= writeln"### add_list_of_fractions xs: has done direct_cancel(t3a)";
56.2071 + val rest=rest1 union rest2 union rest3 union rest4;
56.2072 + in
56.2073 + (writeln"### add_list_of_fractions in";
56.2074 + (
56.2075 + (t4a,rest)
56.2076 + )
56.2077 + )
56.2078 + end;
56.2079 +
56.2080 +(*. adds a list of expanded terms .*)
56.2081 +fun add_list_of_fractions_exp []= (Free("0",HOLogic.realT),[])
56.2082 + | add_list_of_fractions_exp [x]= direct_cancel_expanded x
56.2083 + | add_list_of_fractions_exp (x::y::xs) =
56.2084 + let
56.2085 + val (t1a,rest1)=direct_cancel_expanded(x);
56.2086 + val (t2a,rest2)=direct_cancel_expanded(y);
56.2087 + val (t3a,rest3)=(add_list_of_fractions_exp (add_fract_exp(t1a,t2a)::xs));
56.2088 + val (t4a,rest4)=direct_cancel_expanded(t3a);
56.2089 + val rest=rest1 union rest2 union rest3 union rest4;
56.2090 + in
56.2091 + (
56.2092 + (t4a,rest)
56.2093 + )
56.2094 + end;
56.2095 +
56.2096 +(*. calculates the lcm of a list of mv_poly .*)
56.2097 +fun calc_lcm ([x],var)= (x,var)
56.2098 + | calc_lcm ((x::xs),var) = (mv_lcm x (#1(calc_lcm (xs,var))),var);
56.2099 +
56.2100 +(*. converts a list of terms to a list of mv_poly .*)
56.2101 +fun t2d([],_)=[]
56.2102 + | t2d((t as (Const("HOL.divide",_) $ p1 $ p2))::xs,vars)= (the(term2poly p2 vars)) :: t2d(xs,vars);
56.2103 +
56.2104 +(*. same as t2d, this time for expanded forms .*)
56.2105 +fun t2d_exp([],_)=[]
56.2106 + | t2d_exp((t as (Const("HOL.divide",_) $ p1 $ p2))::xs,vars)= (the(expanded2poly p2 vars)) :: t2d_exp(xs,vars);
56.2107 +
56.2108 +(*. converts a list of fract terms to a list of their denominators .*)
56.2109 +fun termlist2denominators [] = ([],[])
56.2110 + | termlist2denominators xs =
56.2111 + let
56.2112 + val xxs=ref xs;
56.2113 + val var=ref [];
56.2114 + in
56.2115 + var:=[];
56.2116 + while length(!xxs)>0 do
56.2117 + (
56.2118 + let
56.2119 + val (t as Const ("HOL.divide",_) $ p1x $ p2x)=hd(!xxs);
56.2120 + in
56.2121 + (
56.2122 + xxs:=tl(!xxs);
56.2123 + var:=((get_vars(p2x)) union (get_vars(p1x)) union (!var))
56.2124 + )
56.2125 + end
56.2126 + );
56.2127 + (t2d(xs,!var),!var)
56.2128 + end;
56.2129 +
56.2130 +(*. calculates the lcm of a list of mv_poly .*)
56.2131 +fun calc_lcm ([x],var)= (x,var)
56.2132 + | calc_lcm ((x::xs),var) = (mv_lcm x (#1(calc_lcm (xs,var))),var);
56.2133 +
56.2134 +(*. converts a list of terms to a list of mv_poly .*)
56.2135 +fun t2d([],_)=[]
56.2136 + | t2d((t as (Const("HOL.divide",_) $ p1 $ p2))::xs,vars)= (the(term2poly p2 vars)) :: t2d(xs,vars);
56.2137 +
56.2138 +(*. same as t2d, this time for expanded forms .*)
56.2139 +fun t2d_exp([],_)=[]
56.2140 + | t2d_exp((t as (Const("HOL.divide",_) $ p1 $ p2))::xs,vars)= (the(expanded2poly p2 vars)) :: t2d_exp(xs,vars);
56.2141 +
56.2142 +(*. converts a list of fract terms to a list of their denominators .*)
56.2143 +fun termlist2denominators [] = ([],[])
56.2144 + | termlist2denominators xs =
56.2145 + let
56.2146 + val xxs=ref xs;
56.2147 + val var=ref [];
56.2148 + in
56.2149 + var:=[];
56.2150 + while length(!xxs)>0 do
56.2151 + (
56.2152 + let
56.2153 + val (t as Const ("HOL.divide",_) $ p1x $ p2x)=hd(!xxs);
56.2154 + in
56.2155 + (
56.2156 + xxs:=tl(!xxs);
56.2157 + var:=((get_vars(p2x)) union (get_vars(p1x)) union (!var))
56.2158 + )
56.2159 + end
56.2160 + );
56.2161 + (t2d(xs,!var),!var)
56.2162 + end;
56.2163 +
56.2164 +(*. same as termlist2denminators, this time for expanded forms .*)
56.2165 +fun termlist2denominators_exp [] = ([],[])
56.2166 + | termlist2denominators_exp xs =
56.2167 + let
56.2168 + val xxs=ref xs;
56.2169 + val var=ref [];
56.2170 + in
56.2171 + var:=[];
56.2172 + while length(!xxs)>0 do
56.2173 + (
56.2174 + let
56.2175 + val (t as Const ("HOL.divide",_) $ p1x $ p2x)=hd(!xxs);
56.2176 + in
56.2177 + (
56.2178 + xxs:=tl(!xxs);
56.2179 + var:=((get_vars(p2x)) union (get_vars(p1x)) union (!var))
56.2180 + )
56.2181 + end
56.2182 + );
56.2183 + (t2d_exp(xs,!var),!var)
56.2184 + end;
56.2185 +
56.2186 +(*. reduces all fractions to the least common denominator .*)
56.2187 +fun com_den(x::xs,denom,den,var)=
56.2188 + let
56.2189 + val (t as Const ("HOL.divide",_) $ p1' $ p2')=x;
56.2190 + val p2= sort (mv_geq LEX_) (the(term2poly p2' var));
56.2191 + val p3= #1(mv_division(denom,p2,LEX_));
56.2192 + val p1var=get_vars(p1');
56.2193 + in
56.2194 + if length(xs)>0 then
56.2195 + if p3=[(1,mv_null2(var))] then
56.2196 + (
56.2197 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2198 + $
56.2199 + (
56.2200 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2201 + $
56.2202 + poly2term(the (term2poly p1' p1var),p1var)
56.2203 + $
56.2204 + den
56.2205 + )
56.2206 + $
56.2207 + #1(com_den(xs,denom,den,var))
56.2208 + ,
56.2209 + []
56.2210 + )
56.2211 + else
56.2212 + (
56.2213 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2214 + $
56.2215 + (
56.2216 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2217 + $
56.2218 + (
56.2219 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2220 + poly2term(the (term2poly p1' p1var),p1var) $
56.2221 + poly2term(p3,var)
56.2222 + )
56.2223 + $
56.2224 + (
56.2225 + den
56.2226 + )
56.2227 + )
56.2228 + $
56.2229 + #1(com_den(xs,denom,den,var))
56.2230 + ,
56.2231 + []
56.2232 + )
56.2233 + else
56.2234 + if p3=[(1,mv_null2(var))] then
56.2235 + (
56.2236 + (
56.2237 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2238 + $
56.2239 + poly2term(the (term2poly p1' p1var),p1var)
56.2240 + $
56.2241 + den
56.2242 + )
56.2243 + ,
56.2244 + []
56.2245 + )
56.2246 + else
56.2247 + (
56.2248 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2249 + $
56.2250 + (
56.2251 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2252 + poly2term(the (term2poly p1' p1var),p1var) $
56.2253 + poly2term(p3,var)
56.2254 + )
56.2255 + $
56.2256 + den
56.2257 + ,
56.2258 + []
56.2259 + )
56.2260 + end;
56.2261 +
56.2262 +(*. same as com_den, this time for expanded forms .*)
56.2263 +fun com_den_exp(x::xs,denom,den,var)=
56.2264 + let
56.2265 + val (t as Const ("HOL.divide",_) $ p1' $ p2')=x;
56.2266 + val p2= sort (mv_geq LEX_) (the(expanded2poly p2' var));
56.2267 + val p3= #1(mv_division(denom,p2,LEX_));
56.2268 + val p1var=get_vars(p1');
56.2269 + in
56.2270 + if length(xs)>0 then
56.2271 + if p3=[(1,mv_null2(var))] then
56.2272 + (
56.2273 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2274 + $
56.2275 + (
56.2276 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2277 + $
56.2278 + poly2expanded(the(expanded2poly p1' p1var),p1var)
56.2279 + $
56.2280 + den
56.2281 + )
56.2282 + $
56.2283 + #1(com_den_exp(xs,denom,den,var))
56.2284 + ,
56.2285 + []
56.2286 + )
56.2287 + else
56.2288 + (
56.2289 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2290 + $
56.2291 + (
56.2292 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2293 + $
56.2294 + (
56.2295 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2296 + poly2expanded(the(expanded2poly p1' p1var),p1var) $
56.2297 + poly2expanded(p3,var)
56.2298 + )
56.2299 + $
56.2300 + (
56.2301 + den
56.2302 + )
56.2303 + )
56.2304 + $
56.2305 + #1(com_den_exp(xs,denom,den,var))
56.2306 + ,
56.2307 + []
56.2308 + )
56.2309 + else
56.2310 + if p3=[(1,mv_null2(var))] then
56.2311 + (
56.2312 + (
56.2313 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2314 + $
56.2315 + poly2expanded(the(expanded2poly p1' p1var),p1var)
56.2316 + $
56.2317 + den
56.2318 + )
56.2319 + ,
56.2320 + []
56.2321 + )
56.2322 + else
56.2323 + (
56.2324 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
56.2325 + $
56.2326 + (
56.2327 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2328 + poly2expanded(the(expanded2poly p1' p1var),p1var) $
56.2329 + poly2expanded(p3,var)
56.2330 + )
56.2331 + $
56.2332 + den
56.2333 + ,
56.2334 + []
56.2335 + )
56.2336 + end;
56.2337 +
56.2338 +(* wird aktuell nicht mehr gebraucht, bei rückänderung schon
56.2339 +-------------------------------------------------------------
56.2340 +(* WN0210???SK brauch ma des überhaupt *)
56.2341 +fun com_den2(x::xs,denom,den,var)=
56.2342 + let
56.2343 + val (t as Const ("HOL.divide",_) $ p1' $ p2')=x;
56.2344 + val p2= sort (mv_geq LEX_) (the(term2poly p2' var));
56.2345 + val p3= #1(mv_division(denom,p2,LEX_));
56.2346 + val p1var=get_vars(p1');
56.2347 + in
56.2348 + if length(xs)>0 then
56.2349 + if p3=[(1,mv_null2(var))] then
56.2350 + (
56.2351 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2352 + poly2term(the(term2poly p1' p1var),p1var) $
56.2353 + com_den2(xs,denom,den,var)
56.2354 + )
56.2355 + else
56.2356 + (
56.2357 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2358 + (
56.2359 + let
56.2360 + val p3'=poly2term(p3,var);
56.2361 + val vars= (((map free2str) o vars) p1') union (((map free2str) o vars) p3');
56.2362 + in
56.2363 + poly2term(sort (mv_geq LEX_) (mv_mul(the(term2poly p1' vars) ,the(term2poly p3' vars),LEX_)),vars)
56.2364 + end
56.2365 + ) $
56.2366 + com_den2(xs,denom,den,var)
56.2367 + )
56.2368 + else
56.2369 + if p3=[(1,mv_null2(var))] then
56.2370 + (
56.2371 + poly2term(the(term2poly p1' p1var),p1var)
56.2372 + )
56.2373 + else
56.2374 + (
56.2375 + let
56.2376 + val p3'=poly2term(p3,var);
56.2377 + val vars= (((map free2str) o vars) p1') union (((map free2str) o vars) p3');
56.2378 + in
56.2379 + poly2term(sort (mv_geq LEX_) (mv_mul(the(term2poly p1' vars) ,the(term2poly p3' vars),LEX_)),vars)
56.2380 + end
56.2381 + )
56.2382 + end;
56.2383 +
56.2384 +(* WN0210???SK brauch ma des überhaupt *)
56.2385 +fun com_den_exp2(x::xs,denom,den,var)=
56.2386 + let
56.2387 + val (t as Const ("HOL.divide",_) $ p1' $ p2')=x;
56.2388 + val p2= sort (mv_geq LEX_) (the(expanded2poly p2' var));
56.2389 + val p3= #1(mv_division(denom,p2,LEX_));
56.2390 + val p1var=get_vars p1';
56.2391 + in
56.2392 + if length(xs)>0 then
56.2393 + if p3=[(1,mv_null2(var))] then
56.2394 + (
56.2395 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2396 + poly2expanded(the (expanded2poly p1' p1var),p1var) $
56.2397 + com_den_exp2(xs,denom,den,var)
56.2398 + )
56.2399 + else
56.2400 + (
56.2401 + Const ("op +",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2402 + (
56.2403 + let
56.2404 + val p3'=poly2expanded(p3,var);
56.2405 + val vars= (((map free2str) o vars) p1') union (((map free2str) o vars) p3');
56.2406 + in
56.2407 + poly2expanded(sort (mv_geq LEX_) (mv_mul(the(expanded2poly p1' vars) ,the(expanded2poly p3' vars),LEX_)),vars)
56.2408 + end
56.2409 + ) $
56.2410 + com_den_exp2(xs,denom,den,var)
56.2411 + )
56.2412 + else
56.2413 + if p3=[(1,mv_null2(var))] then
56.2414 + (
56.2415 + poly2expanded(the (expanded2poly p1' p1var),p1var)
56.2416 + )
56.2417 + else
56.2418 + (
56.2419 + let
56.2420 + val p3'=poly2expanded(p3,var);
56.2421 + val vars= (((map free2str) o vars) p1') union (((map free2str) o vars) p3');
56.2422 + in
56.2423 + poly2expanded(sort (mv_geq LEX_) (mv_mul(the(expanded2poly p1' vars) ,the(expanded2poly p3' vars),LEX_)),vars)
56.2424 + end
56.2425 + )
56.2426 + end;
56.2427 +---------------------------------------------------------*)
56.2428 +
56.2429 +
56.2430 +(*. searches for an element y of a list ys, which has an gcd not 1 with x .*)
56.2431 +fun exists_gcd (x,[]) = false
56.2432 + | exists_gcd (x,y::ys) = if mv_gcd x y = [(1,mv_null2(#2(hd(x))))] then exists_gcd (x,ys)
56.2433 + else true;
56.2434 +
56.2435 +(*. divides each element of the list xs with y .*)
56.2436 +fun list_div ([],y) = []
56.2437 + | list_div (x::xs,y) =
56.2438 + let
56.2439 + val (d,r)=mv_division(x,y,LEX_);
56.2440 + in
56.2441 + if r=[] then
56.2442 + d::list_div(xs,y)
56.2443 + else x::list_div(xs,y)
56.2444 + end;
56.2445 +
56.2446 +(*. checks if x is in the list ys .*)
56.2447 +fun in_list (x,[]) = false
56.2448 + | in_list (x,y::ys) = if x=y then true
56.2449 + else in_list(x,ys);
56.2450 +
56.2451 +(*. deletes all equal elements of the list xs .*)
56.2452 +fun kill_equal [] = []
56.2453 + | kill_equal (x::xs) = if in_list(x,xs) orelse x=[(1,mv_null2(#2(hd(x))))] then kill_equal(xs)
56.2454 + else x::kill_equal(xs);
56.2455 +
56.2456 +(*. searches for new factors .*)
56.2457 +fun new_factors [] = []
56.2458 + | new_factors (list:mv_poly list):mv_poly list =
56.2459 + let
56.2460 + val l = kill_equal list;
56.2461 + val len = length(l);
56.2462 + in
56.2463 + if len>=2 then
56.2464 + (
56.2465 + let
56.2466 + val x::y::xs=l;
56.2467 + val gcd=mv_gcd x y;
56.2468 + in
56.2469 + if gcd=[(1,mv_null2(#2(hd(x))))] then
56.2470 + (
56.2471 + if exists_gcd(x,xs) then new_factors (y::xs @ [x])
56.2472 + else x::new_factors(y::xs)
56.2473 + )
56.2474 + else gcd::new_factors(kill_equal(list_div(x::y::xs,gcd)))
56.2475 + end
56.2476 + )
56.2477 + else
56.2478 + if len=1 then [hd(l)]
56.2479 + else []
56.2480 + end;
56.2481 +
56.2482 +(*. gets the factors of a list .*)
56.2483 +fun get_factors x = new_factors x;
56.2484 +
56.2485 +(*. multiplies the elements of the list .*)
56.2486 +fun multi_list [] = []
56.2487 + | multi_list (x::xs) = if xs=[] then x
56.2488 + else mv_mul(x,multi_list xs,LEX_);
56.2489 +
56.2490 +(*. makes a term out of the elements of the list (polynomial representation) .*)
56.2491 +fun make_term ([],vars) = Free(str_of_int 0,HOLogic.realT)
56.2492 + | make_term ((x::xs),vars) = if length(xs)=0 then poly2term(sort (mv_geq LEX_) (x),vars)
56.2493 + else
56.2494 + (
56.2495 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2496 + poly2term(sort (mv_geq LEX_) (x),vars) $
56.2497 + make_term(xs,vars)
56.2498 + );
56.2499 +
56.2500 +(*. factorizes the denominator (polynomial representation) .*)
56.2501 +fun factorize_den (l,den,vars) =
56.2502 + let
56.2503 + val factor_list=kill_equal( (get_factors l));
56.2504 + val mlist=multi_list(factor_list);
56.2505 + val (last,rest)=mv_division(den,multi_list(factor_list),LEX_);
56.2506 + in
56.2507 + if rest=[] then
56.2508 + (
56.2509 + if last=[(1,mv_null2(vars))] then make_term(factor_list,vars)
56.2510 + else make_term(last::factor_list,vars)
56.2511 + )
56.2512 + else raise error ("RATIONALS_FACTORIZE_DEN_EXCEPTION: Invalid factor by division")
56.2513 + end;
56.2514 +
56.2515 +(*. makes a term out of the elements of the list (expanded polynomial representation) .*)
56.2516 +fun make_exp ([],vars) = Free(str_of_int 0,HOLogic.realT)
56.2517 + | make_exp ((x::xs),vars) = if length(xs)=0 then poly2expanded(sort (mv_geq LEX_) (x),vars)
56.2518 + else
56.2519 + (
56.2520 + Const ("op *",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2521 + poly2expanded(sort (mv_geq LEX_) (x),vars) $
56.2522 + make_exp(xs,vars)
56.2523 + );
56.2524 +
56.2525 +(*. factorizes the denominator (expanded polynomial representation) .*)
56.2526 +fun factorize_den_exp (l,den,vars) =
56.2527 + let
56.2528 + val factor_list=kill_equal( (get_factors l));
56.2529 + val mlist=multi_list(factor_list);
56.2530 + val (last,rest)=mv_division(den,multi_list(factor_list),LEX_);
56.2531 + in
56.2532 + if rest=[] then
56.2533 + (
56.2534 + if last=[(1,mv_null2(vars))] then make_exp(factor_list,vars)
56.2535 + else make_exp(last::factor_list,vars)
56.2536 + )
56.2537 + else raise error ("RATIONALS_FACTORIZE_DEN_EXP_EXCEPTION: Invalid factor by division")
56.2538 + end;
56.2539 +
56.2540 +(*. calculates the common denominator of all elements of the list and multiplies .*)
56.2541 +(*. the nominators and denominators with the correct factor .*)
56.2542 +(*. (polynomial representation) .*)
56.2543 +fun step_add_list_of_fractions []=(Free("0",HOLogic.realT),[]:term list)
56.2544 + | step_add_list_of_fractions [x]= raise error ("RATIONALS_STEP_ADD_LIST_OF_FRACTIONS_EXCEPTION: Nothing to add")
56.2545 + | step_add_list_of_fractions (xs) =
56.2546 + let
56.2547 + val den_list=termlist2denominators (xs); (* list of denominators *)
56.2548 + val (denom,var)=calc_lcm(den_list); (* common denominator *)
56.2549 + val den=factorize_den(#1(den_list),denom,var); (* faktorisierter Nenner !!! *)
56.2550 + in
56.2551 + com_den(xs,denom,den,var)
56.2552 + end;
56.2553 +
56.2554 +(*. calculates the common denominator of all elements of the list and multiplies .*)
56.2555 +(*. the nominators and denominators with the correct factor .*)
56.2556 +(*. (expanded polynomial representation) .*)
56.2557 +fun step_add_list_of_fractions_exp [] = (Free("0",HOLogic.realT),[]:term list)
56.2558 + | step_add_list_of_fractions_exp [x] = raise error ("RATIONALS_STEP_ADD_LIST_OF_FRACTIONS_EXP_EXCEPTION: Nothing to add")
56.2559 + | step_add_list_of_fractions_exp (xs)=
56.2560 + let
56.2561 + val den_list=termlist2denominators_exp (xs); (* list of denominators *)
56.2562 + val (denom,var)=calc_lcm(den_list); (* common denominator *)
56.2563 + val den=factorize_den_exp(#1(den_list),denom,var); (* faktorisierter Nenner !!! *)
56.2564 + in
56.2565 + com_den_exp(xs,denom,den,var)
56.2566 + end;
56.2567 +
56.2568 +(* wird aktuell nicht mehr gebraucht, bei rückänderung schon
56.2569 +-------------------------------------------------------------
56.2570 +(* WN0210???SK brauch ma des überhaupt *)
56.2571 +fun step_add_list_of_fractions2 []=(Free("0",HOLogic.realT),[]:term list)
56.2572 + | step_add_list_of_fractions2 [x]=(x,[])
56.2573 + | step_add_list_of_fractions2 (xs) =
56.2574 + let
56.2575 + val den_list=termlist2denominators (xs); (* list of denominators *)
56.2576 + val (denom,var)=calc_lcm(den_list); (* common denominator *)
56.2577 + val den=factorize_den(#1(den_list),denom,var); (* faktorisierter Nenner !!! *)
56.2578 + in
56.2579 + (
56.2580 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2581 + com_den2(xs,denom, poly2term(denom,var)(*den*),var) $
56.2582 + poly2term(denom,var)
56.2583 + ,
56.2584 + []
56.2585 + )
56.2586 + end;
56.2587 +
56.2588 +(* WN0210???SK brauch ma des überhaupt *)
56.2589 +fun step_add_list_of_fractions2_exp []=(Free("0",HOLogic.realT),[]:term list)
56.2590 + | step_add_list_of_fractions2_exp [x]=(x,[])
56.2591 + | step_add_list_of_fractions2_exp (xs) =
56.2592 + let
56.2593 + val den_list=termlist2denominators_exp (xs); (* list of denominators *)
56.2594 + val (denom,var)=calc_lcm(den_list); (* common denominator *)
56.2595 + val den=factorize_den_exp(#1(den_list),denom,var); (* faktorisierter Nenner !!! *)
56.2596 + in
56.2597 + (
56.2598 + Const ("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2599 + com_den_exp2(xs,denom, poly2term(denom,var)(*den*),var) $
56.2600 + poly2expanded(denom,var)
56.2601 + ,
56.2602 + []
56.2603 + )
56.2604 + end;
56.2605 +---------------------------------------------- *)
56.2606 +
56.2607 +
56.2608 +(*. converts a term, which contains severel terms seperated by +, into a list of these terms .*)
56.2609 +fun term2list (t as (Const("HOL.divide",_) $ _ $ _)) = [t]
56.2610 + | term2list (t as (Const("Atools.pow",_) $ _ $ _)) =
56.2611 + [Const("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2612 + t $ Free("1",HOLogic.realT)
56.2613 + ]
56.2614 + | term2list (t as (Free(_,_))) =
56.2615 + [Const("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2616 + t $ Free("1",HOLogic.realT)
56.2617 + ]
56.2618 + | term2list (t as (Const("op *",_) $ _ $ _)) =
56.2619 + [Const("HOL.divide",[HOLogic.realT,HOLogic.realT]--->HOLogic.realT) $
56.2620 + t $ Free("1",HOLogic.realT)
56.2621 + ]
56.2622 + | term2list (Const("op +",_) $ t1 $ t2) = term2list(t1) @ term2list(t2)
56.2623 + | term2list (Const("op -",_) $ t1 $ t2) =
56.2624 + raise error ("RATIONALS_TERM2LIST_EXCEPTION: - not implemented yet")
56.2625 + | term2list _ = raise error ("RATIONALS_TERM2LIST_EXCEPTION: invalid term");
56.2626 +
56.2627 +(*.factors out the gcd of nominator and denominator:
56.2628 + a/b = (a' * gcd)/(b' * gcd), a,b,gcd are poly[2].*)
56.2629 +fun factout_p_ (thy:theory) t = Some (step_cancel t,[]:term list);
56.2630 +fun factout_ (thy:theory) t = Some (step_cancel_expanded t,[]:term list);
56.2631 +
56.2632 +(*.cancels a single fraction with normalform [2]
56.2633 + resulting in a canceled fraction [2], see factout_ .*)
56.2634 +fun cancel_p_ (thy:theory) t = (*WN.2.6.03 no rewrite -> None !*)
56.2635 + (let val (t',asm) = direct_cancel(*_expanded ... corrected MG.21.8.03*) t
56.2636 + in if t = t' then None else Some (t',asm)
56.2637 + end) handle _ => None;
56.2638 +(*.the same as above with normalform [3]
56.2639 + val cancel_ :
56.2640 + theory -> (*10.02 unused *)
56.2641 + term -> (*fraction in normalform [3] *)
56.2642 + (term * (*fraction in normalform [3] *)
56.2643 + term list) (*casual asumptions in normalform [3] *)
56.2644 + option (*None: the function is not applicable *).*)
56.2645 +fun cancel_ (thy:theory) t = Some (direct_cancel_expanded t) handle _ => None;
56.2646 +
56.2647 +(*.transforms sums of at least 2 fractions [3] to
56.2648 + sums with the least common multiple as nominator.*)
56.2649 +fun common_nominator_p_ (thy:theory) t =
56.2650 +((*writeln("### common_nominator_p_ called");*)
56.2651 + Some (step_add_list_of_fractions(term2list(t))) handle _ => None
56.2652 +);
56.2653 +fun common_nominator_ (thy:theory) t =
56.2654 + Some (step_add_list_of_fractions_exp(term2list(t))) handle _ => None;
56.2655 +
56.2656 +(*.add 2 or more fractions
56.2657 +val add_fraction_p_ :
56.2658 + theory -> (*10.02 unused *)
56.2659 + term -> (*2 or more fractions with normalform [2] *)
56.2660 + (term * (*one fraction with normalform [2] *)
56.2661 + term list) (*casual assumptions in normalform [2] WN0210???SK *)
56.2662 + option (*None: the function is not applicable *).*)
56.2663 +fun add_fraction_p_ (thy:theory) t =
56.2664 +(writeln("### add_fraction_p_ called");
56.2665 + (let val ts = term2list t
56.2666 + in if 1 < length ts
56.2667 + then Some (add_list_of_fractions ts)
56.2668 + else None (*raise error ("RATIONALS_ADD_EXCEPTION: nothing to add")*)
56.2669 + end) handle _ => None
56.2670 +);
56.2671 +(*.same as add_fraction_p_ but with normalform [3].*)
56.2672 +(*Some (step_add_list_of_fractions2(term2list(t))); *)
56.2673 +fun add_fraction_ (thy:theory) t =
56.2674 + if length(term2list(t))>1
56.2675 + then Some (add_list_of_fractions_exp(term2list(t))) handle _ => None
56.2676 + else (*raise error ("RATIONALS_ADD_FRACTION_EXCEPTION: nothing to add")*)
56.2677 + None;
56.2678 +fun add_fraction_ (thy:theory) t =
56.2679 + (if 1 < length (term2list t)
56.2680 + then Some (add_list_of_fractions_exp (term2list t))
56.2681 + else (*raise error ("RATIONALS_ADD_FRACTION_EXCEPTION: nothing to add")*)
56.2682 + None) handle _ => None;
56.2683 +
56.2684 +(*Some (step_add_list_of_fractions2_exp(term2list(t))); *)
56.2685 +
56.2686 +(*. brings the term into a normal form .*)
56.2687 +fun norm_rational_ (thy:theory) t =
56.2688 + Some (add_list_of_fractions(term2list(t))) handle _ => None;
56.2689 +fun norm_expanded_rat_ (thy:theory) t =
56.2690 + Some (add_list_of_fractions_exp(term2list(t))) handle _ => None;
56.2691 +
56.2692 +
56.2693 +(*.evaluates conditions in calculate_Rational.*)
56.2694 +(*make local with FIXX@ME result:term *term list*)
56.2695 +val calc_rat_erls = prep_rls(
56.2696 + Rls {id = "calc_rat_erls", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.2697 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [], *)
56.2698 + rules =
56.2699 + [Calc ("op =",eval_equal "#equal_"),
56.2700 + Calc ("Atools.is'_const",eval_const "#is_const_"),
56.2701 + Thm ("not_true",num_str not_true),
56.2702 + Thm ("not_false",num_str not_false)
56.2703 + ],
56.2704 + scr = EmptyScr});
56.2705 +
56.2706 +
56.2707 +(*.simplifies expressions with numerals;
56.2708 + does NOT rearrange the term by AC-rewriting; thus terms with variables
56.2709 + need to have constants to be commuted together respectively.*)
56.2710 +val calculate_Rational = prep_rls(
56.2711 + merge_rls "calculate_Rational"
56.2712 + (Rls {id = "divide", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.2713 + erls = calc_rat_erls, srls = Erls, (*asm_thm = [],*)
56.2714 + calc = [],
56.2715 + rules =
56.2716 + [Calc ("HOL.divide" ,eval_cancel "#divide_"),
56.2717 +
56.2718 + Thm ("sym_real_minus_divide_eq",
56.2719 + num_str (real_minus_divide_eq RS sym)),
56.2720 + (*SYM - ?x / ?y = - (?x / ?y) may come from subst*)
56.2721 +
56.2722 + Thm ("rat_add",num_str rat_add),
56.2723 + (*"[| a is_const; b is_const; c is_const; d is_const |] ==> \
56.2724 + \"a / c + b / d = (a * d) / (c * d) + (b * c ) / (d * c)"*)
56.2725 + Thm ("rat_add1",num_str rat_add1),
56.2726 + (*"[| a is_const; b is_const; c is_const |] ==> \
56.2727 + \"a / c + b / c = (a + b) / c"*)
56.2728 + Thm ("rat_add2",num_str rat_add2),
56.2729 + (*"[| ?a is_const; ?b is_const; ?c is_const |] ==> \
56.2730 + \?a / ?c + ?b = (?a + ?b * ?c) / ?c"*)
56.2731 + Thm ("rat_add3",num_str rat_add3),
56.2732 + (*"[| a is_const; b is_const; c is_const |] ==> \
56.2733 + \"a + b / c = (a * c) / c + b / c"\
56.2734 + \.... is_const to be omitted here FIXME*)
56.2735 +
56.2736 + Thm ("rat_mult",num_str rat_mult),
56.2737 + (*a / b * (c / d) = a * c / (b * d)*)
56.2738 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
56.2739 + (*?x * (?y / ?z) = ?x * ?y / ?z*)
56.2740 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq),
56.2741 + (*?y / ?z * ?x = ?y * ?x / ?z*)
56.2742 +
56.2743 + Thm ("real_divide_divide1",num_str real_divide_divide1),
56.2744 + (*"?y ~= 0 ==> ?u / ?v / (?y / ?z) = ?u / ?v * (?z / ?y)"*)
56.2745 + Thm ("real_divide_divide2_eq",num_str real_divide_divide2_eq),
56.2746 + (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
56.2747 +
56.2748 + Thm ("rat_power", num_str rat_power),
56.2749 + (*"(?a / ?b) ^^^ ?n = ?a ^^^ ?n / ?b ^^^ ?n"*)
56.2750 +
56.2751 + Thm ("mult_cross",num_str mult_cross),
56.2752 + (*"[| b ~= 0; d ~= 0 |] ==> (a / b = c / d) = (a * d = b * c)*)
56.2753 + Thm ("mult_cross1",num_str mult_cross1),
56.2754 + (*" b ~= 0 ==> (a / b = c ) = (a = b * c)*)
56.2755 + Thm ("mult_cross2",num_str mult_cross2)
56.2756 + (*" d ~= 0 ==> (a = c / d) = (a * d = c)*)
56.2757 + ], scr = EmptyScr})
56.2758 + calculate_Poly);
56.2759 +
56.2760 +
56.2761 +(*("is_expanded", ("Rational.is'_expanded", eval_is_expanded ""))*)
56.2762 +fun eval_is_expanded (thmid:string) _
56.2763 + (t as (Const("Rational.is'_expanded", _) $ arg)) thy =
56.2764 + if is_expanded arg
56.2765 + then Some (mk_thmid thmid ""
56.2766 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
56.2767 + Trueprop $ (mk_equality (t, HOLogic.true_const)))
56.2768 + else Some (mk_thmid thmid ""
56.2769 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
56.2770 + Trueprop $ (mk_equality (t, HOLogic.false_const)))
56.2771 + | eval_is_expanded _ _ _ _ = None;
56.2772 +
56.2773 +val rational_erls =
56.2774 + merge_rls "rational_erls" calculate_Rational
56.2775 + (append_rls "is_expanded" Atools_erls
56.2776 + [Calc ("Rational.is'_expanded", eval_is_expanded "")
56.2777 + ]);
56.2778 +
56.2779 +
56.2780 +
56.2781 +(*.3 'reverse-rewrite-sets' for symbolic computation on rationals:
56.2782 + =================================================================
56.2783 + A[2] 'cancel_p': .
56.2784 + A[3] 'cancel': .
56.2785 + B[2] 'common_nominator_p': transforms summands in a term [2]
56.2786 + to fractions with the (least) common multiple as nominator.
56.2787 + B[3] 'norm_rational': normalizes arbitrary algebraic terms (without
56.2788 + radicals and transzendental functions) to one canceled fraction,
56.2789 + nominator and denominator in polynomial form.
56.2790 +
56.2791 +In order to meet isac's requirements for interactive and stepwise calculation,
56.2792 +each 'reverse-rewerite-set' consists of an initialization for the interpreter
56.2793 +state and of 4 functions, each of which employs rewriting as much as possible.
56.2794 +The signature of these functions are the same in each 'reverse-rewrite-set'
56.2795 +respectively.*)
56.2796 +
56.2797 +(* ************************************************************************* *)
56.2798 +
56.2799 +
56.2800 +local(*. cancel_p
56.2801 +------------------------
56.2802 +cancels a single fraction consisting of two (uni- or multivariate)
56.2803 +polynomials WN0609???SK[2] into another such a fraction; examples:
56.2804 +
56.2805 + a^2 + -1*b^2 a + b
56.2806 + -------------------- = ---------
56.2807 + a^2 + -2*a*b + b^2 a + -1*b
56.2808 +
56.2809 + a^2 a
56.2810 + --- = ---
56.2811 + a 1
56.2812 +
56.2813 +Remark: the reverse ruleset does _NOT_ work properly with other input !.*)
56.2814 +(*WN020824 wir werden "uberlegen, wie wir ungeeignete inputs zur"uckweisen*)
56.2815 +
56.2816 +val {rules, rew_ord=(_,ro),...} =
56.2817 + rep_rls (assoc_rls "make_polynomial");
56.2818 +(*WN060829 ... make_deriv does not terminate with 1st expl above,
56.2819 + see rational.sml --- investigate rulesets for cancel_p ---*)
56.2820 +val {rules, rew_ord=(_,ro),...} =
56.2821 + rep_rls (assoc_rls "rev_rew_p");
56.2822 +
56.2823 +val thy = Rational.thy;
56.2824 +
56.2825 +(*.init_state = fn : term -> istate
56.2826 +initialzies the state of the script interpreter. The state is:
56.2827 +
56.2828 +type rrlsstate = (*state for reverse rewriting*)
56.2829 + (term * (*the current formula*)
56.2830 + term * (*the final term*)
56.2831 + rule list (*'reverse rule list' (#)*)
56.2832 + list * (*may be serveral, eg. in norm_rational*)
56.2833 + (rule * (*Thm (+ Thm generated from Calc) resulting in ...*)
56.2834 + (term * (*... rewrite with ...*)
56.2835 + term list)) (*... assumptions*)
56.2836 + list); (*derivation from given term to normalform
56.2837 + in reverse order with sym_thm;
56.2838 + (#) could be extracted from here by (map #1)*).*)
56.2839 +(* val {rules, rew_ord=(_,ro),...} =
56.2840 + rep_rls (assoc_rls "rev_rew_p") (*USE ALWAYS, SEE val cancel_p*);
56.2841 + val (thy, eval_rls, ro) =(Rational.thy, Atools_erls, ro) (*..val cancel_p*);
56.2842 + val t = t;
56.2843 + *)
56.2844 +fun init_state thy eval_rls ro t =
56.2845 + let val Some (t',_) = factout_p_ thy t
56.2846 + val Some (t'',asm) = cancel_p_ thy t
56.2847 + val der = reverse_deriv thy eval_rls rules ro None t'
56.2848 + val der = der @ [(Thm ("real_mult_div_cancel2",
56.2849 + num_str real_mult_div_cancel2),
56.2850 + (t'',asm))]
56.2851 + val rs = (distinct_Thm o (map #1)) der
56.2852 + val rs = filter_out (eq_Thms ["sym_real_add_zero_left",
56.2853 + "sym_real_mult_0",
56.2854 + "sym_real_mult_1"
56.2855 + (*..insufficient,eg.make_Polynomial*)])rs
56.2856 + in (t,t'',[rs(*here only _ONE_ to ease locate_rule*)],der) end;
56.2857 +
56.2858 +(*.locate_rule = fn : rule list -> term -> rule
56.2859 + -> (rule * (term * term list) option) list.
56.2860 + checks a rule R for being a cancel-rule, and if it is,
56.2861 + then return the list of rules (+ the terms they are rewriting to)
56.2862 + which need to be applied before R should be applied.
56.2863 + precondition: the rule is applicable to the argument-term.
56.2864 +arguments:
56.2865 + rule list: the reverse rule list
56.2866 + -> term : ... to which the rule shall be applied
56.2867 + -> rule : ... to be applied to term
56.2868 +value:
56.2869 + -> (rule : a rule rewriting to ...
56.2870 + * (term : ... the resulting term ...
56.2871 + * term list): ... with the assumptions ( //#0).
56.2872 + ) list : there may be several such rules;
56.2873 + the list is empty, if the rule has nothing to do
56.2874 + with cancelation.*)
56.2875 +(* val () = ();
56.2876 + *)
56.2877 +fun locate_rule thy eval_rls ro [rs] t r =
56.2878 + if (id_of_thm r) mem (map (id_of_thm)) rs
56.2879 + then let val ropt =
56.2880 + rewrite_ thy ro eval_rls true (thm_of_thm r) t;
56.2881 + in case ropt of
56.2882 + Some ta => [(r, ta)]
56.2883 + | None => (writeln("### locate_rule: rewrite "^
56.2884 + (id_of_thm r)^" "^(term2str t)^" = None");
56.2885 + []) end
56.2886 + else (writeln("### locate_rule: "^(id_of_thm r)^" not mem rrls");[])
56.2887 + | locate_rule _ _ _ _ _ _ =
56.2888 + raise error ("locate_rule: doesnt match rev-sets in istate");
56.2889 +
56.2890 +(*.next_rule = fn : rule list -> term -> rule option
56.2891 + for a given term return the next rules to be done for cancelling.
56.2892 +arguments:
56.2893 + rule list : the reverse rule list
56.2894 + term : the term for which ...
56.2895 +value:
56.2896 + -> rule option: ... this rule is appropriate for cancellation;
56.2897 + there may be no such rule (if the term is canceled already.*)
56.2898 +(* val thy = Rational.thy;
56.2899 + val Rrls {rew_ord=(_,ro),...} = cancel;
56.2900 + val ([rs],t) = (rss,f);
56.2901 + next_rule thy eval_rls ro [rs] t;(*eval fun next_rule ... before!*)
56.2902 +
56.2903 + val (thy, [rs]) = (Rational.thy, revsets);
56.2904 + val Rrls {rew_ord=(_,ro),...} = cancel;
56.2905 + nex [rs] t;
56.2906 + *)
56.2907 +fun next_rule thy eval_rls ro [rs] t =
56.2908 + let val der = make_deriv thy eval_rls rs ro None t;
56.2909 + in case der of
56.2910 +(* val (_,r,_)::_ = der;
56.2911 + *)
56.2912 + (_,r,_)::_ => Some r
56.2913 + | _ => None
56.2914 + end
56.2915 + | next_rule _ _ _ _ _ =
56.2916 + raise error ("next_rule: doesnt match rev-sets in istate");
56.2917 +
56.2918 +(*.val attach_form = f : rule list -> term -> term
56.2919 + -> (rule * (term * term list)) list
56.2920 + checks an input term TI, if it may belong to a current cancellation, by
56.2921 + trying to derive it from the given term TG.
56.2922 +arguments:
56.2923 + term : TG, the last one in the cancellation agreed upon by user + math-eng
56.2924 + -> term: TI, the next one input by the user
56.2925 +value:
56.2926 + -> (rule : the rule to be applied in order to reach TI
56.2927 + * (term : ... obtained by applying the rule ...
56.2928 + * term list): ... and the respective assumptions.
56.2929 + ) list : there may be several such rules;
56.2930 + the list is empty, if the users term does not belong
56.2931 + to a cancellation of the term last agreed upon.*)
56.2932 +fun attach_form (_:rule list list) (_:term) (_:term) = (*still missing*)
56.2933 + []:(rule * (term * term list)) list;
56.2934 +
56.2935 +in
56.2936 +
56.2937 +val cancel_p =
56.2938 + Rrls {id = "cancel_p", prepat=[],
56.2939 + rew_ord=("ord_make_polynomial",
56.2940 + ord_make_polynomial false Rational.thy),
56.2941 + erls = rational_erls,
56.2942 + calc = [("plus" ,("op +" ,eval_binop "#add_")),
56.2943 + ("times" ,("op *" ,eval_binop "#mult_")),
56.2944 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
56.2945 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
56.2946 + (*asm_thm=[("real_mult_div_cancel2","")],*)
56.2947 + scr=Rfuns {init_state = init_state thy Atools_erls ro,
56.2948 + normal_form = cancel_p_ thy,
56.2949 + locate_rule = locate_rule thy Atools_erls ro,
56.2950 + next_rule = next_rule thy Atools_erls ro,
56.2951 + attach_form = attach_form}}
56.2952 +end;(*local*)
56.2953 +
56.2954 +
56.2955 +local(*.ad (1) 'cancel'
56.2956 +------------------------------
56.2957 +cancels a single fraction consisting of two (uni- or multivariate)
56.2958 +polynomials WN0609???SK[3] into another such a fraction; examples:
56.2959 +
56.2960 + a^2 - b^2 a + b
56.2961 + -------------------- = ---------
56.2962 + a^2 - 2*a*b + b^2 a - *b
56.2963 +
56.2964 +Remark: the reverse ruleset does _NOT_ work properly with other input !.*)
56.2965 +(*WN 24.8.02: wir werden "uberlegen, wie wir ungeeignete inputs zur"uckweisen*)
56.2966 +
56.2967 +(*
56.2968 +val Some (Rls {rules=rules,rew_ord=(_,ro),...}) =
56.2969 + assoc'(!ruleset',"expand_binoms");
56.2970 +*)
56.2971 +val {rules=rules,rew_ord=(_,ro),...} =
56.2972 + rep_rls (assoc_rls "expand_binoms");
56.2973 +val thy = Rational.thy;
56.2974 +
56.2975 +fun init_state thy eval_rls ro t =
56.2976 + let val Some (t',_) = factout_ thy t;
56.2977 + val Some (t'',asm) = cancel_ thy t;
56.2978 + val der = reverse_deriv thy eval_rls rules ro None t';
56.2979 + val der = der @ [(Thm ("real_mult_div_cancel2",
56.2980 + num_str real_mult_div_cancel2),
56.2981 + (t'',asm))]
56.2982 + val rs = map #1 der;
56.2983 + in (t,t'',[rs],der) end;
56.2984 +
56.2985 +fun locate_rule thy eval_rls ro [rs] t r =
56.2986 + if (id_of_thm r) mem (map (id_of_thm)) rs
56.2987 + then let val ropt =
56.2988 + rewrite_ thy ro eval_rls true (thm_of_thm r) t;
56.2989 + in case ropt of
56.2990 + Some ta => [(r, ta)]
56.2991 + | None => (writeln("### locate_rule: rewrite "^
56.2992 + (id_of_thm r)^" "^(term2str t)^" = None");
56.2993 + []) end
56.2994 + else (writeln("### locate_rule: "^(id_of_thm r)^" not mem rrls");[])
56.2995 + | locate_rule _ _ _ _ _ _ =
56.2996 + raise error ("locate_rule: doesnt match rev-sets in istate");
56.2997 +
56.2998 +fun next_rule thy eval_rls ro [rs] t =
56.2999 + let val der = make_deriv thy eval_rls rs ro None t;
56.3000 + in case der of
56.3001 +(* val (_,r,_)::_ = der;
56.3002 + *)
56.3003 + (_,r,_)::_ => Some r
56.3004 + | _ => None
56.3005 + end
56.3006 + | next_rule _ _ _ _ _ =
56.3007 + raise error ("next_rule: doesnt match rev-sets in istate");
56.3008 +
56.3009 +fun attach_form (_:rule list list) (_:term) (_:term) = (*still missing*)
56.3010 + []:(rule * (term * term list)) list;
56.3011 +
56.3012 +val pat = (term_of o the o (parse thy)) "?r/?s";
56.3013 +val pre1 = (term_of o the o (parse thy)) "?r is_expanded";
56.3014 +val pre2 = (term_of o the o (parse thy)) "?s is_expanded";
56.3015 +val prepat = [([pre1, pre2], pat)];
56.3016 +
56.3017 +in
56.3018 +
56.3019 +
56.3020 +val cancel =
56.3021 + Rrls {id = "cancel", prepat=prepat,
56.3022 + rew_ord=("ord_make_polynomial",
56.3023 + ord_make_polynomial false Rational.thy),
56.3024 + erls = rational_erls,
56.3025 + calc = [("plus" ,("op +" ,eval_binop "#add_")),
56.3026 + ("times" ,("op *" ,eval_binop "#mult_")),
56.3027 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
56.3028 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
56.3029 + scr=Rfuns {init_state = init_state thy Atools_erls ro,
56.3030 + normal_form = cancel_ thy,
56.3031 + locate_rule = locate_rule thy Atools_erls ro,
56.3032 + next_rule = next_rule thy Atools_erls ro,
56.3033 + attach_form = attach_form}}
56.3034 +end;(*local*)
56.3035 +
56.3036 +
56.3037 +
56.3038 +local(*.ad [2] 'common_nominator_p'
56.3039 +---------------------------------
56.3040 +FIXME Beschreibung .*)
56.3041 +
56.3042 +
56.3043 +val {rules=rules,rew_ord=(_,ro),...} =
56.3044 + rep_rls (assoc_rls "make_polynomial");
56.3045 +(*WN060829 ... make_deriv does not terminate with 1st expl above,
56.3046 + see rational.sml --- investigate rulesets for cancel_p ---*)
56.3047 +val {rules, rew_ord=(_,ro),...} =
56.3048 + rep_rls (assoc_rls "rev_rew_p");
56.3049 +val thy = Rational.thy;
56.3050 +
56.3051 +
56.3052 +(*.common_nominator_p_ = fn : theory -> term -> (term * term list) option
56.3053 + as defined above*)
56.3054 +
56.3055 +(*.init_state = fn : term -> istate
56.3056 +initialzies the state of the interactive interpreter. The state is:
56.3057 +
56.3058 +type rrlsstate = (*state for reverse rewriting*)
56.3059 + (term * (*the current formula*)
56.3060 + term * (*the final term*)
56.3061 + rule list (*'reverse rule list' (#)*)
56.3062 + list * (*may be serveral, eg. in norm_rational*)
56.3063 + (rule * (*Thm (+ Thm generated from Calc) resulting in ...*)
56.3064 + (term * (*... rewrite with ...*)
56.3065 + term list)) (*... assumptions*)
56.3066 + list); (*derivation from given term to normalform
56.3067 + in reverse order with sym_thm;
56.3068 + (#) could be extracted from here by (map #1)*).*)
56.3069 +fun init_state thy eval_rls ro t =
56.3070 + let val Some (t',_) = common_nominator_p_ thy t;
56.3071 + val Some (t'',asm) = add_fraction_p_ thy t;
56.3072 + val der = reverse_deriv thy eval_rls rules ro None t';
56.3073 + val der = der @ [(Thm ("real_mult_div_cancel2",
56.3074 + num_str real_mult_div_cancel2),
56.3075 + (t'',asm))]
56.3076 + val rs = (distinct_Thm o (map #1)) der;
56.3077 + val rs = filter_out (eq_Thms ["sym_real_add_zero_left",
56.3078 + "sym_real_mult_0",
56.3079 + "sym_real_mult_1"]) rs;
56.3080 + in (t,t'',[rs(*here only _ONE_*)],der) end;
56.3081 +
56.3082 +(* use"knowledge/Rational.ML";
56.3083 + *)
56.3084 +
56.3085 +(*.locate_rule = fn : rule list -> term -> rule
56.3086 + -> (rule * (term * term list) option) list.
56.3087 + checks a rule R for being a cancel-rule, and if it is,
56.3088 + then return the list of rules (+ the terms they are rewriting to)
56.3089 + which need to be applied before R should be applied.
56.3090 + precondition: the rule is applicable to the argument-term.
56.3091 +arguments:
56.3092 + rule list: the reverse rule list
56.3093 + -> term : ... to which the rule shall be applied
56.3094 + -> rule : ... to be applied to term
56.3095 +value:
56.3096 + -> (rule : a rule rewriting to ...
56.3097 + * (term : ... the resulting term ...
56.3098 + * term list): ... with the assumptions ( //#0).
56.3099 + ) list : there may be several such rules;
56.3100 + the list is empty, if the rule has nothing to do
56.3101 + with cancelation.*)
56.3102 +(* val () = ();
56.3103 + *)
56.3104 +fun locate_rule thy eval_rls ro [rs] t r =
56.3105 + if (id_of_thm r) mem (map (id_of_thm)) rs
56.3106 + then let val ropt =
56.3107 + rewrite_ thy ro eval_rls true (thm_of_thm r) t;
56.3108 + in case ropt of
56.3109 + Some ta => [(r, ta)]
56.3110 + | None => (writeln("### locate_rule: rewrite "^
56.3111 + (id_of_thm r)^" "^(term2str t)^" = None");
56.3112 + []) end
56.3113 + else (writeln("### locate_rule: "^(id_of_thm r)^" not mem rrls");[])
56.3114 + | locate_rule _ _ _ _ _ _ =
56.3115 + raise error ("locate_rule: doesnt match rev-sets in istate");
56.3116 +
56.3117 +(*.next_rule = fn : rule list -> term -> rule option
56.3118 + for a given term return the next rules to be done for cancelling.
56.3119 +arguments:
56.3120 + rule list : the reverse rule list
56.3121 + term : the term for which ...
56.3122 +value:
56.3123 + -> rule option: ... this rule is appropriate for cancellation;
56.3124 + there may be no such rule (if the term is canceled already.*)
56.3125 +(* val thy = Rational.thy;
56.3126 + val Rrls {rew_ord=(_,ro),...} = cancel;
56.3127 + val ([rs],t) = (rss,f);
56.3128 + next_rule thy eval_rls ro [rs] t;(*eval fun next_rule ... before!*)
56.3129 +
56.3130 + val (thy, [rs]) = (Rational.thy, revsets);
56.3131 + val Rrls {rew_ord=(_,ro),...} = cancel;
56.3132 + nex [rs] t;
56.3133 + *)
56.3134 +fun next_rule thy eval_rls ro [rs] t =
56.3135 + let val der = make_deriv thy eval_rls rs ro None t;
56.3136 + in case der of
56.3137 +(* val (_,r,_)::_ = der;
56.3138 + *)
56.3139 + (_,r,_)::_ => Some r
56.3140 + | _ => None
56.3141 + end
56.3142 + | next_rule _ _ _ _ _ =
56.3143 + raise error ("next_rule: doesnt match rev-sets in istate");
56.3144 +
56.3145 +(*.val attach_form = f : rule list -> term -> term
56.3146 + -> (rule * (term * term list)) list
56.3147 + checks an input term TI, if it may belong to a current cancellation, by
56.3148 + trying to derive it from the given term TG.
56.3149 +arguments:
56.3150 + term : TG, the last one in the cancellation agreed upon by user + math-eng
56.3151 + -> term: TI, the next one input by the user
56.3152 +value:
56.3153 + -> (rule : the rule to be applied in order to reach TI
56.3154 + * (term : ... obtained by applying the rule ...
56.3155 + * term list): ... and the respective assumptions.
56.3156 + ) list : there may be several such rules;
56.3157 + the list is empty, if the users term does not belong
56.3158 + to a cancellation of the term last agreed upon.*)
56.3159 +fun attach_form (_:rule list list) (_:term) (_:term) = (*still missing*)
56.3160 + []:(rule * (term * term list)) list;
56.3161 +
56.3162 +val pat0 = (term_of o the o (parse thy)) "?r/?s+?u/?v";
56.3163 +val pat1 = (term_of o the o (parse thy)) "?r/?s+?u ";
56.3164 +val pat2 = (term_of o the o (parse thy)) "?r +?u/?v";
56.3165 +val prepat = [([HOLogic.true_const], pat0),
56.3166 + ([HOLogic.true_const], pat1),
56.3167 + ([HOLogic.true_const], pat2)];
56.3168 +
56.3169 +in
56.3170 +
56.3171 +(*11.02 schnelle L"osung f"ur RL: Bruch auch gek"urzt;
56.3172 + besser w"are: auf 1 gemeinsamen Bruchstrich, Nenner und Z"ahler unvereinfacht
56.3173 + dh. wie common_nominator_p_, aber auf 1 Bruchstrich*)
56.3174 +val common_nominator_p =
56.3175 + Rrls {id = "common_nominator_p", prepat=prepat,
56.3176 + rew_ord=("ord_make_polynomial",
56.3177 + ord_make_polynomial false Rational.thy),
56.3178 + erls = rational_erls,
56.3179 + calc = [("plus" ,("op +" ,eval_binop "#add_")),
56.3180 + ("times" ,("op *" ,eval_binop "#mult_")),
56.3181 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
56.3182 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
56.3183 + scr=Rfuns {init_state = init_state thy Atools_erls ro,
56.3184 + normal_form = add_fraction_p_ thy,(*FIXME.WN0211*)
56.3185 + locate_rule = locate_rule thy Atools_erls ro,
56.3186 + next_rule = next_rule thy Atools_erls ro,
56.3187 + attach_form = attach_form}}
56.3188 +end;(*local*)
56.3189 +
56.3190 +
56.3191 +local(*.ad [2] 'common_nominator'
56.3192 +---------------------------------
56.3193 +FIXME Beschreibung .*)
56.3194 +
56.3195 +
56.3196 +val {rules=rules,rew_ord=(_,ro),...} =
56.3197 + rep_rls (assoc_rls "make_polynomial");
56.3198 +val thy = Rational.thy;
56.3199 +
56.3200 +
56.3201 +(*.common_nominator_ = fn : theory -> term -> (term * term list) option
56.3202 + as defined above*)
56.3203 +
56.3204 +(*.init_state = fn : term -> istate
56.3205 +initialzies the state of the interactive interpreter. The state is:
56.3206 +
56.3207 +type rrlsstate = (*state for reverse rewriting*)
56.3208 + (term * (*the current formula*)
56.3209 + term * (*the final term*)
56.3210 + rule list (*'reverse rule list' (#)*)
56.3211 + list * (*may be serveral, eg. in norm_rational*)
56.3212 + (rule * (*Thm (+ Thm generated from Calc) resulting in ...*)
56.3213 + (term * (*... rewrite with ...*)
56.3214 + term list)) (*... assumptions*)
56.3215 + list); (*derivation from given term to normalform
56.3216 + in reverse order with sym_thm;
56.3217 + (#) could be extracted from here by (map #1)*).*)
56.3218 +fun init_state thy eval_rls ro t =
56.3219 + let val Some (t',_) = common_nominator_ thy t;
56.3220 + val Some (t'',asm) = add_fraction_ thy t;
56.3221 + val der = reverse_deriv thy eval_rls rules ro None t';
56.3222 + val der = der @ [(Thm ("real_mult_div_cancel2",
56.3223 + num_str real_mult_div_cancel2),
56.3224 + (t'',asm))]
56.3225 + val rs = (distinct_Thm o (map #1)) der;
56.3226 + val rs = filter_out (eq_Thms ["sym_real_add_zero_left",
56.3227 + "sym_real_mult_0",
56.3228 + "sym_real_mult_1"]) rs;
56.3229 + in (t,t'',[rs(*here only _ONE_*)],der) end;
56.3230 +
56.3231 +(* use"knowledge/Rational.ML";
56.3232 + *)
56.3233 +
56.3234 +(*.locate_rule = fn : rule list -> term -> rule
56.3235 + -> (rule * (term * term list) option) list.
56.3236 + checks a rule R for being a cancel-rule, and if it is,
56.3237 + then return the list of rules (+ the terms they are rewriting to)
56.3238 + which need to be applied before R should be applied.
56.3239 + precondition: the rule is applicable to the argument-term.
56.3240 +arguments:
56.3241 + rule list: the reverse rule list
56.3242 + -> term : ... to which the rule shall be applied
56.3243 + -> rule : ... to be applied to term
56.3244 +value:
56.3245 + -> (rule : a rule rewriting to ...
56.3246 + * (term : ... the resulting term ...
56.3247 + * term list): ... with the assumptions ( //#0).
56.3248 + ) list : there may be several such rules;
56.3249 + the list is empty, if the rule has nothing to do
56.3250 + with cancelation.*)
56.3251 +(* val () = ();
56.3252 + *)
56.3253 +fun locate_rule thy eval_rls ro [rs] t r =
56.3254 + if (id_of_thm r) mem (map (id_of_thm)) rs
56.3255 + then let val ropt =
56.3256 + rewrite_ thy ro eval_rls true (thm_of_thm r) t;
56.3257 + in case ropt of
56.3258 + Some ta => [(r, ta)]
56.3259 + | None => (writeln("### locate_rule: rewrite "^
56.3260 + (id_of_thm r)^" "^(term2str t)^" = None");
56.3261 + []) end
56.3262 + else (writeln("### locate_rule: "^(id_of_thm r)^" not mem rrls");[])
56.3263 + | locate_rule _ _ _ _ _ _ =
56.3264 + raise error ("locate_rule: doesnt match rev-sets in istate");
56.3265 +
56.3266 +(*.next_rule = fn : rule list -> term -> rule option
56.3267 + for a given term return the next rules to be done for cancelling.
56.3268 +arguments:
56.3269 + rule list : the reverse rule list
56.3270 + term : the term for which ...
56.3271 +value:
56.3272 + -> rule option: ... this rule is appropriate for cancellation;
56.3273 + there may be no such rule (if the term is canceled already.*)
56.3274 +(* val thy = Rational.thy;
56.3275 + val Rrls {rew_ord=(_,ro),...} = cancel;
56.3276 + val ([rs],t) = (rss,f);
56.3277 + next_rule thy eval_rls ro [rs] t;(*eval fun next_rule ... before!*)
56.3278 +
56.3279 + val (thy, [rs]) = (Rational.thy, revsets);
56.3280 + val Rrls {rew_ord=(_,ro),...} = cancel_p;
56.3281 + nex [rs] t;
56.3282 + *)
56.3283 +fun next_rule thy eval_rls ro [rs] t =
56.3284 + let val der = make_deriv thy eval_rls rs ro None t;
56.3285 + in case der of
56.3286 +(* val (_,r,_)::_ = der;
56.3287 + *)
56.3288 + (_,r,_)::_ => Some r
56.3289 + | _ => None
56.3290 + end
56.3291 + | next_rule _ _ _ _ _ =
56.3292 + raise error ("next_rule: doesnt match rev-sets in istate");
56.3293 +
56.3294 +(*.val attach_form = f : rule list -> term -> term
56.3295 + -> (rule * (term * term list)) list
56.3296 + checks an input term TI, if it may belong to a current cancellation, by
56.3297 + trying to derive it from the given term TG.
56.3298 +arguments:
56.3299 + term : TG, the last one in the cancellation agreed upon by user + math-eng
56.3300 + -> term: TI, the next one input by the user
56.3301 +value:
56.3302 + -> (rule : the rule to be applied in order to reach TI
56.3303 + * (term : ... obtained by applying the rule ...
56.3304 + * term list): ... and the respective assumptions.
56.3305 + ) list : there may be several such rules;
56.3306 + the list is empty, if the users term does not belong
56.3307 + to a cancellation of the term last agreed upon.*)
56.3308 +fun attach_form (_:rule list list) (_:term) (_:term) = (*still missing*)
56.3309 + []:(rule * (term * term list)) list;
56.3310 +
56.3311 +val pat0 = (term_of o the o (parse thy)) "?r/?s+?u/?v";
56.3312 +val pat01 = (term_of o the o (parse thy)) "?r/?s-?u/?v";
56.3313 +val pat1 = (term_of o the o (parse thy)) "?r/?s+?u ";
56.3314 +val pat11 = (term_of o the o (parse thy)) "?r/?s-?u ";
56.3315 +val pat2 = (term_of o the o (parse thy)) "?r +?u/?v";
56.3316 +val pat21 = (term_of o the o (parse thy)) "?r -?u/?v";
56.3317 +val prepat = [([HOLogic.true_const], pat0),
56.3318 + ([HOLogic.true_const], pat01),
56.3319 + ([HOLogic.true_const], pat1),
56.3320 + ([HOLogic.true_const], pat11),
56.3321 + ([HOLogic.true_const], pat2),
56.3322 + ([HOLogic.true_const], pat21)];
56.3323 +
56.3324 +
56.3325 +in
56.3326 +
56.3327 +val common_nominator =
56.3328 + Rrls {id = "common_nominator", prepat=prepat,
56.3329 + rew_ord=("ord_make_polynomial",
56.3330 + ord_make_polynomial false Rational.thy),
56.3331 + erls = rational_erls,
56.3332 + calc = [("plus" ,("op +" ,eval_binop "#add_")),
56.3333 + ("times" ,("op *" ,eval_binop "#mult_")),
56.3334 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
56.3335 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
56.3336 + (*asm_thm=[("real_mult_div_cancel2","")],*)
56.3337 + scr=Rfuns {init_state = init_state thy Atools_erls ro,
56.3338 + normal_form = add_fraction_ (*NOT common_nominator_*) thy,
56.3339 + locate_rule = locate_rule thy Atools_erls ro,
56.3340 + next_rule = next_rule thy Atools_erls ro,
56.3341 + attach_form = attach_form}}
56.3342 +
56.3343 +end;(*local*)
56.3344 +
56.3345 +
56.3346 +(*##*)
56.3347 +end;(*struct*)
56.3348 +
56.3349 +open RationalI;
56.3350 +(*##*)
56.3351 +
56.3352 +(*.the expression contains + - * ^ / only ?.*)
56.3353 +fun is_ratpolyexp (Free _) = true
56.3354 + | is_ratpolyexp (Const ("op +",_) $ Free _ $ Free _) = true
56.3355 + | is_ratpolyexp (Const ("op -",_) $ Free _ $ Free _) = true
56.3356 + | is_ratpolyexp (Const ("op *",_) $ Free _ $ Free _) = true
56.3357 + | is_ratpolyexp (Const ("Atools.pow",_) $ Free _ $ Free _) = true
56.3358 + | is_ratpolyexp (Const ("HOL.divide",_) $ Free _ $ Free _) = true
56.3359 + | is_ratpolyexp (Const ("op +",_) $ t1 $ t2) =
56.3360 + ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
56.3361 + | is_ratpolyexp (Const ("op -",_) $ t1 $ t2) =
56.3362 + ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
56.3363 + | is_ratpolyexp (Const ("op *",_) $ t1 $ t2) =
56.3364 + ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
56.3365 + | is_ratpolyexp (Const ("Atools.pow",_) $ t1 $ t2) =
56.3366 + ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
56.3367 + | is_ratpolyexp (Const ("HOL.divide",_) $ t1 $ t2) =
56.3368 + ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
56.3369 + | is_ratpolyexp _ = false;
56.3370 +
56.3371 +(*("is_ratpolyexp", ("Rational.is'_ratpolyexp", eval_is_ratpolyexp ""))*)
56.3372 +fun eval_is_ratpolyexp (thmid:string) _
56.3373 + (t as (Const("Rational.is'_ratpolyexp", _) $ arg)) thy =
56.3374 + if is_ratpolyexp arg
56.3375 + then Some (mk_thmid thmid ""
56.3376 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
56.3377 + Trueprop $ (mk_equality (t, HOLogic.true_const)))
56.3378 + else Some (mk_thmid thmid ""
56.3379 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
56.3380 + Trueprop $ (mk_equality (t, HOLogic.false_const)))
56.3381 + | eval_is_ratpolyexp _ _ _ _ = None;
56.3382 +
56.3383 +
56.3384 +
56.3385 +(*-------------------18.3.03 --> struct <-----------vvv--*)
56.3386 +val add_fractions_p = common_nominator_p; (*FIXXXME:eilig f"ur norm_Rational*)
56.3387 +
56.3388 +(*.discard binary minus, shift unary minus into -1*;
56.3389 + unary minus before numerals are put into the numeral by parsing;
56.3390 + contains absolute minimum of thms for context in norm_Rational .*)
56.3391 +val discard_minus = prep_rls(
56.3392 + Rls {id = "discard_minus", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.3393 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
56.3394 + rules = [Thm ("real_diff_minus", num_str real_diff_minus),
56.3395 + (*"a - b = a + -1 * b"*)
56.3396 + Thm ("sym_real_mult_minus1",num_str (real_mult_minus1 RS sym))
56.3397 + (*- ?z = "-1 * ?z"*)
56.3398 + ],
56.3399 + scr = Script ((term_of o the o (parse thy))
56.3400 + "empty_script")
56.3401 + }):rls;
56.3402 +(*erls for calculate_Rational; make local with FIXX@ME result:term *term list*)
56.3403 +val powers_erls = prep_rls(
56.3404 + Rls {id = "powers_erls", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.3405 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
56.3406 + rules = [Calc ("Atools.is'_atom",eval_is_atom "#is_atom_"),
56.3407 + Calc ("Atools.is'_even",eval_is_even "#is_even_"),
56.3408 + Calc ("op <",eval_equ "#less_"),
56.3409 + Thm ("not_false", not_false),
56.3410 + Thm ("not_true", not_true),
56.3411 + Calc ("op +",eval_binop "#add_")
56.3412 + ],
56.3413 + scr = Script ((term_of o the o (parse thy))
56.3414 + "empty_script")
56.3415 + }:rls);
56.3416 +(*.all powers over + distributed; atoms over * collected, other distributed
56.3417 + contains absolute minimum of thms for context in norm_Rational .*)
56.3418 +val powers = prep_rls(
56.3419 + Rls {id = "powers", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.3420 + erls = powers_erls, srls = Erls, calc = [], (*asm_thm = [],*)
56.3421 + rules = [Thm ("realpow_multI", num_str realpow_multI),
56.3422 + (*"(r * s) ^^^ n = r ^^^ n * s ^^^ n"*)
56.3423 + Thm ("realpow_pow",num_str realpow_pow),
56.3424 + (*"(a ^^^ b) ^^^ c = a ^^^ (b * c)"*)
56.3425 + Thm ("realpow_oneI",num_str realpow_oneI),
56.3426 + (*"r ^^^ 1 = r"*)
56.3427 + Thm ("realpow_minus_even",num_str realpow_minus_even),
56.3428 + (*"n is_even ==> (- r) ^^^ n = r ^^^ n" ?-->discard_minus?*)
56.3429 + Thm ("realpow_minus_odd",num_str realpow_minus_odd),
56.3430 + (*"Not (n is_even) ==> (- r) ^^^ n = -1 * r ^^^ n"*)
56.3431 +
56.3432 + (*----- collect atoms over * -----*)
56.3433 + Thm ("realpow_two_atom",num_str realpow_two_atom),
56.3434 + (*"r is_atom ==> r * r = r ^^^ 2"*)
56.3435 + Thm ("realpow_plus_1",num_str realpow_plus_1),
56.3436 + (*"r is_atom ==> r * r ^^^ n = r ^^^ (n + 1)"*)
56.3437 + Thm ("realpow_addI_atom",num_str realpow_addI_atom),
56.3438 + (*"r is_atom ==> r ^^^ n * r ^^^ m = r ^^^ (n + m)"*)
56.3439 +
56.3440 + (*----- distribute none-atoms -----*)
56.3441 + Thm ("realpow_def_atom",num_str realpow_def_atom),
56.3442 + (*"[| 1 < n; not(r is_atom) |]==>r ^^^ n = r * r ^^^ (n + -1)"*)
56.3443 + Thm ("realpow_eq_oneI",num_str realpow_eq_oneI),
56.3444 + (*"1 ^^^ n = 1"*)
56.3445 + Calc ("op +",eval_binop "#add_")
56.3446 + ],
56.3447 + scr = Script ((term_of o the o (parse thy))
56.3448 + "empty_script")
56.3449 + }:rls);
56.3450 +(*.contains absolute minimum of thms for context in norm_Rational.*)
56.3451 +val rat_mult_divide = prep_rls(
56.3452 + Rls {id = "rat_mult_divide", preconds = [],
56.3453 + rew_ord = ("dummy_ord",dummy_ord),
56.3454 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
56.3455 + rules = [Thm ("rat_mult",num_str rat_mult),
56.3456 + (*(1)"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
56.3457 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
56.3458 + (*(2)"?a * (?c / ?d) = ?a * ?c / ?d" must be [2],
56.3459 + otherwise inv.to a / b / c = ...*)
56.3460 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq),
56.3461 + (*"?a / ?b * ?c = ?a * ?c / ?b" order weights x^^^n too much
56.3462 + and does not commute a / b * c ^^^ 2 !*)
56.3463 +
56.3464 + Thm ("real_divide_divide1_eq", real_divide_divide1_eq),
56.3465 + (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
56.3466 + Thm ("real_divide_divide2_eq", real_divide_divide2_eq),
56.3467 + (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
56.3468 + Calc ("HOL.divide" ,eval_cancel "#divide_")
56.3469 + ],
56.3470 + scr = Script ((term_of o the o (parse thy)) "empty_script")
56.3471 + }:rls);
56.3472 +(*.contains absolute minimum of thms for context in norm_Rational.*)
56.3473 +val reduce_0_1_2 = prep_rls(
56.3474 + Rls{id = "reduce_0_1_2", preconds = [], rew_ord = ("dummy_ord", dummy_ord),
56.3475 + erls = e_rls,srls = Erls,calc = [],(*asm_thm = [],*)
56.3476 + rules = [(*Thm ("real_divide_1",num_str real_divide_1),
56.3477 + "?x / 1 = ?x" unnecess.for normalform*)
56.3478 + Thm ("real_mult_1",num_str real_mult_1),
56.3479 + (*"1 * z = z"*)
56.3480 + (*Thm ("real_mult_minus1",num_str real_mult_minus1),
56.3481 + "-1 * z = - z"*)
56.3482 + (*Thm ("real_minus_mult_cancel",num_str real_minus_mult_cancel),
56.3483 + "- ?x * - ?y = ?x * ?y"*)
56.3484 +
56.3485 + Thm ("real_mult_0",num_str real_mult_0),
56.3486 + (*"0 * z = 0"*)
56.3487 + Thm ("real_add_zero_left",num_str real_add_zero_left),
56.3488 + (*"0 + z = z"*)
56.3489 + (*Thm ("real_add_minus",num_str real_add_minus),
56.3490 + "?z + - ?z = 0"*)
56.3491 +
56.3492 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
56.3493 + (*"z1 + z1 = 2 * z1"*)
56.3494 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
56.3495 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
56.3496 +
56.3497 + Thm ("real_0_divide",num_str real_0_divide)
56.3498 + (*"0 / ?x = 0"*)
56.3499 + ], scr = EmptyScr}:rls);
56.3500 +
56.3501 +(*erls for calculate_Rational;
56.3502 + make local with FIXX@ME result:term *term list WN0609???SKMG*)
56.3503 +val norm_rat_erls = prep_rls(
56.3504 + Rls {id = "norm_rat_erls", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.3505 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
56.3506 + rules = [Calc ("Atools.is'_const",eval_const "#is_const_")
56.3507 + ],
56.3508 + scr = Script ((term_of o the o (parse thy))
56.3509 + "empty_script")
56.3510 + }:rls);
56.3511 +(*.consists of rls containing the absolute minimum of thms.*)
56.3512 +(*040209: this version has been used by RL for his equations,
56.3513 +which is now replaced by MGs version below
56.3514 +vvv OLD VERSION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
56.3515 +val norm_Rational = prep_rls(
56.3516 + Rls {id = "norm_Rational", preconds = [], rew_ord = ("dummy_ord",dummy_ord),
56.3517 + erls = norm_rat_erls, srls = Erls, calc = [], (*asm_thm = [],*)
56.3518 + rules = [(*sequence given by operator precedence*)
56.3519 + Rls_ discard_minus,
56.3520 + Rls_ powers,
56.3521 + Rls_ rat_mult_divide,
56.3522 + Rls_ expand,
56.3523 + Rls_ reduce_0_1_2,
56.3524 + (*^^^^^^^^^ from RL -- not the latest one vvvvvvvvv*)
56.3525 + Rls_ order_add_mult,
56.3526 + Rls_ collect_numerals,
56.3527 + Rls_ add_fractions_p,
56.3528 + Rls_ cancel_p
56.3529 + ],
56.3530 + scr = Script ((term_of o the o (parse thy))
56.3531 + "empty_script")
56.3532 + }:rls);
56.3533 +val norm_Rational_parenthesized = prep_rls(
56.3534 + Seq {id = "norm_Rational_parenthesized", preconds = []:term list,
56.3535 + rew_ord = ("dummy_ord", dummy_ord),
56.3536 + erls = Atools_erls, srls = Erls,
56.3537 + calc = [], (*asm_thm = [],*)
56.3538 + rules = [Rls_ norm_Rational, (*from RL -- not the latest one*)
56.3539 + Rls_ discard_parentheses
56.3540 + ],
56.3541 + scr = EmptyScr
56.3542 + }:rls);
56.3543 +
56.3544 +
56.3545 +(*-------------------18.3.03 --> struct <-----------^^^--*)
56.3546 +
56.3547 +
56.3548 +
56.3549 +theory' := overwritel (!theory', [("Rational.thy",Rational.thy)]);
56.3550 +
56.3551 +
56.3552 +(*WN030318???SK: simplifies all but cancel and common_nominator*)
56.3553 +val simplify_rational =
56.3554 + merge_rls "simplify_rational" expand_binoms
56.3555 + (append_rls "divide" calculate_Rational
56.3556 + [Thm ("real_divide_1",num_str real_divide_1),
56.3557 + (*"?x / 1 = ?x"*)
56.3558 + Thm ("rat_mult",num_str rat_mult),
56.3559 + (*(1)"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
56.3560 + Thm ("real_times_divide1_eq",num_str real_times_divide1_eq),
56.3561 + (*(2)"?a * (?c / ?d) = ?a * ?c / ?d" must be [2],
56.3562 + otherwise inv.to a / b / c = ...*)
56.3563 + Thm ("real_times_divide2_eq",num_str real_times_divide2_eq),
56.3564 + (*"?a / ?b * ?c = ?a * ?c / ?b"*)
56.3565 + Thm ("add_minus",num_str add_minus),
56.3566 + (*"?a + ?b - ?b = ?a"*)
56.3567 + Thm ("add_minus1",num_str add_minus1),
56.3568 + (*"?a - ?b + ?b = ?a"*)
56.3569 + Thm ("real_divide_minus1",num_str real_divide_minus1)
56.3570 + (*"?x / -1 = - ?x"*)
56.3571 +(*
56.3572 +,
56.3573 + Thm ("",num_str )
56.3574 +*)
56.3575 + ]);
56.3576 +
56.3577 +(*---------vvv-------------MG ab 1.07.2003--------------vvv-----------*)
56.3578 +
56.3579 +(* ------------------------------------------------------------------ *)
56.3580 +(* Simplifier für beliebige Buchterme *)
56.3581 +(* ------------------------------------------------------------------ *)
56.3582 +(*----------------------- norm_Rational_mg ---------------------------*)
56.3583 +(*. description of the simplifier see MG-DA.p.56ff .*)
56.3584 +(* ------------------------------------------------------------------- *)
56.3585 +val common_nominator_p_rls = prep_rls(
56.3586 + Rls {id = "common_nominator_p_rls", preconds = [],
56.3587 + rew_ord = ("dummy_ord",dummy_ord),
56.3588 + erls = e_rls, srls = Erls, calc = [],
56.3589 + rules =
56.3590 + [Rls_ common_nominator_p
56.3591 + (*FIXME.WN0401 ? redesign Rrls - use exhaustively on a term ?
56.3592 + FIXME.WN0510 unnecessary nesting: introduce RRls_ : rls -> rule*)
56.3593 + ],
56.3594 + scr = EmptyScr});
56.3595 +(* ------------------------------------------------------------------- *)
56.3596 +val cancel_p_rls = prep_rls(
56.3597 + Rls {id = "cancel_p_rls", preconds = [],
56.3598 + rew_ord = ("dummy_ord",dummy_ord),
56.3599 + erls = e_rls, srls = Erls, calc = [],
56.3600 + rules =
56.3601 + [Rls_ cancel_p
56.3602 + (*FIXME.WN.0401 ? redesign Rrls - use exhaustively on a term ?*)
56.3603 + ],
56.3604 + scr = EmptyScr});
56.3605 +(* -------------------------------------------------------------------- *)
56.3606 +(*. makes 'normal' fractions; 'is_polyexp' inhibits double fractions;
56.3607 + used in initial part norm_Rational_mg, see example DA-M02-main.p.60.*)
56.3608 +val rat_mult_poly = prep_rls(
56.3609 + Rls {id = "rat_mult_poly", preconds = [],
56.3610 + rew_ord = ("dummy_ord",dummy_ord),
56.3611 + erls = append_rls "e_rls-is_polyexp" e_rls
56.3612 + [Calc ("Poly.is'_polyexp", eval_is_polyexp "")],
56.3613 + srls = Erls, calc = [],
56.3614 + rules =
56.3615 + [Thm ("rat_mult_poly_l",num_str rat_mult_poly_l),
56.3616 + (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
56.3617 + Thm ("rat_mult_poly_r",num_str rat_mult_poly_r)
56.3618 + (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
56.3619 + ],
56.3620 + scr = EmptyScr});
56.3621 +(* ------------------------------------------------------------------ *)
56.3622 +(*. makes 'normal' fractions; 'is_polyexp' inhibits double fractions;
56.3623 + used in looping part norm_Rational_rls, see example DA-M02-main.p.60
56.3624 + .. WHERE THE LATTER DOES ALWAYS WORK, BECAUSE erls = e_rls,
56.3625 + I.E. THE RESPECTIVE ASSUMPTION IS STORED AND Thm APPLIED; WN051028
56.3626 + ... WN0609???MG.*)
56.3627 +val rat_mult_div_pow = prep_rls(
56.3628 + Rls {id = "rat_mult_div_pow", preconds = [],
56.3629 + rew_ord = ("dummy_ord",dummy_ord),
56.3630 + erls = e_rls,
56.3631 + (*FIXME.WN051028 append_rls "e_rls-is_polyexp" e_rls
56.3632 + [Calc ("Poly.is'_polyexp", eval_is_polyexp "")],
56.3633 + with this correction ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ we get
56.3634 + error "rational.sml.sml: diff.behav. in norm_Rational_mg 29" etc.
56.3635 + thus we decided to go on with this flaw*)
56.3636 + srls = Erls, calc = [],
56.3637 + rules = [Thm ("rat_mult",num_str rat_mult),
56.3638 + (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
56.3639 + Thm ("rat_mult_poly_l",num_str rat_mult_poly_l),
56.3640 + (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
56.3641 + Thm ("rat_mult_poly_r",num_str rat_mult_poly_r),
56.3642 + (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
56.3643 +
56.3644 + Thm ("real_divide_divide1_mg", real_divide_divide1_mg),
56.3645 + (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
56.3646 + Thm ("real_divide_divide1_eq", real_divide_divide1_eq),
56.3647 + (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
56.3648 + Thm ("real_divide_divide2_eq", real_divide_divide2_eq),
56.3649 + (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
56.3650 + Calc ("HOL.divide" ,eval_cancel "#divide_"),
56.3651 +
56.3652 + Thm ("rat_power", num_str rat_power)
56.3653 + (*"(?a / ?b) ^^^ ?n = ?a ^^^ ?n / ?b ^^^ ?n"*)
56.3654 + ],
56.3655 + scr = Script ((term_of o the o (parse thy)) "empty_script")
56.3656 + }:rls);
56.3657 +(* ------------------------------------------------------------------ *)
56.3658 +val rat_reduce_1 = prep_rls(
56.3659 + Rls {id = "rat_reduce_1", preconds = [],
56.3660 + rew_ord = ("dummy_ord",dummy_ord),
56.3661 + erls = e_rls, srls = Erls, calc = [],
56.3662 + rules = [Thm ("real_divide_1",num_str real_divide_1),
56.3663 + (*"?x / 1 = ?x"*)
56.3664 + Thm ("real_mult_1",num_str real_mult_1)
56.3665 + (*"1 * z = z"*)
56.3666 + ],
56.3667 + scr = Script ((term_of o the o (parse thy)) "empty_script")
56.3668 + }:rls);
56.3669 +(* ------------------------------------------------------------------ *)
56.3670 +(*. looping part of norm_Rational(*_mg*) .*)
56.3671 +val norm_Rational_rls = prep_rls(
56.3672 + Rls {id = "norm_Rational_rls", preconds = [],
56.3673 + rew_ord = ("dummy_ord",dummy_ord),
56.3674 + erls = norm_rat_erls, srls = Erls, calc = [],
56.3675 + rules = [Rls_ common_nominator_p_rls,
56.3676 + Rls_ rat_mult_div_pow,
56.3677 + Rls_ make_rat_poly_with_parentheses,
56.3678 + Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
56.3679 + Rls_ rat_reduce_1
56.3680 + ],
56.3681 + scr = Script ((term_of o the o (parse thy)) "empty_script")
56.3682 + }:rls);
56.3683 +(* ------------------------------------------------------------------ *)
56.3684 +(*040109 'norm_Rational'(by RL) replaced by 'norm_Rational_mg'(MG)
56.3685 + just be renaming:*)
56.3686 +val norm_Rational(*_mg*) = prep_rls(
56.3687 + Seq {id = "norm_Rational"(*_mg*), preconds = [],
56.3688 + rew_ord = ("dummy_ord",dummy_ord),
56.3689 + erls = norm_rat_erls, srls = Erls, calc = [],
56.3690 + rules = [Rls_ discard_minus_,
56.3691 + Rls_ rat_mult_poly,(* removes double fractions like a/b/c *)
56.3692 + Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
56.3693 + Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
56.3694 + Rls_ norm_Rational_rls, (* the main rls, looping (#) *)
56.3695 + Rls_ discard_parentheses_ (* mult only *)
56.3696 + ],
56.3697 + scr = Script ((term_of o the o (parse thy)) "empty_script")
56.3698 + }:rls);
56.3699 +(* ------------------------------------------------------------------ *)
56.3700 +
56.3701 +
56.3702 +ruleset' := overwritelthy thy (!ruleset',
56.3703 + [("calculate_Rational", calculate_Rational),
56.3704 + ("calc_rat_erls",calc_rat_erls),
56.3705 + ("rational_erls", rational_erls),
56.3706 + ("cancel_p", cancel_p),
56.3707 + ("cancel", cancel),
56.3708 + ("common_nominator_p", common_nominator_p),
56.3709 + ("common_nominator_p_rls", common_nominator_p_rls),
56.3710 + ("common_nominator" , common_nominator),
56.3711 + ("discard_minus", discard_minus),
56.3712 + ("powers_erls", powers_erls),
56.3713 + ("powers", powers),
56.3714 + ("rat_mult_divide", rat_mult_divide),
56.3715 + ("reduce_0_1_2", reduce_0_1_2),
56.3716 + ("rat_reduce_1", rat_reduce_1),
56.3717 + ("norm_rat_erls", norm_rat_erls),
56.3718 + ("norm_Rational", norm_Rational),
56.3719 + ("norm_Rational_rls", norm_Rational_rls),
56.3720 + ("norm_Rational_parenthesized", norm_Rational_parenthesized),
56.3721 + ("rat_mult_poly", rat_mult_poly),
56.3722 + ("rat_mult_div_pow", rat_mult_div_pow),
56.3723 + ("cancel_p_rls", cancel_p_rls)
56.3724 + ]);
56.3725 +
56.3726 +calclist':= overwritel (!calclist',
56.3727 + [("is_expanded", ("Rational.is'_expanded", eval_is_expanded ""))
56.3728 + ]);
56.3729 +
56.3730 +(** problems **)
56.3731 +
56.3732 +store_pbt
56.3733 + (prep_pbt Rational.thy "pbl_simp_rat" [] e_pblID
56.3734 + (["rational","simplification"],
56.3735 + [("#Given" ,["term t_"]),
56.3736 + ("#Where" ,["t_ is_ratpolyexp"]),
56.3737 + ("#Find" ,["normalform n_"])
56.3738 + ],
56.3739 + append_rls "e_rls" e_rls [(*for preds in where_*)],
56.3740 + Some "Simplify t_",
56.3741 + [["simplification","of_rationals"]]));
56.3742 +
56.3743 +(** methods **)
56.3744 +
56.3745 +(*WN061025 this methods script is copied from (auto-generated) script
56.3746 + of norm_Rational in order to ease repair on inform*)
56.3747 +store_met
56.3748 + (prep_met Rational.thy "met_simp_rat" [] e_metID
56.3749 + (["simplification","of_rationals"],
56.3750 + [("#Given" ,["term t_"]),
56.3751 + ("#Where" ,["t_ is_ratpolyexp"]),
56.3752 + ("#Find" ,["normalform n_"])
56.3753 + ],
56.3754 + {rew_ord'="tless_true",
56.3755 + rls' = e_rls,
56.3756 + calc = [], srls = e_rls,
56.3757 + prls = append_rls "simplification_of_rationals_prls" e_rls
56.3758 + [(*for preds in where_*)
56.3759 + Calc ("Rational.is'_ratpolyexp",
56.3760 + eval_is_ratpolyexp "")],
56.3761 + crls = e_rls, nrls = norm_Rational_rls},
56.3762 +"Script SimplifyScript (t_::real) = \
56.3763 +\ ((Try (Rewrite_Set discard_minus_ False) @@ \
56.3764 +\ Try (Rewrite_Set rat_mult_poly False) @@ \
56.3765 +\ Try (Rewrite_Set make_rat_poly_with_parentheses False) @@ \
56.3766 +\ Try (Rewrite_Set cancel_p_rls False) @@ \
56.3767 +\ (Repeat \
56.3768 +\ ((Try (Rewrite_Set common_nominator_p_rls False) @@ \
56.3769 +\ Try (Rewrite_Set rat_mult_div_pow False) @@ \
56.3770 +\ Try (Rewrite_Set make_rat_poly_with_parentheses False) @@\
56.3771 +\ Try (Rewrite_Set cancel_p_rls False) @@ \
56.3772 +\ Try (Rewrite_Set rat_reduce_1 False)))) @@ \
56.3773 +\ Try (Rewrite_Set discard_parentheses_ False)) \
56.3774 +\ t_)"
56.3775 + ));
56.3776 +
56.3777 +(* use"../IsacKnowledge/Rational.ML";
56.3778 + use"IsacKnowledge/Rational.ML";
56.3779 + use"Rational.ML";
56.3780 + *)
56.3781 +
57.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
57.2 +++ b/src/Pure/isac/IsacKnowledge/Rational.thy Wed Jul 21 13:53:39 2010 +0200
57.3 @@ -0,0 +1,76 @@
57.4 +(* rationals, i.e. fractions of multivariate polynomials over the real field
57.5 + author: isac team
57.6 + Copyright (c) isac team 2002
57.7 + Use is subject to license terms.
57.8 +
57.9 + depends on Poly (and not on Atools), because
57.10 + fractions with _normalized_ polynomials are canceled, added, etc.
57.11 +
57.12 + use_thy_only"IsacKnowledge/Rational";
57.13 + use_thy"../IsacKnowledge/Rational";
57.14 + use_thy"IsacKnowledge/Rational";
57.15 +
57.16 + remove_thy"Rational";
57.17 + use_thy"IsacKnowledge/Isac";
57.18 + use_thy_only"IsacKnowledge/Rational";
57.19 +
57.20 +*)
57.21 +
57.22 +Rational = Poly +
57.23 +
57.24 +consts
57.25 +
57.26 + is'_expanded :: "real => bool" ("_ is'_expanded") (*RL->Poly.thy*)
57.27 + is'_ratpolyexp :: "real => bool" ("_ is'_ratpolyexp")
57.28 +
57.29 +rules (*.not contained in Isabelle2002,
57.30 + stated as axioms, TODO: prove as theorems*)
57.31 +
57.32 + mult_cross "[| b ~= 0; d ~= 0 |] ==> (a / b = c / d) = (a * d = b * c)"
57.33 + mult_cross1 " b ~= 0 ==> (a / b = c ) = (a = b * c)"
57.34 + mult_cross2 " d ~= 0 ==> (a = c / d) = (a * d = c)"
57.35 +
57.36 + add_minus "a + b - b = a"(*RL->Poly.thy*)
57.37 + add_minus1 "a - b + b = a"(*RL->Poly.thy*)
57.38 +
57.39 + rat_mult "a / b * (c / d) = a * c / (b * d)"(*?Isa02*)
57.40 + rat_mult2 "a / b * c = a * c / b "(*?Isa02*)
57.41 +
57.42 + rat_mult_poly_l "c is_polyexp ==> c * (a / b) = c * a / b"
57.43 + rat_mult_poly_r "c is_polyexp ==> (a / b) * c = a * c / b"
57.44 +
57.45 +(*real_times_divide1_eq .. Isa02*)
57.46 + real_times_divide_1_eq "-1 * (c / d) =-1 * c / d "
57.47 + real_times_divide_num "a is_const ==> \
57.48 + \a * (c / d) = a * c / d "
57.49 +
57.50 + real_mult_div_cancel2 "k ~= 0 ==> m * k / (n * k) = m / n"
57.51 +(*real_mult_div_cancel1 "k ~= 0 ==> k * m / (k * n) = m / n"..Isa02*)
57.52 +
57.53 + real_divide_divide1 "y ~= 0 ==> (u / v) / (y / z) = (u / v) * (z / y)"
57.54 + real_divide_divide1_mg "y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"
57.55 +(*real_divide_divide2_eq "x / y / z = x / (y * z)"..Isa02*)
57.56 +
57.57 + rat_power "(a / b)^^^n = (a^^^n) / (b^^^n)"
57.58 +
57.59 +
57.60 + rat_add "[| a is_const; b is_const; c is_const; d is_const |] ==> \
57.61 + \a / c + b / d = (a * d + b * c) / (c * d)"
57.62 + rat_add_assoc "[| a is_const; b is_const; c is_const; d is_const |] ==> \
57.63 + \a / c +(b / d + e) = (a * d + b * c)/(d * c) + e"
57.64 + rat_add1 "[| a is_const; b is_const; c is_const |] ==> \
57.65 + \a / c + b / c = (a + b) / c"
57.66 + rat_add1_assoc "[| a is_const; b is_const; c is_const |] ==> \
57.67 + \a / c + (b / c + e) = (a + b) / c + e"
57.68 + rat_add2 "[| a is_const; b is_const; c is_const |] ==> \
57.69 + \a / c + b = (a + b * c) / c"
57.70 + rat_add2_assoc "[| a is_const; b is_const; c is_const |] ==> \
57.71 + \a / c + (b + e) = (a + b * c) / c + e"
57.72 + rat_add3 "[| a is_const; b is_const; c is_const |] ==> \
57.73 + \a + b / c = (a * c + b) / c"
57.74 + rat_add3_assoc "[| a is_const; b is_const; c is_const |] ==> \
57.75 + \a + (b / c + e) = (a * c + b) / c + e"
57.76 +
57.77 +
57.78 +
57.79 +end
58.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
58.2 +++ b/src/Pure/isac/IsacKnowledge/Root.ML Wed Jul 21 13:53:39 2010 +0200
58.3 @@ -0,0 +1,299 @@
58.4 +(* collecting all knowledge for Root
58.5 + created by:
58.6 + date:
58.7 + changed by: rlang
58.8 + last change by: rlang
58.9 + date: 02.10.24
58.10 +*)
58.11 +
58.12 +(* use"../knowledge/Root.ML";
58.13 + use"IsacKnowledge/Root.ML";
58.14 + use"Root.ML";
58.15 +
58.16 + remove_thy"Root";
58.17 + use_thy"IsacKnowledge/Isac";
58.18 +
58.19 + use"ROOT.ML";
58.20 + cd"knowledge";
58.21 + *)
58.22 +"******* Root.ML begin *******";
58.23 +theory' := overwritel (!theory', [("Root.thy",Root.thy)]);
58.24 +(*-------------------------functions---------------------*)
58.25 +(*evaluation square-root over the integers*)
58.26 +fun eval_sqrt (thmid:string) (op_:string) (t as
58.27 + (Const(op0,t0) $ arg)) thy =
58.28 + (case arg of
58.29 + Free (n1,t1) =>
58.30 + (case int_of_str n1 of
58.31 + Some ni =>
58.32 + if ni < 0 then None
58.33 + else
58.34 + let val fact = squfact ni;
58.35 + in if fact*fact = ni
58.36 + then Some ("#sqrt #"^(string_of_int ni)^" = #"
58.37 + ^(string_of_int (if ni = 0 then 0
58.38 + else ni div fact)),
58.39 + Trueprop $ mk_equality (t, term_of_num t1 fact))
58.40 + else if fact = 1 then None
58.41 + else Some ("#sqrt #"^(string_of_int ni)^" = sqrt (#"
58.42 + ^(string_of_int fact)^" * #"
58.43 + ^(string_of_int fact)^" * #"
58.44 + ^(string_of_int (ni div (fact*fact))^")"),
58.45 + Trueprop $
58.46 + (mk_equality
58.47 + (t,
58.48 + (mk_factroot op0 t1 fact
58.49 + (ni div (fact*fact))))))
58.50 + end
58.51 + | None => None)
58.52 + | _ => None)
58.53 +
58.54 + | eval_sqrt _ _ _ _ = None;
58.55 +(*val (thmid, op_, t as Const(op0,t0) $ arg) = ("","", str2term "sqrt 0");
58.56 +> eval_sqrt thmid op_ t thy;
58.57 +> val Free (n1,t1) = arg;
58.58 +> val Some ni = int_of_str n1;
58.59 +*)
58.60 +
58.61 +calclist':= overwritel (!calclist',
58.62 + [("sqrt_" ,("Root.sqrt" ,eval_sqrt "#sqrt_"))
58.63 + (*different types for 'sqrt 4' --- 'Calculate sqrt_'*)
58.64 + ]);
58.65 +
58.66 +
58.67 +local (* Vers. 7.10.99.A *)
58.68 +
58.69 +open Term; (* for type order = EQUAL | LESS | GREATER *)
58.70 +
58.71 +fun pr_ord EQUAL = "EQUAL"
58.72 + | pr_ord LESS = "LESS"
58.73 + | pr_ord GREATER = "GREATER";
58.74 +
58.75 +fun dest_hd' (Const (a, T)) = (* ~ term.ML *)
58.76 + (case a of "Root.sqrt" => ((("|||", 0), T), 0) (*WN greatest *)
58.77 + | _ => (((a, 0), T), 0))
58.78 + | dest_hd' (Free (a, T)) = (((a, 0), T), 1)
58.79 + | dest_hd' (Var v) = (v, 2)
58.80 + | dest_hd' (Bound i) = ((("", i), dummyT), 3)
58.81 + | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
58.82 +fun size_of_term' (Const(str,_) $ t) =
58.83 + (case str of "Root.sqrt" => (1000 + size_of_term' t)
58.84 + | _ => 1 + size_of_term' t)
58.85 + | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
58.86 + | size_of_term' (f $ t) = size_of_term' f + size_of_term' t
58.87 + | size_of_term' _ = 1;
58.88 +fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
58.89 + (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
58.90 + | term_ord' pr thy (t, u) =
58.91 + (if pr then
58.92 + let
58.93 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
58.94 + val _=writeln("t= f@ts= \""^
58.95 + ((string_of_cterm o cterm_of (sign_of thy)) f)^"\" @ \"["^
58.96 + (commas(map(string_of_cterm o cterm_of (sign_of thy)) ts))^"]\"");
58.97 + val _=writeln("u= g@us= \""^
58.98 + ((string_of_cterm o cterm_of (sign_of thy)) g)^"\" @ \"["^
58.99 + (commas(map(string_of_cterm o cterm_of (sign_of thy)) us))^"]\"");
58.100 + val _=writeln("size_of_term(t,u)= ("^
58.101 + (string_of_int(size_of_term' t))^", "^
58.102 + (string_of_int(size_of_term' u))^")");
58.103 + val _=writeln("hd_ord(f,g) = "^((pr_ord o hd_ord)(f,g)));
58.104 + val _=writeln("terms_ord(ts,us) = "^
58.105 + ((pr_ord o terms_ord str false)(ts,us)));
58.106 + val _=writeln("-------");
58.107 + in () end
58.108 + else ();
58.109 + case int_ord (size_of_term' t, size_of_term' u) of
58.110 + EQUAL =>
58.111 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
58.112 + (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
58.113 + | ord => ord)
58.114 + end
58.115 + | ord => ord)
58.116 +and hd_ord (f, g) = (* ~ term.ML *)
58.117 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f, dest_hd' g)
58.118 +and terms_ord str pr (ts, us) =
58.119 + list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
58.120 +
58.121 +in
58.122 +(* associates a+(b+c) => (a+b)+c = a+b+c ... avoiding parentheses
58.123 + by (1) size_of_term: less(!) to right, size_of 'sqrt (...)' = 1
58.124 + (2) hd_ord: greater to right, 'sqrt' < numerals < variables
58.125 + (3) terms_ord: recurs. on args, greater to right
58.126 +*)
58.127 +
58.128 +(*args
58.129 + pr: print trace, WN0509 'sqrt_right true' not used anymore
58.130 + thy:
58.131 + subst: no bound variables, only Root.sqrt
58.132 + tu: the terms to compare (t1, t2) ... *)
58.133 +fun sqrt_right (pr:bool) thy (_:subst) tu =
58.134 + (term_ord' pr thy(***) tu = LESS );
58.135 +end;
58.136 +
58.137 +rew_ord' := overwritel (!rew_ord',
58.138 +[("termlessI", termlessI),
58.139 + ("sqrt_right", sqrt_right false ProtoPure.thy)
58.140 + ]);
58.141 +
58.142 +(*-------------------------rulse-------------------------*)
58.143 +val Root_crls =
58.144 + append_rls "Root_crls" Atools_erls
58.145 + [Thm ("real_unari_minus",num_str real_unari_minus),
58.146 + Calc ("Root.sqrt" ,eval_sqrt "#sqrt_"),
58.147 + Calc ("HOL.divide",eval_cancel "#divide_"),
58.148 + Calc ("Atools.pow" ,eval_binop "#power_"),
58.149 + Calc ("op +", eval_binop "#add_"),
58.150 + Calc ("op -", eval_binop "#sub_"),
58.151 + Calc ("op *", eval_binop "#mult_"),
58.152 + Calc ("op =",eval_equal "#equal_")
58.153 + ];
58.154 +
58.155 +val Root_erls =
58.156 + append_rls "Root_erls" Atools_erls
58.157 + [Thm ("real_unari_minus",num_str real_unari_minus),
58.158 + Calc ("Root.sqrt" ,eval_sqrt "#sqrt_"),
58.159 + Calc ("HOL.divide",eval_cancel "#divide_"),
58.160 + Calc ("Atools.pow" ,eval_binop "#power_"),
58.161 + Calc ("op +", eval_binop "#add_"),
58.162 + Calc ("op -", eval_binop "#sub_"),
58.163 + Calc ("op *", eval_binop "#mult_"),
58.164 + Calc ("op =",eval_equal "#equal_")
58.165 + ];
58.166 +
58.167 +ruleset' := overwritelthy thy (!ruleset',
58.168 + [("Root_erls",Root_erls) (*FIXXXME:del with rls.rls'*)
58.169 + ]);
58.170 +
58.171 +val make_rooteq = prep_rls(
58.172 + Rls{id = "make_rooteq", preconds = []:term list,
58.173 + rew_ord = ("sqrt_right", sqrt_right false Root.thy),
58.174 + erls = Atools_erls, srls = Erls,
58.175 + calc = [],
58.176 + (*asm_thm = [],*)
58.177 + rules = [Thm ("real_diff_minus",num_str real_diff_minus),
58.178 + (*"a - b = a + (-1) * b"*)
58.179 +
58.180 + Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
58.181 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
58.182 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
58.183 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
58.184 + Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
58.185 + (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
58.186 + Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
58.187 + (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
58.188 +
58.189 + Thm ("real_mult_1",num_str real_mult_1),
58.190 + (*"1 * z = z"*)
58.191 + Thm ("real_mult_0",num_str real_mult_0),
58.192 + (*"0 * z = 0"*)
58.193 + Thm ("real_add_zero_left",num_str real_add_zero_left),
58.194 + (*"0 + z = z"*)
58.195 +
58.196 + Thm ("real_mult_commute",num_str real_mult_commute), (*AC-rewriting*)
58.197 + Thm ("real_mult_left_commute",num_str real_mult_left_commute), (**)
58.198 + Thm ("real_mult_assoc",num_str real_mult_assoc), (**)
58.199 + Thm ("real_add_commute",num_str real_add_commute), (**)
58.200 + Thm ("real_add_left_commute",num_str real_add_left_commute), (**)
58.201 + Thm ("real_add_assoc",num_str real_add_assoc), (**)
58.202 +
58.203 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
58.204 + (*"r1 * r1 = r1 ^^^ 2"*)
58.205 + Thm ("realpow_plus_1",num_str realpow_plus_1),
58.206 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
58.207 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
58.208 + (*"z1 + z1 = 2 * z1"*)
58.209 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
58.210 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
58.211 +
58.212 + Thm ("real_num_collect",num_str real_num_collect),
58.213 + (*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
58.214 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
58.215 + (*"[| l is_const; m is_const |] ==> l * n + (m * n + k) = (l + m) * n + k"*)
58.216 + Thm ("real_one_collect",num_str real_one_collect),
58.217 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
58.218 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
58.219 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
58.220 +
58.221 + Calc ("op +", eval_binop "#add_"),
58.222 + Calc ("op *", eval_binop "#mult_"),
58.223 + Calc ("Atools.pow", eval_binop "#power_")
58.224 + ],
58.225 + scr = Script ((term_of o the o (parse thy)) "empty_script")
58.226 + }:rls);
58.227 +ruleset' := overwritelthy thy (!ruleset',
58.228 + [("make_rooteq", make_rooteq)
58.229 + ]);
58.230 +
58.231 +val expand_rootbinoms = prep_rls(
58.232 + Rls{id = "expand_rootbinoms", preconds = [],
58.233 + rew_ord = ("termlessI",termlessI),
58.234 + erls = Atools_erls, srls = Erls,
58.235 + calc = [],
58.236 + (*asm_thm = [],*)
58.237 + rules = [Thm ("real_plus_binom_pow2" ,num_str real_plus_binom_pow2),
58.238 + (*"(a + b) ^^^ 2 = a ^^^ 2 + 2 * a * b + b ^^^ 2"*)
58.239 + Thm ("real_plus_binom_times" ,num_str real_plus_binom_times),
58.240 + (*"(a + b)*(a + b) = ...*)
58.241 + Thm ("real_minus_binom_pow2" ,num_str real_minus_binom_pow2),
58.242 + (*"(a - b) ^^^ 2 = a ^^^ 2 - 2 * a * b + b ^^^ 2"*)
58.243 + Thm ("real_minus_binom_times",num_str real_minus_binom_times),
58.244 + (*"(a - b)*(a - b) = ...*)
58.245 + Thm ("real_plus_minus_binom1",num_str real_plus_minus_binom1),
58.246 + (*"(a + b) * (a - b) = a ^^^ 2 - b ^^^ 2"*)
58.247 + Thm ("real_plus_minus_binom2",num_str real_plus_minus_binom2),
58.248 + (*"(a - b) * (a + b) = a ^^^ 2 - b ^^^ 2"*)
58.249 + (*RL 020915*)
58.250 + Thm ("real_pp_binom_times",num_str real_pp_binom_times),
58.251 + (*(a + b)*(c + d) = a*c + a*d + b*c + b*d*)
58.252 + Thm ("real_pm_binom_times",num_str real_pm_binom_times),
58.253 + (*(a + b)*(c - d) = a*c - a*d + b*c - b*d*)
58.254 + Thm ("real_mp_binom_times",num_str real_mp_binom_times),
58.255 + (*(a - b)*(c p d) = a*c + a*d - b*c - b*d*)
58.256 + Thm ("real_mm_binom_times",num_str real_mm_binom_times),
58.257 + (*(a - b)*(c p d) = a*c - a*d - b*c + b*d*)
58.258 + Thm ("realpow_mul",num_str realpow_mul),
58.259 + (*(a*b)^^^n = a^^^n * b^^^n*)
58.260 +
58.261 + Thm ("real_mult_1",num_str real_mult_1), (*"1 * z = z"*)
58.262 + Thm ("real_mult_0",num_str real_mult_0), (*"0 * z = 0"*)
58.263 + Thm ("real_add_zero_left",num_str real_add_zero_left), (*"0 + z = z"*)
58.264 +
58.265 + Calc ("op +", eval_binop "#add_"),
58.266 + Calc ("op -", eval_binop "#sub_"),
58.267 + Calc ("op *", eval_binop "#mult_"),
58.268 + Calc ("HOL.divide" ,eval_cancel "#divide_"),
58.269 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
58.270 + Calc ("Atools.pow", eval_binop "#power_"),
58.271 +
58.272 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
58.273 + (*"r1 * r1 = r1 ^^^ 2"*)
58.274 + Thm ("realpow_plus_1",num_str realpow_plus_1),
58.275 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
58.276 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
58.277 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
58.278 +
58.279 + Thm ("real_num_collect",num_str real_num_collect),
58.280 + (*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
58.281 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
58.282 + (*"[| l is_const; m is_const |] ==> l * n + (m * n + k) = (l + m) * n + k"*)
58.283 + Thm ("real_one_collect",num_str real_one_collect),
58.284 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
58.285 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
58.286 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
58.287 +
58.288 + Calc ("op +", eval_binop "#add_"),
58.289 + Calc ("op -", eval_binop "#sub_"),
58.290 + Calc ("op *", eval_binop "#mult_"),
58.291 + Calc ("HOL.divide" ,eval_cancel "#divide_"),
58.292 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
58.293 + Calc ("Atools.pow", eval_binop "#power_")
58.294 + ],
58.295 + scr = Script ((term_of o the o (parse thy)) "empty_script")
58.296 + }:rls);
58.297 +
58.298 +
58.299 +ruleset' := overwritelthy thy (!ruleset',
58.300 + [("expand_rootbinoms", expand_rootbinoms)
58.301 + ]);
58.302 +"******* Root.ML end *******";
59.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
59.2 +++ b/src/Pure/isac/IsacKnowledge/Root.thy Wed Jul 21 13:53:39 2010 +0200
59.3 @@ -0,0 +1,53 @@
59.4 +(* theory collecting all knowledge for Root
59.5 + created by:
59.6 + date:
59.7 + changed by: rlang
59.8 + last change by: rlang
59.9 + date: 02.10.21
59.10 +*)
59.11 +
59.12 +(* use_thy_only"IsacKnowledge/Root";
59.13 + remove_thy"Root";
59.14 + use_thy"IsacKnowledge/Isac";
59.15 +*)
59.16 +Root = Simplify +
59.17 +
59.18 +(*-------------------- consts------------------------------------------------*)
59.19 +consts
59.20 +
59.21 + sqrt :: "real => real" (*"(sqrt _ )" [80] 80*)
59.22 + nroot :: "[real, real] => real"
59.23 +
59.24 +(*----------------------scripts-----------------------*)
59.25 +
59.26 +(*-------------------- rules------------------------------------------------*)
59.27 +rules (*.not contained in Isabelle2002,
59.28 + stated as axioms, TODO: prove as theorems;
59.29 + theorem-IDs 'xxxI' with ^^^ instead of ^ in 'xxx' in Isabelle2002.*)
59.30 +
59.31 + root_plus_minus "0 <= b ==> \
59.32 + \(a^^^2 = b) = ((a = sqrt b) | (a = (-1)*sqrt b))"
59.33 + root_false "b < 0 ==> (a^^^2 = b) = False"
59.34 +
59.35 + (* for expand_rootbinom *)
59.36 + real_pp_binom_times "(a + b)*(c + d) = a*c + a*d + b*c + b*d"
59.37 + real_pm_binom_times "(a + b)*(c - d) = a*c - a*d + b*c - b*d"
59.38 + real_mp_binom_times "(a - b)*(c + d) = a*c + a*d - b*c - b*d"
59.39 + real_mm_binom_times "(a - b)*(c - d) = a*c - a*d - b*c + b*d"
59.40 + real_plus_binom_pow3 "(a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3"
59.41 + real_minus_binom_pow3 "(a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3"
59.42 + realpow_mul "(a*b)^^^n = a^^^n * b^^^n"
59.43 +
59.44 + real_diff_minus "a - b = a + (-1) * b"
59.45 + real_plus_binom_times "(a + b)*(a + b) = a^^^2 + 2*a*b + b^^^2"
59.46 + real_minus_binom_times "(a - b)*(a - b) = a^^^2 - 2*a*b + b^^^2"
59.47 + real_plus_binom_pow2 "(a + b)^^^2 = a^^^2 + 2*a*b + b^^^2"
59.48 + real_minus_binom_pow2 "(a - b)^^^2 = a^^^2 - 2*a*b + b^^^2"
59.49 + real_plus_minus_binom1 "(a + b)*(a - b) = a^^^2 - b^^^2"
59.50 + real_plus_minus_binom2 "(a - b)*(a + b) = a^^^2 - b^^^2"
59.51 +
59.52 + real_root_positive "0 <= a ==> (x ^^^ 2 = a) = (x = sqrt a)"
59.53 + real_root_negative "a < 0 ==> (x ^^^ 2 = a) = False"
59.54 +
59.55 +
59.56 +end
60.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
60.2 +++ b/src/Pure/isac/IsacKnowledge/RootEq.ML Wed Jul 21 13:53:39 2010 +0200
60.3 @@ -0,0 +1,505 @@
60.4 +(*.(c) by Richard Lang, 2003 .*)
60.5 +(* theory collecting all knowledge for RootEquations
60.6 + created by: rlang
60.7 + date: 02.09
60.8 + changed by: rlang
60.9 + last change by: rlang
60.10 + date: 02.11.14
60.11 +*)
60.12 +
60.13 +(* use"IsacKnowledge/RootEq.ML";
60.14 + use"RootEq.ML";
60.15 +
60.16 + use"ROOT.ML";
60.17 + cd"knowledge";
60.18 +
60.19 + remove_thy"RootEq";
60.20 + use_thy"IsacKnowledge/Isac";
60.21 + *)
60.22 +"******* RootEq.ML begin *******";
60.23 +
60.24 +theory' := overwritel (!theory', [("RootEq.thy",RootEq.thy)]);
60.25 +(*-------------------------functions---------------------*)
60.26 +(* true if bdv is under sqrt of a Equation*)
60.27 +fun is_rootTerm_in t v =
60.28 + let
60.29 + fun coeff_in c v = v mem (vars c);
60.30 + fun findroot (_ $ _ $ _ $ _) v = raise error("is_rootTerm_in:")
60.31 + (* at the moment there is no term like this, but ....*)
60.32 + | findroot (t as (Const ("Root.nroot",_) $ _ $ t3)) v = coeff_in t3 v
60.33 + | findroot (_ $ t2 $ t3) v = (findroot t2 v) orelse (findroot t3 v)
60.34 + | findroot (t as (Const ("Root.sqrt",_) $ t2)) v = coeff_in t2 v
60.35 + | findroot (_ $ t2) v = (findroot t2 v)
60.36 + | findroot _ _ = false;
60.37 + in
60.38 + findroot t v
60.39 + end;
60.40 +
60.41 + fun is_sqrtTerm_in t v =
60.42 + let
60.43 + fun coeff_in c v = v mem (vars c);
60.44 + fun findsqrt (_ $ _ $ _ $ _) v = raise error("is_sqrteqation_in:")
60.45 + (* at the moment there is no term like this, but ....*)
60.46 + | findsqrt (_ $ t1 $ t2) v = (findsqrt t1 v) orelse (findsqrt t2 v)
60.47 + | findsqrt (t as (Const ("Root.sqrt",_) $ a)) v = coeff_in a v
60.48 + | findsqrt (_ $ t1) v = (findsqrt t1 v)
60.49 + | findsqrt _ _ = false;
60.50 + in
60.51 + findsqrt t v
60.52 + end;
60.53 +
60.54 +(* RL: 030518: Is in the rightest subterm of a term a sqrt with bdv,
60.55 +and the subterm ist connected with + or * --> is normalized*)
60.56 + fun is_normSqrtTerm_in t v =
60.57 + let
60.58 + fun coeff_in c v = v mem (vars c);
60.59 + fun isnorm (_ $ _ $ _ $ _) v = raise error("is_normSqrtTerm_in:")
60.60 + (* at the moment there is no term like this, but ....*)
60.61 + | isnorm (Const ("op +",_) $ _ $ t2) v = is_sqrtTerm_in t2 v
60.62 + | isnorm (Const ("op *",_) $ _ $ t2) v = is_sqrtTerm_in t2 v
60.63 + | isnorm (Const ("op -",_) $ _ $ _) v = false
60.64 + | isnorm (Const ("HOL.divide",_) $ t1 $ t2) v = (is_sqrtTerm_in t1 v) orelse
60.65 + (is_sqrtTerm_in t2 v)
60.66 + | isnorm (Const ("Root.sqrt",_) $ t1) v = coeff_in t1 v
60.67 + | isnorm (_ $ t1) v = is_sqrtTerm_in t1 v
60.68 + | isnorm _ _ = false;
60.69 + in
60.70 + isnorm t v
60.71 + end;
60.72 +
60.73 +fun eval_is_rootTerm_in _ _ (p as (Const ("RootEq.is'_rootTerm'_in",_) $ t $ v)) _ =
60.74 + if is_rootTerm_in t v then
60.75 + Some ((term2str p) ^ " = True",
60.76 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
60.77 + else Some ((term2str p) ^ " = True",
60.78 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
60.79 + | eval_is_rootTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) None);
60.80 +
60.81 +fun eval_is_sqrtTerm_in _ _ (p as (Const ("RootEq.is'_sqrtTerm'_in",_) $ t $ v)) _ =
60.82 + if is_sqrtTerm_in t v then
60.83 + Some ((term2str p) ^ " = True",
60.84 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
60.85 + else Some ((term2str p) ^ " = True",
60.86 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
60.87 + | eval_is_sqrtTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) None);
60.88 +
60.89 +fun eval_is_normSqrtTerm_in _ _ (p as (Const ("RootEq.is'_normSqrtTerm'_in",_) $ t $ v)) _ =
60.90 + if is_normSqrtTerm_in t v then
60.91 + Some ((term2str p) ^ " = True",
60.92 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
60.93 + else Some ((term2str p) ^ " = True",
60.94 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
60.95 + | eval_is_normSqrtTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) None);
60.96 +
60.97 +(*-------------------------rulse-------------------------*)
60.98 +val RootEq_prls = (*15.10.02:just the following order due to subterm evaluation*)
60.99 + append_rls "RootEq_prls" e_rls
60.100 + [Calc ("Atools.ident",eval_ident "#ident_"),
60.101 + Calc ("Tools.matches",eval_matches ""),
60.102 + Calc ("Tools.lhs" ,eval_lhs ""),
60.103 + Calc ("Tools.rhs" ,eval_rhs ""),
60.104 + Calc ("RootEq.is'_sqrtTerm'_in",eval_is_sqrtTerm_in ""),
60.105 + Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
60.106 + Calc ("RootEq.is'_normSqrtTerm'_in",eval_is_normSqrtTerm_in ""),
60.107 + Calc ("op =",eval_equal "#equal_"),
60.108 + Thm ("not_true",num_str not_true),
60.109 + Thm ("not_false",num_str not_false),
60.110 + Thm ("and_true",num_str and_true),
60.111 + Thm ("and_false",num_str and_false),
60.112 + Thm ("or_true",num_str or_true),
60.113 + Thm ("or_false",num_str or_false)
60.114 + ];
60.115 +
60.116 +val RootEq_erls =
60.117 + append_rls "RootEq_erls" Root_erls
60.118 + [Thm ("real_divide_divide2_eq",num_str real_divide_divide2_eq)
60.119 + ];
60.120 +
60.121 +val RootEq_crls =
60.122 + append_rls "RootEq_crls" Root_crls
60.123 + [Thm ("real_divide_divide2_eq",num_str real_divide_divide2_eq)
60.124 + ];
60.125 +
60.126 +val rooteq_srls =
60.127 + append_rls "rooteq_srls" e_rls
60.128 + [Calc ("RootEq.is'_sqrtTerm'_in",eval_is_sqrtTerm_in ""),
60.129 + Calc ("RootEq.is'_normSqrtTerm'_in",eval_is_normSqrtTerm_in ""),
60.130 + Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in "")
60.131 + ];
60.132 +
60.133 +ruleset' := overwritelthy thy (!ruleset',
60.134 + [("RootEq_erls",RootEq_erls), (*FIXXXME:del with rls.rls'*)
60.135 + ("rooteq_srls",rooteq_srls)
60.136 + ]);
60.137 +
60.138 +(*isolate the bound variable in an sqrt equation; 'bdv' is a meta-constant*)
60.139 + val sqrt_isolate = prep_rls(
60.140 + Rls {id = "sqrt_isolate", preconds = [], rew_ord = ("termlessI",termlessI),
60.141 + erls = RootEq_erls, srls = Erls, calc = [],
60.142 + (*asm_thm = [("sqrt_square_1",""),("sqrt_square_equation_left_1",""),
60.143 + ("sqrt_square_equation_left_2",""),("sqrt_square_equation_left_3",""),
60.144 + ("sqrt_square_equation_left_4",""),("sqrt_square_equation_left_5",""),
60.145 + ("sqrt_square_equation_left_6",""),("sqrt_square_equation_right_1",""),
60.146 + ("sqrt_square_equation_right_2",""),("sqrt_square_equation_right_3",""),
60.147 + ("sqrt_square_equation_right_4",""),("sqrt_square_equation_right_5",""),
60.148 + ("sqrt_square_equation_right_6","")],*)
60.149 + rules = [
60.150 + Thm("sqrt_square_1",num_str sqrt_square_1), (* (sqrt a)^^^2 -> a *)
60.151 + Thm("sqrt_square_2",num_str sqrt_square_2), (* sqrt (a^^^2) -> a *)
60.152 + Thm("sqrt_times_root_1",num_str sqrt_times_root_1), (* sqrt a sqrt b -> sqrt(ab) *)
60.153 + Thm("sqrt_times_root_2",num_str sqrt_times_root_2), (* a sqrt b sqrt c -> a sqrt(bc) *)
60.154 + Thm("sqrt_square_equation_both_1",num_str sqrt_square_equation_both_1),
60.155 + (* (sqrt a + sqrt b = sqrt c + sqrt d) -> (a+2*sqrt(a)*sqrt(b)+b) = c+2*sqrt(c)*sqrt(d)+d) *)
60.156 + Thm("sqrt_square_equation_both_2",num_str sqrt_square_equation_both_2),
60.157 + (* (sqrt a - sqrt b = sqrt c + sqrt d) -> (a-2*sqrt(a)*sqrt(b)+b) = c+2*sqrt(c)*sqrt(d)+d) *)
60.158 + Thm("sqrt_square_equation_both_3",num_str sqrt_square_equation_both_3),
60.159 + (* (sqrt a + sqrt b = sqrt c - sqrt d) -> (a+2*sqrt(a)*sqrt(b)+b) = c-2*sqrt(c)*sqrt(d)+d) *)
60.160 + Thm("sqrt_square_equation_both_4",num_str sqrt_square_equation_both_4),
60.161 + (* (sqrt a - sqrt b = sqrt c - sqrt d) -> (a-2*sqrt(a)*sqrt(b)+b) = c-2*sqrt(c)*sqrt(d)+d) *)
60.162 + Thm("sqrt_isolate_l_add1",num_str sqrt_isolate_l_add1), (* a+b*sqrt(x)=d -> b*sqrt(x) = d-a *)
60.163 + Thm("sqrt_isolate_l_add2",num_str sqrt_isolate_l_add2), (* a+ sqrt(x)=d -> sqrt(x) = d-a *)
60.164 + Thm("sqrt_isolate_l_add3",num_str sqrt_isolate_l_add3), (* a+b*c/sqrt(x)=d->b*c/sqrt(x)=d-a *)
60.165 + Thm("sqrt_isolate_l_add4",num_str sqrt_isolate_l_add4), (* a+c/sqrt(x)=d -> c/sqrt(x) = d-a *)
60.166 + Thm("sqrt_isolate_l_add5",num_str sqrt_isolate_l_add5), (* a+b*c/f*sqrt(x)=d->b*c/f*sqrt(x)=d-a *)
60.167 + Thm("sqrt_isolate_l_add6",num_str sqrt_isolate_l_add6), (* a+c/f*sqrt(x)=d -> c/f*sqrt(x) = d-a *)
60.168 + (*Thm("sqrt_isolate_l_div",num_str sqrt_isolate_l_div),*) (* b*sqrt(x) = d sqrt(x) d/b *)
60.169 + Thm("sqrt_isolate_r_add1",num_str sqrt_isolate_r_add1), (* a= d+e*sqrt(x) -> a-d=e*sqrt(x) *)
60.170 + Thm("sqrt_isolate_r_add2",num_str sqrt_isolate_r_add2), (* a= d+ sqrt(x) -> a-d= sqrt(x) *)
60.171 + Thm("sqrt_isolate_r_add3",num_str sqrt_isolate_r_add3), (* a=d+e*g/sqrt(x)->a-d=e*g/sqrt(x)*)
60.172 + Thm("sqrt_isolate_r_add4",num_str sqrt_isolate_r_add4), (* a= d+g/sqrt(x) -> a-d=g/sqrt(x) *)
60.173 + Thm("sqrt_isolate_r_add5",num_str sqrt_isolate_r_add5), (* a=d+e*g/h*sqrt(x)->a-d=e*g/h*sqrt(x)*)
60.174 + Thm("sqrt_isolate_r_add6",num_str sqrt_isolate_r_add6), (* a= d+g/h*sqrt(x) -> a-d=g/h*sqrt(x) *)
60.175 + (*Thm("sqrt_isolate_r_div",num_str sqrt_isolate_r_div),*) (* a=e*sqrt(x) -> a/e = sqrt(x) *)
60.176 + Thm("sqrt_square_equation_left_1",num_str sqrt_square_equation_left_1),
60.177 + (* sqrt(x)=b -> x=b^2 *)
60.178 + Thm("sqrt_square_equation_left_2",num_str sqrt_square_equation_left_2),
60.179 + (* c*sqrt(x)=b -> c^2*x=b^2 *)
60.180 + Thm("sqrt_square_equation_left_3",num_str sqrt_square_equation_left_3),
60.181 + (* c/sqrt(x)=b -> c^2/x=b^2 *)
60.182 + Thm("sqrt_square_equation_left_4",num_str sqrt_square_equation_left_4),
60.183 + (* c*d/sqrt(x)=b -> c^2*d^2/x=b^2 *)
60.184 + Thm("sqrt_square_equation_left_5",num_str sqrt_square_equation_left_5),
60.185 + (* c/d*sqrt(x)=b -> c^2/d^2x=b^2 *)
60.186 + Thm("sqrt_square_equation_left_6",num_str sqrt_square_equation_left_6),
60.187 + (* c*d/g*sqrt(x)=b -> c^2*d^2/g^2x=b^2 *)
60.188 + Thm("sqrt_square_equation_right_1",num_str sqrt_square_equation_right_1),
60.189 + (* a=sqrt(x) ->a^2=x *)
60.190 + Thm("sqrt_square_equation_right_2",num_str sqrt_square_equation_right_2),
60.191 + (* a=c*sqrt(x) ->a^2=c^2*x *)
60.192 + Thm("sqrt_square_equation_right_3",num_str sqrt_square_equation_right_3),
60.193 + (* a=c/sqrt(x) ->a^2=c^2/x *)
60.194 + Thm("sqrt_square_equation_right_4",num_str sqrt_square_equation_right_4),
60.195 + (* a=c*d/sqrt(x) ->a^2=c^2*d^2/x *)
60.196 + Thm("sqrt_square_equation_right_5",num_str sqrt_square_equation_right_5),
60.197 + (* a=c/e*sqrt(x) ->a^2=c^2/e^2x *)
60.198 + Thm("sqrt_square_equation_right_6",num_str sqrt_square_equation_right_6)
60.199 + (* a=c*d/g*sqrt(x) ->a^2=c^2*d^2/g^2*x *)
60.200 + ],
60.201 + scr = Script ((term_of o the o (parse thy)) "empty_script")
60.202 + }:rls);
60.203 +ruleset' := overwritelthy thy (!ruleset',
60.204 + [("sqrt_isolate",sqrt_isolate)
60.205 + ]);
60.206 +(* -- left 28.08.02--*)
60.207 +(*isolate the bound variable in an sqrt left equation; 'bdv' is a meta-constant*)
60.208 + val l_sqrt_isolate = prep_rls(
60.209 + Rls {id = "l_sqrt_isolate", preconds = [],
60.210 + rew_ord = ("termlessI",termlessI),
60.211 + erls = RootEq_erls, srls = Erls, calc = [],
60.212 + (*asm_thm = [("sqrt_square_1",""),("sqrt_square_equation_left_1",""),
60.213 + ("sqrt_square_equation_left_2",""),("sqrt_square_equation_left_3",""),
60.214 + ("sqrt_square_equation_left_4",""),("sqrt_square_equation_left_5",""),
60.215 + ("sqrt_square_equation_left_6","")],*)
60.216 + rules = [
60.217 + Thm("sqrt_square_1",num_str sqrt_square_1), (* (sqrt a)^^^2 -> a *)
60.218 + Thm("sqrt_square_2",num_str sqrt_square_2), (* sqrt (a^^^2) -> a *)
60.219 + Thm("sqrt_times_root_1",num_str sqrt_times_root_1), (* sqrt a sqrt b -> sqrt(ab) *)
60.220 + Thm("sqrt_times_root_2",num_str sqrt_times_root_2), (* a sqrt b sqrt c -> a sqrt(bc) *)
60.221 + Thm("sqrt_isolate_l_add1",num_str sqrt_isolate_l_add1), (* a+b*sqrt(x)=d -> b*sqrt(x) = d-a *)
60.222 + Thm("sqrt_isolate_l_add2",num_str sqrt_isolate_l_add2), (* a+ sqrt(x)=d -> sqrt(x) = d-a *)
60.223 + Thm("sqrt_isolate_l_add3",num_str sqrt_isolate_l_add3), (* a+b*c/sqrt(x)=d->b*c/sqrt(x)=d-a *)
60.224 + Thm("sqrt_isolate_l_add4",num_str sqrt_isolate_l_add4), (* a+c/sqrt(x)=d -> c/sqrt(x) = d-a *)
60.225 + Thm("sqrt_isolate_l_add5",num_str sqrt_isolate_l_add5), (* a+b*c/f*sqrt(x)=d->b*c/f*sqrt(x)=d-a *)
60.226 + Thm("sqrt_isolate_l_add6",num_str sqrt_isolate_l_add6), (* a+c/f*sqrt(x)=d -> c/f*sqrt(x) = d-a *)
60.227 + (*Thm("sqrt_isolate_l_div",num_str sqrt_isolate_l_div),*) (* b*sqrt(x) = d sqrt(x) d/b *)
60.228 + Thm("sqrt_square_equation_left_1",num_str sqrt_square_equation_left_1),
60.229 + (* sqrt(x)=b -> x=b^2 *)
60.230 + Thm("sqrt_square_equation_left_2",num_str sqrt_square_equation_left_2),
60.231 + (* a*sqrt(x)=b -> a^2*x=b^2*)
60.232 + Thm("sqrt_square_equation_left_3",num_str sqrt_square_equation_left_3),
60.233 + (* c/sqrt(x)=b -> c^2/x=b^2 *)
60.234 + Thm("sqrt_square_equation_left_4",num_str sqrt_square_equation_left_4),
60.235 + (* c*d/sqrt(x)=b -> c^2*d^2/x=b^2 *)
60.236 + Thm("sqrt_square_equation_left_5",num_str sqrt_square_equation_left_5),
60.237 + (* c/d*sqrt(x)=b -> c^2/d^2x=b^2 *)
60.238 + Thm("sqrt_square_equation_left_6",num_str sqrt_square_equation_left_6)
60.239 + (* c*d/g*sqrt(x)=b -> c^2*d^2/g^2x=b^2 *)
60.240 + ],
60.241 + scr = Script ((term_of o the o (parse thy)) "empty_script")
60.242 + }:rls);
60.243 +ruleset' := overwritelthy thy (!ruleset',
60.244 + [("l_sqrt_isolate",l_sqrt_isolate)
60.245 + ]);
60.246 +
60.247 +(* -- right 28.8.02--*)
60.248 +(*isolate the bound variable in an sqrt right equation; 'bdv' is a meta-constant*)
60.249 + val r_sqrt_isolate = prep_rls(
60.250 + Rls {id = "r_sqrt_isolate", preconds = [],
60.251 + rew_ord = ("termlessI",termlessI),
60.252 + erls = RootEq_erls, srls = Erls, calc = [],
60.253 + (*asm_thm = [("sqrt_square_1",""),("sqrt_square_equation_right_1",""),
60.254 + ("sqrt_square_equation_right_2",""),("sqrt_square_equation_right_3",""),
60.255 + ("sqrt_square_equation_right_4",""),("sqrt_square_equation_right_5",""),
60.256 + ("sqrt_square_equation_right_6","")],*)
60.257 + rules = [
60.258 + Thm("sqrt_square_1",num_str sqrt_square_1), (* (sqrt a)^^^2 -> a *)
60.259 + Thm("sqrt_square_2",num_str sqrt_square_2), (* sqrt (a^^^2) -> a *)
60.260 + Thm("sqrt_times_root_1",num_str sqrt_times_root_1), (* sqrt a sqrt b -> sqrt(ab) *)
60.261 + Thm("sqrt_times_root_2",num_str sqrt_times_root_2), (* a sqrt b sqrt c -> a sqrt(bc) *)
60.262 + Thm("sqrt_isolate_r_add1",num_str sqrt_isolate_r_add1), (* a= d+e*sqrt(x) -> a-d=e*sqrt(x) *)
60.263 + Thm("sqrt_isolate_r_add2",num_str sqrt_isolate_r_add2), (* a= d+ sqrt(x) -> a-d= sqrt(x) *)
60.264 + Thm("sqrt_isolate_r_add3",num_str sqrt_isolate_r_add3), (* a=d+e*g/sqrt(x)->a-d=e*g/sqrt(x)*)
60.265 + Thm("sqrt_isolate_r_add4",num_str sqrt_isolate_r_add4), (* a= d+g/sqrt(x) -> a-d=g/sqrt(x) *)
60.266 + Thm("sqrt_isolate_r_add5",num_str sqrt_isolate_r_add5), (* a=d+e*g/h*sqrt(x)->a-d=e*g/h*sqrt(x)*)
60.267 + Thm("sqrt_isolate_r_add6",num_str sqrt_isolate_r_add6), (* a= d+g/h*sqrt(x) -> a-d=g/h*sqrt(x) *)
60.268 + (*Thm("sqrt_isolate_r_div",num_str sqrt_isolate_r_div),*) (* a=e*sqrt(x) -> a/e = sqrt(x) *)
60.269 + Thm("sqrt_square_equation_right_1",num_str sqrt_square_equation_right_1),
60.270 + (* a=sqrt(x) ->a^2=x *)
60.271 + Thm("sqrt_square_equation_right_2",num_str sqrt_square_equation_right_2),
60.272 + (* a=c*sqrt(x) ->a^2=c^2*x *)
60.273 + Thm("sqrt_square_equation_right_3",num_str sqrt_square_equation_right_3),
60.274 + (* a=c/sqrt(x) ->a^2=c^2/x *)
60.275 + Thm("sqrt_square_equation_right_4",num_str sqrt_square_equation_right_4),
60.276 + (* a=c*d/sqrt(x) ->a^2=c^2*d^2/x *)
60.277 + Thm("sqrt_square_equation_right_5",num_str sqrt_square_equation_right_5),
60.278 + (* a=c/e*sqrt(x) ->a^2=c^2/e^2x *)
60.279 + Thm("sqrt_square_equation_right_6",num_str sqrt_square_equation_right_6)
60.280 + (* a=c*d/g*sqrt(x) ->a^2=c^2*d^2/g^2*x *)
60.281 + ],
60.282 + scr = Script ((term_of o the o (parse thy)) "empty_script")
60.283 + }:rls);
60.284 +ruleset' := overwritelthy thy (!ruleset',
60.285 + [("r_sqrt_isolate",r_sqrt_isolate)
60.286 + ]);
60.287 +
60.288 +val rooteq_simplify = prep_rls(
60.289 + Rls {id = "rooteq_simplify",
60.290 + preconds = [], rew_ord = ("termlessI",termlessI),
60.291 + erls = RootEq_erls, srls = Erls, calc = [],
60.292 + (*asm_thm = [("sqrt_square_1","")],*)
60.293 + rules = [Thm ("real_assoc_1",num_str real_assoc_1), (* a+(b+c) = a+b+c *)
60.294 + Thm ("real_assoc_2",num_str real_assoc_2), (* a*(b*c) = a*b*c *)
60.295 + Calc ("op +",eval_binop "#add_"),
60.296 + Calc ("op -",eval_binop "#sub_"),
60.297 + Calc ("op *",eval_binop "#mult_"),
60.298 + Calc ("HOL.divide", eval_cancel "#divide_"),
60.299 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
60.300 + Calc ("Atools.pow" ,eval_binop "#power_"),
60.301 + Thm("real_plus_binom_pow2",num_str real_plus_binom_pow2),
60.302 + Thm("real_minus_binom_pow2",num_str real_minus_binom_pow2),
60.303 + Thm("realpow_mul",num_str realpow_mul), (* (a * b)^n = a^n * b^n*)
60.304 + Thm("sqrt_times_root_1",num_str sqrt_times_root_1), (* sqrt b * sqrt c = sqrt(b*c) *)
60.305 + Thm("sqrt_times_root_2",num_str sqrt_times_root_2), (* a * sqrt a * sqrt b = a * sqrt(a*b) *)
60.306 + Thm("sqrt_square_2",num_str sqrt_square_2), (* sqrt (a^^^2) = a *)
60.307 + Thm("sqrt_square_1",num_str sqrt_square_1) (* sqrt a ^^^ 2 = a *)
60.308 + ],
60.309 + scr = Script ((term_of o the o (parse thy)) "empty_script")
60.310 + }:rls);
60.311 + ruleset' := overwritelthy thy (!ruleset',
60.312 + [("rooteq_simplify",rooteq_simplify)
60.313 + ]);
60.314 +
60.315 +(*-------------------------Problem-----------------------*)
60.316 +(*
60.317 +(get_pbt ["root","univariate","equation"]);
60.318 +show_ptyps();
60.319 +*)
60.320 +(* ---------root----------- *)
60.321 +store_pbt
60.322 + (prep_pbt RootEq.thy "pbl_equ_univ_root" [] e_pblID
60.323 + (["root","univariate","equation"],
60.324 + [("#Given" ,["equality e_","solveFor v_"]),
60.325 + ("#Where" ,["(lhs e_) is_rootTerm_in (v_::real) | \
60.326 + \(rhs e_) is_rootTerm_in (v_::real)"]),
60.327 + ("#Find" ,["solutions v_i_"])
60.328 + ],
60.329 + RootEq_prls, Some "solve (e_::bool, v_)",
60.330 + []));
60.331 +(* ---------sqrt----------- *)
60.332 +store_pbt
60.333 + (prep_pbt RootEq.thy "pbl_equ_univ_root_sq" [] e_pblID
60.334 + (["sq","root","univariate","equation"],
60.335 + [("#Given" ,["equality e_","solveFor v_"]),
60.336 + ("#Where" ,["( ((lhs e_) is_sqrtTerm_in (v_::real)) &\
60.337 + \ ((lhs e_) is_normSqrtTerm_in (v_::real)) ) |\
60.338 + \( ((rhs e_) is_sqrtTerm_in (v_::real)) &\
60.339 + \ ((rhs e_) is_normSqrtTerm_in (v_::real)) )"]),
60.340 + ("#Find" ,["solutions v_i_"])
60.341 + ],
60.342 + RootEq_prls, Some "solve (e_::bool, v_)",
60.343 + [["RootEq","solve_sq_root_equation"]]));
60.344 +(* ---------normalize----------- *)
60.345 +store_pbt
60.346 + (prep_pbt RootEq.thy "pbl_equ_univ_root_norm" [] e_pblID
60.347 + (["normalize","root","univariate","equation"],
60.348 + [("#Given" ,["equality e_","solveFor v_"]),
60.349 + ("#Where" ,["( ((lhs e_) is_sqrtTerm_in (v_::real)) &\
60.350 + \ Not((lhs e_) is_normSqrtTerm_in (v_::real))) | \
60.351 + \( ((rhs e_) is_sqrtTerm_in (v_::real)) &\
60.352 + \ Not((rhs e_) is_normSqrtTerm_in (v_::real)))"]),
60.353 + ("#Find" ,["solutions v_i_"])
60.354 + ],
60.355 + RootEq_prls, Some "solve (e_::bool, v_)",
60.356 + [["RootEq","norm_sq_root_equation"]]));
60.357 +
60.358 +(*-------------------------methods-----------------------*)
60.359 +(* ---- root 20.8.02 ---*)
60.360 +store_met
60.361 + (prep_met RootEq.thy "met_rooteq" [] e_metID
60.362 + (["RootEq"],
60.363 + [],
60.364 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
60.365 + crls=RootEq_crls, nrls=norm_Poly(*,
60.366 + asm_rls=[],asm_thm=[]*)}, "empty_script"));
60.367 +(*-- normalize 20.10.02 --*)
60.368 +store_met
60.369 + (prep_met RootEq.thy "met_rooteq_norm" [] e_metID
60.370 + (["RootEq","norm_sq_root_equation"],
60.371 + [("#Given" ,["equality e_","solveFor v_"]),
60.372 + ("#Where" ,["( ((lhs e_) is_sqrtTerm_in (v_::real)) &\
60.373 + \ Not((lhs e_) is_normSqrtTerm_in (v_::real))) | \
60.374 + \( ((rhs e_) is_sqrtTerm_in (v_::real)) &\
60.375 + \ Not((rhs e_) is_normSqrtTerm_in (v_::real)))"]),
60.376 + ("#Find" ,["solutions v_i_"])
60.377 + ],
60.378 + {rew_ord'="termlessI",
60.379 + rls'=RootEq_erls,
60.380 + srls=e_rls,
60.381 + prls=RootEq_prls,
60.382 + calc=[],
60.383 + crls=RootEq_crls, nrls=norm_Poly(*,
60.384 + asm_rls=[],
60.385 + asm_thm=[("sqrt_square_1","")]*)},
60.386 + "Script Norm_sq_root_equation (e_::bool) (v_::real) = \
60.387 + \(let e_ = ((Repeat(Try (Rewrite makex1_x False))) @@ \
60.388 + \ (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ \
60.389 + \ (Try (Rewrite_Set rooteq_simplify True)) @@ \
60.390 + \ (Try (Repeat (Rewrite_Set make_rooteq False))) @@ \
60.391 + \ (Try (Rewrite_Set rooteq_simplify True))) e_ \
60.392 + \ in ((SubProblem (RootEq_,[univariate,equation], \
60.393 + \ [no_met]) [bool_ e_, real_ v_])))"
60.394 + ));
60.395 +
60.396 +store_met
60.397 + (prep_met RootEq.thy "met_rooteq_sq" [] e_metID
60.398 + (["RootEq","solve_sq_root_equation"],
60.399 + [("#Given" ,["equality e_","solveFor v_"]),
60.400 + ("#Where" ,["( ((lhs e_) is_sqrtTerm_in (v_::real)) &\
60.401 + \ ((lhs e_) is_normSqrtTerm_in (v_::real)) ) |\
60.402 + \( ((rhs e_) is_sqrtTerm_in (v_::real)) &\
60.403 + \ ((rhs e_) is_normSqrtTerm_in (v_::real)) )"]),
60.404 + ("#Find" ,["solutions v_i_"])
60.405 + ],
60.406 + {rew_ord'="termlessI",
60.407 + rls'=RootEq_erls,
60.408 + srls = rooteq_srls,
60.409 + prls = RootEq_prls,
60.410 + calc = [],
60.411 + crls=RootEq_crls, nrls=norm_Poly(*,
60.412 + asm_rls = [],
60.413 + asm_thm = [("sqrt_square_1",""),("sqrt_square_equation_left_1",""),
60.414 + ("sqrt_square_equation_left_2",""),("sqrt_square_equation_left_3",""),
60.415 + ("sqrt_square_equation_left_4",""),("sqrt_square_equation_left_5",""),
60.416 + ("sqrt_square_equation_left_6",""),("sqrt_square_equation_right_1",""),
60.417 + ("sqrt_square_equation_right_2",""),("sqrt_square_equation_right_3",""),
60.418 + ("sqrt_square_equation_right_4",""),("sqrt_square_equation_right_5",""),
60.419 + ("sqrt_square_equation_right_6","")]*)},
60.420 +"Script Solve_sq_root_equation (e_::bool) (v_::real) = \
60.421 +\(let e_ = \
60.422 +\ ((Try (Rewrite_Set_Inst [(bdv,v_::real)] sqrt_isolate True)) @@ \
60.423 +\ (Try (Rewrite_Set rooteq_simplify True)) @@ \
60.424 +\ (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ \
60.425 +\ (Try (Repeat (Rewrite_Set make_rooteq False))) @@ \
60.426 +\ (Try (Rewrite_Set rooteq_simplify True))) e_;\
60.427 +\ (L_::bool list) = \
60.428 +\ (if (((lhs e_) is_sqrtTerm_in v_) | ((rhs e_) is_sqrtTerm_in v_))\
60.429 +\ then (SubProblem (RootEq_,[normalize,root,univariate,equation], \
60.430 +\ [no_met]) [bool_ e_, real_ v_]) \
60.431 +\ else (SubProblem (RootEq_,[univariate,equation], \
60.432 +\ [no_met]) [bool_ e_, real_ v_])) \
60.433 +\ in Check_elementwise L_ {(v_::real). Assumptions})"
60.434 + ));
60.435 +
60.436 +(*-- right 28.08.02 --*)
60.437 +store_met
60.438 + (prep_met RootEq.thy "met_rooteq_sq_right" [] e_metID
60.439 + (["RootEq","solve_right_sq_root_equation"],
60.440 + [("#Given" ,["equality e_","solveFor v_"]),
60.441 + ("#Where" ,["(rhs e_) is_sqrtTerm_in v_"]),
60.442 + ("#Find" ,["solutions v_i_"])
60.443 + ],
60.444 + {rew_ord'="termlessI",
60.445 + rls'=RootEq_erls,
60.446 + srls=e_rls,
60.447 + prls=RootEq_prls,
60.448 + calc=[],
60.449 + crls=RootEq_crls, nrls=norm_Poly(*,
60.450 + asm_rls=[],
60.451 + asm_thm=[("sqrt_square_1",""),("sqrt_square_1",""),("sqrt_square_equation_right_1",""),
60.452 + ("sqrt_square_equation_right_2",""),("sqrt_square_equation_right_3",""),
60.453 + ("sqrt_square_equation_right_4",""),("sqrt_square_equation_right_5",""),
60.454 + ("sqrt_square_equation_right_6","")]*)},
60.455 + "Script Solve_right_sq_root_equation (e_::bool) (v_::real) = \
60.456 + \(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] r_sqrt_isolate False)) @@ \
60.457 + \ (Try (Rewrite_Set rooteq_simplify False)) @@ \
60.458 + \ (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ \
60.459 + \ (Try (Repeat (Rewrite_Set make_rooteq False))) @@ \
60.460 + \ (Try (Rewrite_Set rooteq_simplify False))) e_\
60.461 + \ in if ((rhs e_) is_sqrtTerm_in v_) \
60.462 + \ then (SubProblem (RootEq_,[normalize,root,univariate,equation], \
60.463 + \ [no_met]) [bool_ e_, real_ v_]) \
60.464 + \ else ((SubProblem (RootEq_,[univariate,equation], \
60.465 + \ [no_met]) [bool_ e_, real_ v_])))"
60.466 + ));
60.467 +
60.468 +(*-- left 28.08.02 --*)
60.469 +store_met
60.470 + (prep_met RootEq.thy "met_rooteq_sq_left" [] e_metID
60.471 + (["RootEq","solve_left_sq_root_equation"],
60.472 + [("#Given" ,["equality e_","solveFor v_"]),
60.473 + ("#Where" ,["(lhs e_) is_sqrtTerm_in v_"]),
60.474 + ("#Find" ,["solutions v_i_"])
60.475 + ],
60.476 + {rew_ord'="termlessI",
60.477 + rls'=RootEq_erls,
60.478 + srls=e_rls,
60.479 + prls=RootEq_prls,
60.480 + calc=[],
60.481 + crls=RootEq_crls, nrls=norm_Poly(*,
60.482 + asm_rls=[],
60.483 + asm_thm=[("sqrt_square_1",""),("sqrt_square_equation_left_1",""),
60.484 + ("sqrt_square_equation_left_2",""),("sqrt_square_equation_left_3",""),
60.485 + ("sqrt_square_equation_left_4",""),("sqrt_square_equation_left_5",""),
60.486 + ("sqrt_square_equation_left_6","")]*)},
60.487 + "Script Solve_left_sq_root_equation (e_::bool) (v_::real) = \
60.488 + \(let e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)] l_sqrt_isolate False)) @@ \
60.489 + \ (Try (Rewrite_Set rooteq_simplify False)) @@ \
60.490 + \ (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ \
60.491 + \ (Try (Repeat (Rewrite_Set make_rooteq False))) @@ \
60.492 + \ (Try (Rewrite_Set rooteq_simplify False))) e_\
60.493 + \ in if ((lhs e_) is_sqrtTerm_in v_) \
60.494 + \ then (SubProblem (RootEq_,[normalize,root,univariate,equation], \
60.495 + \ [no_met]) [bool_ e_, real_ v_]) \
60.496 + \ else ((SubProblem (RootEq_,[univariate,equation], \
60.497 + \ [no_met]) [bool_ e_, real_ v_])))"
60.498 + ));
60.499 +
60.500 +calclist':= overwritel (!calclist',
60.501 + [("is_rootTerm_in", ("RootEq.is'_rootTerm'_in",
60.502 + eval_is_rootTerm_in"")),
60.503 + ("is_sqrtTerm_in", ("RootEq.is'_sqrtTerm'_in",
60.504 + eval_is_sqrtTerm_in"")),
60.505 + ("is_normSqrtTerm_in", ("RootEq.is_normSqrtTerm_in",
60.506 + eval_is_normSqrtTerm_in""))
60.507 + ]);(*("", ("", "")),*)
60.508 +"******* RootEq.ML end *******";
61.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
61.2 +++ b/src/Pure/isac/IsacKnowledge/RootEq.thy Wed Jul 21 13:53:39 2010 +0200
61.3 @@ -0,0 +1,142 @@
61.4 +(*.(c) by Richard Lang, 2003 .*)
61.5 +(* collecting all knowledge for Root Equations
61.6 + created by: rlang
61.7 + date: 02.08
61.8 + changed by: rlang
61.9 + last change by: rlang
61.10 + date: 02.11.14
61.11 +*)
61.12 +(* use"../knowledge/RootEq.ML";
61.13 + use"knowledge/RootEq.ML";
61.14 + use"RootEq.ML";
61.15 +
61.16 + remove_thy"RootEq";
61.17 + use_thy"Isac";
61.18 +
61.19 + use"ROOT.ML";
61.20 + cd"knowledge";
61.21 + *)
61.22 +
61.23 +RootEq = Root +
61.24 +
61.25 +(*-------------------- consts------------------------------------------------*)
61.26 +consts
61.27 + (*-------------------------root-----------------------*)
61.28 + is'_rootTerm'_in :: [real, real] => bool ("_ is'_rootTerm'_in _")
61.29 + is'_sqrtTerm'_in :: [real, real] => bool ("_ is'_sqrtTerm'_in _")
61.30 + is'_normSqrtTerm'_in :: [real, real] => bool ("_ is'_normSqrtTerm'_in _")
61.31 + (*----------------------scripts-----------------------*)
61.32 + Norm'_sq'_root'_equation
61.33 + :: "[bool,real, \
61.34 + \ bool list] => bool list"
61.35 + ("((Script Norm'_sq'_root'_equation (_ _ =))// \
61.36 + \ (_))" 9)
61.37 + Solve'_sq'_root'_equation
61.38 + :: "[bool,real, \
61.39 + \ bool list] => bool list"
61.40 + ("((Script Solve'_sq'_root'_equation (_ _ =))// \
61.41 + \ (_))" 9)
61.42 + Solve'_left'_sq'_root'_equation
61.43 + :: "[bool,real, \
61.44 + \ bool list] => bool list"
61.45 + ("((Script Solve'_left'_sq'_root'_equation (_ _ =))// \
61.46 + \ (_))" 9)
61.47 + Solve'_right'_sq'_root'_equation
61.48 + :: "[bool,real, \
61.49 + \ bool list] => bool list"
61.50 + ("((Script Solve'_right'_sq'_root'_equation (_ _ =))// \
61.51 + \ (_))" 9)
61.52 +
61.53 +(*-------------------- rules------------------------------------------------*)
61.54 +rules
61.55 +
61.56 +(* normalize *)
61.57 + makex1_x
61.58 + "a^^^1 = a"
61.59 + real_assoc_1
61.60 + "a+(b+c) = a+b+c"
61.61 + real_assoc_2
61.62 + "a*(b*c) = a*b*c"
61.63 +
61.64 + (* simplification of root*)
61.65 + sqrt_square_1
61.66 + "[|0 <= a|] ==> (sqrt a)^^^2 = a"
61.67 + sqrt_square_2
61.68 + "sqrt (a ^^^ 2) = a"
61.69 + sqrt_times_root_1
61.70 + "sqrt a * sqrt b = sqrt(a*b)"
61.71 + sqrt_times_root_2
61.72 + "a * sqrt b * sqrt c = a * sqrt(b*c)"
61.73 +
61.74 + (* isolate one root on the LEFT or RIGHT hand side of the equation *)
61.75 + sqrt_isolate_l_add1
61.76 + "[|bdv occurs_in c|] ==> (a + b*sqrt(c) = d) = (b * sqrt(c) = d+ (-1) * a)"
61.77 + sqrt_isolate_l_add2
61.78 + "[|bdv occurs_in c|] ==>(a + sqrt(c) = d) = ((sqrt(c) = d+ (-1) * a))"
61.79 + sqrt_isolate_l_add3
61.80 + "[|bdv occurs_in c|] ==> (a + b*(e/sqrt(c)) = d) = (b * (e/sqrt(c)) = d+ (-1) * a)"
61.81 + sqrt_isolate_l_add4
61.82 + "[|bdv occurs_in c|] ==>(a + b/(f*sqrt(c)) = d) = (b / (f*sqrt(c)) = d+ (-1) * a)"
61.83 + sqrt_isolate_l_add5
61.84 + "[|bdv occurs_in c|] ==> (a + b*(e/(f*sqrt(c))) = d) = (b * (e/(f*sqrt(c))) = d+ (-1) * a)"
61.85 + sqrt_isolate_l_add6
61.86 + "[|bdv occurs_in c|] ==>(a + b/sqrt(c) = d) = (b / sqrt(c) = d+ (-1) * a)"
61.87 + sqrt_isolate_r_add1
61.88 + "[|bdv occurs_in f|] ==>(a = d + e*sqrt(f)) = (a + (-1) * d = e*sqrt(f))"
61.89 + sqrt_isolate_r_add2
61.90 + "[|bdv occurs_in f|] ==>(a = d + sqrt(f)) = (a + (-1) * d = sqrt(f))"
61.91 + (* small hack: thm 3,5,6 are not needed if rootnormalize is well done*)
61.92 + sqrt_isolate_r_add3
61.93 + "[|bdv occurs_in f|] ==>(a = d + e*(g/sqrt(f))) = (a + (-1) * d = e*(g/sqrt(f)))"
61.94 + sqrt_isolate_r_add4
61.95 + "[|bdv occurs_in f|] ==>(a = d + g/sqrt(f)) = (a + (-1) * d = g/sqrt(f))"
61.96 + sqrt_isolate_r_add5
61.97 + "[|bdv occurs_in f|] ==>(a = d + e*(g/(h*sqrt(f)))) = (a + (-1) * d = e*(g/(h*sqrt(f))))"
61.98 + sqrt_isolate_r_add6
61.99 + "[|bdv occurs_in f|] ==>(a = d + g/(h*sqrt(f))) = (a + (-1) * d = g/(h*sqrt(f)))"
61.100 +
61.101 + (* eliminate isolates sqrt *)
61.102 + sqrt_square_equation_both_1
61.103 + "[|bdv occurs_in b; bdv occurs_in d|] ==>
61.104 + ( (sqrt a + sqrt b = sqrt c + sqrt d) =
61.105 + (a+2*sqrt(a)*sqrt(b)+b = c+2*sqrt(c)*sqrt(d)+d))"
61.106 + sqrt_square_equation_both_2
61.107 + "[|bdv occurs_in b; bdv occurs_in d|] ==>
61.108 + ( (sqrt a - sqrt b = sqrt c + sqrt d) =
61.109 + (a - 2*sqrt(a)*sqrt(b)+b = c+2*sqrt(c)*sqrt(d)+d))"
61.110 + sqrt_square_equation_both_3
61.111 + "[|bdv occurs_in b; bdv occurs_in d|] ==>
61.112 + ( (sqrt a + sqrt b = sqrt c - sqrt d) =
61.113 + (a + 2*sqrt(a)*sqrt(b)+b = c - 2*sqrt(c)*sqrt(d)+d))"
61.114 + sqrt_square_equation_both_4
61.115 + "[|bdv occurs_in b; bdv occurs_in d|] ==>
61.116 + ( (sqrt a - sqrt b = sqrt c - sqrt d) =
61.117 + (a - 2*sqrt(a)*sqrt(b)+b = c - 2*sqrt(c)*sqrt(d)+d))"
61.118 + sqrt_square_equation_left_1
61.119 + "[|bdv occurs_in a; 0 <= a; 0 <= b|] ==> ( (sqrt (a) = b) = (a = (b^^^2)))"
61.120 + sqrt_square_equation_left_2
61.121 + "[|bdv occurs_in a; 0 <= a; 0 <= b*c|] ==> ( (c*sqrt(a) = b) = (c^^^2*a = b^^^2))"
61.122 + sqrt_square_equation_left_3
61.123 + "[|bdv occurs_in a; 0 <= a; 0 <= b*c|] ==> ( c/sqrt(a) = b) = (c^^^2 / a = b^^^2)"
61.124 + (* small hack: thm 4-6 are not needed if rootnormalize is well done*)
61.125 + sqrt_square_equation_left_4
61.126 + "[|bdv occurs_in a; 0 <= a; 0 <= b*c*d|] ==> ( (c*(d/sqrt (a)) = b) = (c^^^2*(d^^^2/a) = b^^^2))"
61.127 + sqrt_square_equation_left_5
61.128 + "[|bdv occurs_in a; 0 <= a; 0 <= b*c*d|] ==> ( c/(d*sqrt(a)) = b) = (c^^^2 / (d^^^2*a) = b^^^2)"
61.129 + sqrt_square_equation_left_6
61.130 + "[|bdv occurs_in a; 0 <= a; 0 <= b*c*d*e|] ==> ( (c*(d/(e*sqrt (a))) = b) = (c^^^2*(d^^^2/(e^^^2*a)) = b^^^2))"
61.131 + sqrt_square_equation_right_1
61.132 + "[|bdv occurs_in b; 0 <= a; 0 <= b|] ==> ( (a = sqrt (b)) = (a^^^2 = b))"
61.133 + sqrt_square_equation_right_2
61.134 + "[|bdv occurs_in b; 0 <= a*c; 0 <= b|] ==> ( (a = c*sqrt (b)) = ((a^^^2) = c^^^2*b))"
61.135 + sqrt_square_equation_right_3
61.136 + "[|bdv occurs_in b; 0 <= a*c; 0 <= b|] ==> ( (a = c/sqrt (b)) = (a^^^2 = c^^^2/b))"
61.137 + (* small hack: thm 4-6 are not needed if rootnormalize is well done*)
61.138 + sqrt_square_equation_right_4
61.139 + "[|bdv occurs_in b; 0 <= a*c*d; 0 <= b|] ==> ( (a = c*(d/sqrt (b))) = ((a^^^2) = c^^^2*(d^^^2/b)))"
61.140 + sqrt_square_equation_right_5
61.141 + "[|bdv occurs_in b; 0 <= a*c*d; 0 <= b|] ==> ( (a = c/(d*sqrt (b))) = (a^^^2 = c^^^2/(d^^^2*b)))"
61.142 + sqrt_square_equation_right_6
61.143 + "[|bdv occurs_in b; 0 <= a*c*d*e; 0 <= b|] ==> ( (a = c*(d/(e*sqrt (b)))) = ((a^^^2) = c^^^2*(d^^^2/(e^^^2*b))))"
61.144 +
61.145 +end
62.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
62.2 +++ b/src/Pure/isac/IsacKnowledge/RootRat.ML Wed Jul 21 13:53:39 2010 +0200
62.3 @@ -0,0 +1,50 @@
62.4 +(*.(c) by Richard Lang, 2003 .*)
62.5 +(* collecting all knowledge for Root and Rational
62.6 + created by: rlang
62.7 + date: 02.10
62.8 + changed by: rlang
62.9 + last change by: rlang
62.10 + date: 02.10.21
62.11 +*)
62.12 +(* use"knowledge/RootRat.ML";
62.13 + use"RootRat.ML";
62.14 +
62.15 + use"ROOT.ML";
62.16 + cd"knowledge";
62.17 +
62.18 + remove_thy"RootRat";
62.19 + use_thy"Isac";
62.20 + *)
62.21 +
62.22 +"******* RootRat.ML begin *******";
62.23 +theory' := overwritel (!theory', [("RootRat.thy",RootRat.thy)]);
62.24 +
62.25 +(*-------------------------functions---------------------*)
62.26 +
62.27 +(*-------------------------rulse-------------------------*)
62.28 +val rootrat_erls =
62.29 + merge_rls "rootrat_erls" Root_erls
62.30 + (merge_rls "" rational_erls
62.31 + (append_rls "" e_rls
62.32 + []));
62.33 +
62.34 +ruleset' := overwritelthy thy (!ruleset',
62.35 + [("rootrat_erls",rootrat_erls) (*FIXXXME:del with rls.rls'*)
62.36 + ]);
62.37 +
62.38 +(*.calculate numeral groundterms.*)
62.39 +val calculate_RootRat =
62.40 + append_rls "calculate_RootRat" calculate_Rational
62.41 + [Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
62.42 + (* w*(z1.0 + z2.0) = w * z1.0 + w * z2.0 *)
62.43 + Thm ("real_mult_1",num_str real_mult_1),
62.44 + (* 1 * z = z *)
62.45 + Thm ("sym_real_mult_minus1",num_str (real_mult_minus1 RS sym)),
62.46 + (* "- z1 = -1 * z1" *)
62.47 + Calc ("Root.sqrt",eval_sqrt "#sqrt_")
62.48 + ];
62.49 +ruleset' := overwritelthy thy (!ruleset',
62.50 + [("calculate_RootRat",calculate_RootRat)]);
62.51 +
62.52 +
62.53 +"******* RootRat.ML end *******";
63.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
63.2 +++ b/src/Pure/isac/IsacKnowledge/RootRat.thy Wed Jul 21 13:53:39 2010 +0200
63.3 @@ -0,0 +1,16 @@
63.4 +(*.(c) by Richard Lang, 2003 .*)
63.5 +(* collecting all knowledge for Root and Rational
63.6 + created by: rlang
63.7 + date: 02.10
63.8 + changed by: rlang
63.9 + last change by: rlang
63.10 + date: 02.10.20
63.11 +*)
63.12 +
63.13 +RootRat = Root + Rational +
63.14 +(*-------------------- consts------------------------------------------------*)
63.15 +
63.16 +
63.17 +(*-------------------- rules------------------------------------------------*)
63.18 +
63.19 +end
64.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
64.2 +++ b/src/Pure/isac/IsacKnowledge/RootRatEq.ML Wed Jul 21 13:53:39 2010 +0200
64.3 @@ -0,0 +1,166 @@
64.4 +(*.(c) by Richard Lang, 2003 .*)
64.5 +(* collecting all knowledge for Root and Rational Equations
64.6 + created by: rlang
64.7 + date: 02.10
64.8 + changed by: rlang
64.9 + last change by: rlang
64.10 + date: 02.11.04
64.11 +*)
64.12 +
64.13 +(* use"knowledge/RootRatEq.ML";
64.14 + use"RootRatEq.ML";
64.15 +
64.16 + use"ROOT.ML";
64.17 + cd"knowledge";
64.18 +
64.19 + remove_thy"RootRatEq";
64.20 + use_thy"Isac";
64.21 + *)
64.22 +
64.23 +"******* RootRatEq.ML begin *******";
64.24 +theory' := overwritel (!theory', [("RootRatEq.thy",RootRatEq.thy)]);
64.25 +
64.26 +(*-------------------------functions---------------------*)
64.27 +(* true if denominator contains (sq)root in + or - term
64.28 + 1/(sqrt(x+3)*(x+4)) -> false; 1/(sqrt(x)+2) -> true
64.29 + if false then (term)^2 contains no (sq)root *)
64.30 +fun is_rootRatAddTerm_in t v =
64.31 + let
64.32 + fun coeff_in c v = v mem (vars c);
64.33 + fun rootadd (t as (Const ("op +",_) $ t2 $ t3)) v = (is_rootTerm_in t2 v) orelse
64.34 + (is_rootTerm_in t3 v)
64.35 + | rootadd (t as (Const ("op -",_) $ t2 $ t3)) v = (is_rootTerm_in t2 v) orelse
64.36 + (is_rootTerm_in t3 v)
64.37 + | rootadd _ _ = false;
64.38 + fun findrootrat (_ $ _ $ _ $ _) v = raise error("is_rootRatAddTerm_in:")
64.39 + (* at the moment there is no term like this, but ....*)
64.40 + | findrootrat (t as (Const ("HOL.divide",_) $ _ $ t3)) v =
64.41 + if (is_rootTerm_in t3 v) then rootadd t3 v else false
64.42 + | findrootrat (_ $ t1 $ t2) v = (findrootrat t1 v) orelse (findrootrat t2 v)
64.43 + | findrootrat (_ $ t1) v = (findrootrat t1 v)
64.44 + | findrootrat _ _ = false;
64.45 + in
64.46 + findrootrat t v
64.47 + end;
64.48 +
64.49 +fun eval_is_rootRatAddTerm_in _ _ (p as (Const ("RootRatEq.is'_rootRatAddTerm'_in",_) $ t $ v)) _ =
64.50 + if is_rootRatAddTerm_in t v then
64.51 + Some ((term2str p) ^ " = True",
64.52 + Trueprop $ (mk_equality (p, HOLogic.true_const)))
64.53 + else Some ((term2str p) ^ " = True",
64.54 + Trueprop $ (mk_equality (p, HOLogic.false_const)))
64.55 + | eval_is_rootRatAddTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) None);
64.56 +
64.57 +(*-------------------------rulse-------------------------*)
64.58 +val RootRatEq_prls =
64.59 + append_rls "RootRatEq_prls" e_rls
64.60 + [Calc ("Atools.ident",eval_ident "#ident_"),
64.61 + Calc ("Tools.matches",eval_matches ""),
64.62 + Calc ("Tools.lhs" ,eval_lhs ""),
64.63 + Calc ("Tools.rhs" ,eval_rhs ""),
64.64 + Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
64.65 + Calc ("RootRatEq.is'_rootRatAddTerm'_in", eval_is_rootRatAddTerm_in ""),
64.66 + Calc ("op =",eval_equal "#equal_"),
64.67 + Thm ("not_true",num_str not_true),
64.68 + Thm ("not_false",num_str not_false),
64.69 + Thm ("and_true",num_str and_true),
64.70 + Thm ("and_false",num_str and_false),
64.71 + Thm ("or_true",num_str or_true),
64.72 + Thm ("or_false",num_str or_false)
64.73 + ];
64.74 +
64.75 +
64.76 +val RooRatEq_erls =
64.77 + merge_rls "RooRatEq_erls" rootrat_erls
64.78 + (merge_rls "" RootEq_erls
64.79 + (merge_rls "" rateq_erls
64.80 + (append_rls "" e_rls
64.81 + [])));
64.82 +
64.83 +val RootRatEq_crls =
64.84 + merge_rls "RootRatEq_crls" rootrat_erls
64.85 + (merge_rls "" RootEq_erls
64.86 + (merge_rls "" rateq_erls
64.87 + (append_rls "" e_rls
64.88 + [])));
64.89 +
64.90 +ruleset' := overwritelthy thy (!ruleset',
64.91 + [("RooRatEq_erls",RooRatEq_erls) (*FIXXXME:del with rls.rls'*)
64.92 + ]);
64.93 +
64.94 +(* Solves a rootrat Equation *)
64.95 + val rootrat_solve = prep_rls(
64.96 + Rls {id = "rootrat_solve", preconds = [],
64.97 + rew_ord = ("termlessI",termlessI),
64.98 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
64.99 + rules = [ Thm("rootrat_equation_left_1",num_str rootrat_equation_left_1),
64.100 + (* [|c is_rootTerm_in bdv|] ==> ( (a + b/c = d) = ( b = (d - a) * c )) *)
64.101 + Thm("rootrat_equation_left_2",num_str rootrat_equation_left_2),
64.102 + (* [|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c )) *)
64.103 + Thm("rootrat_equation_right_1",num_str rootrat_equation_right_1),
64.104 + (* [|f is_rootTerm_in bdv|] ==> ( (a = d + e/f) = ( (a - d) * f = e )) *)
64.105 + Thm("rootrat_equation_right_2",num_str rootrat_equation_right_2)
64.106 + (* [|f is_rootTerm_in bdv|] ==> ( (a = e/f) = ( a * f = e )) *)
64.107 + ],
64.108 + scr = Script ((term_of o the o (parse thy)) "empty_script")
64.109 + }:rls);
64.110 +ruleset' := overwritelthy thy (!ruleset',
64.111 + [("rootrat_solve",rootrat_solve)
64.112 + ]);
64.113 +
64.114 +(*-----------------------probleme------------------------*)
64.115 +(*
64.116 +(get_pbt ["rat","root","univariate","equation"]);
64.117 +show_ptyps();
64.118 +*)
64.119 +store_pbt
64.120 + (prep_pbt RootRatEq.thy "pbl_equ_univ_root_sq_rat" [] e_pblID
64.121 + (["rat","sq","root","univariate","equation"],
64.122 + [("#Given" ,["equality e_","solveFor v_"]),
64.123 + ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) )| \
64.124 + \( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
64.125 + ("#Find" ,["solutions v_i_"])
64.126 + ],
64.127 + RootRatEq_prls, Some "solve (e_::bool, v_)",
64.128 + [["RootRatEq","elim_rootrat_equation"]]));
64.129 +
64.130 +(*-------------------------Methode-----------------------*)
64.131 +store_met
64.132 + (prep_met LinEq.thy "met_rootrateq" [] e_metID
64.133 + (["RootRatEq"],
64.134 + [],
64.135 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
64.136 + crls=Atools_erls, nrls=norm_Rational(*,
64.137 + asm_rls=[],asm_thm=[]*)}, "empty_script"));
64.138 +(*-- left 20.10.02 --*)
64.139 +store_met
64.140 + (prep_met RootRatEq.thy "met_rootrateq_elim" [] e_metID
64.141 + (["RootRatEq","elim_rootrat_equation"],
64.142 + [("#Given" ,["equality e_","solveFor v_"]),
64.143 + ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) ) | \
64.144 + \( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
64.145 + ("#Find" ,["solutions v_i_"])
64.146 + ],
64.147 + {rew_ord'="termlessI",
64.148 + rls'=RooRatEq_erls,
64.149 + srls=e_rls,
64.150 + prls=RootRatEq_prls,
64.151 + calc=[],
64.152 + crls=RootRatEq_crls, nrls=norm_Rational(*,
64.153 + asm_rls=[],
64.154 + asm_thm=[]*)},
64.155 + "Script Elim_rootrat_equation (e_::bool) (v_::real) = \
64.156 + \(let e_ = ((Try (Rewrite_Set expand_rootbinoms False)) @@ \
64.157 + \ (Try (Rewrite_Set rooteq_simplify False)) @@ \
64.158 + \ (Try (Rewrite_Set make_rooteq False)) @@ \
64.159 + \ (Try (Rewrite_Set rooteq_simplify False)) @@ \
64.160 + \ (Try (Rewrite_Set_Inst [(bdv,v_)] \
64.161 + \ rootrat_solve False))) e_ \
64.162 + \ in (SubProblem (RootEq_,[univariate,equation], \
64.163 + \ [no_met]) [bool_ e_, real_ v_]))"
64.164 + ));
64.165 +calclist':= overwritel (!calclist',
64.166 + [("is_rootRatAddTerm_in", ("RootRatEq.is_rootRatAddTerm_in",
64.167 + eval_is_rootRatAddTerm_in""))
64.168 + ]);(*("", ("", "")),*)
64.169 +"******* RootRatEq.ML end *******";
65.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
65.2 +++ b/src/Pure/isac/IsacKnowledge/RootRatEq.thy Wed Jul 21 13:53:39 2010 +0200
65.3 @@ -0,0 +1,48 @@
65.4 +(*.c) by Richard Lang, 2003 .*)
65.5 +(* collecting all knowledge for Root and Rational Equations
65.6 + created by: rlang
65.7 + date: 02.10
65.8 + changed by: rlang
65.9 + last change by: rlang
65.10 + date: 02.11.04
65.11 +*)
65.12 +
65.13 +(* use"knowledge/RootRatEq.ML";
65.14 + use"RootRatEq.ML";
65.15 +
65.16 + use"ROOT.ML";
65.17 + cd"knowledge";
65.18 +
65.19 + remove_thy"RootRatEq";
65.20 + use_thy"Isac";
65.21 + *)
65.22 +
65.23 +RootRatEq = RootEq + RatEq + RootRat +
65.24 +
65.25 +(*-------------------- consts-----------------------------------------------*)
65.26 +consts
65.27 +
65.28 + is'_rootRatAddTerm'_in :: [real, real] => bool ("_ is'_rootRatAddTerm'_in _") (*RL DA*)
65.29 +
65.30 +(*---------scripts--------------------------*)
65.31 + Elim'_rootrat'_equation
65.32 + :: "[bool,real, \
65.33 + \ bool list] => bool list"
65.34 + ("((Script Elim'_rootrat'_equation (_ _ =))// \
65.35 + \ (_))" 9)
65.36 + (*-------------------- rules------------------------------------------------*)
65.37 +rules
65.38 +
65.39 + (* eliminate ratRootTerm *)
65.40 + rootrat_equation_left_1
65.41 + "[|c is_rootTerm_in bdv|] ==> ( (a + b/c = d) = ( b = (d - a) * c ))"
65.42 + rootrat_equation_left_2
65.43 + "[|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c ))"
65.44 + rootrat_equation_right_2
65.45 + "[|f is_rootTerm_in bdv|] ==> ( (a = d + e/f) = ( (a - d) * f = e ))"
65.46 + rootrat_equation_right_1
65.47 + "[|f is_rootTerm_in bdv|] ==> ( (a = e/f) = ( a * f = e ))"
65.48 +
65.49 +
65.50 +
65.51 +end
66.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
66.2 +++ b/src/Pure/isac/IsacKnowledge/Simplify.ML Wed Jul 21 13:53:39 2010 +0200
66.3 @@ -0,0 +1,76 @@
66.4 +(* simplification of terms
66.5 + author: Walther Neuper 050912
66.6 + (c) due to copyright terms
66.7 +
66.8 +use"IsacKnowledge/Simplify.ML";
66.9 +use"Simplify.ML";
66.10 +*)
66.11 +
66.12 +
66.13 +(** interface isabelle -- isac **)
66.14 +
66.15 +theory' := overwritel (!theory', [("Simplify.thy",Simplify.thy)]);
66.16 +
66.17 +(** problems **)
66.18 +
66.19 +store_pbt
66.20 + (prep_pbt Simplify.thy "pbl_simp" [] e_pblID
66.21 + (["simplification"],
66.22 + [("#Given" ,["term t_"]),
66.23 + ("#Find" ,["normalform n_"])
66.24 + ],
66.25 + append_rls "e_rls" e_rls [(*for preds in where_*)],
66.26 + Some "Simplify t_",
66.27 + []));
66.28 +
66.29 +store_pbt
66.30 + (prep_pbt Simplify.thy "pbl_vereinfache" [] e_pblID
66.31 + (["vereinfachen"],
66.32 + [("#Given" ,["term t_"]),
66.33 + ("#Find" ,["normalform n_"])
66.34 + ],
66.35 + append_rls "e_rls" e_rls [(*for preds in where_*)],
66.36 + Some "Vereinfache t_",
66.37 + []));
66.38 +
66.39 +(** methods **)
66.40 +
66.41 +store_met
66.42 + (prep_met Simplify.thy "met_simp" [] e_metID
66.43 + (["simplification"],
66.44 + [("#Given" ,["term t_"]),
66.45 + ("#Find" ,["normalform n_"])
66.46 + ],
66.47 + {rew_ord'="tless_true",
66.48 + rls'= e_rls,
66.49 + calc = [],
66.50 + srls = e_rls,
66.51 + prls=e_rls,
66.52 + crls = e_rls, nrls = e_rls},
66.53 + "empty_script"
66.54 + ));
66.55 +
66.56 +(** CAS-command **)
66.57 +
66.58 +(*.function for handling the cas-input "Simplify (2*a + 3*a)":
66.59 + make a model which is already in ptree-internal format.*)
66.60 +(* val (h,argl) = strip_comb (str2term "Simplify (2*a + 3*a)");
66.61 + val (h,argl) = strip_comb ((term_of o the o (parse thy))
66.62 + "Simplify (2*a + 3*a)");
66.63 + *)
66.64 +fun argl2dtss t =
66.65 + [((term_of o the o (parse thy)) "term", t),
66.66 + ((term_of o the o (parse thy)) "normalform",
66.67 + [(term_of o the o (parse thy)) "N"])
66.68 + ]
66.69 + | argl2dtss _ = raise error "Simplify.ML: wrong argument for argl2dtss";
66.70 +
66.71 +castab :=
66.72 +overwritel (!castab,
66.73 + [((term_of o the o (parse thy)) "Simplify",
66.74 + (("Isac.thy", ["simplification"], ["no_met"]),
66.75 + argl2dtss)),
66.76 + ((term_of o the o (parse thy)) "Vereinfache",
66.77 + (("Isac.thy", ["vereinfachen"], ["no_met"]),
66.78 + argl2dtss))
66.79 + ]);
67.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
67.2 +++ b/src/Pure/isac/IsacKnowledge/Simplify.thy Wed Jul 21 13:53:39 2010 +0200
67.3 @@ -0,0 +1,29 @@
67.4 +(* simplification of terms
67.5 + author: Walther Neuper 050912
67.6 + (c) due to copyright terms
67.7 +
67.8 +remove_thy"Simplify";
67.9 +use_thy"~/proto2/isac/src/sml/IsacKnowledge/Simplify";
67.10 +
67.11 +use_thy_only"~/proto2/isac/src/sml/IsacKnowledge/Simplify";
67.12 +use_thy"~/proto2/isac/src/sml/IsacKnowledge/Isac";
67.13 +*)
67.14 +
67.15 +Simplify = Atools +
67.16 +
67.17 +consts
67.18 +
67.19 + (*descriptions in the related problem*)
67.20 + term :: real => una
67.21 + normalform :: real => una
67.22 +
67.23 + (*the CAS-command*)
67.24 + Simplify :: "real => real" (*"Simplify (1+2a+3+4a)*)
67.25 + Vereinfache :: "real => real" (*"Vereinfache (1+2a+3+4a)*)
67.26 +
67.27 + (*Script-name*)
67.28 + SimplifyScript :: "[real, real] => real"
67.29 + ("((Script SimplifyScript (_ =))// (_))" 9)
67.30 +
67.31 +
67.32 +end
67.33 \ No newline at end of file
68.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
68.2 +++ b/src/Pure/isac/IsacKnowledge/Test.ML Wed Jul 21 13:53:39 2010 +0200
68.3 @@ -0,0 +1,1301 @@
68.4 +(* SML functions for rational arithmetic
68.5 + WN.22.10.99
68.6 + use"../knowledge/Test.ML";
68.7 + use"IsacKnowledge/Test.ML";
68.8 + use"Test.ML";
68.9 + *)
68.10 +
68.11 +
68.12 +(** interface isabelle -- isac **)
68.13 +
68.14 +theory' := overwritel (!theory', [("Test.thy",Test.thy)]);
68.15 +
68.16 +(** evaluation of numerals and predicates **)
68.17 +
68.18 +(*does a term contain a root ?*)
68.19 +fun eval_root_free (thmid:string) _ (t as (Const(op0,t0) $ arg)) thy =
68.20 + if strip_thy op0 <> "is'_root'_free"
68.21 + then raise error ("eval_root_free: wrong "^op0)
68.22 + else if const_in (strip_thy op0) arg
68.23 + then Some (mk_thmid thmid ""
68.24 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
68.25 + Trueprop $ (mk_equality (t, false_as_term)))
68.26 + else Some (mk_thmid thmid ""
68.27 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
68.28 + Trueprop $ (mk_equality (t, true_as_term)))
68.29 + | eval_root_free _ _ _ _ = None;
68.30 +
68.31 +(*does a term contain a root ?*)
68.32 +fun eval_contains_root (thmid:string) _
68.33 + (t as (Const("Test.contains'_root",t0) $ arg)) thy =
68.34 + if "sqrt" mem (ids_of arg)
68.35 + then Some (mk_thmid thmid ""
68.36 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
68.37 + Trueprop $ (mk_equality (t, true_as_term)))
68.38 + else Some (mk_thmid thmid ""
68.39 + ((string_of_cterm o cterm_of (sign_of thy)) arg) "",
68.40 + Trueprop $ (mk_equality (t, false_as_term)))
68.41 + | eval_contains_root _ _ _ _ = None;
68.42 +
68.43 +calclist':= overwritel (!calclist',
68.44 + [("is_root_free", ("Test.is'_root'_free",
68.45 + eval_root_free"#is_root_free_")),
68.46 + ("contains_root", ("Test.contains'_root",
68.47 + eval_contains_root"#contains_root_"))
68.48 + ]);
68.49 +
68.50 +(** term order **)
68.51 +fun term_order (_:subst) tu = (term_ordI [] tu = LESS);
68.52 +
68.53 +(** rule sets **)
68.54 +
68.55 +val testerls =
68.56 + Rls {id = "testerls", preconds = [], rew_ord = ("termlessI",termlessI),
68.57 + erls = e_rls, srls = Erls,
68.58 + calc = [],
68.59 + rules = [Thm ("refl",num_str refl),
68.60 + Thm ("le_refl",num_str le_refl),
68.61 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
68.62 + Thm ("not_true",num_str not_true),
68.63 + Thm ("not_false",num_str not_false),
68.64 + Thm ("and_true",and_true),
68.65 + Thm ("and_false",and_false),
68.66 + Thm ("or_true",or_true),
68.67 + Thm ("or_false",or_false),
68.68 + Thm ("and_commute",num_str and_commute),
68.69 + Thm ("or_commute",num_str or_commute),
68.70 +
68.71 + Calc ("Atools.is'_const",eval_const "#is_const_"),
68.72 + Calc ("Tools.matches",eval_matches ""),
68.73 +
68.74 + Calc ("op +",eval_binop "#add_"),
68.75 + Calc ("op *",eval_binop "#mult_"),
68.76 + Calc ("Atools.pow" ,eval_binop "#power_"),
68.77 +
68.78 + Calc ("op <",eval_equ "#less_"),
68.79 + Calc ("op <=",eval_equ "#less_equal_"),
68.80 +
68.81 + Calc ("Atools.ident",eval_ident "#ident_")],
68.82 + scr = Script ((term_of o the o (parse thy))
68.83 + "empty_script")
68.84 + }:rls;
68.85 +
68.86 +(*.for evaluation of conditions in rewrite rules.*)
68.87 +(*FIXXXXXXME 10.8.02: handle like _simplify*)
68.88 +val tval_rls =
68.89 + Rls{id = "tval_rls", preconds = [],
68.90 + rew_ord = ("sqrt_right",sqrt_right false ProtoPure.thy),
68.91 + erls=testerls,srls = e_rls,
68.92 + calc=[],
68.93 + rules = [Thm ("refl",num_str refl),
68.94 + Thm ("le_refl",num_str le_refl),
68.95 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
68.96 + Thm ("not_true",num_str not_true),
68.97 + Thm ("not_false",num_str not_false),
68.98 + Thm ("and_true",and_true),
68.99 + Thm ("and_false",and_false),
68.100 + Thm ("or_true",or_true),
68.101 + Thm ("or_false",or_false),
68.102 + Thm ("and_commute",num_str and_commute),
68.103 + Thm ("or_commute",num_str or_commute),
68.104 +
68.105 + Thm ("real_diff_minus",num_str real_diff_minus),
68.106 +
68.107 + Thm ("root_ge0",num_str root_ge0),
68.108 + Thm ("root_add_ge0",num_str root_add_ge0),
68.109 + Thm ("root_ge0_1",num_str root_ge0_1),
68.110 + Thm ("root_ge0_2",num_str root_ge0_2),
68.111 +
68.112 + Calc ("Atools.is'_const",eval_const "#is_const_"),
68.113 + Calc ("Test.is'_root'_free",eval_root_free "#is_root_free_"),
68.114 + Calc ("Tools.matches",eval_matches ""),
68.115 + Calc ("Test.contains'_root",
68.116 + eval_contains_root"#contains_root_"),
68.117 +
68.118 + Calc ("op +",eval_binop "#add_"),
68.119 + Calc ("op *",eval_binop "#mult_"),
68.120 + Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
68.121 + Calc ("Atools.pow" ,eval_binop "#power_"),
68.122 +
68.123 + Calc ("op <",eval_equ "#less_"),
68.124 + Calc ("op <=",eval_equ "#less_equal_"),
68.125 +
68.126 + Calc ("Atools.ident",eval_ident "#ident_")],
68.127 + scr = Script ((term_of o the o (parse thy))
68.128 + "empty_script")
68.129 + }:rls;
68.130 +
68.131 +
68.132 +ruleset' := overwritelthy thy (!ruleset',
68.133 + [("testerls", prep_rls testerls)
68.134 + ]);
68.135 +
68.136 +
68.137 +(*make () dissappear*)
68.138 +val rearrange_assoc =
68.139 + Rls{id = "rearrange_assoc", preconds = [],
68.140 + rew_ord = ("e_rew_ord",e_rew_ord),
68.141 + erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
68.142 + rules =
68.143 + [Thm ("sym_radd_assoc",num_str (radd_assoc RS sym)),
68.144 + Thm ("sym_rmult_assoc",num_str (rmult_assoc RS sym))],
68.145 + scr = Script ((term_of o the o (parse thy))
68.146 + "empty_script")
68.147 + }:rls;
68.148 +
68.149 +val ac_plus_times =
68.150 + Rls{id = "ac_plus_times", preconds = [], rew_ord = ("term_order",term_order),
68.151 + erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
68.152 + rules =
68.153 + [Thm ("radd_commute",radd_commute),
68.154 + Thm ("radd_left_commute",radd_left_commute),
68.155 + Thm ("radd_assoc",radd_assoc),
68.156 + Thm ("rmult_commute",rmult_commute),
68.157 + Thm ("rmult_left_commute",rmult_left_commute),
68.158 + Thm ("rmult_assoc",rmult_assoc)],
68.159 + scr = Script ((term_of o the o (parse thy))
68.160 + "empty_script")
68.161 + }:rls;
68.162 +
68.163 +(*todo: replace by Rewrite("rnorm_equation_add",num_str rnorm_equation_add)*)
68.164 +val norm_equation =
68.165 + Rls{id = "norm_equation", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
68.166 + erls = tval_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
68.167 + rules = [Thm ("rnorm_equation_add",num_str rnorm_equation_add)
68.168 + ],
68.169 + scr = Script ((term_of o the o (parse thy))
68.170 + "empty_script")
68.171 + }:rls;
68.172 +
68.173 +(** rule sets **)
68.174 +
68.175 +val STest_simplify = (* vv--- not changed to real by parse*)
68.176 + "Script STest_simplify (t_::'z) = \
68.177 + \(Repeat\
68.178 + \ ((Try (Repeat (Rewrite real_diff_minus False))) @@ \
68.179 + \ (Try (Repeat (Rewrite radd_mult_distrib2 False))) @@ \
68.180 + \ (Try (Repeat (Rewrite rdistr_right_assoc False))) @@ \
68.181 + \ (Try (Repeat (Rewrite rdistr_right_assoc_p False))) @@\
68.182 + \ (Try (Repeat (Rewrite rdistr_div_right False))) @@ \
68.183 + \ (Try (Repeat (Rewrite rbinom_power_2 False))) @@ \
68.184 +
68.185 + \ (Try (Repeat (Rewrite radd_commute False))) @@ \
68.186 + \ (Try (Repeat (Rewrite radd_left_commute False))) @@ \
68.187 + \ (Try (Repeat (Rewrite radd_assoc False))) @@ \
68.188 + \ (Try (Repeat (Rewrite rmult_commute False))) @@ \
68.189 + \ (Try (Repeat (Rewrite rmult_left_commute False))) @@ \
68.190 + \ (Try (Repeat (Rewrite rmult_assoc False))) @@ \
68.191 +
68.192 + \ (Try (Repeat (Rewrite radd_real_const_eq False))) @@ \
68.193 + \ (Try (Repeat (Rewrite radd_real_const False))) @@ \
68.194 + \ (Try (Repeat (Calculate plus))) @@ \
68.195 + \ (Try (Repeat (Calculate times))) @@ \
68.196 + \ (Try (Repeat (Calculate divide_))) @@\
68.197 + \ (Try (Repeat (Calculate power_))) @@ \
68.198 +
68.199 + \ (Try (Repeat (Rewrite rcollect_right False))) @@ \
68.200 + \ (Try (Repeat (Rewrite rcollect_one_left False))) @@ \
68.201 + \ (Try (Repeat (Rewrite rcollect_one_left_assoc False))) @@ \
68.202 + \ (Try (Repeat (Rewrite rcollect_one_left_assoc_p False))) @@ \
68.203 +
68.204 + \ (Try (Repeat (Rewrite rshift_nominator False))) @@ \
68.205 + \ (Try (Repeat (Rewrite rcancel_den False))) @@ \
68.206 + \ (Try (Repeat (Rewrite rroot_square_inv False))) @@ \
68.207 + \ (Try (Repeat (Rewrite rroot_times_root False))) @@ \
68.208 + \ (Try (Repeat (Rewrite rroot_times_root_assoc_p False))) @@ \
68.209 + \ (Try (Repeat (Rewrite rsqare False))) @@ \
68.210 + \ (Try (Repeat (Rewrite power_1 False))) @@ \
68.211 + \ (Try (Repeat (Rewrite rtwo_of_the_same False))) @@ \
68.212 + \ (Try (Repeat (Rewrite rtwo_of_the_same_assoc_p False))) @@ \
68.213 +
68.214 + \ (Try (Repeat (Rewrite rmult_1 False))) @@ \
68.215 + \ (Try (Repeat (Rewrite rmult_1_right False))) @@ \
68.216 + \ (Try (Repeat (Rewrite rmult_0 False))) @@ \
68.217 + \ (Try (Repeat (Rewrite rmult_0_right False))) @@ \
68.218 + \ (Try (Repeat (Rewrite radd_0 False))) @@ \
68.219 + \ (Try (Repeat (Rewrite radd_0_right False)))) \
68.220 + \ t_)";
68.221 +
68.222 +
68.223 +(* expects * distributed over + *)
68.224 +val Test_simplify =
68.225 + Rls{id = "Test_simplify", preconds = [],
68.226 + rew_ord = ("sqrt_right",sqrt_right false ProtoPure.thy),
68.227 + erls = tval_rls, srls = e_rls,
68.228 + calc=[(*since 040209 filled by prep_rls*)],
68.229 + (*asm_thm = [],*)
68.230 + rules = [
68.231 + Thm ("real_diff_minus",num_str real_diff_minus),
68.232 + Thm ("radd_mult_distrib2",num_str radd_mult_distrib2),
68.233 + Thm ("rdistr_right_assoc",num_str rdistr_right_assoc),
68.234 + Thm ("rdistr_right_assoc_p",num_str rdistr_right_assoc_p),
68.235 + Thm ("rdistr_div_right",num_str rdistr_div_right),
68.236 + Thm ("rbinom_power_2",num_str rbinom_power_2),
68.237 +
68.238 + Thm ("radd_commute",num_str radd_commute),
68.239 + Thm ("radd_left_commute",num_str radd_left_commute),
68.240 + Thm ("radd_assoc",num_str radd_assoc),
68.241 + Thm ("rmult_commute",num_str rmult_commute),
68.242 + Thm ("rmult_left_commute",num_str rmult_left_commute),
68.243 + Thm ("rmult_assoc",num_str rmult_assoc),
68.244 +
68.245 + Thm ("radd_real_const_eq",num_str radd_real_const_eq),
68.246 + Thm ("radd_real_const",num_str radd_real_const),
68.247 + (* these 2 rules are invers to distr_div_right wrt. termination.
68.248 + thus they MUST be done IMMEDIATELY before calc *)
68.249 + Calc ("op +", eval_binop "#add_"),
68.250 + Calc ("op *", eval_binop "#mult_"),
68.251 + Calc ("HOL.divide", eval_cancel "#divide_"),
68.252 + Calc ("Atools.pow", eval_binop "#power_"),
68.253 +
68.254 + Thm ("rcollect_right",num_str rcollect_right),
68.255 + Thm ("rcollect_one_left",num_str rcollect_one_left),
68.256 + Thm ("rcollect_one_left_assoc",num_str rcollect_one_left_assoc),
68.257 + Thm ("rcollect_one_left_assoc_p",num_str rcollect_one_left_assoc_p),
68.258 +
68.259 + Thm ("rshift_nominator",num_str rshift_nominator),
68.260 + Thm ("rcancel_den",num_str rcancel_den),
68.261 + Thm ("rroot_square_inv",num_str rroot_square_inv),
68.262 + Thm ("rroot_times_root",num_str rroot_times_root),
68.263 + Thm ("rroot_times_root_assoc_p",num_str rroot_times_root_assoc_p),
68.264 + Thm ("rsqare",num_str rsqare),
68.265 + Thm ("power_1",num_str power_1),
68.266 + Thm ("rtwo_of_the_same",num_str rtwo_of_the_same),
68.267 + Thm ("rtwo_of_the_same_assoc_p",num_str rtwo_of_the_same_assoc_p),
68.268 +
68.269 + Thm ("rmult_1",num_str rmult_1),
68.270 + Thm ("rmult_1_right",num_str rmult_1_right),
68.271 + Thm ("rmult_0",num_str rmult_0),
68.272 + Thm ("rmult_0_right",num_str rmult_0_right),
68.273 + Thm ("radd_0",num_str radd_0),
68.274 + Thm ("radd_0_right",num_str radd_0_right)
68.275 + ],
68.276 + scr = Script ((term_of o the o (parse thy)) "empty_script")
68.277 + (*since 040209 filled by prep_rls: STest_simplify*)
68.278 + }:rls;
68.279 +
68.280 +
68.281 +
68.282 +
68.283 +
68.284 +(** rule sets **)
68.285 +
68.286 +
68.287 +
68.288 +(*isolate the root in a root-equation*)
68.289 +val isolate_root =
68.290 + Rls{id = "isolate_root", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
68.291 + erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
68.292 + rules = [Thm ("rroot_to_lhs",num_str rroot_to_lhs),
68.293 + Thm ("rroot_to_lhs_mult",num_str rroot_to_lhs_mult),
68.294 + Thm ("rroot_to_lhs_add_mult",num_str rroot_to_lhs_add_mult),
68.295 + Thm ("risolate_root_add",num_str risolate_root_add),
68.296 + Thm ("risolate_root_mult",num_str risolate_root_mult),
68.297 + Thm ("risolate_root_div",num_str risolate_root_div) ],
68.298 + scr = Script ((term_of o the o (parse thy))
68.299 + "empty_script")
68.300 + }:rls;
68.301 +
68.302 +(*isolate the bound variable in an equation; 'bdv' is a meta-constant*)
68.303 +val isolate_bdv =
68.304 + Rls{id = "isolate_bdv", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
68.305 + erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
68.306 + rules =
68.307 + [Thm ("risolate_bdv_add",num_str risolate_bdv_add),
68.308 + Thm ("risolate_bdv_mult_add",num_str risolate_bdv_mult_add),
68.309 + Thm ("risolate_bdv_mult",num_str risolate_bdv_mult),
68.310 + Thm ("mult_square",num_str mult_square),
68.311 + Thm ("constant_square",num_str constant_square),
68.312 + Thm ("constant_mult_square",num_str constant_mult_square)
68.313 + ],
68.314 + scr = Script ((term_of o the o (parse thy))
68.315 + "empty_script")
68.316 + }:rls;
68.317 +
68.318 +
68.319 +
68.320 +
68.321 +(* association list for calculate_, calculate
68.322 + "op +" etc. not usable in scripts *)
68.323 +val calclist =
68.324 + [
68.325 + (*as Tools.ML*)
68.326 + ("Vars" ,("Tools.Vars" ,eval_var "#Vars_")),
68.327 + ("matches",("Tools.matches",eval_matches "#matches_")),
68.328 + ("lhs" ,("Tools.lhs" ,eval_lhs "")),
68.329 + (*aus Atools.ML*)
68.330 + ("plus" ,("op +" ,eval_binop "#add_")),
68.331 + ("times" ,("op *" ,eval_binop "#mult_")),
68.332 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
68.333 + ("power_" ,("Atools.pow" ,eval_binop "#power_")),
68.334 + ("is_const",("Atools.is'_const",eval_const "#is_const_")),
68.335 + ("le" ,("op <" ,eval_equ "#less_")),
68.336 + ("leq" ,("op <=" ,eval_equ "#less_equal_")),
68.337 + ("ident" ,("Atools.ident",eval_ident "#ident_")),
68.338 + (*von hier (ehem.SqRoot*)
68.339 + ("sqrt" ,("Root.sqrt" ,eval_sqrt "#sqrt_")),
68.340 + ("Test.is_root_free",("is'_root'_free", eval_root_free"#is_root_free_")),
68.341 + ("Test.contains_root",("contains'_root",
68.342 + eval_contains_root"#contains_root_"))
68.343 + ];
68.344 +
68.345 +ruleset' := overwritelthy thy (!ruleset',
68.346 + [("Test_simplify", prep_rls Test_simplify),
68.347 + ("tval_rls", prep_rls tval_rls),
68.348 + ("isolate_root", prep_rls isolate_root),
68.349 + ("isolate_bdv", prep_rls isolate_bdv),
68.350 + ("matches",
68.351 + prep_rls (append_rls "matches" testerls
68.352 + [Calc ("Tools.matches",eval_matches "#matches_")]))
68.353 + ]);
68.354 +
68.355 +(** problem types **)
68.356 +store_pbt
68.357 + (prep_pbt Test.thy "pbl_test" [] e_pblID
68.358 + (["test"],
68.359 + [],
68.360 + e_rls, None, []));
68.361 +store_pbt
68.362 + (prep_pbt Test.thy "pbl_test_equ" [] e_pblID
68.363 + (["equation","test"],
68.364 + [("#Given" ,["equality e_","solveFor v_"]),
68.365 + ("#Where" ,["matches (?a = ?b) e_"]),
68.366 + ("#Find" ,["solutions v_i_"])
68.367 + ],
68.368 + assoc_rls "matches",
68.369 + Some "solve (e_::bool, v_)", []));
68.370 +
68.371 +store_pbt
68.372 + (prep_pbt Test.thy "pbl_test_uni" [] e_pblID
68.373 + (["univariate","equation","test"],
68.374 + [("#Given" ,["equality e_","solveFor v_"]),
68.375 + ("#Where" ,["matches (?a = ?b) e_"]),
68.376 + ("#Find" ,["solutions v_i_"])
68.377 + ],
68.378 + assoc_rls "matches",
68.379 + Some "solve (e_::bool, v_)", []));
68.380 +
68.381 +store_pbt
68.382 + (prep_pbt Test.thy "pbl_test_uni_lin" [] e_pblID
68.383 + (["linear","univariate","equation","test"],
68.384 + [("#Given" ,["equality e_","solveFor v_"]),
68.385 + ("#Where" ,["(matches ( v_ = 0) e_) | (matches ( ?b*v_ = 0) e_) |\
68.386 + \(matches (?a+v_ = 0) e_) | (matches (?a+?b*v_ = 0) e_) "]),
68.387 + ("#Find" ,["solutions v_i_"])
68.388 + ],
68.389 + assoc_rls "matches",
68.390 + Some "solve (e_::bool, v_)", [["Test","solve_linear"]]));
68.391 +
68.392 +(*25.8.01 ------
68.393 +store_pbt
68.394 + (prep_pbt Test.thy
68.395 + (["Test.thy"],
68.396 + [("#Given" ,"boolTestGiven g_"),
68.397 + ("#Find" ,"boolTestFind f_")
68.398 + ],
68.399 + []));
68.400 +
68.401 +store_pbt
68.402 + (prep_pbt Test.thy
68.403 + (["testeq","Test.thy"],
68.404 + [("#Given" ,"boolTestGiven g_"),
68.405 + ("#Find" ,"boolTestFind f_")
68.406 + ],
68.407 + []));
68.408 +
68.409 +
68.410 +val ttt = (term_of o the o (parse Isac.thy)) "(matches ( v_ = 0) e_)";
68.411 +
68.412 + ------ 25.8.01*)
68.413 +
68.414 +
68.415 +(** methods **)
68.416 +store_met
68.417 + (prep_met Diff.thy "met_test" [] e_metID
68.418 + (["Test"],
68.419 + [],
68.420 + {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
68.421 + crls=Atools_erls, nrls=e_rls(*,
68.422 + asm_rls=[],asm_thm=[]*)}, "empty_script"));
68.423 +(*
68.424 +store_met
68.425 + (prep_met Script.thy
68.426 + (e_metID,(*empty method*)
68.427 + [],
68.428 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
68.429 + asm_rls=[],asm_thm=[]},
68.430 + "Undef"));*)
68.431 +store_met
68.432 + (prep_met Test.thy "met_test_solvelin" [] e_metID
68.433 + (["Test","solve_linear"]:metID,
68.434 + [("#Given" ,["equality e_","solveFor v_"]),
68.435 + ("#Where" ,["matches (?a = ?b) e_"]),
68.436 + ("#Find" ,["solutions v_i_"])
68.437 + ],
68.438 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,
68.439 + prls=assoc_rls "matches",
68.440 + calc=[],
68.441 + crls=tval_rls, nrls=Test_simplify},
68.442 + "Script Solve_linear (e_::bool) (v_::real)= \
68.443 + \(let e_ =\
68.444 + \ Repeat\
68.445 + \ (((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
68.446 + \ (Rewrite_Set Test_simplify False))) e_\
68.447 + \ in [e_::bool])"
68.448 + )
68.449 +(*, prep_met Test.thy (*test for equations*)
68.450 + (["Test","testeq"]:metID,
68.451 + [("#Given" ,["boolTestGiven g_"]),
68.452 + ("#Find" ,["boolTestFind f_"])
68.453 + ],
68.454 + {rew_ord'="e_rew_ord",rls'="tval_rls",asm_rls=[],
68.455 + asm_thm=[("square_equation_left","")]},
68.456 + "Script Testeq (eq_::bool) = \
68.457 + \Repeat \
68.458 + \ (let e_ = Try (Repeat (Rewrite rroot_square_inv False eq_)); \
68.459 + \ e_ = Try (Repeat (Rewrite square_equation_left True e_)); \
68.460 + \ e_ = Try (Repeat (Rewrite rmult_0 False e_)) \
68.461 + \ in e_) Until (is_root_free e_)" (*deleted*)
68.462 + )
68.463 +, ---------27.4.02*)
68.464 +);
68.465 +
68.466 +
68.467 +
68.468 +
68.469 +ruleset' := overwritelthy thy (!ruleset',
68.470 + [("norm_equation", prep_rls norm_equation),
68.471 + ("ac_plus_times", prep_rls ac_plus_times),
68.472 + ("rearrange_assoc", prep_rls rearrange_assoc)
68.473 + ]);
68.474 +
68.475 +
68.476 +fun bin_o (Const (op_,(Type ("fun",
68.477 + [Type (s2,[]),Type ("fun",
68.478 + [Type (s4,tl4),Type (s5,tl5)])])))) =
68.479 + if (s2=s4)andalso(s4=s5)then[op_]else[]
68.480 + | bin_o _ = [];
68.481 +
68.482 +fun bin_op (t1 $ t2) = (bin_op t1) union (bin_op t2)
68.483 + | bin_op t = bin_o t;
68.484 +fun is_bin_op t = ((bin_op t)<>[]);
68.485 +
68.486 +fun bin_op_arg1 ((Const (op_,(Type ("fun",
68.487 + [Type (s2,[]),Type ("fun",
68.488 + [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) =
68.489 + arg1;
68.490 +fun bin_op_arg2 ((Const (op_,(Type ("fun",
68.491 + [Type (s2,[]),Type ("fun",
68.492 + [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) =
68.493 + arg2;
68.494 +
68.495 +
68.496 +exception NO_EQUATION_TERM;
68.497 +fun is_equation ((Const ("op =",(Type ("fun",
68.498 + [Type (_,[]),Type ("fun",
68.499 + [Type (_,[]),Type ("bool",[])])])))) $ _ $ _)
68.500 + = true
68.501 + | is_equation _ = false;
68.502 +fun equ_lhs ((Const ("op =",(Type ("fun",
68.503 + [Type (_,[]),Type ("fun",
68.504 + [Type (_,[]),Type ("bool",[])])])))) $ l $ r)
68.505 + = l
68.506 + | equ_lhs _ = raise NO_EQUATION_TERM;
68.507 +fun equ_rhs ((Const ("op =",(Type ("fun",
68.508 + [Type (_,[]),Type ("fun",
68.509 + [Type (_,[]),Type ("bool",[])])])))) $ l $ r)
68.510 + = r
68.511 + | equ_rhs _ = raise NO_EQUATION_TERM;
68.512 +
68.513 +
68.514 +fun atom (Const (_,Type (_,[]))) = true
68.515 + | atom (Free (_,Type (_,[]))) = true
68.516 + | atom (Var (_,Type (_,[]))) = true
68.517 +(*| atom (_ (_,"?DUMMY" )) = true ..ML-error *)
68.518 + | atom((Const ("Bin.integ_of_bin",_)) $ _) = true
68.519 + | atom _ = false;
68.520 +
68.521 +fun varids (Const (s,Type (_,[]))) = [strip_thy s]
68.522 + | varids (Free (s,Type (_,[]))) = if is_no s then []
68.523 + else [strip_thy s]
68.524 + | varids (Var((s,_),Type (_,[]))) = [strip_thy s]
68.525 +(*| varids (_ (s,"?DUMMY" )) = ..ML-error *)
68.526 + | varids((Const ("Bin.integ_of_bin",_)) $ _)= [](*8.01: superfluous?*)
68.527 + | varids (Abs(a,T,t)) = [a] union (varids t)
68.528 + | varids (t1 $ t2) = (varids t1) union (varids t2)
68.529 + | varids _ = [];
68.530 +(*> val t = term_of (hd (parse Diophant.thy "x"));
68.531 +val t = Free ("x","?DUMMY") : term
68.532 +> varids t;
68.533 +val it = [] : string list [] !!! *)
68.534 +
68.535 +
68.536 +fun bin_ops_only ((Const op_) $ t1 $ t2) =
68.537 + if(is_bin_op (Const op_))
68.538 + then(bin_ops_only t1)andalso(bin_ops_only t2)
68.539 + else false
68.540 + | bin_ops_only t =
68.541 + if atom t then true else bin_ops_only t;
68.542 +
68.543 +fun polynomial opl t bdVar = (* bdVar TODO *)
68.544 + (bin_op t) subset opl andalso (bin_ops_only t);
68.545 +
68.546 +fun poly_equ opl bdVar t = is_equation t (* bdVar TODO *)
68.547 + andalso polynomial opl (equ_lhs t) bdVar
68.548 + andalso polynomial opl (equ_rhs t) bdVar
68.549 + andalso ((varids bdVar) subset (varids (equ_lhs t))
68.550 + orelse(varids bdVar) subset (varids (equ_lhs t)));
68.551 +
68.552 +(*fun max is =
68.553 + let fun max_ m [] = m
68.554 + | max_ m (i::is) = if m<i then max_ i is else max_ m is;
68.555 + in max_ (hd is) is end;
68.556 +> max [1,5,3,7,4,2];
68.557 +val it = 7 : int *)
68.558 +
68.559 +fun max (a,b) = if a < b then b else a;
68.560 +
68.561 +fun degree addl mul bdVar t =
68.562 +let
68.563 +fun deg _ _ v (Const (s,Type (_,[]))) = if v=strip_thy s then 1 else 0
68.564 + | deg _ _ v (Free (s,Type (_,[]))) = if v=strip_thy s then 1 else 0
68.565 + | deg _ _ v (Var((s,_),Type (_,[]))) = if v=strip_thy s then 1 else 0
68.566 +(*| deg _ _ v (_ (s,"?DUMMY" )) = ..ML-error *)
68.567 + | deg _ _ v((Const ("Bin.integ_of_bin",_)) $ _ )= 0
68.568 + | deg addl mul v (h $ t1 $ t2) =
68.569 + if(bin_op h)subset addl
68.570 + then max (deg addl mul v t1 ,deg addl mul v t2)
68.571 + else (*mul!*)(deg addl mul v t1)+(deg addl mul v t2)
68.572 +in if polynomial (addl @ [mul]) t bdVar
68.573 + then Some (deg addl mul (id_of bdVar) t) else (None:int option)
68.574 +end;
68.575 +fun degree_ addl mul bdVar t = (* do not export *)
68.576 + let fun opt (Some i)= i
68.577 + | opt None = 0
68.578 +in opt (degree addl mul bdVar t) end;
68.579 +
68.580 +
68.581 +fun linear addl mul t bdVar = (degree_ addl mul bdVar t)<2;
68.582 +
68.583 +fun linear_equ addl mul bdVar t =
68.584 + if is_equation t
68.585 + then let val degl = degree_ addl mul bdVar (equ_lhs t);
68.586 + val degr = degree_ addl mul bdVar (equ_rhs t)
68.587 + in if (degl>0 orelse degr>0)andalso max(degl,degr)<2
68.588 + then true else false
68.589 + end
68.590 + else false;
68.591 +(* strip_thy op_ before *)
68.592 +fun is_div_op (dv,(Const (op_,(Type ("fun",
68.593 + [Type (s2,[]),Type ("fun",
68.594 + [Type (s4,tl4),Type (s5,tl5)])])))) )= (dv = strip_thy op_)
68.595 + | is_div_op _ = false;
68.596 +
68.597 +fun is_denom bdVar div_op t =
68.598 + let fun is bool[v]dv (Const (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
68.599 + | is bool[v]dv (Free (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
68.600 + | is bool[v]dv (Var((s,_),Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
68.601 + | is bool[v]dv((Const ("Bin.integ_of_bin",_)) $ _) = false
68.602 + | is bool[v]dv (h$n$d) =
68.603 + if is_div_op(dv,h)
68.604 + then (is false[v]dv n)orelse(is true[v]dv d)
68.605 + else (is bool [v]dv n)orelse(is bool[v]dv d)
68.606 +in is false (varids bdVar) (strip_thy div_op) t end;
68.607 +
68.608 +
68.609 +fun rational t div_op bdVar =
68.610 + is_denom bdVar div_op t andalso bin_ops_only t;
68.611 +
68.612 +
68.613 +
68.614 +(** problem types **)
68.615 +
68.616 +store_pbt
68.617 + (prep_pbt Test.thy "pbl_test_uni_plain2" [] e_pblID
68.618 + (["plain_square","univariate","equation","test"],
68.619 + [("#Given" ,["equality e_","solveFor v_"]),
68.620 + ("#Where" ,["(matches (?a + ?b*v_ ^^^2 = 0) e_) |\
68.621 + \(matches ( ?b*v_ ^^^2 = 0) e_) |\
68.622 + \(matches (?a + v_ ^^^2 = 0) e_) |\
68.623 + \(matches ( v_ ^^^2 = 0) e_)"]),
68.624 + ("#Find" ,["solutions v_i_"])
68.625 + ],
68.626 + assoc_rls "matches",
68.627 + Some "solve (e_::bool, v_)", [["Test","solve_plain_square"]]));
68.628 +(*
68.629 + val e_ = (term_of o the o (parse thy)) "e_::bool";
68.630 + val ve = (term_of o the o (parse thy)) "4 + 3*x^^^2 = 0";
68.631 + val env = [(e_,ve)];
68.632 +
68.633 + val pre = (term_of o the o (parse thy))
68.634 + "(matches (a + b*v_ ^^^2 = 0, e_::bool)) |\
68.635 + \(matches ( b*v_ ^^^2 = 0, e_::bool)) |\
68.636 + \(matches (a + v_ ^^^2 = 0, e_::bool)) |\
68.637 + \(matches ( v_ ^^^2 = 0, e_::bool))";
68.638 + val prei = subst_atomic env pre;
68.639 + val cpre = cterm_of (sign_of thy) prei;
68.640 +
68.641 + val Some (ct,_) = rewrite_set_ thy false tval_rls cpre;
68.642 +val ct = "True | False | False | False" : cterm
68.643 +
68.644 +> val Some (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
68.645 +> val Some (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
68.646 +> val Some (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
68.647 +val ct = "True" : cterm
68.648 +
68.649 +*)
68.650 +
68.651 +store_pbt
68.652 + (prep_pbt Test.thy "pbl_test_uni_poly" [] e_pblID
68.653 + (["polynomial","univariate","equation","test"],
68.654 + [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
68.655 + ("#Where" ,["False"]),
68.656 + ("#Find" ,["solutions v_i_"])
68.657 + ],
68.658 + e_rls, Some "solve (e_::bool, v_)", []));
68.659 +
68.660 +store_pbt
68.661 + (prep_pbt Test.thy "pbl_test_uni_poly_deg2" [] e_pblID
68.662 + (["degree_two","polynomial","univariate","equation","test"],
68.663 + [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
68.664 + ("#Find" ,["solutions v_i_"])
68.665 + ],
68.666 + e_rls, Some "solve (v_ ^^^2 + p_ * v_ + q__ = 0, v_)", []));
68.667 +
68.668 +store_pbt
68.669 + (prep_pbt Test.thy "pbl_test_uni_poly_deg2_pq" [] e_pblID
68.670 + (["pq_formula","degree_two","polynomial","univariate","equation","test"],
68.671 + [("#Given" ,["equality (v_ ^^^2 + p_ * v_ + q__ = 0)","solveFor v_"]),
68.672 + ("#Find" ,["solutions v_i_"])
68.673 + ],
68.674 + e_rls, Some "solve (v_ ^^^2 + p_ * v_ + q__ = 0, v_)", []));
68.675 +
68.676 +store_pbt
68.677 + (prep_pbt Test.thy "pbl_test_uni_poly_deg2_abc" [] e_pblID
68.678 + (["abc_formula","degree_two","polynomial","univariate","equation","test"],
68.679 + [("#Given" ,["equality (a_ * x ^^^2 + b_ * x + c_ = 0)","solveFor v_"]),
68.680 + ("#Find" ,["solutions v_i_"])
68.681 + ],
68.682 + e_rls, Some "solve (a_ * x ^^^2 + b_ * x + c_ = 0, v_)", []));
68.683 +
68.684 +store_pbt
68.685 + (prep_pbt Test.thy "pbl_test_uni_root" [] e_pblID
68.686 + (["squareroot","univariate","equation","test"],
68.687 + [("#Given" ,["equality e_","solveFor v_"]),
68.688 + ("#Where" ,["contains_root (e_::bool)"]),
68.689 + ("#Find" ,["solutions v_i_"])
68.690 + ],
68.691 + append_rls "contains_root" e_rls [Calc ("Test.contains'_root",
68.692 + eval_contains_root "#contains_root_")],
68.693 + Some "solve (e_::bool, v_)", [["Test","square_equation"]]));
68.694 +
68.695 +store_pbt
68.696 + (prep_pbt Test.thy "pbl_test_uni_norm" [] e_pblID
68.697 + (["normalize","univariate","equation","test"],
68.698 + [("#Given" ,["equality e_","solveFor v_"]),
68.699 + ("#Where" ,[]),
68.700 + ("#Find" ,["solutions v_i_"])
68.701 + ],
68.702 + e_rls, Some "solve (e_::bool, v_)", [["Test","norm_univar_equation"]]));
68.703 +
68.704 +store_pbt
68.705 + (prep_pbt Test.thy "pbl_test_uni_roottest" [] e_pblID
68.706 + (["sqroot-test","univariate","equation","test"],
68.707 + [("#Given" ,["equality e_","solveFor v_"]),
68.708 + (*("#Where" ,["contains_root (e_::bool)"]),*)
68.709 + ("#Find" ,["solutions v_i_"])
68.710 + ],
68.711 + e_rls, Some "solve (e_::bool, v_)", []));
68.712 +
68.713 +(*
68.714 +(#ppc o get_pbt) ["sqroot-test","univariate","equation"];
68.715 + *)
68.716 +
68.717 +
68.718 +store_met
68.719 + (prep_met Test.thy "met_test_sqrt" [] e_metID
68.720 +(*root-equation, version for tests before 8.01.01*)
68.721 + (["Test","sqrt-equ-test"]:metID,
68.722 + [("#Given" ,["equality e_","solveFor v_"]),
68.723 + ("#Where" ,["contains_root (e_::bool)"]),
68.724 + ("#Find" ,["solutions v_i_"])
68.725 + ],
68.726 + {rew_ord'="e_rew_ord",rls'=tval_rls,
68.727 + srls =append_rls "srls_contains_root" e_rls
68.728 + [Calc ("Test.contains'_root",eval_contains_root "")],
68.729 + prls =append_rls "prls_contains_root" e_rls
68.730 + [Calc ("Test.contains'_root",eval_contains_root "")],
68.731 + calc=[],
68.732 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
68.733 + asm_thm=[("square_equation_left",""),
68.734 + ("square_equation_right","")]*)},
68.735 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.736 + \(let e_ = \
68.737 + \ ((While (contains_root e_) Do\
68.738 + \ ((Rewrite square_equation_left True) @@\
68.739 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.740 + \ (Try (Rewrite_Set rearrange_assoc False)) @@\
68.741 + \ (Try (Rewrite_Set isolate_root False)) @@\
68.742 + \ (Try (Rewrite_Set Test_simplify False)))) @@\
68.743 + \ (Try (Rewrite_Set norm_equation False)) @@\
68.744 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.745 + \ (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
68.746 + \ (Try (Rewrite_Set Test_simplify False)))\
68.747 + \ e_\
68.748 + \ in [e_::bool])"
68.749 + ));
68.750 +
68.751 +store_met
68.752 + (prep_met Test.thy "met_test_sqrt2" [] e_metID
68.753 +(*root-equation ... for test-*.sml until 8.01*)
68.754 + (["Test","squ-equ-test2"]:metID,
68.755 + [("#Given" ,["equality e_","solveFor v_"]),
68.756 + ("#Find" ,["solutions v_i_"])
68.757 + ],
68.758 + {rew_ord'="e_rew_ord",rls'=tval_rls,
68.759 + srls = append_rls "srls_contains_root" e_rls
68.760 + [Calc ("Test.contains'_root",eval_contains_root"")],
68.761 + prls=e_rls,calc=[],
68.762 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
68.763 + asm_thm=[("square_equation_left",""),
68.764 + ("square_equation_right","")]*)},
68.765 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.766 + \(let e_ = \
68.767 + \ ((While (contains_root e_) Do\
68.768 + \ ((Rewrite square_equation_left True) @@\
68.769 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.770 + \ (Try (Rewrite_Set rearrange_assoc False)) @@\
68.771 + \ (Try (Rewrite_Set isolate_root False)) @@\
68.772 + \ (Try (Rewrite_Set Test_simplify False)))) @@\
68.773 + \ (Try (Rewrite_Set norm_equation False)) @@\
68.774 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.775 + \ (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
68.776 + \ (Try (Rewrite_Set Test_simplify False)))\
68.777 + \ e_;\
68.778 + \ (L_::bool list) = Tac subproblem_equation_dummy; \
68.779 + \ L_ = Tac solve_equation_dummy \
68.780 + \ in Check_elementwise L_ {(v_::real). Assumptions})"
68.781 + ));
68.782 +
68.783 +store_met
68.784 + (prep_met Test.thy "met_test_squ_sub" [] e_metID
68.785 +(*tests subproblem fixed linear*)
68.786 + (["Test","squ-equ-test-subpbl1"]:metID,
68.787 + [("#Given" ,["equality e_","solveFor v_"]),
68.788 + ("#Find" ,["solutions v_i_"])
68.789 + ],
68.790 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
68.791 + crls=tval_rls, nrls=Test_simplify},
68.792 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.793 + \ (let e_ = ((Try (Rewrite_Set norm_equation False)) @@ \
68.794 + \ (Try (Rewrite_Set Test_simplify False))) e_; \
68.795 + \(L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test],\
68.796 + \ [Test,solve_linear]) [bool_ e_, real_ v_])\
68.797 + \in Check_elementwise L_ {(v_::real). Assumptions})"
68.798 + ));
68.799 +
68.800 +store_met
68.801 + (prep_met Test.thy "met_test_squ_sub2" [] e_metID
68.802 + (*tests subproblem fixed degree 2*)
68.803 + (["Test","squ-equ-test-subpbl2"]:metID,
68.804 + [("#Given" ,["equality e_","solveFor v_"]),
68.805 + ("#Find" ,["solutions v_i_"])
68.806 + ],
68.807 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
68.808 + crls=tval_rls, nrls=e_rls(*,
68.809 + asm_rls=[],asm_thm=[("square_equation_left",""),
68.810 + ("square_equation_right","")]*)},
68.811 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.812 + \ (let e_ = Try (Rewrite_Set norm_equation False) e_; \
68.813 + \(L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test],\
68.814 + \ [Test,solve_by_pq_formula]) [bool_ e_, real_ v_])\
68.815 + \in Check_elementwise L_ {(v_::real). Assumptions})"
68.816 + ));
68.817 +
68.818 +store_met
68.819 + (prep_met Test.thy "met_test_squ_nonterm" [] e_metID
68.820 + (*root-equation: see foils..., but notTerminating*)
68.821 + (["Test","square_equation...notTerminating"]:metID,
68.822 + [("#Given" ,["equality e_","solveFor v_"]),
68.823 + ("#Find" ,["solutions v_i_"])
68.824 + ],
68.825 + {rew_ord'="e_rew_ord",rls'=tval_rls,
68.826 + srls = append_rls "srls_contains_root" e_rls
68.827 + [Calc ("Test.contains'_root",eval_contains_root"")],
68.828 + prls=e_rls,calc=[],
68.829 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
68.830 + asm_thm=[("square_equation_left",""),
68.831 + ("square_equation_right","")]*)},
68.832 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.833 + \(let e_ = \
68.834 + \ ((While (contains_root e_) Do\
68.835 + \ ((Rewrite square_equation_left True) @@\
68.836 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.837 + \ (Try (Rewrite_Set rearrange_assoc False)) @@\
68.838 + \ (Try (Rewrite_Set isolate_root False)) @@\
68.839 + \ (Try (Rewrite_Set Test_simplify False)))) @@\
68.840 + \ (Try (Rewrite_Set norm_equation False)) @@\
68.841 + \ (Try (Rewrite_Set Test_simplify False)))\
68.842 + \ e_;\
68.843 + \ (L_::bool list) = \
68.844 + \ (SubProblem (Test_,[linear,univariate,equation,test],\
68.845 + \ [Test,solve_linear]) [bool_ e_, real_ v_])\
68.846 + \in Check_elementwise L_ {(v_::real). Assumptions})"
68.847 + ));
68.848 +
68.849 +store_met
68.850 + (prep_met Test.thy "met_test_eq1" [] e_metID
68.851 +(*root-equation1:*)
68.852 + (["Test","square_equation1"]:metID,
68.853 + [("#Given" ,["equality e_","solveFor v_"]),
68.854 + ("#Find" ,["solutions v_i_"])
68.855 + ],
68.856 + {rew_ord'="e_rew_ord",rls'=tval_rls,
68.857 + srls = append_rls "srls_contains_root" e_rls
68.858 + [Calc ("Test.contains'_root",eval_contains_root"")],
68.859 + prls=e_rls,calc=[],
68.860 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
68.861 + asm_thm=[("square_equation_left",""),
68.862 + ("square_equation_right","")]*)},
68.863 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.864 + \(let e_ = \
68.865 + \ ((While (contains_root e_) Do\
68.866 + \ ((Rewrite square_equation_left True) @@\
68.867 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.868 + \ (Try (Rewrite_Set rearrange_assoc False)) @@\
68.869 + \ (Try (Rewrite_Set isolate_root False)) @@\
68.870 + \ (Try (Rewrite_Set Test_simplify False)))) @@\
68.871 + \ (Try (Rewrite_Set norm_equation False)) @@\
68.872 + \ (Try (Rewrite_Set Test_simplify False)))\
68.873 + \ e_;\
68.874 + \ (L_::bool list) = (SubProblem (Test_,[linear,univariate,equation,test],\
68.875 + \ [Test,solve_linear]) [bool_ e_, real_ v_])\
68.876 + \ in Check_elementwise L_ {(v_::real). Assumptions})"
68.877 + ));
68.878 +
68.879 +store_met
68.880 + (prep_met Test.thy "met_test_squ2" [] e_metID
68.881 + (*root-equation2*)
68.882 + (["Test","square_equation2"]:metID,
68.883 + [("#Given" ,["equality e_","solveFor v_"]),
68.884 + ("#Find" ,["solutions v_i_"])
68.885 + ],
68.886 + {rew_ord'="e_rew_ord",rls'=tval_rls,
68.887 + srls = append_rls "srls_contains_root" e_rls
68.888 + [Calc ("Test.contains'_root",eval_contains_root"")],
68.889 + prls=e_rls,calc=[],
68.890 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
68.891 + asm_thm=[("square_equation_left",""),
68.892 + ("square_equation_right","")]*)},
68.893 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.894 + \(let e_ = \
68.895 + \ ((While (contains_root e_) Do\
68.896 + \ (((Rewrite square_equation_left True) Or \
68.897 + \ (Rewrite square_equation_right True)) @@\
68.898 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.899 + \ (Try (Rewrite_Set rearrange_assoc False)) @@\
68.900 + \ (Try (Rewrite_Set isolate_root False)) @@\
68.901 + \ (Try (Rewrite_Set Test_simplify False)))) @@\
68.902 + \ (Try (Rewrite_Set norm_equation False)) @@\
68.903 + \ (Try (Rewrite_Set Test_simplify False)))\
68.904 + \ e_;\
68.905 + \ (L_::bool list) = (SubProblem (Test_,[plain_square,univariate,equation,test],\
68.906 + \ [Test,solve_plain_square]) [bool_ e_, real_ v_])\
68.907 + \ in Check_elementwise L_ {(v_::real). Assumptions})"
68.908 + ));
68.909 +
68.910 +store_met
68.911 + (prep_met Test.thy "met_test_squeq" [] e_metID
68.912 + (*root-equation*)
68.913 + (["Test","square_equation"]:metID,
68.914 + [("#Given" ,["equality e_","solveFor v_"]),
68.915 + ("#Find" ,["solutions v_i_"])
68.916 + ],
68.917 + {rew_ord'="e_rew_ord",rls'=tval_rls,
68.918 + srls = append_rls "srls_contains_root" e_rls
68.919 + [Calc ("Test.contains'_root",eval_contains_root"")],
68.920 + prls=e_rls,calc=[],
68.921 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],
68.922 + asm_thm=[("square_equation_left",""),
68.923 + ("square_equation_right","")]*)},
68.924 + "Script Solve_root_equation (e_::bool) (v_::real) = \
68.925 + \(let e_ = \
68.926 + \ ((While (contains_root e_) Do\
68.927 + \ (((Rewrite square_equation_left True) Or\
68.928 + \ (Rewrite square_equation_right True)) @@\
68.929 + \ (Try (Rewrite_Set Test_simplify False)) @@\
68.930 + \ (Try (Rewrite_Set rearrange_assoc False)) @@\
68.931 + \ (Try (Rewrite_Set isolate_root False)) @@\
68.932 + \ (Try (Rewrite_Set Test_simplify False)))) @@\
68.933 + \ (Try (Rewrite_Set norm_equation False)) @@\
68.934 + \ (Try (Rewrite_Set Test_simplify False)))\
68.935 + \ e_;\
68.936 + \ (L_::bool list) = (SubProblem (Test_,[univariate,equation,test],\
68.937 + \ [no_met]) [bool_ e_, real_ v_])\
68.938 + \ in Check_elementwise L_ {(v_::real). Assumptions})"
68.939 + ) ); (*#######*)
68.940 +
68.941 +store_met
68.942 + (prep_met Test.thy "met_test_eq_plain" [] e_metID
68.943 + (*solve_plain_square*)
68.944 + (["Test","solve_plain_square"]:metID,
68.945 + [("#Given",["equality e_","solveFor v_"]),
68.946 + ("#Where" ,["(matches (?a + ?b*v_ ^^^2 = 0) e_) |\
68.947 + \(matches ( ?b*v_ ^^^2 = 0) e_) |\
68.948 + \(matches (?a + v_ ^^^2 = 0) e_) |\
68.949 + \(matches ( v_ ^^^2 = 0) e_)"]),
68.950 + ("#Find" ,["solutions v_i_"])
68.951 + ],
68.952 + {rew_ord'="e_rew_ord",rls'=tval_rls,calc=[],srls=e_rls,
68.953 + prls = assoc_rls "matches",
68.954 + crls=tval_rls, nrls=e_rls(*,
68.955 + asm_rls=[],asm_thm=[]*)},
68.956 + "Script Solve_plain_square (e_::bool) (v_::real) = \
68.957 + \ (let e_ = ((Try (Rewrite_Set isolate_bdv False)) @@ \
68.958 + \ (Try (Rewrite_Set Test_simplify False)) @@ \
68.959 + \ ((Rewrite square_equality_0 False) Or \
68.960 + \ (Rewrite square_equality True)) @@ \
68.961 + \ (Try (Rewrite_Set tval_rls False))) e_ \
68.962 + \ in ((Or_to_List e_)::bool list))"
68.963 + ));
68.964 +
68.965 +store_met
68.966 + (prep_met Test.thy "met_test_norm_univ" [] e_metID
68.967 + (["Test","norm_univar_equation"]:metID,
68.968 + [("#Given",["equality e_","solveFor v_"]),
68.969 + ("#Where" ,[]),
68.970 + ("#Find" ,["solutions v_i_"])
68.971 + ],
68.972 + {rew_ord'="e_rew_ord",rls'=tval_rls,srls = e_rls,prls=e_rls,
68.973 + calc=[],
68.974 + crls=tval_rls, nrls=e_rls(*,asm_rls=[],asm_thm=[]*)},
68.975 + "Script Norm_univar_equation (e_::bool) (v_::real) = \
68.976 + \ (let e_ = ((Try (Rewrite rnorm_equation_add False)) @@ \
68.977 + \ (Try (Rewrite_Set Test_simplify False))) e_ \
68.978 + \ in (SubProblem (Test_,[univariate,equation,test], \
68.979 + \ [no_met]) [bool_ e_, real_ v_]))"
68.980 + ));
68.981 +
68.982 +
68.983 +
68.984 +(*17.9.02 aus SqRoot.ML------------------------------^^^---*)
68.985 +
68.986 +(*8.4.03 aus Poly.ML--------------------------------vvv---
68.987 + make_polynomial ---> make_poly
68.988 + ^-- for user ^-- for systest _ONLY_*)
68.989 +
68.990 +local (*. for make_polytest .*)
68.991 +
68.992 +open Term; (* for type order = EQUAL | LESS | GREATER *)
68.993 +
68.994 +fun pr_ord EQUAL = "EQUAL"
68.995 + | pr_ord LESS = "LESS"
68.996 + | pr_ord GREATER = "GREATER";
68.997 +
68.998 +fun dest_hd' (Const (a, T)) = (* ~ term.ML *)
68.999 + (case a of
68.1000 + "Atools.pow" => ((("|||||||||||||", 0), T), 0) (*WN greatest *)
68.1001 + | _ => (((a, 0), T), 0))
68.1002 + | dest_hd' (Free (a, T)) = (((a, 0), T), 1)
68.1003 + | dest_hd' (Var v) = (v, 2)
68.1004 + | dest_hd' (Bound i) = ((("", i), dummyT), 3)
68.1005 + | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
68.1006 +(* RL *)
68.1007 +fun get_order_pow (t $ (Free(order,_))) =
68.1008 + (case int_of_str (order) of
68.1009 + Some d => d
68.1010 + | None => 0)
68.1011 + | get_order_pow _ = 0;
68.1012 +
68.1013 +fun size_of_term' (Const(str,_) $ t) =
68.1014 + if "Atools.pow"= str then 1000 + size_of_term' t else 1 + size_of_term' t (*WN*)
68.1015 + | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
68.1016 + | size_of_term' (f$t) = size_of_term' f + size_of_term' t
68.1017 + | size_of_term' _ = 1;
68.1018 +
68.1019 +fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) = (* ~ term.ML *)
68.1020 + (case term_ord' pr thy (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
68.1021 + | term_ord' pr thy (t, u) =
68.1022 + (if pr then
68.1023 + let
68.1024 + val (f, ts) = strip_comb t and (g, us) = strip_comb u;
68.1025 + val _=writeln("t= f@ts= \""^
68.1026 + ((string_of_cterm o cterm_of (sign_of thy)) f)^"\" @ \"["^
68.1027 + (commas(map(string_of_cterm o cterm_of (sign_of thy)) ts))^"]\"");
68.1028 + val _=writeln("u= g@us= \""^
68.1029 + ((string_of_cterm o cterm_of (sign_of thy)) g)^"\" @ \"["^
68.1030 + (commas(map(string_of_cterm o cterm_of (sign_of thy)) us))^"]\"");
68.1031 + val _=writeln("size_of_term(t,u)= ("^
68.1032 + (string_of_int(size_of_term' t))^", "^
68.1033 + (string_of_int(size_of_term' u))^")");
68.1034 + val _=writeln("hd_ord(f,g) = "^((pr_ord o hd_ord)(f,g)));
68.1035 + val _=writeln("terms_ord(ts,us) = "^
68.1036 + ((pr_ord o terms_ord str false)(ts,us)));
68.1037 + val _=writeln("-------");
68.1038 + in () end
68.1039 + else ();
68.1040 + case int_ord (size_of_term' t, size_of_term' u) of
68.1041 + EQUAL =>
68.1042 + let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
68.1043 + (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us)
68.1044 + | ord => ord)
68.1045 + end
68.1046 + | ord => ord)
68.1047 +and hd_ord (f, g) = (* ~ term.ML *)
68.1048 + prod_ord (prod_ord indexname_ord typ_ord) int_ord (dest_hd' f, dest_hd' g)
68.1049 +and terms_ord str pr (ts, us) =
68.1050 + list_ord (term_ord' pr (assoc_thy "Isac.thy"))(ts, us);
68.1051 +in
68.1052 +
68.1053 +fun ord_make_polytest (pr:bool) thy (_:subst) tu =
68.1054 + (term_ord' pr thy(***) tu = LESS );
68.1055 +
68.1056 +end;(*local*)
68.1057 +
68.1058 +rew_ord' := overwritel (!rew_ord',
68.1059 +[("termlessI", termlessI),
68.1060 + ("ord_make_polytest", ord_make_polytest false thy)
68.1061 + ]);
68.1062 +
68.1063 +(*WN060510 this was a preparation for prep_rls ...
68.1064 +val scr_make_polytest =
68.1065 +"Script Expand_binomtest t_ =\
68.1066 +\(Repeat \
68.1067 +\((Try (Repeat (Rewrite real_diff_minus False))) @@ \
68.1068 +
68.1069 +\ (Try (Repeat (Rewrite real_add_mult_distrib False))) @@ \
68.1070 +\ (Try (Repeat (Rewrite real_add_mult_distrib2 False))) @@ \
68.1071 +\ (Try (Repeat (Rewrite real_diff_mult_distrib False))) @@ \
68.1072 +\ (Try (Repeat (Rewrite real_diff_mult_distrib2 False))) @@ \
68.1073 +
68.1074 +\ (Try (Repeat (Rewrite real_mult_1 False))) @@ \
68.1075 +\ (Try (Repeat (Rewrite real_mult_0 False))) @@ \
68.1076 +\ (Try (Repeat (Rewrite real_add_zero_left False))) @@ \
68.1077 +
68.1078 +\ (Try (Repeat (Rewrite real_mult_commute False))) @@ \
68.1079 +\ (Try (Repeat (Rewrite real_mult_left_commute False))) @@ \
68.1080 +\ (Try (Repeat (Rewrite real_mult_assoc False))) @@ \
68.1081 +\ (Try (Repeat (Rewrite real_add_commute False))) @@ \
68.1082 +\ (Try (Repeat (Rewrite real_add_left_commute False))) @@ \
68.1083 +\ (Try (Repeat (Rewrite real_add_assoc False))) @@ \
68.1084 +
68.1085 +\ (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ \
68.1086 +\ (Try (Repeat (Rewrite realpow_plus_1 False))) @@ \
68.1087 +\ (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ \
68.1088 +\ (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ \
68.1089 +
68.1090 +\ (Try (Repeat (Rewrite real_num_collect False))) @@ \
68.1091 +\ (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ \
68.1092 +
68.1093 +\ (Try (Repeat (Rewrite real_one_collect False))) @@ \
68.1094 +\ (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ \
68.1095 +
68.1096 +\ (Try (Repeat (Calculate plus ))) @@ \
68.1097 +\ (Try (Repeat (Calculate times ))) @@ \
68.1098 +\ (Try (Repeat (Calculate power_)))) \
68.1099 +\ t_)";
68.1100 +-----------------------------------------------------*)
68.1101 +
68.1102 +val make_polytest =
68.1103 + Rls{id = "make_polytest", preconds = []:term list, rew_ord = ("ord_make_polytest",
68.1104 + ord_make_polytest false Poly.thy),
68.1105 + erls = testerls, srls = Erls,
68.1106 + calc = [("plus" , ("op +", eval_binop "#add_")),
68.1107 + ("times" , ("op *", eval_binop "#mult_")),
68.1108 + ("power_", ("Atools.pow", eval_binop "#power_"))
68.1109 + ],
68.1110 + (*asm_thm = [],*)
68.1111 + rules = [Thm ("real_diff_minus",num_str real_diff_minus),
68.1112 + (*"a - b = a + (-1) * b"*)
68.1113 + Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
68.1114 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
68.1115 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
68.1116 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
68.1117 + Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
68.1118 + (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
68.1119 + Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
68.1120 + (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
68.1121 + Thm ("real_mult_1",num_str real_mult_1),
68.1122 + (*"1 * z = z"*)
68.1123 + Thm ("real_mult_0",num_str real_mult_0),
68.1124 + (*"0 * z = 0"*)
68.1125 + Thm ("real_add_zero_left",num_str real_add_zero_left),
68.1126 + (*"0 + z = z"*)
68.1127 +
68.1128 + (*AC-rewriting*)
68.1129 + Thm ("real_mult_commute",num_str real_mult_commute),
68.1130 + (* z * w = w * z *)
68.1131 + Thm ("real_mult_left_commute",num_str real_mult_left_commute),
68.1132 + (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
68.1133 + Thm ("real_mult_assoc",num_str real_mult_assoc),
68.1134 + (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
68.1135 + Thm ("real_add_commute",num_str real_add_commute),
68.1136 + (*z + w = w + z*)
68.1137 + Thm ("real_add_left_commute",num_str real_add_left_commute),
68.1138 + (*x + (y + z) = y + (x + z)*)
68.1139 + Thm ("real_add_assoc",num_str real_add_assoc),
68.1140 + (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
68.1141 +
68.1142 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
68.1143 + (*"r1 * r1 = r1 ^^^ 2"*)
68.1144 + Thm ("realpow_plus_1",num_str realpow_plus_1),
68.1145 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
68.1146 + Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
68.1147 + (*"z1 + z1 = 2 * z1"*)
68.1148 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
68.1149 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
68.1150 +
68.1151 + Thm ("real_num_collect",num_str real_num_collect),
68.1152 + (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
68.1153 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
68.1154 + (*"[| l is_const; m is_const |] ==>
68.1155 + l * n + (m * n + k) = (l + m) * n + k"*)
68.1156 + Thm ("real_one_collect",num_str real_one_collect),
68.1157 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
68.1158 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
68.1159 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
68.1160 +
68.1161 + Calc ("op +", eval_binop "#add_"),
68.1162 + Calc ("op *", eval_binop "#mult_"),
68.1163 + Calc ("Atools.pow", eval_binop "#power_")
68.1164 + ],
68.1165 + scr = EmptyScr(*Script ((term_of o the o (parse thy))
68.1166 + scr_make_polytest)*)
68.1167 + }:rls;
68.1168 +(*WN060510 this was done before 'fun prep_rls' ...
68.1169 +val scr_expand_binomtest =
68.1170 +"Script Expand_binomtest t_ =\
68.1171 +\(Repeat \
68.1172 +\((Try (Repeat (Rewrite real_plus_binom_pow2 False))) @@ \
68.1173 +\ (Try (Repeat (Rewrite real_plus_binom_times False))) @@ \
68.1174 +\ (Try (Repeat (Rewrite real_minus_binom_pow2 False))) @@ \
68.1175 +\ (Try (Repeat (Rewrite real_minus_binom_times False))) @@ \
68.1176 +\ (Try (Repeat (Rewrite real_plus_minus_binom1 False))) @@ \
68.1177 +\ (Try (Repeat (Rewrite real_plus_minus_binom2 False))) @@ \
68.1178 +
68.1179 +\ (Try (Repeat (Rewrite real_mult_1 False))) @@ \
68.1180 +\ (Try (Repeat (Rewrite real_mult_0 False))) @@ \
68.1181 +\ (Try (Repeat (Rewrite real_add_zero_left False))) @@ \
68.1182 +
68.1183 +\ (Try (Repeat (Calculate plus ))) @@ \
68.1184 +\ (Try (Repeat (Calculate times ))) @@ \
68.1185 +\ (Try (Repeat (Calculate power_))) @@ \
68.1186 +
68.1187 +\ (Try (Repeat (Rewrite sym_realpow_twoI False))) @@ \
68.1188 +\ (Try (Repeat (Rewrite realpow_plus_1 False))) @@ \
68.1189 +\ (Try (Repeat (Rewrite sym_real_mult_2 False))) @@ \
68.1190 +\ (Try (Repeat (Rewrite real_mult_2_assoc False))) @@ \
68.1191 +
68.1192 +\ (Try (Repeat (Rewrite real_num_collect False))) @@ \
68.1193 +\ (Try (Repeat (Rewrite real_num_collect_assoc False))) @@ \
68.1194 +
68.1195 +\ (Try (Repeat (Rewrite real_one_collect False))) @@ \
68.1196 +\ (Try (Repeat (Rewrite real_one_collect_assoc False))) @@ \
68.1197 +
68.1198 +\ (Try (Repeat (Calculate plus ))) @@ \
68.1199 +\ (Try (Repeat (Calculate times ))) @@ \
68.1200 +\ (Try (Repeat (Calculate power_)))) \
68.1201 +\ t_)";
68.1202 +------------------------------------------------------*)
68.1203 +
68.1204 +val expand_binomtest =
68.1205 + Rls{id = "expand_binomtest", preconds = [],
68.1206 + rew_ord = ("termlessI",termlessI),
68.1207 + erls = testerls, srls = Erls,
68.1208 + calc = [("plus" , ("op +", eval_binop "#add_")),
68.1209 + ("times" , ("op *", eval_binop "#mult_")),
68.1210 + ("power_", ("Atools.pow", eval_binop "#power_"))
68.1211 + ],
68.1212 + (*asm_thm = [],*)
68.1213 + rules = [Thm ("real_plus_binom_pow2" ,num_str real_plus_binom_pow2),
68.1214 + (*"(a + b) ^^^ 2 = a ^^^ 2 + 2 * a * b + b ^^^ 2"*)
68.1215 + Thm ("real_plus_binom_times" ,num_str real_plus_binom_times),
68.1216 + (*"(a + b)*(a + b) = ...*)
68.1217 + Thm ("real_minus_binom_pow2" ,num_str real_minus_binom_pow2),
68.1218 + (*"(a - b) ^^^ 2 = a ^^^ 2 - 2 * a * b + b ^^^ 2"*)
68.1219 + Thm ("real_minus_binom_times",num_str real_minus_binom_times),
68.1220 + (*"(a - b)*(a - b) = ...*)
68.1221 + Thm ("real_plus_minus_binom1",num_str real_plus_minus_binom1),
68.1222 + (*"(a + b) * (a - b) = a ^^^ 2 - b ^^^ 2"*)
68.1223 + Thm ("real_plus_minus_binom2",num_str real_plus_minus_binom2),
68.1224 + (*"(a - b) * (a + b) = a ^^^ 2 - b ^^^ 2"*)
68.1225 + (*RL 020915*)
68.1226 + Thm ("real_pp_binom_times",num_str real_pp_binom_times),
68.1227 + (*(a + b)*(c + d) = a*c + a*d + b*c + b*d*)
68.1228 + Thm ("real_pm_binom_times",num_str real_pm_binom_times),
68.1229 + (*(a + b)*(c - d) = a*c - a*d + b*c - b*d*)
68.1230 + Thm ("real_mp_binom_times",num_str real_mp_binom_times),
68.1231 + (*(a - b)*(c p d) = a*c + a*d - b*c - b*d*)
68.1232 + Thm ("real_mm_binom_times",num_str real_mm_binom_times),
68.1233 + (*(a - b)*(c p d) = a*c - a*d - b*c + b*d*)
68.1234 + Thm ("realpow_multI",num_str realpow_multI),
68.1235 + (*(a*b)^^^n = a^^^n * b^^^n*)
68.1236 + Thm ("real_plus_binom_pow3",num_str real_plus_binom_pow3),
68.1237 + (* (a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3 *)
68.1238 + Thm ("real_minus_binom_pow3",num_str real_minus_binom_pow3),
68.1239 + (* (a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3 *)
68.1240 +
68.1241 +
68.1242 + (* Thm ("real_add_mult_distrib" ,num_str real_add_mult_distrib),
68.1243 + (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
68.1244 + Thm ("real_add_mult_distrib2",num_str real_add_mult_distrib2),
68.1245 + (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
68.1246 + Thm ("real_diff_mult_distrib" ,num_str real_diff_mult_distrib),
68.1247 + (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
68.1248 + Thm ("real_diff_mult_distrib2",num_str real_diff_mult_distrib2),
68.1249 + (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
68.1250 + *)
68.1251 +
68.1252 + Thm ("real_mult_1",num_str real_mult_1), (*"1 * z = z"*)
68.1253 + Thm ("real_mult_0",num_str real_mult_0), (*"0 * z = 0"*)
68.1254 + Thm ("real_add_zero_left",num_str real_add_zero_left),(*"0 + z = z"*)
68.1255 +
68.1256 + Calc ("op +", eval_binop "#add_"),
68.1257 + Calc ("op *", eval_binop "#mult_"),
68.1258 + Calc ("Atools.pow", eval_binop "#power_"),
68.1259 + (*
68.1260 + Thm ("real_mult_commute",num_str real_mult_commute), (*AC-rewriting*)
68.1261 + Thm ("real_mult_left_commute",num_str real_mult_left_commute), (**)
68.1262 + Thm ("real_mult_assoc",num_str real_mult_assoc), (**)
68.1263 + Thm ("real_add_commute",num_str real_add_commute), (**)
68.1264 + Thm ("real_add_left_commute",num_str real_add_left_commute), (**)
68.1265 + Thm ("real_add_assoc",num_str real_add_assoc), (**)
68.1266 + *)
68.1267 +
68.1268 + Thm ("sym_realpow_twoI",num_str (realpow_twoI RS sym)),
68.1269 + (*"r1 * r1 = r1 ^^^ 2"*)
68.1270 + Thm ("realpow_plus_1",num_str realpow_plus_1),
68.1271 + (*"r * r ^^^ n = r ^^^ (n + 1)"*)
68.1272 + (*Thm ("sym_real_mult_2",num_str (real_mult_2 RS sym)),
68.1273 + (*"z1 + z1 = 2 * z1"*)*)
68.1274 + Thm ("real_mult_2_assoc",num_str real_mult_2_assoc),
68.1275 + (*"z1 + (z1 + k) = 2 * z1 + k"*)
68.1276 +
68.1277 + Thm ("real_num_collect",num_str real_num_collect),
68.1278 + (*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
68.1279 + Thm ("real_num_collect_assoc",num_str real_num_collect_assoc),
68.1280 + (*"[| l is_const; m is_const |] ==> l * n + (m * n + k) = (l + m) * n + k"*)
68.1281 + Thm ("real_one_collect",num_str real_one_collect),
68.1282 + (*"m is_const ==> n + m * n = (1 + m) * n"*)
68.1283 + Thm ("real_one_collect_assoc",num_str real_one_collect_assoc),
68.1284 + (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
68.1285 +
68.1286 + Calc ("op +", eval_binop "#add_"),
68.1287 + Calc ("op *", eval_binop "#mult_"),
68.1288 + Calc ("Atools.pow", eval_binop "#power_")
68.1289 + ],
68.1290 + scr = EmptyScr
68.1291 +(*Script ((term_of o the o (parse thy)) scr_expand_binomtest)*)
68.1292 + }:rls;
68.1293 +
68.1294 +
68.1295 +ruleset' := overwritelthy thy (!ruleset',
68.1296 + [("make_polytest", prep_rls make_polytest),
68.1297 + ("expand_binomtest", prep_rls expand_binomtest)
68.1298 + ]);
68.1299 +
68.1300 +
68.1301 +
68.1302 +
68.1303 +
68.1304 +
69.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
69.2 +++ b/src/Pure/isac/IsacKnowledge/Test.sml Wed Jul 21 13:53:39 2010 +0200
69.3 @@ -0,0 +1,158 @@
69.4 +val ttt = (term_of o the o (parse thy))
69.5 +"(Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) e_";
69.6 +val ttt = (term_of o the o (parse thy))
69.7 +"(Try (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) e_)";
69.8 +
69.9 +val ttt = (term_of o the o (parse thy))
69.10 + "(Rewrite_Set SqRoot_simplify False) e_ ";
69.11 +val ttt = (term_of o the o (parseold thy))
69.12 + "%e_. (Rewrite_Set SqRoot_simplify False) e_";
69.13 +val ttt = (term_of o the o (parseold thy))
69.14 + "Repeat (%e_. (Rewrite_Set SqRoot_simplify False)) e_";
69.15 +
69.16 +val ttt = (term_of o the o (parse thy))
69.17 + "Script Solve_linear (e_::bool) (v_::real)= \
69.18 + \[e_]";
69.19 +val ttt = (term_of o the o (parse thy))
69.20 + "Script Solve_linear (e_::bool) (v_::real)= \
69.21 + \((%e_. [e_]) e_)";
69.22 +val ttt = (term_of o the o (parse thy))
69.23 + "Script Solve_linear (e_::bool) (v_::real)= \
69.24 + \((%e_. (let e_ = e_ in [e_])) e_)";
69.25 +val ttt = (term_of o the o (parse thy))
69.26 + "Script Solve_linear (e_::bool) (v_::real)= \
69.27 + \((%e_. \
69.28 + \ (let e_ = ((Rewrite_Set SqRoot_simplify False) e_)\
69.29 + \ in [e_]))\
69.30 + \ e_)";
69.31 +val ttt = (term_of o the o (parse thy))
69.32 + "Script Solve_linear (e_::bool) (v_::real)= \
69.33 + \((%ee_. (let e_ = ((Rewrite_Set SqRoot_simplify False) ee_) in [e_])) e_)";
69.34 +
69.35 +val ttt = (term_of o the o (parse thy))
69.36 + "Script Solve_linear (e_::bool) (v_::real)= \
69.37 + \(let e_ = \
69.38 + \ (Repeat ((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False)) e_)\
69.39 + \ in [e_])";
69.40 +(*----*)
69.41 +val ttt = (term_of o the o (parse thy))
69.42 +
69.43 +(*----*)
69.44 +val ttt = (term_of o the o (parse thy))
69.45 + "Script Solve_linear (e_::bool) (v_::real)= \
69.46 + \(let e_ = \
69.47 + \ (Repeat\
69.48 + \ ((%ee_. (Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) ee_)\
69.49 + \ e_)\
69.50 + \ e_)\
69.51 + \ in [e_])";
69.52 +val ttt = (term_of o the o (parse thy))
69.53 + "Script Solve_linear (e_::bool) (v_::real)= \
69.54 + \(let e_ = \
69.55 + \ (Repeat\
69.56 + \ ((%ee_.\
69.57 + \ ((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) ee_))\
69.58 + \ e_)\
69.59 + \ e_)\
69.60 + \ in [e_])";
69.61 +val ttt = (term_of o the o (parse thy))
69.62 + "Script Solve_linear (e_::bool) (v_::real)= \
69.63 + \(let e_ = \
69.64 + \ (Repeat\
69.65 + \ ((%ee_.\
69.66 + \ (let e_ = ((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) ee_)\
69.67 + \ in ((Rewrite_Set SqRoot_simplify False) e_)) )\
69.68 + \ e_)\
69.69 + \ e_)\
69.70 + \ in [e_])";
69.71 +atomty ttt;
69.72 +atomt ttt;
69.73 +
69.74 +val ttt = (term_of o the o (parse thy))
69.75 + "Script Testterm (g_::real) = \
69.76 + \Repeat\
69.77 + \ (Rewrite rmult_1 False) g_";
69.78 +val ttt = (term_of o the o (parse thy))
69.79 + "Script Testterm (g_::real) = \
69.80 + \Repeat\
69.81 + \ (((Rewrite rmult_1 False)) Or ((Rewrite rmult_0 False))) g_";
69.82 +val ttt = (term_of o the o (parse thy))
69.83 + "Script Testterm (g_::real) = \
69.84 + \Repeat\
69.85 + \ ((Repeat (Rewrite rmult_1 False)) Or (Repeat (Rewrite rmult_0 False))) g_";
69.86 +val ttt = (term_of o the o (parse thy))
69.87 + "Script Testterm (g_::real) = \
69.88 + \Repeat\
69.89 + \ ((Repeat (Rewrite rmult_1 False)) Or\
69.90 + \ (Repeat (Rewrite rmult_0 False))) g_";
69.91 +val ttt = (term_of o the o (parse thy))
69.92 + "Script Testterm (g_::real) = \
69.93 + \Repeat\
69.94 + \ ((Repeat (Rewrite rmult_1 False)) Or\
69.95 + \ (Repeat (Rewrite rmult_0 False)) Or\
69.96 + \ (Repeat (Rewrite rmult_0 False))) g_";
69.97 +val ttt = (term_of o the o (parse thy))
69.98 + "Script Testterm (g_::real) = \
69.99 + \Repeat\
69.100 + \ ((Try Repeat (Rewrite rmult_1 False)) Or\
69.101 + \ (Try Repeat (Rewrite rmult_0 False)) Or\
69.102 + \ (Try Repeat (Rewrite rmult_0 False))) g_";
69.103 +
69.104 +
69.105 +
69.106 +
69.107 +
69.108 +
69.109 +
69.110 +
69.111 +
69.112 +
69.113 +
69.114 +
69.115 +
69.116 +(*################### 29.4.02: Rewrite o Rewrite o ...###############*)
69.117 +(*################### 29.4.02: Rewrite o Rewrite o ...###############*)
69.118 +(*################### 29.4.02: Rewrite o Rewrite o ...###############*)
69.119 +
69.120 +
69.121 +
69.122 +atomt ttt;
69.123 +val ttt = (term_of o the o (parse thy))
69.124 + "Script Solve_linear (e_::bool) (v_::real)= \
69.125 + \(let e_ = \
69.126 + \ ((Repeat\
69.127 + \ (((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
69.128 + \ (Rewrite_Set SqRoot_simplify False)))) e_)\
69.129 + \ in [e_])";
69.130 +atomty ttt;
69.131 +
69.132 +
69.133 +val ttt = (term_of o the o (parse thy))
69.134 +"(Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@ yyy";
69.135 +atomty ttt;
69.136 +val ttt = (term_of o the o (parse thy))
69.137 + "(Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
69.138 + \ (Rewrite_Set SqRoot_simplify False)";
69.139 +atomty ttt;
69.140 +val ttt = (term_of o the o (parse thy))
69.141 + "(Repeat\
69.142 + \ ((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
69.143 + \ (Rewrite_Set SqRoot_simplify False))) e_";
69.144 +atomty ttt;
69.145 +val ttt = (term_of o the o (parseold thy))
69.146 +"(let e_ = Repeat xxx e_ in [e_::bool])";
69.147 +atomty ttt;
69.148 +val ttt = (term_of o the o (parseold thy))
69.149 + "Script Solve_linear (e_::bool) (v_::real)= \
69.150 + \(let e_ = Repeat (xxx) e_ in [e_::bool])";
69.151 +atomty ttt;
69.152 +val ttt = (term_of o the o (parseold thy))
69.153 + "Script Solve_linear (e_::bool) (v_::real)= \
69.154 + \(let e_ =\
69.155 + \ Repeat\
69.156 + \ (((Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False) @@\
69.157 + \ (Rewrite_Set SqRoot_simplify False))) e_\
69.158 + \ in [e_::bool])"
69.159 +;
69.160 +atomty ttt;
69.161 +
70.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
70.2 +++ b/src/Pure/isac/IsacKnowledge/Test.thy Wed Jul 21 13:53:39 2010 +0200
70.3 @@ -0,0 +1,169 @@
70.4 +(* use_thy"IsacKnowledge/Test";
70.5 + *)
70.6 +
70.7 +Test = Atools + Rational + Root + Poly +
70.8 +
70.9 +consts
70.10 +
70.11 +(*"cancel":: [real, real] => real (infixl "'/'/'/" 70) ...divide 2002*)
70.12 +
70.13 + Expand'_binomtest
70.14 + :: "['y, \
70.15 + \ 'y] => 'y"
70.16 + ("((Script Expand'_binomtest (_ =))// \
70.17 + \ (_))" 9)
70.18 +
70.19 + Solve'_univar'_err
70.20 + :: "[bool,real,bool, \
70.21 + \ bool list] => bool list"
70.22 + ("((Script Solve'_univar'_err (_ _ _ =))// \
70.23 + \ (_))" 9)
70.24 +
70.25 + Solve'_linear
70.26 + :: "[bool,real, \
70.27 + \ bool list] => bool list"
70.28 + ("((Script Solve'_linear (_ _ =))// \
70.29 + \ (_))" 9)
70.30 +
70.31 +(*17.9.02 aus SqRoot.thy------------------------------vvv---*)
70.32 +
70.33 + "is'_root'_free" :: 'a => bool ("is'_root'_free _" 10)
70.34 + "contains'_root" :: 'a => bool ("contains'_root _" 10)
70.35 +
70.36 + Solve'_root'_equation
70.37 + :: "[bool,real, \
70.38 + \ bool list] => bool list"
70.39 + ("((Script Solve'_root'_equation (_ _ =))// \
70.40 + \ (_))" 9)
70.41 +
70.42 + Solve'_plain'_square
70.43 + :: "[bool,real, \
70.44 + \ bool list] => bool list"
70.45 + ("((Script Solve'_plain'_square (_ _ =))// \
70.46 + \ (_))" 9)
70.47 +
70.48 + Norm'_univar'_equation
70.49 + :: "[bool,real, \
70.50 + \ bool] => bool"
70.51 + ("((Script Norm'_univar'_equation (_ _ =))// \
70.52 + \ (_))" 9)
70.53 +
70.54 + STest'_simplify
70.55 + :: "['z, \
70.56 + \ 'z] => 'z"
70.57 + ("((Script STest'_simplify (_ =))// \
70.58 + \ (_))" 9)
70.59 +
70.60 +(*17.9.02 aus SqRoot.thy------------------------------^^^---*)
70.61 +
70.62 +rules (*stated as axioms, todo: prove as theorems*)
70.63 +
70.64 + radd_mult_distrib2 "(k::real) * (m + n) = k * m + k * n"
70.65 + rdistr_right_assoc "(k::real) + l * n + m * n = k + (l + m) * n"
70.66 + rdistr_right_assoc_p "l * n + (m * n + (k::real)) = (l + m) * n + k"
70.67 + rdistr_div_right "((k::real) + l) / n = k / n + l / n"
70.68 + rcollect_right
70.69 + "[| l is_const; m is_const |] ==> (l::real)*n + m*n = (l + m) * n"
70.70 + rcollect_one_left
70.71 + "m is_const ==> (n::real) + m * n = (1 + m) * n"
70.72 + rcollect_one_left_assoc
70.73 + "m is_const ==> (k::real) + n + m * n = k + (1 + m) * n"
70.74 + rcollect_one_left_assoc_p
70.75 + "m is_const ==> n + (m * n + (k::real)) = (1 + m) * n + k"
70.76 +
70.77 + rtwo_of_the_same "a + a = 2 * a"
70.78 + rtwo_of_the_same_assoc "(x + a) + a = x + 2 * a"
70.79 + rtwo_of_the_same_assoc_p"a + (a + x) = 2 * a + x"
70.80 +
70.81 + rcancel_den "not(a=0) ==> a * (b / a) = b"
70.82 + rcancel_const "[| a is_const; b is_const |] ==> a*(x/b) = a/b*x"
70.83 + rshift_nominator "(a::real) * b / c = a / c * b"
70.84 +
70.85 + exp_pow "(a ^^^ b) ^^^ c = a ^^^ (b * c)"
70.86 + rsqare "(a::real) * a = a ^^^ 2"
70.87 + power_1 "(a::real) ^^^ 1 = a"
70.88 + rbinom_power_2 "((a::real) + b)^^^ 2 = a^^^ 2 + 2*a*b + b^^^ 2"
70.89 +
70.90 + rmult_1 "1 * k = (k::real)"
70.91 + rmult_1_right "k * 1 = (k::real)"
70.92 + rmult_0 "0 * k = (0::real)"
70.93 + rmult_0_right "k * 0 = (0::real)"
70.94 + radd_0 "0 + k = (k::real)"
70.95 + radd_0_right "k + 0 = (k::real)"
70.96 +
70.97 + radd_real_const_eq
70.98 + "[| a is_const; c is_const; d is_const |] ==> a/d + c/d = (a+c)/(d::real)"
70.99 + radd_real_const
70.100 + "[| a is_const; b is_const; c is_const; d is_const |] ==> a/b + c/d = (a*d + b*c)/(b*(d::real))"
70.101 +
70.102 +(*for AC-operators*)
70.103 + radd_commute "(m::real) + (n::real) = n + m"
70.104 + radd_left_commute "(x::real) + (y + z) = y + (x + z)"
70.105 + radd_assoc "(m::real) + n + k = m + (n + k)"
70.106 + rmult_commute "(m::real) * n = n * m"
70.107 + rmult_left_commute "(x::real) * (y * z) = y * (x * z)"
70.108 + rmult_assoc "(m::real) * n * k = m * (n * k)"
70.109 +
70.110 +(*for equations: 'bdv' is a meta-constant*)
70.111 + risolate_bdv_add "((k::real) + bdv = m) = (bdv = m + (-1)*k)"
70.112 + risolate_bdv_mult_add "((k::real) + n*bdv = m) = (n*bdv = m + (-1)*k)"
70.113 + risolate_bdv_mult "((n::real) * bdv = m) = (bdv = m / n)"
70.114 +
70.115 + rnorm_equation_add
70.116 + "~(b =!= 0) ==> (a = b) = (a + (-1)*b = 0)"
70.117 +
70.118 +(*17.9.02 aus SqRoot.thy------------------------------vvv---*)
70.119 + root_ge0 "0 <= a ==> 0 <= sqrt a"
70.120 + (*should be dropped with better simplification in eval_rls ...*)
70.121 + root_add_ge0
70.122 + "[| 0 <= a; 0 <= b |] ==> (0 <= sqrt a + sqrt b) = True"
70.123 + root_ge0_1
70.124 + "[| 0<=a; 0<=b; 0<=c |] ==> (0 <= a * sqrt b + sqrt c) = True"
70.125 + root_ge0_2
70.126 + "[| 0<=a; 0<=b; 0<=c |] ==> (0 <= sqrt a + b * sqrt c) = True"
70.127 +
70.128 +
70.129 + rroot_square_inv "(sqrt a)^^^ 2 = a"
70.130 + rroot_times_root "sqrt a * sqrt b = sqrt(a*b)"
70.131 + rroot_times_root_assoc "(a * sqrt b) * sqrt c = a * sqrt(b*c)"
70.132 + rroot_times_root_assoc_p "sqrt b * (sqrt c * a)= sqrt(b*c) * a"
70.133 +
70.134 +
70.135 +(*for root-equations*)
70.136 + square_equation_left
70.137 + "[| 0 <= a; 0 <= b |] ==> (((sqrt a)=b)=(a=(b^^^ 2)))"
70.138 + square_equation_right
70.139 + "[| 0 <= a; 0 <= b |] ==> ((a=(sqrt b))=((a^^^ 2)=b))"
70.140 + (*causes frequently non-termination:*)
70.141 + square_equation
70.142 + "[| 0 <= a; 0 <= b |] ==> ((a=b)=((a^^^ 2)=b^^^ 2))"
70.143 +
70.144 + risolate_root_add "(a+ sqrt c = d) = ( sqrt c = d + (-1)*a)"
70.145 + risolate_root_mult "(a+b*sqrt c = d) = (b*sqrt c = d + (-1)*a)"
70.146 + risolate_root_div "(a * sqrt c = d) = ( sqrt c = d / a)"
70.147 +
70.148 +(*for polynomial equations of degree 2; linear case in RatArith*)
70.149 + mult_square "(a*bdv^^^2 = b) = (bdv^^^2 = b / a)"
70.150 + constant_square "(a + bdv^^^2 = b) = (bdv^^^2 = b + -1*a)"
70.151 + constant_mult_square "(a + b*bdv^^^2 = c) = (b*bdv^^^2 = c + -1*a)"
70.152 +
70.153 + square_equality
70.154 + "0 <= a ==> (x^^^2 = a) = ((x=sqrt a) | (x=-1*sqrt a))"
70.155 + square_equality_0
70.156 + "(x^^^2 = 0) = (x = 0)"
70.157 +
70.158 +(*isolate root on the LEFT hand side of the equation
70.159 + otherwise shuffling from left to right would not terminate*)
70.160 +
70.161 + rroot_to_lhs
70.162 + "is_root_free a ==> (a = sqrt b) = (a + (-1)*sqrt b = 0)"
70.163 + rroot_to_lhs_mult
70.164 + "is_root_free a ==> (a = c*sqrt b) = (a + (-1)*c*sqrt b = 0)"
70.165 + rroot_to_lhs_add_mult
70.166 + "is_root_free a ==> (a = d+c*sqrt b) = (a + (-1)*c*sqrt b = d)"
70.167 +
70.168 +
70.169 +(*17.9.02 aus SqRoot.thy------------------------------^^^---*)
70.170 +
70.171 +
70.172 +end
71.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
71.2 +++ b/src/Pure/isac/IsacKnowledge/Trig.thy Wed Jul 21 13:53:39 2010 +0200
71.3 @@ -0,0 +1,4 @@
71.4 +
71.5 +Trig = Real +
71.6 +
71.7 +end
71.8 \ No newline at end of file
72.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
72.2 +++ b/src/Pure/isac/IsacKnowledge/Typefix.thy Wed Jul 21 13:53:39 2010 +0200
72.3 @@ -0,0 +1,30 @@
72.4 +(* fixed type for _RE_parsing of strings from frontend
72.5 + WN.11.99, from Markus Wenzel
72.6 + *)
72.7 +
72.8 +Typefix = Script +
72.9 +
72.10 +syntax
72.11 +
72.12 + "_plus" :: 'a
72.13 + "_minus" :: 'a
72.14 + "_umin" :: 'a
72.15 + "_times" :: 'a
72.16 +
72.17 +translations
72.18 +
72.19 + "op +" => "_plus :: [real, real] => real" (*infixl 65 *)
72.20 + "op -" => "_minus :: [real, real] => real" (*infixl 65 *)
72.21 + "uminus"=> "_umin :: [real] => real" (*"- _" [80] 80*)
72.22 + "op *" => "_times :: [real, real] => real" (*infixl 70 *)
72.23 +
72.24 +end
72.25 +
72.26 +
72.27 +ML
72.28 +
72.29 +val parse_translation =
72.30 + [("_plus", curry Term.list_comb (Syntax.const "op +")),
72.31 + ("_minus", curry Term.list_comb (Syntax.const "op -")),
72.32 + ("_umin", curry Term.list_comb (Syntax.const "uminus")),
72.33 + ("_times", curry Term.list_comb (Syntax.const "op *"))];
73.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
73.2 +++ b/src/Pure/isac/IsacKnowledge/Vect.thy Wed Jul 21 13:53:39 2010 +0200
73.3 @@ -0,0 +1,5 @@
73.4 +Vect = Real +
73.5 +(*-------------------- consts ------------------------------------------------*)
73.6 +
73.7 +(*-------------------- rules -------------------------------------------------*)
73.8 +end
74.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
74.2 +++ b/src/Pure/isac/Isac_Mathengine.thy Wed Jul 21 13:53:39 2010 +0200
74.3 @@ -0,0 +1,175 @@
74.4 +(* Title: ~~~/isac/Isac_Mathengine.thy
74.5 + Author: Walther Neuper, TU Graz
74.6 +
74.7 +$ cd /usr/local/isabisac/src/Pure/isac
74.8 +$ /usr/local/isabisac/bin/isabelle emacs Isac_Mathengine.thy &
74.9 +
74.10 +OR tty (unusable: after errors wrong toplevel):
74.11 +$ cd "/home/neuper/proto2/isac/src/sml"
74.12 +$ isabelle-process HOL HOL-Isac
74.13 +ML> use_thy "Isac_Mathengine";
74.14 +*)
74.15 +
74.16 +header {* Loading the isac mathengine *}
74.17 +
74.18 +theory Isac_Mathengine
74.19 +imports Complex_Main "Scripts/Script" (*ListG, Tools, Script*)
74.20 +begin
74.21 +
74.22 +ML {* 1.2;3.4;5; *}
74.23 +
74.24 +use "library.sml"
74.25 +use "calcelems.sml"
74.26 +ML {* check_guhs_unique := true *}
74.27 +
74.28 +use "Scripts/term_G.sml"
74.29 +use "Scripts/calculate.sml"
74.30 +
74.31 +use "Scripts/rewrite.sml"
74.32 +use_thy"Scripts/Script"
74.33 +(*
74.34 +use "Scripts/ListG.ML"
74.35 +use "Scripts/Tools.ML"
74.36 +use "Scripts/Script.ML"
74.37 +
74.38 +use "Scripts/scrtools.sml"
74.39 +
74.40 +use "ME/mstools.sml"
74.41 +use "ME/ctree.sml"
74.42 +use "ME/ptyps.sml"
74.43 +use "ME/generate.sml"
74.44 +use "ME/calchead.sml"
74.45 +use "ME/appl.sml"
74.46 +use "ME/rewtools.sml"
74.47 +use "ME/script.sml"
74.48 +use "ME/solve.sml"
74.49 +use "ME/inform.sml"
74.50 +use "ME/mathengine.sml"
74.51 +
74.52 +use "xmlsrc/mathml.sml"
74.53 +use "xmlsrc/datatypes.sml"
74.54 +use "xmlsrc/pbl-met-hierarchy.sml"
74.55 +use "xmlsrc/thy-hierarchy.sml"
74.56 +use "xmlsrc/interface-xml.sml"
74.57 +
74.58 +use "FE-interface/messages.sml"
74.59 +use "FE-interface/states.sml"
74.60 +use "FE-interface/interface.sml"
74.61 +
74.62 +use "print_exn_G.sml"
74.63 +
74.64 +text "**** build math-engine complete *************************"
74.65 +*)(*
74.66 +setup {*
74.67 + Code_Preproc.setup
74.68 + #> Code_ML.setup
74.69 + #> Code_Haskell.setup
74.70 + #> Nbe.setup
74.71 +*}
74.72 +*)
74.73 +
74.74 +
74.75 +(*cleaner output from...*)
74.76 +ML_command {*
74.77 +"----- ";
74.78 +writeln "werwerw";
74.79 +*}
74.80 +
74.81 +ML {* @{prop "False"} *}
74.82 +(*ML {* @{type "int"} *} only new version*)
74.83 +ML {* @{thm conjI} *}
74.84 +ML {* @{thms conjI TrueI} *}
74.85 +ML {* @{theory} *}
74.86 +
74.87 +ML{* @{const_name plus} *} (*creates long names (extern names)*)
74.88 +term plus
74.89 +
74.90 +term foo
74.91 +(*ML{* @{const_name foo} *} only new version*)
74.92 +
74.93 +text {*
74.94 +werwer
74.95 + *}
74.96 +
74.97 +ML {*
74.98 + fun inc_by_five x =
74.99 + x |> (fn x => x + 1)
74.100 +*}
74.101 +
74.102 +(*canonical argument order introduced after 1997*)
74.103 +
74.104 +text{*
74.105 +this is the most appropriate fold for lists (generalizes to lists of lists by (fold o fold o fold))
74.106 +@{ML fold}
74.107 +
74.108 +@{ML fold_rev}
74.109 +
74.110 +for accumulating side results in |>
74.111 +@{ML fold_map}
74.112 +*}
74.113 +
74.114 +ML {*
74.115 + val items = 1 upto 10;
74.116 + val l1 = fold cons items []; (*alternating useful frequently*)
74.117 +*}
74.118 +
74.119 +ML{*
74.120 + fun merge_list eq (xs, ys) = fold_rev (insert eq) ys xs;
74.121 +*}
74.122 +ML{*
74.123 + merge_list (op =) ([3,2,1], [7,5,3,1]);
74.124 + merge_list (op =) ([3,2,1], [7,5,3,1]);
74.125 +*}
74.126 +
74.127 +(*session 2-------Christian+Makarius---------------*)
74.128 +ML{*
74.129 +let
74.130 + val ctxt = @{context}
74.131 +in 1 end
74.132 +*}
74.133 +
74.134 +(* build and handle tables THIS IS THE ACCESS-STRUCTURE...
74.135 +ML{*
74.136 + structure Data = Theory_Data
74.137 + (
74.138 + type T = term Symtab.table
74.139 + val empty = Symtab.empty
74.140 + val extend = O
74.141 + fun merge (t1, t2) = Symtab.merge (op = ) (t1, t2)
74.142 + )
74.143 +*}
74.144 +*)
74.145 +(*session 3-------Blanchette--------------------
74.146 +working on nitpic, ML level tool
74.147 +
74.148 +SEE THESE LECTURE NOTES !!!*)
74.149 +
74.150 +(*
74.151 +ML{*
74.152 +Const ("x", dummyT) |> Syntax.check_term @{context}
74.153 + ^^^^^^^^^^^^^^^^^
74.154 +*}
74.155 +*)
74.156 +
74.157 +text{*
74.158 +SEE funs for
74.159 +# deleting identifiers
74.160 +# handle Bounds when made visible
74.161 +# kill trivial quantifiers, e.g. \foral x. (NO x)
74.162 +# handling name clashes in Abs
74.163 +# which constants, free vars ... occur in a term !!!!!!!!!!!
74.164 +# Var (("x", 2), dummyT) ... 25 old from Larry "maxidx"
74.165 +# get fresh Const, Var
74.166 +# use the "Name" structure
74.167 +
74.168 +*}
74.169 +
74.170 +ML{* val context = Name.make_context ["d"] *}
74.171 +
74.172 +(*
74.173 +ML{* Name.invents context "foo" 10 *}
74.174 +(*ML{* Name variants ... *}*)
74.175 +*)
74.176 +
74.177 +end
74.178 +
75.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
75.2 +++ b/src/Pure/isac/ME/appl.sml Wed Jul 21 13:53:39 2010 +0200
75.3 @@ -0,0 +1,784 @@
75.4 +(* use"ME/appl.sml";
75.5 + use"appl.sml";
75.6 + *)
75.7 +val e_cterm' = empty_cterm';
75.8 +
75.9 +
75.10 +fun rew_info (Rls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
75.11 + (rew_ord':rew_ord',erls,ca)
75.12 + | rew_info (Seq {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
75.13 + (rew_ord',erls,ca)
75.14 + | rew_info (Rrls {erls,rew_ord=(rew_ord',_),calc=ca, ...}) =
75.15 + (rew_ord',erls, ca)
75.16 + | rew_info rls = raise error ("rew_info called with '"^rls2str rls^"'");
75.17 +
75.18 +(*FIXME.3.4.03:re-organize from_pblobj_or_detail_thm after rls' --> rls*)
75.19 +fun from_pblobj_or_detail_thm thm' p pt =
75.20 + let val (pbl,p',rls') = par_pbl_det pt p
75.21 + in if pbl
75.22 + then let (*val _= writeln("### from_pblobj_or_detail_thm: pbl=true")*)
75.23 + val thy' = get_obj g_domID pt p'
75.24 + val {rew_ord',erls,(*asm_thm,*)...} =
75.25 + get_met (get_obj g_metID pt p')
75.26 + (*val _= writeln("### from_pblobj_or_detail_thm: metID= "^
75.27 + (metID2str(get_obj g_metID pt p')))
75.28 + val _= writeln("### from_pblobj_or_detail_thm: erls= "^erls)*)
75.29 + in ("OK",thy',rew_ord',erls,(*put_asm*)false)
75.30 + end
75.31 + else ((*writeln("### from_pblobj_or_detail_thm: pbl=false");*)
75.32 + (*case assoc(!ruleset', rls') of !!!FIXME.3.4.03:re-organize !!!
75.33 + None => ("unknown ruleset '"^rls'^"'","","",Erls,false)
75.34 + | Some rls =>*)
75.35 + let val thy' = get_obj g_domID pt (par_pblobj pt p)
75.36 + val (rew_ord',erls,(*asm_thm,*)_) = rew_info rls'
75.37 + (*val put_asm = (fst thm') mem (map fst asm_thm);*)
75.38 + in ("OK",thy',rew_ord',erls,(*put_asm*)false) end)
75.39 + end;
75.40 +(*FIXME.3.4.03:re-organize from_pblobj_or_detail_calc after rls' --> rls*)
75.41 +fun from_pblobj_or_detail_calc scrop p pt =
75.42 +(* val (scrop, p, pt) = (op_, p, pt);
75.43 + *)
75.44 + let val (pbl,p',rls') = par_pbl_det pt p
75.45 + in if pbl
75.46 + then let val thy' = get_obj g_domID pt p'
75.47 + val {calc = scr_isa_fns,...} =
75.48 + get_met (get_obj g_metID pt p')
75.49 + val opt = assoc (scr_isa_fns, scrop)
75.50 + in case opt of
75.51 + Some isa_fn => ("OK",thy',isa_fn)
75.52 + | None => ("applicable_in Calculate: unknown '"^scrop^"'",
75.53 + "",("",e_evalfn)) end
75.54 + else (*case assoc(!ruleset', rls') of
75.55 + None => ("unknown ruleset '"^rls'^"'","",("",e_evalfn))
75.56 + | Some rls => !!!FIXME.3.4.03:re-organize from_pblobj_or_detai*)
75.57 + (* val Some rls = assoc(!ruleset', rls');
75.58 + *)
75.59 + let val thy' = get_obj g_domID pt (par_pblobj pt p);
75.60 + val (_,_,(*_,*)scr_isa_fns) = rew_info rls'(*rls*)
75.61 + in case assoc (scr_isa_fns, scrop) of
75.62 + Some isa_fn => ("OK",thy',isa_fn)
75.63 + | None => ("applicable_in Calculate: unknown '"^scrop^"'",
75.64 + "",("",e_evalfn)) end
75.65 + end;
75.66 +(*------------------------------------------------------------------*)
75.67 +
75.68 +val op_and = Const ("op &", [bool, bool] ---> bool);
75.69 +(*> cterm_of (sign_of thy) (op_and $ Free("a",bool) $ Free("b",bool));
75.70 +val it = "a & b" : cterm
75.71 +*)
75.72 +fun mk_and a b = op_and $ a $ b;
75.73 +(*> cterm_of (sign_of thy)
75.74 + (mk_and (Free("a",bool)) (Free("b",bool)));
75.75 +val it = "a & b" : cterm*)
75.76 +
75.77 +fun mk_and [] = HOLogic.true_const
75.78 + | mk_and (t::[]) = t
75.79 + | mk_and (t::ts) =
75.80 + let fun mk t' (t::[]) = op_and $ t' $ t
75.81 + | mk t' (t::ts) = mk (op_and $ t' $ t) ts
75.82 + in mk t ts end;
75.83 +(*> val pred = map (term_of o the o (parse thy))
75.84 + ["#0 <= #9 + #4 * x","#0 <= sqrt x + sqrt (#-3 + x)"];
75.85 +> cterm_of (sign_of thy) (mk_and pred);
75.86 +val it = "#0 <= #9 + #4 * x & #0 <= sqrt x + sqrt (#-3 + x)" : cterm*)
75.87 +
75.88 +
75.89 +
75.90 +
75.91 +(*for Check_elementwise in applicable_in: [x=1,..] Assumptions -> (x,0<=x&..)*)
75.92 +fun mk_set thy pt p (Const ("List.list.Nil",_)) pred = (e_term, [])
75.93 +
75.94 + | mk_set thy pt p (Const ("Tools.UniversalList",_)) pred =
75.95 + (e_term, if pred <> Const ("Script.Assumptions",bool)
75.96 + then [pred]
75.97 + else (map fst) (get_assumptions_ pt (p,Res)))
75.98 +
75.99 +(* val pred = (term_of o the o (parse thy)) pred;
75.100 + val consts as Const ("List.list.Cons",_) $ eq $ _ = ft;
75.101 + mk_set thy pt p consts pred;
75.102 + *)
75.103 + | mk_set thy pt p (consts as Const ("List.list.Cons",_) $ eq $ _) pred =
75.104 + let val (bdv,_) = HOLogic.dest_eq eq;
75.105 + val pred = if pred <> Const ("Script.Assumptions",bool)
75.106 + then [pred]
75.107 + else (map fst) (get_assumptions_ pt (p,Res))
75.108 + in (bdv, pred) end
75.109 +
75.110 + | mk_set thy _ _ l _ =
75.111 + raise error ("check_elementwise: no set "^
75.112 + (Sign.string_of_term (sign_of thy) l));
75.113 +(*> val consts = str2term "[x=#4]";
75.114 +> val pred = str2term "Assumptions";
75.115 +> val pt = union_asm pt p
75.116 + [("#0 <= sqrt x + sqrt (#5 + x)",[11]),("#0 <= #9 + #4 * x",[22]),
75.117 + ("#0 <= x ^^^ #2 + #5 * x",[33]),("#0 <= #2 + x",[44])];
75.118 +> val p = [];
75.119 +> val (sss,ttt) = mk_set thy pt p consts pred;
75.120 +> (Sign.string_of_term (sign_of thy) sss,Sign.string_of_term(sign_of thy) ttt);
75.121 +val it = ("x","((#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x) & ...
75.122 +
75.123 + val consts = str2term "UniversalList";
75.124 + val pred = str2term "Assumptions";
75.125 +
75.126 +*)
75.127 +
75.128 +
75.129 +
75.130 +(*check a list (/set) of constants [c_1,..,c_n] for c_i:set (: in)*)
75.131 +(* val (erls,consts,(bdv,pred)) = (erl,ft,vp);
75.132 + val (consts,(bdv,pred)) = (ft,vp);
75.133 + *)
75.134 +fun check_elementwise thy erls all_results (bdv, asm) =
75.135 + let (*bdv extracted from ~~~~~~~~~~~ in mk_set already*)
75.136 + fun check sub =
75.137 + let val inst_ = map (subst_atomic [sub]) asm
75.138 + in case eval__true thy 1 inst_ [] erls of
75.139 + (asm', true) => ([HOLogic.mk_eq sub], asm')
75.140 + | (_, false) => ([],[])
75.141 + end;
75.142 + (*val _= writeln("### check_elementwise: res= "^(term2str all_results)^
75.143 + ", bdv= "^(term2str bdv)^", asm= "^(terms2str asm));*)
75.144 + val c' = isalist2list all_results
75.145 + val c'' = map (snd o HOLogic.dest_eq) c' (*assumes [x=1,x=2,..]*)
75.146 + val subs = map (pair bdv) c''
75.147 + in if asm = [] then (all_results, [])
75.148 + else ((apfst ((list2isalist bool) o flat)) o
75.149 + (apsnd flat) o split_list o (map check)) subs end;
75.150 +(* 20.5.03
75.151 +> val all_results = str2term "[x=a+b,x=b,x=3]";
75.152 +> val bdv = str2term "x";
75.153 +> val asm = str2term "(x ~= a) & (x ~= b)";
75.154 +> val erls = e_rls;
75.155 +> val (t, ts) = check_elementwise thy erls all_results (bdv, asm);
75.156 +> term2str t; writeln(terms2str ts);
75.157 +val it = "[x = a + b, x = b, x = c]" : string
75.158 +["a + b ~= a & a + b ~= b","b ~= a & b ~= b","c ~= a & c ~= b"]
75.159 +... with appropriate erls this should be:
75.160 +val it = "[x = a + b, x = c]" : string
75.161 +["b ~= 0 & a ~= 0", "3 ~= a & 3 ~= b"]
75.162 + ////// because b ~= b False*)
75.163 +
75.164 +
75.165 +
75.166 +(*before 5.03-----
75.167 +> val ct = "((#0 <= #18 & #0 <= sqrt (#5 + #3) + sqrt (#5 - #3)) &\
75.168 + \ #0 <= #25 + #-1 * #3 ^^^ #2) & #0 <= #4";
75.169 +> val Some(ct',_) = rewrite_set "Isac.thy" false "eval_rls" ct;
75.170 +val ct' = "True" : cterm'
75.171 +
75.172 +> val ct = "((#0 <= #18 & #0 <= sqrt (#5 + #-3) + sqrt (#5 - #-3)) &\
75.173 + \ #0 <= #25 + #-1 * #-3 ^^^ #2) & #0 <= #4";
75.174 +> val Some(ct',_) = rewrite_set "Isac.thy" false "eval_rls" ct;
75.175 +val ct' = "True" : cterm'
75.176 +
75.177 +
75.178 +> val const = (term_of o the o (parse thy)) "(#3::real)";
75.179 +> val pred' = subst_atomic [(bdv,const)] pred;
75.180 +
75.181 +
75.182 +> val consts = (term_of o the o (parse thy)) "[x = #-3, x = #3]";
75.183 +> val bdv = (term_of o the o (parse thy)) "(x::real)";
75.184 +> val pred = (term_of o the o (parse thy))
75.185 + "((#0 <= #18 & #0 <= sqrt (#5 + x) + sqrt (#5 - x)) & #0 <= #25 + #-1 * x ^^^ #2) & #0 <= #4";
75.186 +> val ttt = check_elementwise thy consts (bdv, pred);
75.187 +> cterm_of (sign_of thy) ttt;
75.188 +val it = "[x = #-3, x = #3]" : cterm
75.189 +
75.190 +> val consts = (term_of o the o (parse thy)) "[x = #4]";
75.191 +> val bdv = (term_of o the o (parse thy)) "(x::real)";
75.192 +> val pred = (term_of o the o (parse thy))
75.193 + "#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x & #0 <= x ^^^ #2 + #5 * x & #0 <= #2 + x";
75.194 +> val ttt = check_elementwise thy consts (bdv,pred);
75.195 +> cterm_of (sign_of thy) ttt;
75.196 +val it = "[x = #4]" : cterm
75.197 +
75.198 +> val consts = (term_of o the o (parse thy)) "[x = #-12 // #5]";
75.199 +> val bdv = (term_of o the o (parse thy)) "(x::real)";
75.200 +> val pred = (term_of o the o (parse thy))
75.201 + " #0 <= sqrt x + sqrt (#-3 + x) & #0 <= #9 + #4 * x & #0 <= x ^^^ #2 + #-3 * x & #0 <= #6 + x";
75.202 +> val ttt = check_elementwise thy consts (bdv,pred);
75.203 +> cterm_of (sign_of thy) ttt;
75.204 +val it = "[]" : cterm*)
75.205 +
75.206 +
75.207 +(* 14.1.01: for Tac-dummies in root-equ only: skip str until "("*)
75.208 +fun split_dummy str =
75.209 +let fun scan s' [] = (implode s', "")
75.210 + | scan s' (s::ss) = if s=" " then (implode s', implode ss)
75.211 + else scan (s'@[s]) ss;
75.212 +in ((scan []) o explode) str end;
75.213 +(* split_dummy "subproblem_equation_dummy (x=-#5//#12)";
75.214 +val it = ("subproblem_equation_dummy","(x=-#5//#12)") : string * string
75.215 +> split_dummy "x=-#5//#12";
75.216 +val it = ("x=-#5//#12","") : string * string*)
75.217 +
75.218 +
75.219 +
75.220 +
75.221 +(*.applicability of a tacic wrt. a calc-state (ptree,pos').
75.222 + additionally used by next_tac in the script-interpreter for sequence-tacs.
75.223 + tests for applicability are so expensive, that results (rewrites!)
75.224 + are kept in the return-value of 'type tac_'.
75.225 +.*)
75.226 +fun applicable_in (_:pos') _ (Init_Proof (ct', spec)) =
75.227 + Appl (Init_Proof' (ct', spec))
75.228 +
75.229 + | applicable_in (p,p_) pt Model_Problem =
75.230 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.231 + then Notappl ((tac2str Model_Problem)^
75.232 + " not for pos "^(pos'2str (p,p_)))
75.233 + else let val (PblObj{origin=(_,(_,pI',_),_),...}) = get_obj I pt p
75.234 + val {ppc,...} = get_pbt pI'
75.235 + val pbl = init_pbl ppc
75.236 + in Appl (Model_Problem' (pI', pbl, [])) end
75.237 +(* val Refine_Tacitly pI = m;
75.238 + *)
75.239 + | applicable_in (p,p_) pt (Refine_Tacitly pI) =
75.240 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.241 + then Notappl ((tac2str (Refine_Tacitly pI))^
75.242 + " not for pos "^(pos'2str (p,p_)))
75.243 + else (* val Refine_Tacitly pI = m;
75.244 + *)
75.245 + let val (PblObj {origin = (oris, (dI',_,_),_), ...}) = get_obj I pt p;
75.246 + val opt = refine_ori oris pI;
75.247 + in case opt of
75.248 + Some pblID =>
75.249 + Appl (Refine_Tacitly' (pI, pblID,
75.250 + e_domID, e_metID, [](*filled in specify*)))
75.251 + | None => Notappl ((tac2str (Refine_Tacitly pI))^
75.252 + " not applicable") end
75.253 +(* val (p,p_) = ip;
75.254 + val Refine_Problem pI = m;
75.255 + *)
75.256 + | applicable_in (p,p_) pt (Refine_Problem pI) =
75.257 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.258 + then Notappl ((tac2str (Refine_Problem pI))^
75.259 + " not for pos "^(pos'2str (p,p_)))
75.260 + else
75.261 + let val (PblObj {origin=(_,(dI,_,_),_),spec=(dI',_,_),
75.262 + probl=itms, ...}) = get_obj I pt p;
75.263 + val thy = if dI' = e_domID then dI else dI';
75.264 + val rfopt = refine_pbl (assoc_thy thy) pI itms;
75.265 + in case rfopt of
75.266 + None => Notappl ((tac2str (Refine_Problem pI))^" not applicable")
75.267 + | Some (rf as (pI',_)) =>
75.268 +(* val Some (rf as (pI',_)) = rfopt;
75.269 + *)
75.270 + if pI' = pI
75.271 + then Notappl ((tac2str (Refine_Problem pI))^" not applicable")
75.272 + else Appl (Refine_Problem' rf)
75.273 + end
75.274 +
75.275 + (*the specify-tacs have cterm' instead term:
75.276 + parse+error here!!!: see appl_add*)
75.277 + | applicable_in (p,p_) pt (Add_Given ct') =
75.278 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.279 + then Notappl ((tac2str (Add_Given ct'))^
75.280 + " not for pos "^(pos'2str (p,p_)))
75.281 + else Appl (Add_Given' (ct', [(*filled in specify_additem*)]))
75.282 + (*Add_.. should reject (dsc //) (see fmz=[] in sqrt*)
75.283 +
75.284 + | applicable_in (p,p_) pt (Del_Given ct') =
75.285 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.286 + then Notappl ((tac2str (Del_Given ct'))^
75.287 + " not for pos "^(pos'2str (p,p_)))
75.288 + else Appl (Del_Given' ct')
75.289 +
75.290 + | applicable_in (p,p_) pt (Add_Find ct') =
75.291 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.292 + then Notappl ((tac2str (Add_Find ct'))^
75.293 + " not for pos "^(pos'2str (p,p_)))
75.294 + else Appl (Add_Find' (ct', [(*filled in specify_additem*)]))
75.295 +
75.296 + | applicable_in (p,p_) pt (Del_Find ct') =
75.297 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.298 + then Notappl ((tac2str (Del_Find ct'))^
75.299 + " not for pos "^(pos'2str (p,p_)))
75.300 + else Appl (Del_Find' ct')
75.301 +
75.302 + | applicable_in (p,p_) pt (Add_Relation ct') =
75.303 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.304 + then Notappl ((tac2str (Add_Relation ct'))^
75.305 + " not for pos "^(pos'2str (p,p_)))
75.306 + else Appl (Add_Relation' (ct', [(*filled in specify_additem*)]))
75.307 +
75.308 + | applicable_in (p,p_) pt (Del_Relation ct') =
75.309 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.310 + then Notappl ((tac2str (Del_Relation ct'))^
75.311 + " not for pos "^(pos'2str (p,p_)))
75.312 + else Appl (Del_Relation' ct')
75.313 +
75.314 + | applicable_in (p,p_) pt (Specify_Theory dI) =
75.315 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.316 + then Notappl ((tac2str (Specify_Theory dI))^
75.317 + " not for pos "^(pos'2str (p,p_)))
75.318 + else Appl (Specify_Theory' dI)
75.319 +(* val (p,p_) = p; val Specify_Problem pID = m;
75.320 + val Specify_Problem pID = m;
75.321 + *)
75.322 + | applicable_in (p,p_) pt (Specify_Problem pID) =
75.323 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.324 + then Notappl ((tac2str (Specify_Problem pID))^
75.325 + " not for pos "^(pos'2str (p,p_)))
75.326 + else
75.327 + let val (PblObj {origin=(oris,(dI,pI,_),_),spec=(dI',pI',_),
75.328 + probl=itms, ...}) = get_obj I pt p;
75.329 + val thy = assoc_thy (if dI' = e_domID then dI else dI');
75.330 + val {ppc,where_,prls,...} = get_pbt pID;
75.331 + val pbl = if pI'=e_pblID andalso pI=e_pblID
75.332 + then (false, (init_pbl ppc, []))
75.333 + else match_itms_oris thy itms (ppc,where_,prls) oris;
75.334 + in Appl (Specify_Problem' (pID, pbl)) end
75.335 +(* val Specify_Method mID = nxt; val (p,p_) = p;
75.336 + *)
75.337 + | applicable_in (p,p_) pt (Specify_Method mID) =
75.338 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.339 + then Notappl ((tac2str (Specify_Method mID))^
75.340 + " not for pos "^(pos'2str (p,p_)))
75.341 + else Appl (Specify_Method' (mID,[(*filled in specify*)],
75.342 + [(*filled in specify*)]))
75.343 +
75.344 + | applicable_in (p,p_) pt (Apply_Method mI) =
75.345 + if not (is_pblobj (get_obj I pt p)) orelse p_ = Res
75.346 + then Notappl ((tac2str (Apply_Method mI))^
75.347 + " not for pos "^(pos'2str (p,p_)))
75.348 + else Appl (Apply_Method' (mI, None, e_istate (*filled in solve*)))
75.349 +
75.350 + | applicable_in (p,p_) pt (Check_Postcond pI) =
75.351 + if p_ mem [Pbl,Met]
75.352 + then Notappl ((tac2str (Check_Postcond pI))^
75.353 + " not for pos "^(pos'2str (p,p_)))
75.354 + else Appl (Check_Postcond'
75.355 + (pI,(e_term,[(*asm in solve*)])))
75.356 + (* in solve -"- ^^^^^^ gets returnvalue of scr*)
75.357 +
75.358 + (*these are always applicable*)
75.359 + | applicable_in (p,p_) _ (Take str) = Appl (Take' (str2term str))
75.360 + | applicable_in (p,p_) _ (Free_Solve) = Appl (Free_Solve')
75.361 +
75.362 +(* val m as Rewrite_Inst (subs, thm') = m;
75.363 + *)
75.364 + | applicable_in (p,p_) pt (m as Rewrite_Inst (subs, thm')) =
75.365 + if p_ mem [Pbl,Met]
75.366 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.367 + else
75.368 + let
75.369 + val pp = par_pblobj pt p;
75.370 + val thy' = (get_obj g_domID pt pp):theory';
75.371 + val thy = assoc_thy thy';
75.372 + val {rew_ord'=ro',erls=erls,(*asm_thm=asm_thm,*)...} =
75.373 + get_met (get_obj g_metID pt pp);
75.374 + (*val put_asm = (fst thm') mem (map fst asm_thm);*)
75.375 + val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
75.376 + Frm => (get_obj g_form pt p, p)
75.377 + | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
75.378 + | _ => raise error ("applicable_in: call by "^
75.379 + (pos'2str (p,p_)));
75.380 + in
75.381 + let val subst = subs2subst thy subs;
75.382 + val subs' = subst2subs' subst;
75.383 + in case rewrite_inst_ thy (assoc_rew_ord ro') erls
75.384 + (*put_asm*)false subst (assoc_thm' thy thm') f of
75.385 + Some (f',asm) => Appl (
75.386 + Rewrite_Inst' (thy',ro',erls,(*put_asm*)false,subst,thm',
75.387 + (*term_of o the o (parse (assoc_thy thy'))*) f,
75.388 + (*(term_of o the o (parse (assoc_thy thy'))*) (f',
75.389 + (*map (term_of o the o (parse (assoc_thy thy')))*) asm)))
75.390 + | None => Notappl ((fst thm')^" not applicable") end
75.391 + handle _ => Notappl ("syntax error in "^(subs2str subs)) end
75.392 +
75.393 +(* val ((p,p_), pt, m as Rewrite thm') = (p, pt, m);
75.394 + val ((p,p_), pt, m as Rewrite thm') = (pos, pt, tac);
75.395 + *)
75.396 +| applicable_in (p,p_) pt (m as Rewrite thm') =
75.397 + if p_ mem [Pbl,Met]
75.398 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.399 + else
75.400 + let val (msg,thy',ro,rls',(*put_asm*)_)= from_pblobj_or_detail_thm thm' p pt;
75.401 + val thy = assoc_thy thy';
75.402 + val f = case p_ of
75.403 + Frm => get_obj g_form pt p
75.404 + | Res => (fst o (get_obj g_result pt)) p
75.405 + | _ => raise error ("applicable_in Rewrite: call by "^
75.406 + (pos'2str (p,p_)));
75.407 + in if msg = "OK"
75.408 + then
75.409 + ((*writeln("### applicable_in rls'= "^rls');*)
75.410 + (* val Some (f',asm)=rewrite thy' ro (id_rls rls') put_asm thm' f;
75.411 + *)
75.412 + case rewrite_ thy (assoc_rew_ord ro)
75.413 + rls' false (assoc_thm' thy thm') f of
75.414 + Some (f',asm) => Appl (
75.415 + Rewrite' (thy',ro,rls',(*put_asm*)false,thm', f, (f', asm)))
75.416 + | None => Notappl ("'"^(fst thm')^"' not applicable") )
75.417 + else Notappl msg
75.418 + end
75.419 +
75.420 +| applicable_in (p,p_) pt (m as Rewrite_Asm thm') =
75.421 + if p_ mem [Pbl,Met]
75.422 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.423 + else
75.424 + let
75.425 + val pp = par_pblobj pt p;
75.426 + val thy' = (get_obj g_domID pt pp):theory';
75.427 + val thy = assoc_thy thy';
75.428 + val {rew_ord'=ro',erls=erls,...} =
75.429 + get_met (get_obj g_metID pt pp);
75.430 + (*val put_asm = true;*)
75.431 + val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
75.432 + Frm => (get_obj g_form pt p, p)
75.433 + | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
75.434 + | _ => raise error ("applicable_in: call by "^
75.435 + (pos'2str (p,p_)));
75.436 + in case rewrite_ thy (assoc_rew_ord ro') erls
75.437 + (*put_asm*)false (assoc_thm' thy thm') f of
75.438 + Some (f',asm) => Appl (
75.439 + Rewrite' (thy',ro',erls,(*put_asm*)false,thm', f, (f', asm)))
75.440 + | None => Notappl ("'"^(fst thm')^"' not applicable") end
75.441 +
75.442 + | applicable_in (p,p_) pt (m as Detail_Set_Inst (subs, rls)) =
75.443 + if p_ mem [Pbl,Met]
75.444 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.445 + else
75.446 + let
75.447 + val pp = par_pblobj pt p;
75.448 + val thy' = (get_obj g_domID pt pp):theory';
75.449 + val thy = assoc_thy thy';
75.450 + val {rew_ord'=ro',...} = get_met (get_obj g_metID pt pp);
75.451 + val f = case p_ of Frm => get_obj g_form pt p
75.452 + | Res => (fst o (get_obj g_result pt)) p
75.453 + | _ => raise error ("applicable_in: call by "^
75.454 + (pos'2str (p,p_)));
75.455 + in
75.456 + let val subst = subs2subst thy subs
75.457 + val subs' = subst2subs' subst
75.458 + in case rewrite_set_inst_ thy false subst (assoc_rls rls) f of
75.459 + Some (f',asm) => Appl (
75.460 + Detail_Set_Inst' (thy',false,subst,assoc_rls rls, f, (f', asm)))
75.461 + | None => Notappl (rls^" not applicable") end
75.462 + handle _ => Notappl ("syntax error in "^(subs2str subs)) end
75.463 +
75.464 + | applicable_in (p,p_) pt (m as Rewrite_Set_Inst (subs, rls)) =
75.465 + if p_ mem [Pbl,Met]
75.466 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.467 + else
75.468 + let
75.469 + val pp = par_pblobj pt p;
75.470 + val thy' = (get_obj g_domID pt pp):theory';
75.471 + val thy = assoc_thy thy';
75.472 + val {rew_ord'=ro',(*asm_rls=asm_rls,*)...} =
75.473 + get_met (get_obj g_metID pt pp);
75.474 + (*val put_asm = rls mem asm_rls;*)
75.475 + val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
75.476 + Frm => (get_obj g_form pt p, p)
75.477 + | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
75.478 + | _ => raise error ("applicable_in: call by "^
75.479 + (pos'2str (p,p_)));
75.480 + in
75.481 + let val subst = subs2subst thy subs;
75.482 + val subs' = subst2subs' subst;
75.483 + in case rewrite_set_inst_ thy (*put_asm*)false subst (assoc_rls rls) f of
75.484 + Some (f',asm) => Appl (
75.485 + Rewrite_Set_Inst' (thy',(*put_asm*)false,subst,assoc_rls rls, f, (f', asm)))
75.486 + | None => Notappl (rls^" not applicable") end
75.487 + handle _ => Notappl ("syntax error in "^(subs2str subs)) end
75.488 +
75.489 + | applicable_in (p,p_) pt (m as Rewrite_Set rls) =
75.490 + if p_ mem [Pbl,Met]
75.491 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.492 + else
75.493 + let
75.494 + val pp = par_pblobj pt p;
75.495 + val thy' = (get_obj g_domID pt pp):theory';
75.496 + (*val {asm_rls=asm_rls,...} = get_met (get_obj g_metID pt pp);
75.497 + val put_asm = rls mem asm_rls;*)
75.498 + val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
75.499 + Frm => (get_obj g_form pt p, p)
75.500 + | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
75.501 + | _ => raise error ("applicable_in: call by "^
75.502 + (pos'2str (p,p_)));
75.503 + in case rewrite_set_ (assoc_thy thy') (*put_asm*)false (assoc_rls rls) f of
75.504 + Some (f',asm) =>
75.505 + ((*writeln("#.# applicable_in Rewrite_Set,2f'= "^f');*)
75.506 + Appl (Rewrite_Set' (thy',(*put_asm*)false,assoc_rls rls, f, (f', asm)))
75.507 + )
75.508 + | None => Notappl (rls^" not applicable") end
75.509 +
75.510 + | applicable_in (p,p_) pt (m as Detail_Set rls) =
75.511 + if p_ mem [Pbl,Met]
75.512 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.513 + else
75.514 + let val pp = par_pblobj pt p
75.515 + val thy' = (get_obj g_domID pt pp):theory'
75.516 + val f = case p_ of
75.517 + Frm => get_obj g_form pt p
75.518 + | Res => (fst o (get_obj g_result pt)) p
75.519 + | _ => raise error ("applicable_in: call by "^
75.520 + (pos'2str (p,p_)));
75.521 + in case rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
75.522 + Some (f',asm) =>
75.523 + Appl (Detail_Set' (thy',false,assoc_rls rls, f, (f',asm)))
75.524 + | None => Notappl (rls^" not applicable") end
75.525 +
75.526 +
75.527 + | applicable_in p pt (End_Ruleset) =
75.528 + raise error ("applicable_in: not impl. for "^
75.529 + (tac2str End_Ruleset))
75.530 +
75.531 +(* val ((p,p_), pt, (m as Calculate op_)) = (p, pt, m);
75.532 + *)
75.533 +| applicable_in (p,p_) pt (m as Calculate op_) =
75.534 + if p_ mem [Pbl,Met]
75.535 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.536 + else
75.537 + let
75.538 + val (msg,thy',isa_fn) = from_pblobj_or_detail_calc op_ p pt;
75.539 + val f = case p_ of
75.540 + Frm => get_obj g_form pt p
75.541 + | Res => (fst o (get_obj g_result pt)) p
75.542 + in if msg = "OK" then
75.543 + case calculate_ (assoc_thy thy') isa_fn f of
75.544 + Some (f', (id, thm)) =>
75.545 + Appl (Calculate' (thy',op_, f, (f', (id, string_of_thmI thm))))
75.546 + | None => Notappl ("'calculate "^op_^"' not applicable")
75.547 + else Notappl msg
75.548 + end
75.549 +
75.550 +(*Substitute combines two different kind of "substitution":
75.551 + (1) subst_atomic: for ?a..?z
75.552 + (2) Pattern.match: for solving equational systems
75.553 + (which raises exn for ?a..?z)*)
75.554 + | applicable_in (p,p_) pt (m as Substitute sube) =
75.555 + if p_ mem [Pbl,Met]
75.556 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.557 + else let val pp = par_pblobj pt p
75.558 + val thy = assoc_thy (get_obj g_domID pt pp)
75.559 + val f = case p_ of
75.560 + Frm => get_obj g_form pt p
75.561 + | Res => (fst o (get_obj g_result pt)) p
75.562 + val {rew_ord',erls,...} = get_met (get_obj g_metID pt pp)
75.563 + val subte = sube2subte sube
75.564 + val subst = sube2subst thy sube
75.565 + in if foldl and_ (true, map contains_Var subte)
75.566 + (*1*)
75.567 + then let val f' = subst_atomic subst f
75.568 + in if f = f' then Notappl (sube2str sube^" not applicable")
75.569 + else Appl (Substitute' (subte, f, f'))
75.570 + end
75.571 + (*2*)
75.572 + else case rewrite_terms_ thy (assoc_rew_ord rew_ord')
75.573 + erls subte f of
75.574 + Some (f', _) => Appl (Substitute' (subte, f, f'))
75.575 + | None => Notappl (sube2str sube^" not applicable")
75.576 + end
75.577 +(*-------WN08114 interrupted with error in polyminus.sml "11 = 11"
75.578 + | applicable_in (p,p_) pt (m as Substitute sube) =
75.579 + if p_ mem [Pbl,Met]
75.580 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.581 + else let val pp = par_pblobj pt p
75.582 + val thy = assoc_thy (get_obj g_domID pt pp)
75.583 + val f = case p_ of
75.584 + Frm => get_obj g_form pt p
75.585 + | Res => (fst o (get_obj g_result pt)) p
75.586 + val {rew_ord',erls,...} = get_met (get_obj g_metID pt pp)
75.587 + val subte = sube2subte sube
75.588 + in case rewrite_terms_ thy (assoc_rew_ord rew_ord') erls subte f of
75.589 + Some (f', _) => Appl (Substitute' (subte, f, f'))
75.590 + | None => Notappl (sube2str sube^" not applicable")
75.591 + end
75.592 +------------------*)
75.593 +
75.594 + | applicable_in p pt (Apply_Assumption cts') =
75.595 + (raise error ("applicable_in: not impl. for "^
75.596 + (tac2str (Apply_Assumption cts'))))
75.597 +
75.598 + (*'logical' applicability wrt. script in locate: Inconsistent?*)
75.599 + | applicable_in (p,p_) pt (m as Take ct') =
75.600 + if p_ mem [Pbl,Met]
75.601 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.602 + else
75.603 + let val thy' = get_obj g_domID pt (par_pblobj pt p);
75.604 + in (case parse (assoc_thy thy') ct' of
75.605 + Some ct => Appl (Take' (term_of ct))
75.606 + | None => Notappl ("syntax error in "^ct'))
75.607 + end
75.608 +
75.609 + | applicable_in p pt (Take_Inst ct') =
75.610 + raise error ("applicable_in: not impl. for "^
75.611 + (tac2str (Take_Inst ct')))
75.612 +
75.613 + | applicable_in p pt (Group (con, ints)) =
75.614 + raise error ("applicable_in: not impl. for "^
75.615 + (tac2str (Group (con, ints))))
75.616 +
75.617 + | applicable_in (p,p_) pt (m as Subproblem (domID, pblID)) =
75.618 + if p_ mem [Pbl,Met]
75.619 + then (*maybe Apply_Method has already been done*)
75.620 + case get_obj g_env pt p of
75.621 + Some is => Appl (Subproblem' ((domID, pblID, e_metID), [],
75.622 + e_term, [], subpbl domID pblID))
75.623 + | None => Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.624 + else (*somewhere later in the script*)
75.625 + Appl (Subproblem' ((domID, pblID, e_metID), [],
75.626 + e_term, [], subpbl domID pblID))
75.627 +
75.628 + | applicable_in p pt (End_Subproblem) =
75.629 + raise error ("applicable_in: not impl. for "^
75.630 + (tac2str (End_Subproblem)))
75.631 +
75.632 + | applicable_in p pt (CAScmd ct') =
75.633 + raise error ("applicable_in: not impl. for "^
75.634 + (tac2str (CAScmd ct')))
75.635 +
75.636 + | applicable_in p pt (Split_And) =
75.637 + raise error ("applicable_in: not impl. for "^
75.638 + (tac2str (Split_And)))
75.639 + | applicable_in p pt (Conclude_And) =
75.640 + raise error ("applicable_in: not impl. for "^
75.641 + (tac2str (Conclude_And)))
75.642 + | applicable_in p pt (Split_Or) =
75.643 + raise error ("applicable_in: not impl. for "^
75.644 + (tac2str (Split_Or)))
75.645 + | applicable_in p pt (Conclude_Or) =
75.646 + raise error ("applicable_in: not impl. for "^
75.647 + (tac2str (Conclude_Or)))
75.648 +
75.649 + | applicable_in (p,p_) pt (Begin_Trans) =
75.650 + let
75.651 + val (f,p) = case p_ of (*p 12.4.00 unnecessary*)
75.652 + (*_____ implizit Take in gen*)
75.653 + Frm => (get_obj g_form pt p, (lev_on o lev_dn) p)
75.654 + | Res => ((fst o (get_obj g_result pt)) p, (lev_on o lev_dn o lev_on) p)
75.655 + | _ => raise error ("applicable_in: call by "^
75.656 + (pos'2str (p,p_)));
75.657 + val thy' = get_obj g_domID pt (par_pblobj pt p);
75.658 + in (Appl (Begin_Trans' f))
75.659 + handle _ => raise error ("applicable_in: Begin_Trans finds \
75.660 + \syntaxerror in '"^(term2str f)^"'") end
75.661 +
75.662 + (*TODO: check parent branches*)
75.663 + | applicable_in (p,p_) pt (End_Trans) =
75.664 + let val thy' = get_obj g_domID pt (par_pblobj pt p);
75.665 + in if p_ = Res
75.666 + then Appl (End_Trans' (get_obj g_result pt p))
75.667 + else Notappl "'End_Trans' is not applicable at \
75.668 + \the beginning of a transitive sequence"
75.669 + (*TODO: check parent branches*)
75.670 + end
75.671 +
75.672 + | applicable_in p pt (Begin_Sequ) =
75.673 + raise error ("applicable_in: not impl. for "^
75.674 + (tac2str (Begin_Sequ)))
75.675 + | applicable_in p pt (End_Sequ) =
75.676 + raise error ("applicable_in: not impl. for "^
75.677 + (tac2str (End_Sequ)))
75.678 + | applicable_in p pt (Split_Intersect) =
75.679 + raise error ("applicable_in: not impl. for "^
75.680 + (tac2str (Split_Intersect)))
75.681 + | applicable_in p pt (End_Intersect) =
75.682 + raise error ("applicable_in: not impl. for "^
75.683 + (tac2str (End_Intersect)))
75.684 +(* val Appl (Check_elementwse'(t1,"Assumptions",t2)) = it;
75.685 + val (vvv,ppp) = vp;
75.686 +
75.687 + val Check_elementwise pred = m;
75.688 +
75.689 + val ((p,p_), Check_elementwise pred) = (p, m);
75.690 + *)
75.691 + | applicable_in (p,p_) pt (m as Check_elementwise pred) =
75.692 + if p_ mem [Pbl,Met]
75.693 + then Notappl ((tac2str m)^" not for pos "^(pos'2str (p,p_)))
75.694 + else
75.695 + let
75.696 + val pp = par_pblobj pt p;
75.697 + val thy' = (get_obj g_domID pt pp):theory';
75.698 + val thy = assoc_thy thy'
75.699 + val metID = (get_obj g_metID pt pp)
75.700 + val {crls,...} = get_met metID
75.701 + (*val _=writeln("### applicable_in Check_elementwise: crls= "^crls)
75.702 + val _=writeln("### applicable_in Check_elementwise: pred= "^pred)*)
75.703 + (*val erl = the (assoc'(!ruleset',crls))*)
75.704 + val (f,asm) = case p_ of
75.705 + Frm => (get_obj g_form pt p , [])
75.706 + | Res => get_obj g_result pt p;
75.707 + (*val _= writeln("### applicable_in Check_elementwise: f= "^f);*)
75.708 + val vp = mk_set thy pt p f ((term_of o the o (parse thy)) pred);
75.709 + (*val (v,p)=vp;val _=writeln("### applicable_in Check_elementwise: vp= "^
75.710 + pair2str(term2str v,term2str p))*)
75.711 + in case f of
75.712 + Const ("List.list.Cons",_) $ _ $ _ =>
75.713 + Appl (Check_elementwise'
75.714 + (f, pred,
75.715 + ((*writeln("### applicable_in Check_elementwise: --> "^
75.716 + (res2str (check_elementwise thy crls f vp)));*)
75.717 + check_elementwise thy crls f vp)))
75.718 + | Const ("Tools.UniversalList",_) =>
75.719 + Appl (Check_elementwise' (f, pred, (f,asm)))
75.720 + | Const ("List.list.Nil",_) =>
75.721 + (*Notappl "not applicable to empty list" 3.6.03*)
75.722 + Appl (Check_elementwise' (f, pred, (f,asm(*[] 11.6.03???*))))
75.723 + | _ => Notappl ("not applicable: "^(term2str f)^" should be constants")
75.724 + end
75.725 +
75.726 + | applicable_in (p,p_) pt Or_to_List =
75.727 + if p_ mem [Pbl,Met]
75.728 + then Notappl ((tac2str Or_to_List)^" not for pos "^(pos'2str (p,p_)))
75.729 + else
75.730 + let
75.731 + val pp = par_pblobj pt p;
75.732 + val thy' = (get_obj g_domID pt pp):theory';
75.733 + val thy = assoc_thy thy';
75.734 + val f = case p_ of
75.735 + Frm => get_obj g_form pt p
75.736 + | Res => (fst o (get_obj g_result pt)) p;
75.737 + in (let val ls = or2list f
75.738 + in Appl (Or_to_List' (f, ls)) end)
75.739 + handle _ => Notappl ("'Or_to_List' not applicable to "^(term2str f))
75.740 + end
75.741 +
75.742 + | applicable_in p pt (Collect_Trues) =
75.743 + raise error ("applicable_in: not impl. for "^
75.744 + (tac2str (Collect_Trues)))
75.745 +
75.746 + | applicable_in p pt (Empty_Tac) =
75.747 + Notappl "Empty_Tac is not applicable"
75.748 +
75.749 + | applicable_in (p,p_) pt (Tac id) =
75.750 + let
75.751 + val pp = par_pblobj pt p;
75.752 + val thy' = (get_obj g_domID pt pp):theory';
75.753 + val thy = assoc_thy thy';
75.754 + val f = case p_ of
75.755 + Frm => get_obj g_form pt p
75.756 + | Res => (fst o (get_obj g_result pt)) p;
75.757 + in case id of
75.758 + "subproblem_equation_dummy" =>
75.759 + if is_expliceq f
75.760 + then Appl (Tac_ (thy, term2str f, id,
75.761 + "subproblem_equation_dummy ("^(term2str f)^")"))
75.762 + else Notappl "applicable only to equations made explicit"
75.763 + | "solve_equation_dummy" =>
75.764 + let (*val _= writeln("### applicable_in: solve_equation_dummy: f= "
75.765 + ^f);*)
75.766 + val (id',f') = split_dummy (term2str f);
75.767 + (*val _= writeln("### applicable_in: f'= "^f');*)
75.768 + (*val _= (term_of o the o (parse thy)) f';*)
75.769 + (*val _= writeln"### applicable_in: solve_equation_dummy";*)
75.770 + in if id' <> "subproblem_equation_dummy" then Notappl "no subproblem"
75.771 + else if is_expliceq ((term_of o the o (parse thy)) f')
75.772 + then Appl (Tac_ (thy, term2str f, id, "[" ^ f' ^ "]"))
75.773 + else error ("applicable_in: f= " ^ f') end
75.774 + | _ => Appl (Tac_ (thy, term2str f, id, term2str f)) end
75.775 +
75.776 + | applicable_in p pt End_Proof' = Appl End_Proof''
75.777 +
75.778 + | applicable_in _ _ m =
75.779 + raise error ("applicable_in called for "^(tac2str m));
75.780 +
75.781 +(*WN060614 unused*)
75.782 +fun tac2tac_ pt p m =
75.783 + case applicable_in p pt m of
75.784 + Appl (m') => m'
75.785 + | Notappl _ => raise error ("tac2mstp': fails with"^
75.786 + (tac2str m));
75.787 +
76.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
76.2 +++ b/src/Pure/isac/ME/calchead.sml Wed Jul 21 13:53:39 2010 +0200
76.3 @@ -0,0 +1,2260 @@
76.4 +(* Specify-phase: specifying and modeling a problem or a subproblem. The
76.5 + most important types are declared in mstools.sml.
76.6 + author: Walther Neuper
76.7 + 991122
76.8 + (c) due to copyright terms
76.9 +
76.10 +use"ME/calchead.sml";
76.11 +use"calchead.sml";
76.12 +*)
76.13 +
76.14 +(* TODO interne Funktionen aus sig entfernen *)
76.15 +signature CALC_HEAD =
76.16 + sig
76.17 + datatype additm = Add of SpecifyTools.itm | Err of string
76.18 + val all_dsc_in : SpecifyTools.itm_ list -> Term.term list
76.19 + val all_modspec : ptree * pos' -> ptree * pos'
76.20 + datatype appl = Appl of tac_ | Notappl of string
76.21 + val appl_add :
76.22 + Theory.theory ->
76.23 + string ->
76.24 + SpecifyTools.ori list ->
76.25 + SpecifyTools.itm list ->
76.26 + (string * (Term.term * Term.term)) list -> cterm' -> additm
76.27 + type calcstate
76.28 + type calcstate'
76.29 + val chk_vars : Thm.cterm SpecifyTools.ppc -> string * Term.term list
76.30 + val chktyp :
76.31 + Theory.theory -> int * Thm.cterm list * Thm.cterm list -> Thm.cterm
76.32 + val chktyps :
76.33 + Theory.theory -> Thm.cterm list * Thm.cterm list -> Thm.cterm list
76.34 + val complete_metitms :
76.35 + SpecifyTools.ori list ->
76.36 + SpecifyTools.itm list ->
76.37 + SpecifyTools.itm list -> pat list -> SpecifyTools.itm list
76.38 + val complete_mod_ : ori list * pat list * pat list * itm list ->
76.39 + itm list * itm list
76.40 + val complete_mod : ptree * pos' -> ptree * (pos * pos_)
76.41 + val complete_spec : ptree * pos' -> ptree * pos'
76.42 + val cpy_nam :
76.43 + pat list -> preori list -> pat -> preori
76.44 + val e_calcstate : calcstate
76.45 + val e_calcstate' : calcstate'
76.46 + val eq1 : ''a -> 'b * (''a * 'c) -> bool
76.47 + val eq3 :
76.48 + ''a -> Term.term -> 'b * 'c * 'd * ''a * SpecifyTools.itm_ -> bool
76.49 + val eq4 : ''a -> 'b * ''a list * 'c * 'd * 'e -> bool
76.50 + val eq5 :
76.51 + 'a * 'b * 'c * 'd * SpecifyTools.itm_ ->
76.52 + 'e * 'f * 'g * Term.term * 'h -> bool
76.53 + val eq_dsc : SpecifyTools.itm * SpecifyTools.itm -> bool
76.54 + val eq_pos' : ''a * pos_ -> ''a * pos_ -> bool
76.55 + val f_mout : Theory.theory -> mout -> Term.term
76.56 + val filter_outs :
76.57 + SpecifyTools.ori list ->
76.58 + SpecifyTools.itm list -> SpecifyTools.ori list
76.59 + val filter_pbt :
76.60 + SpecifyTools.ori list ->
76.61 + ('a * (Term.term * 'b)) list -> SpecifyTools.ori list
76.62 + val foldl1 : ('a * 'a -> 'a) -> 'a list -> 'a
76.63 + val foldr1 : ('a * 'a -> 'a) -> 'a list -> 'a
76.64 + val form : 'a -> ptree -> (string * ('a * pos_) * Term.term) list
76.65 + val formres : 'a -> ptree -> (string * ('a * pos_) * Term.term) list
76.66 + val gen_ins' : ('a * 'a -> bool) -> 'a * 'a list -> 'a list
76.67 + val get_formress :
76.68 + (string * (pos * pos_) * Term.term) list list ->
76.69 + pos -> ptree list -> (string * (pos * pos_) * Term.term) list
76.70 + val get_forms :
76.71 + (string * (pos * pos_) * Term.term) list list ->
76.72 + posel list -> ptree list -> (string * (pos * pos_) * Term.term) list
76.73 + val get_interval : pos' -> pos' -> int -> ptree -> (pos' * term) list
76.74 + val get_ocalhd : ptree * pos' -> ocalhd
76.75 + val get_spec_form : tac_ -> pos' -> ptree -> mout
76.76 + val geti_ct :
76.77 + Theory.theory ->
76.78 + SpecifyTools.ori -> SpecifyTools.itm -> string * cterm'
76.79 + val getr_ct : Theory.theory -> SpecifyTools.ori -> string * cterm'
76.80 + val has_list_type : Term.term -> bool
76.81 + val header : pos_ -> pblID -> metID -> pblmet
76.82 + val insert_ppc :
76.83 + Theory.theory ->
76.84 + int * SpecifyTools.vats * bool * string * SpecifyTools.itm_ ->
76.85 + SpecifyTools.itm list -> SpecifyTools.itm list
76.86 + val insert_ppc' :
76.87 + SpecifyTools.itm -> SpecifyTools.itm list -> SpecifyTools.itm list
76.88 + val is_complete_mod : ptree * pos' -> bool
76.89 + val is_complete_mod_ : SpecifyTools.itm list -> bool
76.90 + val is_complete_modspec : ptree * pos' -> bool
76.91 + val is_complete_spec : ptree * pos' -> bool
76.92 + val is_copy_named : 'a * ('b * Term.term) -> bool
76.93 + val is_copy_named_idstr : string -> bool
76.94 + val is_error : SpecifyTools.itm_ -> bool
76.95 + val is_field_correct : ''a -> ''b -> (''a * ''b list) list -> bool
76.96 + val is_known :
76.97 + Theory.theory ->
76.98 + string ->
76.99 + SpecifyTools.ori list ->
76.100 + Term.term -> string * SpecifyTools.ori * Term.term list
76.101 + val is_list_type : Term.typ -> bool
76.102 + val is_notyet_input :
76.103 + Theory.theory ->
76.104 + SpecifyTools.itm list ->
76.105 + Term.term list ->
76.106 + SpecifyTools.ori ->
76.107 + ('a * (Term.term * Term.term)) list -> string * SpecifyTools.itm
76.108 + val is_parsed : SpecifyTools.itm_ -> bool
76.109 + val is_untouched : SpecifyTools.itm -> bool
76.110 + val matc :
76.111 + Theory.theory ->
76.112 + pat list ->
76.113 + Term.term list ->
76.114 + (int list * string * Term.term * Term.term list) list ->
76.115 + (int list * string * Term.term * Term.term list) list
76.116 + val match_ags :
76.117 + Theory.theory -> pat list -> Term.term list -> SpecifyTools.ori list
76.118 + val maxl : int list -> int
76.119 + val match_ags_msg : string list -> Term.term -> Term.term list -> unit
76.120 + val memI : ''a list -> ''a -> bool
76.121 + val mk_additem : string -> cterm' -> tac
76.122 + val mk_delete : Theory.theory -> string -> SpecifyTools.itm_ -> tac
76.123 + val mtc :
76.124 + Theory.theory -> pat -> Term.term -> SpecifyTools.preori Library.option
76.125 + val nxt_add :
76.126 + Theory.theory ->
76.127 + SpecifyTools.ori list ->
76.128 + (string * (Term.term * 'a)) list ->
76.129 + SpecifyTools.itm list -> (string * cterm') Library.option
76.130 + val nxt_model_pbl : tac_ -> ptree * (int list * pos_) -> tac_
76.131 + val nxt_spec :
76.132 + pos_ ->
76.133 + bool ->
76.134 + SpecifyTools.ori list ->
76.135 + spec ->
76.136 + SpecifyTools.itm list * SpecifyTools.itm list ->
76.137 + (string * (Term.term * 'a)) list * (string * (Term.term * 'b)) list ->
76.138 + spec -> pos_ * tac
76.139 + val nxt_specif : tac -> ptree * (int list * pos_) -> calcstate'
76.140 + val nxt_specif_additem :
76.141 + string -> cterm' -> ptree * (int list * pos_) -> calcstate'
76.142 + val nxt_specify_init_calc : fmz -> calcstate
76.143 + val ocalhd_complete :
76.144 + SpecifyTools.itm list ->
76.145 + (bool * Term.term) list -> domID * pblID * metID -> bool
76.146 + val ori2Coritm :
76.147 + pat list -> ori -> itm
76.148 + val ori_2itm :
76.149 + 'a ->
76.150 + SpecifyTools.itm_ ->
76.151 + Term.term -> Term.term list -> SpecifyTools.ori -> SpecifyTools.itm
76.152 + val overwrite_ppc :
76.153 + Theory.theory ->
76.154 + int * SpecifyTools.vats * bool * string * SpecifyTools.itm_ ->
76.155 + SpecifyTools.itm list ->
76.156 + (int * SpecifyTools.vats * bool * string * SpecifyTools.itm_) list
76.157 + val parse_ok : SpecifyTools.itm_ list -> bool
76.158 + val posform2str : pos' * ptform -> string
76.159 + val posforms2str : (pos' * ptform) list -> string
76.160 + val posterms2str : (pos' * term) list -> string (*tests only*)
76.161 + val ppc135list : 'a SpecifyTools.ppc -> 'a list
76.162 + val ppc2list : 'a SpecifyTools.ppc -> 'a list
76.163 + val pt_extract :
76.164 + ptree * (int list * pos_) ->
76.165 + ptform * tac Library.option * Term.term list
76.166 + val pt_form : ppobj -> ptform
76.167 + val pt_model : ppobj -> pos_ -> ptform
76.168 + val reset_calchead : ptree * pos' -> ptree * pos'
76.169 + val seek_oridts :
76.170 + Theory.theory ->
76.171 + string ->
76.172 + Term.term * Term.term list ->
76.173 + (int * SpecifyTools.vats * string * Term.term * Term.term list) list
76.174 + -> string * SpecifyTools.ori * Term.term list
76.175 + val seek_orits :
76.176 + Theory.theory ->
76.177 + string ->
76.178 + Term.term list ->
76.179 + (int * SpecifyTools.vats * string * Term.term * Term.term list) list
76.180 + -> string * SpecifyTools.ori * Term.term list
76.181 + val seek_ppc :
76.182 + int -> SpecifyTools.itm list -> SpecifyTools.itm Library.option
76.183 + val show_pt : ptree -> unit
76.184 + val some_spec : spec -> spec -> spec
76.185 + val specify :
76.186 + tac_ ->
76.187 + pos' ->
76.188 + cid ->
76.189 + ptree ->
76.190 + (posel list * pos_) * ((posel list * pos_) * istate) * mout * tac *
76.191 + safe * ptree
76.192 + val specify_additem :
76.193 + string ->
76.194 + cterm' * 'a ->
76.195 + int list * pos_ ->
76.196 + 'b ->
76.197 + ptree ->
76.198 + (pos * pos_) * ((pos * pos_) * istate) * mout * tac * safe * ptree
76.199 + val tag_form : Theory.theory -> Thm.cterm * Thm.cterm -> Thm.cterm
76.200 + val test_types : Theory.theory -> Term.term * Term.term list -> string
76.201 + val typeless : Term.term -> Term.term
76.202 + val unbound_ppc : Thm.cterm SpecifyTools.ppc -> Term.term list
76.203 + val vals_of_oris : SpecifyTools.ori list -> Term.term list
76.204 + val variants_in : Term.term list -> int
76.205 + val vars_of_pbl_ : ('a * ('b * Term.term)) list -> Term.term list
76.206 + val vars_of_pbl_' : ('a * ('b * Term.term)) list -> Term.term list
76.207 + end
76.208 +
76.209 +
76.210 +
76.211 +
76.212 +
76.213 +(*---------------------------------------------------------------------*)
76.214 +structure CalcHead (**): CALC_HEAD(**) =
76.215 +
76.216 +struct
76.217 +(*---------------------------------------------------------------------*)
76.218 +
76.219 +(* datatypes *)
76.220 +
76.221 +(*.the state wich is stored after each step of calculation; it contains
76.222 + the calc-state and a list of [tac,istate](="tacis") to be applied.
76.223 + the last_elem tacis is the first to apply to the calc-state and
76.224 + the (only) one shown to the front-end as the 'proposed tac'.
76.225 + the calc-state resulting from the application of tacis is not stored,
76.226 + because the tacis hold enought information for efficiently rebuilding
76.227 + this state just by "fun generate ".*)
76.228 +type calcstate =
76.229 + (ptree * pos') * (*the calc-state to which the tacis could be applied*)
76.230 + (taci list); (*ev. several (hidden) steps;
76.231 + in REVERSE order: first tac_ to apply is last_elem*)
76.232 +val e_calcstate = ((EmptyPtree, e_pos'), [e_taci]):calcstate;
76.233 +
76.234 +(*the state used during one calculation within the mathengine; it contains
76.235 + a list of [tac,istate](="tacis") which generated the the calc-state;
76.236 + while this state's tacis are extended by each (internal) step,
76.237 + the calc-state is used for creating new nodes in the calc-tree
76.238 + (eg. applicable_in requires several particular nodes of the calc-tree)
76.239 + and then replaced by the the newly created;
76.240 + on leave of the mathengine the resuing calc-state is dropped anyway,
76.241 + because the tacis hold enought information for efficiently rebuilding
76.242 + this state just by "fun generate ".*)
76.243 +type calcstate' =
76.244 + taci list * (*cas. several (hidden) steps;
76.245 + in REVERSE order: first tac_ to apply is last_elem*)
76.246 + pos' list * (*a "continuous" sequence of pos',
76.247 + deleted by application of taci list*)
76.248 + (ptree * pos'); (*the calc-state resulting from the application of tacis*)
76.249 +val e_calcstate' = ([e_taci], [e_pos'], (EmptyPtree, e_pos')):calcstate';
76.250 +
76.251 +(*FIXXXME.WN020430 intermediate hack for fun ass_up*)
76.252 +fun f_mout thy (Form' (FormKF (_,_,_,_,f))) = (term_of o the o (parse thy)) f
76.253 + | f_mout thy _ = raise error "f_mout: not called with formula";
76.254 +
76.255 +
76.256 +(*.is the calchead complete ?.*)
76.257 +fun ocalhd_complete (its: itm list) (pre: (bool * term) list) (dI,pI,mI) =
76.258 + foldl and_ (true, map #3 its) andalso
76.259 + foldl and_ (true, map #1 pre) andalso
76.260 + dI<>e_domID andalso pI<>e_pblID andalso mI<>e_metID;
76.261 +
76.262 +
76.263 +(* make a term 'typeless' for comparing with another 'typeless' term;
76.264 + 'type-less' usually is illtyped *)
76.265 +fun typeless (Const(s,_)) = (Const(s,e_type))
76.266 + | typeless (Free(s,_)) = (Free(s,e_type))
76.267 + | typeless (Var(n,_)) = (Var(n,e_type))
76.268 + | typeless (Bound i) = (Bound i)
76.269 + | typeless (Abs(s,_,t)) = Abs(s,e_type, typeless t)
76.270 + | typeless (t1 $ t2) = (typeless t1) $ (typeless t2);
76.271 +(*
76.272 +> val (Some ct) = parse thy "max_relation (A=#2*a*b - a^^^#2)";
76.273 +> val (_,t1) = split_dsc_t hs (term_of ct);
76.274 +> val (Some ct) = parse thy "A=#2*a*b - a^^^#2";
76.275 +> val (_,t2) = split_dsc_t hs (term_of ct);
76.276 +> typeless t1 = typeless t2;
76.277 +val it = true : bool
76.278 +*)
76.279 +
76.280 +
76.281 +
76.282 +(*.to an input (d,ts) find the according ori and insert the ts.*)
76.283 +(*WN.11.03: + dont take first inter<>[]*)
76.284 +fun seek_oridts thy sel (d,ts) [] =
76.285 + ("'"^(string_of_cterm (comp_dts thy (d,ts)))^
76.286 + (*"' not found (typed)", e_ori_:ori, []) ///11.11.03*)
76.287 + "' not found (typed)", (0,[],sel,d,ts):ori, [])
76.288 + (* val (id,vat,sel',d',ts')::oris = ori;
76.289 + val (id,vat,sel',d',ts') = ori;
76.290 + *)
76.291 + | seek_oridts thy sel (d,ts) ((id,vat,sel',d',ts')::(oris:ori list)) =
76.292 + if sel = sel' andalso d=d' andalso (ts inter ts') <> []
76.293 + then if sel = sel'
76.294 + then ("",(id,vat,sel,d, ts inter(*!overlap!*) ts'):ori, ts')
76.295 + else ((string_of_cterm (comp_dts thy(d,ts)))^
76.296 + " not for "^sel, e_ori_, [])
76.297 + else seek_oridts thy sel (d,ts) oris;
76.298 +
76.299 +(*FIXXXME.WN.11.03: + dont take first inter<>[] .. ev. variants are following:
76.300 + thus take largest intersection !!!
76.301 + if sel NOTok .. then the correct itm should NOT be overwritten by insert_ppc*)
76.302 +(*fun eq7 d (_,_,_,d',_) = d = d';
76.303 +fun inter_length ((_,_,_,_,ts), (_,_,_,_,ts')) = (length ts) < (length ts');
76.304 +fun seek_oridts _ sel (d,ts) [] =
76.305 + ("'"^(string_of_cterm (comp_dts thy (d,ts)))^
76.306 + (*"' not found (typed)", e_ori_:ori, []) ///11.11.03*)
76.307 + "' not found (typed)", (0,[],sel,d,ts):ori, [])
76.308 + (* val (id,vat,sel',d',ts')::oris = ori;
76.309 + val (id,vat,sel',d',ts') = ori;
76.310 + *)
76.311 + | seek_oridts _ sel (d,ts) oris =
76.312 + let val dscOK = filter (eq7 d) oris;
76.313 + in if dscOK = [] then ("'"^(string_of_cterm (comp_dts thy (d,ts)))^
76.314 + "' not found (typed)", (0,[],sel,d,ts):ori, [])
76.315 + else let val (id,vat,sel',d',ts') = gen_max inter_length dscOK;
76.316 + in if sel = sel' then ("",(id,vat,sel,d,ts inter ts'), [])
76.317 + else ("wrong field",(id,vat,sel,d,ts inter ts'), []) end
76.318 + end;
76.319 +--------------------didnt work with Add_Given/_Find/_Relation 11.03*)
76.320 +
76.321 +(*.to an input (_,ts) find the according ori and insert the ts.*)
76.322 +fun seek_orits thy sel ts [] =
76.323 + ("'"^
76.324 + (strs2str (map (Sign.string_of_term (sign_of thy)) ts))^
76.325 + "' not found (typed)", e_ori_, [])
76.326 + | seek_orits thy sel ts ((id,vat,sel',d,ts')::(oris:ori list)) =
76.327 + if sel = sel' andalso (ts inter ts') <> []
76.328 + then if sel = sel'
76.329 + then ("",(id,vat,sel,d,ts inter(*!overlap!*) ts'):ori, ts')
76.330 + else (((strs2str' o map (Sign.string_of_term (sign_of thy))) ts)^
76.331 + " not for "^sel, e_ori_, [])
76.332 + else seek_orits thy sel ts oris;
76.333 +(* false
76.334 +> val ((id,vat,sel',d,ts')::(ori':ori)) = ori;
76.335 +> seek_orits thy sel ts [(id,vat,sel',d,ts')];
76.336 +uncaught exception TYPE
76.337 +> seek_orits thy sel ts [];
76.338 +uncaught exception TYPE
76.339 +*)
76.340 +
76.341 +(*find_first item with #1 equal to id*)
76.342 +fun seek_ppc id [] = None
76.343 + | seek_ppc id (p::(ppc:itm list)) =
76.344 + if id = #1 p then Some p else seek_ppc id ppc;
76.345 +
76.346 +
76.347 +
76.348 +(*---------------------------------------------(3) nach ptyps.sml 23.3.02*)
76.349 +
76.350 +
76.351 +datatype appl = Appl of tac_ | Notappl of string;
76.352 +
76.353 +fun ppc2list ({Given=gis,Where=whs,Find=fis,
76.354 + With=wis,Relate=res}: 'a ppc) =
76.355 + gis @ whs @ fis @ wis @ res;
76.356 +fun ppc135list ({Given=gis,Find=fis,Relate=res,...}: 'a ppc) =
76.357 + gis @ fis @ res;
76.358 +
76.359 +
76.360 +
76.361 +
76.362 +(* get the number of variants in a problem in 'original',
76.363 + assumes equal descriptions in immediate sequence *)
76.364 +fun variants_in ts =
76.365 + let fun eq(x,y) = head_of x = head_of y;
76.366 + fun cnt eq [] y n = ([n],[])
76.367 + | cnt eq (x::xs) y n = if eq(x,y) then cnt eq xs y (n+1)
76.368 + else ([n], x::xs);
76.369 + fun coll eq xs [] = xs
76.370 + | coll eq xs (y::ys) =
76.371 + let val (n,ys') = cnt eq (y::ys) y 0;
76.372 + in if ys' = [] then xs @ n else coll eq (xs @ n) ys' end;
76.373 + val vts = (distinct (coll eq [] ts))\\[1];
76.374 + in case vts of [] => 1 | [n] => n
76.375 + | _ => error "different variants in formalization" end;
76.376 +(*
76.377 +> cnt (op=) [2,2,2,4,5,5,5,5,5] 2 0;
76.378 +val it = ([3],[4,5,5,5,5,5]) : int list * int list
76.379 +> coll (op=) [] [1,2,2,2,4,5,5,5,5,5];
76.380 +val it = [1,3,1,5] : int list
76.381 +*)
76.382 +
76.383 +fun is_list_type (Type("List.list",_)) = true
76.384 + | is_list_type _ = false;
76.385 +(* fun destr (Type(str,sort)) = (str,sort);
76.386 +> val (Some ct) = parse thy "lll::real list";
76.387 +> val ty = (#T o rep_cterm) ct;
76.388 +> is_list_type ty;
76.389 +val it = true : bool
76.390 +> destr ty;
76.391 +val it = ("List.list",["RealDef.real"]) : string * typ list
76.392 +> atomty ((#t o rep_cterm) ct);
76.393 +*** -------------
76.394 +*** Free ( lll, real list)
76.395 +val it = () : unit
76.396 +
76.397 +> val (Some ct) = parse thy "[lll::real]";
76.398 +> val ty = (#T o rep_cterm) ct;
76.399 +> is_list_type ty;
76.400 +val it = true : bool
76.401 +> destr ty;
76.402 +val it = ("List.list",["'a"]) : string * typ list
76.403 +> atomty ((#t o rep_cterm) ct);
76.404 +*** -------------
76.405 +*** Const ( List.list.Cons, [real, real list] => real list)
76.406 +*** Free ( lll, real)
76.407 +*** Const ( List.list.Nil, real list)
76.408 +
76.409 +> val (Some ct) = parse thy "lll";
76.410 +> val ty = (#T o rep_cterm) ct;
76.411 +> is_list_type ty;
76.412 +val it = false : bool *)
76.413 +
76.414 +
76.415 +fun has_list_type (Free(_,T)) = is_list_type T
76.416 + | has_list_type _ = false;
76.417 +(*
76.418 +> val (Some ct) = parse thy "lll::real list";
76.419 +> has_list_type (term_of ct);
76.420 +val it = true : bool
76.421 +> val (Some ct) = parse thy "[lll::real]";
76.422 +> has_list_type (term_of ct);
76.423 +val it = false : bool *)
76.424 +
76.425 +
76.426 +
76.427 +
76.428 +(*fdcrs = descriptions in formalization
76.429 + unused 22.11.00
76.430 +fun is_already_input thy fdcrs ts t =
76.431 + let
76.432 + val tss = flat (map isalist2list ts);
76.433 +(*28.1. val (dcr,t') = split_dsc_t fdcrs t; *)
76.434 + val (dcr,[t']) = split_dts t;
76.435 + in if (typeless t') mem (map typeless tss)
76.436 + then ("term '"^(Sign.string_of_term (sign_of thy) t')^
76.437 + "' already input")
76.438 + else "" end;
76.439 +
76.440 +> val pts = appc (map (term_of o the o (parse thy))) pbl;
76.441 +> val ts = #Relate pts;
76.442 +> val t = (term_of o the o (parse thy))"(A=#2*a*b - a^^^#2)";
76.443 +> is_already_input thy ts t;
76.444 +val it = "term 'A = #2 * a * b - a ^^^ #2' already input" : string
76.445 +> val t = (term_of o the o (parse thy))"a=#2*R*sin alpha";
76.446 +> is_already_input thy ts t;
76.447 +val it = "term 'a = #2 * R * sin alpha' already input" : string
76.448 +> val t = (term_of o the o (parse thy))"a=R*sin alpha";
76.449 +> is_already_input thy ts t;
76.450 +val it = "" : string
76.451 +*)
76.452 +
76.453 +
76.454 +fun is_parsed (Syn _) = false
76.455 + | is_parsed _ = true;
76.456 +fun parse_ok its = foldl and_ (true, map is_parsed its);
76.457 +
76.458 +fun all_dsc_in itm_s =
76.459 + let
76.460 + fun d_in (Cor ((d,_),_)) = [d]
76.461 + | d_in (Syn c) = []
76.462 + | d_in (Typ c) = []
76.463 + | d_in (Inc ((d,_),_)) = [d]
76.464 + | d_in (Sup (d,_)) = [d]
76.465 + | d_in (Mis (d,_)) = [d];
76.466 + in (flat o (map d_in)) itm_s end;
76.467 +
76.468 +(* 30.1.00 ---
76.469 +fun is_Syn (Syn _) = true
76.470 + | is_Syn (Typ _) = true
76.471 + | is_Syn _ = false;
76.472 + --- *)
76.473 +fun is_error (Cor (_,ts)) = false
76.474 + | is_error (Sup (_,ts)) = false
76.475 + | is_error (Inc (_,ts)) = false
76.476 + | is_error (Mis (_,ts)) = false
76.477 + | is_error _ = true;
76.478 +
76.479 +(* 30.1.00 ---
76.480 +fun ct_in (Syn (c)) = c
76.481 + | ct_in (Typ (c)) = c
76.482 + | ct_in _ = raise error "ct_in called for Cor .. Sup";
76.483 + --- *)
76.484 +
76.485 +(*#############################################################*)
76.486 +(*#############################################################*)
76.487 +(* vvv--- aus nnewcode.sml am 30.1.00 ---vvv *)
76.488 +
76.489 +
76.490 +(* testdaten besorgen:
76.491 + use"test-coil-kernel.sml";
76.492 + val (PblObj{origin=(oris,_,_),meth={ppc=itms,...},...}) =
76.493 + get_obj I pt p;
76.494 + *)
76.495 +
76.496 +(* given oris, ppc,
76.497 + variant V: oris union ppc => int, id ID: oris union ppc => int
76.498 +
76.499 + ppc is_complete ==
76.500 + EX vt:V. ALL r:oris --> EX i:ppc. ID r = ID i & complete i
76.501 +
76.502 + and
76.503 + @vt = max sum(i : ppc) V i
76.504 +*)
76.505 +
76.506 +
76.507 +
76.508 +(*
76.509 +> ((vts_cnt (vts_in itms))) itms;
76.510 +
76.511 +
76.512 +
76.513 +---^^--test 10.3.
76.514 +> val vts = vts_in itms;
76.515 +val vts = [1,2,3] : int list
76.516 +> val nvts = vts_cnt vts itms;
76.517 +val nvts = [(1,6),(2,5),(3,7)] : (int * int) list
76.518 +> val mx = max2 nvts;
76.519 +val mx = (3,7) : int * int
76.520 +> val v = max_vt itms;
76.521 +val v = 3 : int
76.522 +--------------------------
76.523 +>
76.524 +*)
76.525 +
76.526 +(*.get the first term in ts from ori.*)
76.527 +(* val (_,_,fd,d,ts) = hd miss;
76.528 + *)
76.529 +fun getr_ct thy ((_,_,fd,d,ts):ori) =
76.530 + (fd, (string_of_cterm o (comp_dts thy)) (d,[hd ts]):cterm');
76.531 +(* val t = comp_dts thy (d,[hd ts]);
76.532 + *)
76.533 +
76.534 +(* get a term from ori, notyet input in itm *)
76.535 +fun geti_ct thy ((_,_,_,d,ts):ori) ((_,_,_,fd,itm_):itm) =
76.536 + (fd, (string_of_cterm o (comp_dts thy)) (d,ts \\ (ts_in itm_)):cterm');
76.537 +(* test-maximum.sml fmy <> [], Init_Proof ...
76.538 + val (_,_,_,d,ts) = ori; val (_,_,_,fd,itm_) = hd icl;
76.539 + val d' $ ts' = (term_of o the o (parse thy)) "fixedValues [r=Arbfix]";
76.540 + atomty d;
76.541 + atomty d';
76.542 + atomty (hd ts);
76.543 + atomty ts';
76.544 + cterm_of (sign_of thy) (d $ (hd ts));
76.545 + cterm_of (sign_of thy) (d' $ ts');
76.546 +
76.547 + comp_dts thy (d,ts);
76.548 + *)
76.549 +
76.550 +
76.551 +(* in FE dsc, not dat: this is in itms ...*)
76.552 +fun is_untouched ((_,_,false,_,Inc((_,[]),_)):itm) = true
76.553 + | is_untouched _ = false;
76.554 +
76.555 +
76.556 +(* select an item in oris, notyet input in itms
76.557 + (precondition: in itms are only Cor, Sup, Inc) *)
76.558 +fun nxt_add thy ([]:ori list) pbt itms = (*root (only) ori...fmz=[]*)
76.559 + let
76.560 + fun test_d d ((i,_,_,_,itm_):itm) = (d = (d_in itm_)) andalso i<>0;
76.561 + fun is_elem itms (f,(d,t)) =
76.562 + case find_first (test_d d) itms of
76.563 + Some _ => true | None => false;
76.564 + in case filter_out (is_elem itms) pbt of
76.565 +(* val ((f,(d,_))::itms) = filter_out (is_elem itms) pbt;
76.566 + *)
76.567 + (f,(d,_))::itms =>
76.568 + Some (f:string, (string_of_cterm o comp_dts thy) (d,[]):cterm')
76.569 + | _ => None end
76.570 +
76.571 +(* val (thy,itms) = (assoc_thy (if dI=e_domID then dI' else dI),pbl);
76.572 + *)
76.573 + | nxt_add thy oris pbt itms =
76.574 + let
76.575 + fun testr_vt v ori = (curry (op mem) v) (#2 (ori:ori))
76.576 + andalso (#3 ori) <>"#undef";
76.577 + fun testi_vt v itm = (curry (op mem) v) (#2 (itm:itm));
76.578 + fun test_id ids r = curry (op mem) (#1 (r:ori)) ids;
76.579 +(* val itm = hd icl; val (_,_,_,d,ts) = v6;
76.580 + *)
76.581 + fun test_subset (itm:itm) ((_,_,_,d,ts):ori) =
76.582 + (d_in (#5 itm)) = d andalso (ts_in (#5 itm)) subset ts;
76.583 + fun false_and_not_Sup((i,v,false,f,Sup _):itm) = false
76.584 + | false_and_not_Sup (i,v,false,f, _) = true
76.585 + | false_and_not_Sup _ = false;
76.586 +
76.587 + val v = if itms = [] then 1 else max_vt itms;
76.588 + val vors = if v = 0 then oris else filter (testr_vt v) oris;(*oris..vat*)
76.589 + val vits = if v = 0 then itms (*because of dsc without dat*)
76.590 + else filter (testi_vt v) itms; (*itms..vat*)
76.591 + val icl = filter false_and_not_Sup vits; (* incomplete *)
76.592 + in if icl = []
76.593 + then case filter_out (test_id (map #1 vits)) vors of
76.594 + [] => None
76.595 + (* val miss = filter_out (test_id (map #1 vits)) vors;
76.596 + *)
76.597 + | miss => Some (getr_ct thy (hd miss))
76.598 + else
76.599 + case find_first (test_subset (hd icl)) vors of
76.600 + (* val Some ori = find_first (test_subset (hd icl)) vors;
76.601 + *)
76.602 + None => raise error "nxt_add: EX itm. not(dat(itm)<=dat(ori))"
76.603 + | Some ori => Some (geti_ct thy ori (hd icl))
76.604 + end;
76.605 +
76.606 +
76.607 +
76.608 +fun mk_delete thy "#Given" itm_ = Del_Given (itm_out thy itm_)
76.609 + | mk_delete thy "#Find" itm_ = Del_Find (itm_out thy itm_)
76.610 + | mk_delete thy "#Relate" itm_ = Del_Relation(itm_out thy itm_)
76.611 + | mk_delete thy str _ =
76.612 + raise error ("mk_delete: called with field '"^str^"'");
76.613 +fun mk_additem "#Given" ct = Add_Given ct
76.614 + | mk_additem "#Find" ct = Add_Find ct
76.615 + | mk_additem "#Relate"ct = Add_Relation ct
76.616 + | mk_additem str _ =
76.617 + raise error ("mk_additem: called with field '"^str^"'");
76.618 +
76.619 +
76.620 +
76.621 +
76.622 +
76.623 +(* find the next tac in specify (except nxt_model_pbl)
76.624 + 4.00.: TODO: do not return a pos !!!
76.625 + (sind from DG comes the _OLD_ writepos)*)
76.626 +(*
76.627 +> val (pbl,pbt,mpc) =(pbl',get_pbt cpI,(#ppc o get_met) cmI);
76.628 +> val (dI,pI,mI) = empty_spec;
76.629 +> nxt_spec Pbl (oris:ori list) ((dI',pI',mI'):spec(*original*))
76.630 + ((pbl:itm list), (met:itm list)) (pbt,mpc) ((dI,pI,mI):spec);
76.631 +
76.632 +at Init_Proof:
76.633 +> val met = [];val (pbt,mpc) = (get_pbt pI',(#ppc o get_met) mI');
76.634 +> val (dI,pI,mI) = empty_spec;
76.635 +> nxt_spec Pbl (oris:ori list) ((dI',pI',mI'):spec(*original*))
76.636 + ((pbl:itm list), (met:itm list)) (pbt,mpc) ((dI,pI,mI):spec);
76.637 + *)
76.638 +
76.639 +(*. determine the next step of specification;
76.640 + not done here: Refine_Tacitly (otherwise *** unknown method: (..., no_met))
76.641 +eg. in rootpbl 'no_met':
76.642 +args:
76.643 + preok predicates are _all_ ok, or problem matches completely
76.644 + oris immediately from formalization
76.645 + (dI',pI',mI') specification coming from author/parent-problem
76.646 + (pbl, item lists specified by user
76.647 + met) -"-, tacitly completed by copy_probl
76.648 + (dI,pI,mI) specification explicitly done by the user
76.649 + (pbt, mpc) problem type, guard of method
76.650 +.*)
76.651 +(* val (preok,pbl,pbt,mpc)=(pb,pbl',(#ppc o get_pbt) cpI,(#ppc o get_met) cmI);
76.652 + val (preok,pbl,pbt,mpc)=(pb,pbl',ppc,(#ppc o get_met) cmI);
76.653 + val (Pbl, preok, oris, (dI',pI',mI'), (pbl,met), (pbt,mpc), (dI,pI,mI)) =
76.654 + (p_, pb, oris, (dI',pI',mI'), (probl,meth),
76.655 + (ppc, (#ppc o get_met) cmI), (dI,pI,mI));
76.656 + *)
76.657 +fun nxt_spec Pbl preok (oris:ori list) ((dI',pI',mI'):spec)
76.658 + ((pbl:itm list), (met:itm list)) (pbt,mpc) ((dI,pI,mI):spec) =
76.659 + ((*writeln"### nxt_spec Pbl";*)
76.660 + if dI'=e_domID andalso dI=e_domID then (Pbl, Specify_Theory dI')
76.661 + else if pI'=e_pblID andalso pI=e_pblID then (Pbl, Specify_Problem pI')
76.662 + else case find_first (is_error o #5) (pbl:itm list) of
76.663 + Some (_,_,_,fd,itm_) =>
76.664 + (Pbl, mk_delete
76.665 + (assoc_thy (if dI=e_domID then dI' else dI)) fd itm_)
76.666 + | None =>
76.667 + ((*writeln"### nxt_spec is_error None";*)
76.668 + case nxt_add (assoc_thy (if dI=e_domID then dI' else dI))
76.669 + oris pbt pbl of
76.670 +(* val Some (fd,ct') = nxt_add (assoc_thy (if dI=e_domID then dI' else dI))
76.671 + oris pbt pbl;
76.672 + *)
76.673 + Some (fd,ct') => ((*writeln"### nxt_spec nxt_add Some";*)
76.674 + (Pbl, mk_additem fd ct'))
76.675 + | None => (*pbl-items complete*)
76.676 + if not preok then (Pbl, Refine_Problem pI')
76.677 + else
76.678 + if dI = e_domID then (Pbl, Specify_Theory dI')
76.679 + else if pI = e_pblID then (Pbl, Specify_Problem pI')
76.680 + else if mI = e_metID then (Pbl, Specify_Method mI')
76.681 + else
76.682 + case find_first (is_error o #5) met of
76.683 + Some (_,_,_,fd,itm_) =>
76.684 + (Met, mk_delete (assoc_thy dI) fd itm_)
76.685 + | None =>
76.686 + (case nxt_add (assoc_thy dI) oris mpc met of
76.687 + Some (fd,ct') => (*30.8.01: pre?!?*)
76.688 + (Met, mk_additem fd ct')
76.689 + | None =>
76.690 + ((*Solv 3.4.00*)Met, Apply_Method mI))))
76.691 +(* val preok=pb; val (pbl, met) = (pbl,met');
76.692 + val (pbt,mpc)=((#ppc o get_pbt) cpI,(#ppc o get_met) cmI);
76.693 + val (Met, preok, oris, (dI',pI',mI'), (pbl,met), (pbt,mpc), (dI,pI,mI)) =
76.694 + (p_, pb, oris, (dI',pI',mI'), (probl,meth),
76.695 + (ppc, (#ppc o get_met) cmI), (dI,pI,mI));
76.696 + *)
76.697 + | nxt_spec Met preok oris (dI',pI',mI') (pbl, met) (pbt,mpc) (dI,pI,mI) =
76.698 + ((*writeln"### nxt_spec Met"; *)
76.699 + case find_first (is_error o #5) met of
76.700 + Some (_,_,_,fd,itm_) =>
76.701 + (Met, mk_delete (assoc_thy (if dI=e_domID then dI' else dI)) fd itm_)
76.702 + | None =>
76.703 + case nxt_add (assoc_thy (if dI=e_domID then dI' else dI))oris mpc met of
76.704 + Some (fd,ct') => (Met, mk_additem fd ct')
76.705 + | None =>
76.706 + ((*writeln"### nxt_spec Met: nxt_add None";*)
76.707 + if dI = e_domID then (Met, Specify_Theory dI')
76.708 + else if pI = e_pblID then (Met, Specify_Problem pI')
76.709 + else if not preok then (Met, Specify_Method mI)
76.710 + else (Met, Apply_Method mI)));
76.711 +
76.712 +(* di_ pI_ mI_ pos_
76.713 +val itms = [(1,[1],true,"#Find",Cor(e_term,[e_term])):itm,
76.714 + (2,[2],true,"#Find",Syn("empty"))];
76.715 +*)
76.716 +
76.717 +
76.718 +(* ^^^--- aus nnewcode.sml am 30.1.00 ---^^^ *)
76.719 +(*#############################################################*)
76.720 +(*#############################################################*)
76.721 +(* vvv--- aus nnewcode.sml vor 29.1.00 ---vvv *)
76.722 +
76.723 +(*3.3.--
76.724 +fun update_itm (cl,d,ts) ((id,vt,_,sl,Cor (_,_)):itm) =
76.725 + (id,vt,cl,sl,Cor (d,ts)):itm
76.726 + | update_itm (cl,d,ts) (id,vt,_,sl,Syn (_)) =
76.727 + raise error ("update_itm "^(string_of_cterm (comp_dts thy (d,ts)))^
76.728 + " not not for Syn (s:cterm')")
76.729 + | update_itm (cl,d,ts) (id,vt,_,sl,Typ (_)) =
76.730 + raise error ("update_itm "^(string_of_cterm (comp_dts thy (d,ts)))^
76.731 + " not not for Typ (s:cterm')")
76.732 + | update_itm (cl,d,ts) (id,vt,_,sl,Fal (_,_)) =
76.733 + (id,vt,cl,sl,Fal (d,ts))
76.734 + | update_itm (cl,d,ts) (id,vt,_,sl,Inc (_,_)) =
76.735 + (id,vt,cl,sl,Inc (d,ts))
76.736 + | update_itm (cl,d,ts) (id,vt,_,sl,Sup (_,_)) =
76.737 + (id,vt,cl,sl,Sup (d,ts));
76.738 +*)
76.739 +
76.740 +
76.741 +
76.742 +
76.743 +fun is_field_correct sel d dscpbt =
76.744 + case assoc (dscpbt, sel) of
76.745 + None => false
76.746 + | Some ds => d mem ds;
76.747 +
76.748 +(*. update the itm_ already input, all..from ori .*)
76.749 +(* val (id,vt,fd,d,ts) = (i,v,f,d,ts\\ts');
76.750 + *)
76.751 +fun ori_2itm thy itm_ pid all ((id,vt,fd,d,ts):ori) =
76.752 + let
76.753 + val ts' = (ts_in itm_) union ts;
76.754 + val pval = pbl_ids' thy d ts'
76.755 + (*WN.9.5.03: FIXXXME [#0, epsilon]
76.756 + here would upd_penv be called for [#0, epsilon] etc. *)
76.757 + val complete = if eq_set (ts', all) then true else false;
76.758 + in case itm_ of
76.759 + (Cor _) =>
76.760 + (if fd = "#undef" then (id,vt,complete,fd,Sup(d,ts'))
76.761 + else (id,vt,complete,fd,Cor((d,ts'),(pid, pval)))):itm
76.762 + | (Syn c) => raise error ("ori_2itm wants to overwrite "^c)
76.763 + | (Typ c) => raise error ("ori_2itm wants to overwrite "^c)
76.764 + | (Inc _) => if complete
76.765 + then (id,vt,true ,fd, Cor ((d,ts'),(pid, pval)))
76.766 + else (id,vt,false,fd, Inc ((d,ts'),(pid, pval)))
76.767 + | (Sup ((*_,_*)d,ts')) => (*4.9.01 lost env*)
76.768 + (*if fd = "#undef" then*) (id,vt,complete,fd,Sup(d,ts'))
76.769 + (*else (id,vt,complete,fd,Cor((d,ts'),e))*)
76.770 +(* 28.1.00: not completely clear ---^^^ etc.*)
76.771 +(* 4.9.01: Mis just copied---vvv *)
76.772 + | (Mis _) => if complete
76.773 + then (id,vt,true ,fd, Cor ((d,ts'),(pid, pval)))
76.774 + else (id,vt,false,fd, Inc ((d,ts'),(pid, pval)))
76.775 + end;
76.776 +
76.777 +
76.778 +fun eq1 d (_,(d',_)) = (d = d');
76.779 +fun eq3 f d (_,_,_,f',itm_) = f = f' andalso d = (d_in itm_);
76.780 +
76.781 +
76.782 +(* 'all' ts from ori; ts is the input; (ori carries rest of info)
76.783 + 9.01: this + ori_2itm is _VERY UNCLEAR_ ? overhead ?
76.784 + pval: value for problem-environment _NOT_ checked for 'inter' --
76.785 + -- FIXXME.WN.11.03 the generation of penv has to go to insert_ppc
76.786 + (as it has been done for input_icalhd+insert_ppc' in 11.03)*)
76.787 +(*. is_input ori itms <=>
76.788 + EX itm. (1) ori(field,dsc) = itm(field,dsc) & (2..4)
76.789 + (2) ori(ts) subset itm(ts) --- Err "already input"
76.790 + (3) ori(ts) inter itm(ts) = empty --- new: ori(ts)
76.791 + (4) -"- <> empty --- new: ori(ts) \\ inter .*)
76.792 +(* val(itms,(i,v,f,d,ts)) = (ppc,ori');
76.793 + *)
76.794 +fun is_notyet_input thy (itms:itm list) all ((i,v,f,d,ts):ori) pbt =
76.795 + case find_first (eq1 d) pbt of
76.796 + Some (_,(_,pid)) =>(* val Some (_,(_,pid)) = find_first (eq1 d) pbt;
76.797 + val Some (_,_,_,_,itm_)=find_first (eq3 f d) itms;
76.798 + *)
76.799 + (case find_first (eq3 f d) itms of
76.800 + Some (_,_,_,_,itm_) =>
76.801 + let
76.802 + val ts' = (ts_in itm_) inter ts;
76.803 + in if ts subset ts'
76.804 + then (((strs2str' o
76.805 + map (Sign.string_of_term (sign_of thy))) ts')^
76.806 + " already input", e_itm) (*2*)
76.807 + else ("", ori_2itm thy itm_ pid all (i,v,f,d,ts\\ts')) (*3,4*)
76.808 + end
76.809 + | None => ("", ori_2itm thy (Inc ((e_term,[]),(pid,[])))
76.810 + pid all (i,v,f,d,ts)) (*1*)
76.811 + )
76.812 + | None => ("", ori_2itm thy (Sup (d,ts))
76.813 + e_term all (i,v,f,d,ts));
76.814 +(*------------------------------------------------
76.815 +fun eq3 f d (_,_,_,f',itm_) = f = f' andalso d = (d_in itm_);
76.816 +fun is_notyet_input thy itms pval all ((id,vt,fd,d,ts):ori) pbt =
76.817 + case find_first (eq1 d) pbt of
76.818 + Some (_,(_,pid)) => (* val Some (_,(_,pid)) = find_first (eq1 d) pbt;
76.819 + *)
76.820 + (case seek_ppc id itms of
76.821 + Some (id',_,_,_,itm_) =>
76.822 + let
76.823 + val ts' = (ts_in itm_) inter ts;
76.824 + in if ts'= [] then ("", ori_2itm itm_ (pid, pval) all
76.825 + (id,vt,fd,d,(ts_in itm_)@ts))
76.826 + else (((strs2str' o
76.827 + map (Sign.string_of_term (sign_of thy))) ts')^
76.828 + " already input", e_itm) end
76.829 + | None =>
76.830 + if all = ts
76.831 + then ("", ori_2itm (Cor ((e_term,[]),(pid,[])))
76.832 + (pid, pval) all (id,vt,fd,d,ts))
76.833 + else ("", ori_2itm (Inc ((e_term,[]),(e_term,[])))
76.834 + (pid, pval) all (id,vt,fd,d,ts))
76.835 + )
76.836 + | None => ("", ori_2itm (Sup (e_term,[]))
76.837 + (e_term, []) all (id,vt,fd,d,ts));----*)
76.838 +
76.839 +fun test_types thy (d,ts) =
76.840 + let
76.841 + val s = !show_types; val _ = show_types:= true;
76.842 + val opt = (try (comp_dts thy)) (d,ts);
76.843 + val msg = case opt of
76.844 + Some _ => ""
76.845 + | None => ((Sign.string_of_term (sign_of thy) d)^" "^
76.846 + ((strs2str' o map (Sign.string_of_term(sign_of thy)))ts)
76.847 + ^" is illtyped");
76.848 + val _ = show_types:= s
76.849 + in msg end;
76.850 +
76.851 +
76.852 +
76.853 +fun maxl [] = raise error "maxl of []"
76.854 + | maxl (y::ys) =
76.855 + let fun mx x [] = x
76.856 + | mx x (y::ys) = if x < (y:int) then mx y ys else mx x ys
76.857 + in mx y ys end;
76.858 +
76.859 +
76.860 +(*. is the input term t known in oris ?
76.861 + give feedback on all(?) strange input;
76.862 + return _all_ terms already input to this item (e.g. valuesFor a,b) .*)
76.863 +(*WN.11.03: from lists*)
76.864 +fun is_known thy sel ori t =
76.865 +(* val (ori,t)=(oris,term_of ct);
76.866 + *)
76.867 + let
76.868 + val ots = (distinct o flat o (map #5)) (ori:ori list);
76.869 + val oids = ((map (fst o dest_Free)) o distinct o
76.870 + flat o (map vars)) ots;
76.871 + val (d,ts(*,pval*)) = split_dts thy t;
76.872 + val ids = map (fst o dest_Free)
76.873 + ((distinct o (flat o (map vars))) ts);
76.874 + in if (ids \\ oids) <> []
76.875 + then (("identifiers "^(strs2str' (ids \\ oids))^
76.876 + " not in example"), e_ori_, [])
76.877 + else
76.878 + if d = e_term
76.879 + then
76.880 + if not ((map typeless ts) subset (map typeless ots))
76.881 + then (("terms '"^
76.882 + ((strs2str' o (map (Sign.string_of_term
76.883 + (sign_of thy)))) ts)^
76.884 + "' not in example (typeless)"), e_ori_, [])
76.885 + else (case seek_orits thy sel ts ori of
76.886 + ("", ori_ as (_,_,_,d,ts), all) =>
76.887 + (case test_types thy (d,ts) of
76.888 + "" => ("", ori_, all)
76.889 + | msg => (msg, e_ori_, []))
76.890 + | (msg,_,_) => (msg, e_ori_, []))
76.891 + else
76.892 + if d mem (map #4 ori)
76.893 + then seek_oridts thy sel (d,ts) ori
76.894 + else ((Sign.string_of_term (sign_of thy) d)^
76.895 + (*" not in example", e_ori_, []) ///11.11.03*)
76.896 + " not in example", (0,[],sel,d,ts), [])
76.897 + end;
76.898 +
76.899 +
76.900 +(*. for return-value of appl_add .*)
76.901 +datatype additm =
76.902 + Add of itm
76.903 + | Err of string; (*error-message*)
76.904 +
76.905 +
76.906 +(*. add an item; check wrt. oris and pbt .*)
76.907 +
76.908 +(* in contrary to oris<>[] below, this part handles user-input
76.909 + extremely acceptive, i.e. accept input instead error-msg *)
76.910 +fun appl_add thy sel ([]:ori list) ppc pbt ct' =
76.911 +(* val (ppc,pbt,ct',env) = (pbl, (#ppc o get_pbt) cpI, ct, []:envv);
76.912 + !!!! 28.8.01: env tested _minimally_ !!!
76.913 + *)
76.914 + let
76.915 + val i = 1 + (if ppc=[] then 0 else maxl (map #1 ppc));
76.916 + in case parse thy ct' of (*should be done in applicable_in 4.00.FIXME*)
76.917 + None => Add (i,[],false,sel,Syn ct')
76.918 +(* val (Some ct) = parse thy ct';
76.919 + *)
76.920 + | Some ct =>
76.921 + let
76.922 + val (d,ts(*,pval*)) = split_dts thy (term_of ct);
76.923 + in if d = e_term
76.924 + then Add (i,[],false,sel,Mis (dsc_unknown,hd ts(*24.3.02*)))
76.925 +
76.926 + else
76.927 + (case find_first (eq1 d) pbt of
76.928 + None => Add (i,[],true,sel,Sup ((d,ts)))
76.929 + | Some (f,(_,id)) =>
76.930 +(* val Some (f,(_,id)) = find_first (eq1 d) pbt;
76.931 + *)
76.932 + let
76.933 + fun eq2 d ((i,_,_,_,itm_):itm) =
76.934 + (d = (d_in itm_)) andalso i<>0;
76.935 + in case find_first (eq2 d) ppc of
76.936 + None => Add (i,[],true,f, Cor ((d,ts), (id, (*pval*)
76.937 + pbl_ids' thy d ts)))
76.938 + | Some (i',_,_,_,itm_) =>
76.939 +(* val Some (i',_,_,_,itm_) = find_first (eq2 d) ppc;
76.940 + val None = find_first (eq2 d) ppc;
76.941 + *)
76.942 + if is_list_dsc d
76.943 + then let val ts = ts union (ts_in itm_)
76.944 + in Add (if ts_in itm_ = [] then i else i',
76.945 + [],true,f,Cor ((d, ts), (id, (*pval*)
76.946 + pbl_ids' thy d ts)))
76.947 + end
76.948 + else Add (i',[],true,f,Cor ((d,ts),(id, (*pval*)
76.949 + pbl_ids' thy d ts)))
76.950 + end
76.951 + )
76.952 + end
76.953 + end
76.954 +(*. add ct to ppc .*)
76.955 +(*FIXXME: accept items as Sup, Syn here, too (like appl_add..oris=[] above)*)
76.956 +(* val (ppc,pbt) = (pbl, ppc);
76.957 + val (ppc,pbt) = (met, (#ppc o get_met) cmI);
76.958 +
76.959 + val (ppc,pbt) = (pbl, (#ppc o get_pbt) cpI);
76.960 + *)
76.961 + | appl_add thy sel oris ppc pbt(*only for upd_envv*) ct =
76.962 + let
76.963 + val ctopt = parse thy ct;
76.964 + in case ctopt of
76.965 + None => Err ("syntax error in "^ct)
76.966 + | Some ct =>(* val Some ct = ctopt;
76.967 + val (msg,ori',all) = is_known thy sel oris (term_of ct);
76.968 + val (msg,itm) = is_notyet_input thy ppc all ori' pbt;
76.969 + *)
76.970 + (case is_known thy sel oris (term_of ct) of
76.971 + ("",ori'(*ts='ct'*), all) =>
76.972 + (case is_notyet_input thy ppc all ori' pbt of
76.973 + ("",itm) => Add itm
76.974 + | (msg,_) => Err msg)
76.975 + | (msg,_,_) => Err msg)
76.976 + end;
76.977 +(*
76.978 +> val (msg,itm) = is_notyet_input thy ppc all ori';
76.979 +val itm = (12,[3],false,"#Relate",Cor (Const #,[#,#])) : itm
76.980 +> val itm_ = #5 itm;
76.981 +> val ts = ts_in itm_;
76.982 +> map (atomty) ts;
76.983 +*)
76.984 +
76.985 +(*---------------------------------------------(4) nach ptyps.sml 23.3.02*)
76.986 +
76.987 +
76.988 +(** make oris from args of the stac SubProblem and from pbt **)
76.989 +
76.990 +(*.can this formal argument (of a model-pattern) be omitted in the arg-list
76.991 + of a SubProblem ? see ME/ptyps.sml 'type met '.*)
76.992 +fun is_copy_named_idstr str =
76.993 + case (rev o explode) str of
76.994 + "_"::_::"_"::_ => true
76.995 + | _ => false;
76.996 +(*> is_copy_named_idstr "v_i_";
76.997 +val it = true : bool
76.998 + > is_copy_named_idstr "e_";
76.999 +val it = false : bool
76.1000 + > is_copy_named_idstr "L___";
76.1001 +val it = true : bool
76.1002 +*)
76.1003 +(*.should this formal argument (of a model-pattern) create a new identifier?.*)
76.1004 +fun is_copy_named_generating_idstr str =
76.1005 + if is_copy_named_idstr str
76.1006 + then case (rev o explode) str of
76.1007 + "_"::"_"::"_"::_ => false
76.1008 + | _ => true
76.1009 + else false;
76.1010 +(*> is_copy_named_generating_idstr "v_i_";
76.1011 +val it = true : bool
76.1012 + > is_copy_named_generating_idstr "L___";
76.1013 +val it = false : bool
76.1014 +*)
76.1015 +
76.1016 +(*.can this formal argument (of a model-pattern) be omitted in the arg-list
76.1017 + of a SubProblem ? see ME/ptyps.sml 'type met '.*)
76.1018 +fun is_copy_named (_,(_,t)) = (is_copy_named_idstr o free2str) t;
76.1019 +(*.should this formal argument (of a model-pattern) create a new identifier?.*)
76.1020 +fun is_copy_named_generating (_,(_,t)) =
76.1021 + (is_copy_named_generating_idstr o free2str) t;
76.1022 +
76.1023 +
76.1024 +(*.split type-wrapper from scr-arg and build part of an ori;
76.1025 + an type-error is reported immediately, raises an exn,
76.1026 + subsequent handling of exn provides 2nd part of error message.*)
76.1027 +fun mtc thy ((str, (dsc, _)):pat) (ty $ var) =
76.1028 + (* val (thy, (str, (dsc, _)), (ty $ var)) =
76.1029 + (thy, p, a);
76.1030 + *)
76.1031 + (cterm_of (sign_of thy) (dsc $ var);(*type check*)
76.1032 + Some ((([1], str, dsc, (*[var]*)
76.1033 + split_dts' (dsc, var))): preori)(*:ori without leading #*))
76.1034 + handle e as TYPE _ =>
76.1035 + (writeln (dashs 70^"\n"
76.1036 + ^"*** ERROR while creating the items for the model of the ->problem\n"
76.1037 + ^"*** from the ->stac with ->typeconstructor in arglist:\n"
76.1038 + ^"*** item (->description ->value): "^term2str dsc^" "^term2str var^"\n"
76.1039 + ^"*** description: "^(term_detail2str dsc)
76.1040 + ^"*** value: "^(term_detail2str var)
76.1041 + ^"*** typeconstructor in script: "^(term_detail2str ty)
76.1042 + ^"*** checked by theory: "^(theory2str thy)^"\n"
76.1043 + ^"*** "^dots 66);
76.1044 + print_exn e; (*raises exn again*)
76.1045 + None);
76.1046 +(*> val pbt = (#ppc o get_pbt) ["univariate","equation"];
76.1047 +> val Const ("Script.SubProblem",_) $
76.1048 + (Const ("Pair",_) $ Free (thy', _) $
76.1049 + (Const ("Pair",_) $ pblID' $ metID')) $ ags =
76.1050 + str2term"(SubProblem (SqRoot_,[univariate,equation],\
76.1051 + \[SqRoot_,solve_linear]) [bool_ (x+1- 2=0), real_ x])::bool list";
76.1052 +> val ags = isalist2list ags;
76.1053 +> mtc thy (hd pbt) (hd ags);
76.1054 +val it = Some ([1],"#Given",Const (#,#),[# $ #]) *)
76.1055 +
76.1056 +(*.match each pat of the model-pattern with an actual argument;
76.1057 + precondition: copy-named vars are filtered out.*)
76.1058 +fun matc thy ([]:pat list) _ (oris:preori list) = oris
76.1059 + | matc thy pbt [] _ =
76.1060 + (writeln (dashs 70);
76.1061 + raise error ("actual arg(s) missing for '"^pats2str pbt
76.1062 + ^"' i.e. should be 'copy-named' by '*_._'"))
76.1063 + | matc thy ((p as (s,(d,t)))::pbt) (a::ags) oris =
76.1064 + (* val (thy, ((p as (s,(d,t)))::pbt), (a::ags), oris) =
76.1065 + (thy, pbt', ags, []);
76.1066 + (*recursion..*)
76.1067 + val (thy, ((p as (s,(d,t)))::pbt), (a::ags), oris) =
76.1068 + (thy, pbt, ags, (oris @ [ori]));
76.1069 + *)
76.1070 + (*del?..*)if (is_copy_named_idstr o free2str) t then oris
76.1071 + else(*..del?*) let val opt = mtc thy p a;
76.1072 + in case opt of
76.1073 + (* val Some ori = mtc thy p a;
76.1074 + *)
76.1075 + Some ori => matc thy pbt ags (oris @ [ori])
76.1076 + | None => [](*WN050903 skipped by exn handled in match_ags*)
76.1077 + end;
76.1078 +(* run subp-rooteq.sml until Init_Proof before ...
76.1079 +> val Nd (PblObj {origin=(oris,_,_),...},_) = pt;(*from test/subp-rooteq.sml*)
76.1080 +> fun xxxfortest (_,a,b,c,d) = (a,b,c,d);val oris = map xxxfortest oris;
76.1081 +
76.1082 + other vars as in mtc ..
76.1083 +> matc thy (drop_last pbt) ags [];
76.1084 +val it = ([[1],"#Given",Const #,[#]),(0,[#],"#Given",Const #,[#])],2)*)
76.1085 +
76.1086 +
76.1087 +(*WN051014 outcommented with redesign copy-named (for omitting '#Find'
76.1088 + in SubProblem);
76.1089 + kept as initial idea for generating x_1, x_2, ... for equations*)
76.1090 +fun cpy_nam (pbt:pat list) (oris:preori list) (p as (field,(dsc,t)):pat) =
76.1091 +(* val ((pbt:pat list), (oris:preori list), ((field,(dsc,t)):pat)) =
76.1092 + (pbt', oris', hd (*!!!!!*) cy);
76.1093 + *)
76.1094 + (if is_copy_named_generating p
76.1095 + then (*WN051014 kept strange old code ...*)
76.1096 + let fun sel (_,_,d,ts) = comp_ts (d, ts)
76.1097 + val cy' = (implode o drop_last o drop_last o explode o free2str) t
76.1098 + val ext = (last_elem o drop_last o explode o free2str) t
76.1099 + val vars' = map (free2str o snd o snd) pbt(*cpy-nam filtered_out*)
76.1100 + val vals = map sel oris
76.1101 + val cy_ext = (free2str o the) (assoc (vars'~~vals, cy'))^"_"^ext
76.1102 + in ([1], field, dsc, [mk_free (type_of t) cy_ext]):preori end
76.1103 + else ([1], field, dsc, [t])
76.1104 + )
76.1105 + handle _ => raise error ("cpy_nam: for "^(term2str t));
76.1106 +
76.1107 +(*> val (field,(dsc,t)) = last_elem pbt;
76.1108 +> cpy_nam pbt (drop_last oris) (field,(dsc,t));
76.1109 +val it = ([1],"#Find",
76.1110 + Const ("Descript.solutions","bool List.list => Tools.toreall"),
76.1111 + [Free ("x_i","bool List.list")]) *)
76.1112 +
76.1113 +
76.1114 +(*.match the actual arguments of a SubProblem with a model-pattern
76.1115 + and create an ori list (in root-pbl created from formalization).
76.1116 + expects ags:pats = 1:1, while copy-named are filtered out of pats;
76.1117 + copy-named pats are appended in order to get them into the model-items.*)
76.1118 +fun match_ags thy (pbt:pat list) ags =
76.1119 +(* val (thy, pbt, ags) = (thy, (#ppc o get_pbt) pI, ags);
76.1120 + val (thy, pbt, ags) = (thy, pats, ags);
76.1121 + *)
76.1122 + let fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
76.1123 + val pbt' = filter_out is_copy_named pbt;
76.1124 + val cy = filter is_copy_named pbt;
76.1125 + val oris' = matc thy pbt' ags [];
76.1126 + val cy' = map (cpy_nam pbt' oris') cy;
76.1127 + val ors = add_id (oris' @ cy');
76.1128 + (*appended in order to get ^^^^^ them into the model-items*)
76.1129 + in (map flattup ors):ori list end;
76.1130 +(*vars as above ..
76.1131 +> match_ags thy pbt ags;
76.1132 +val it =
76.1133 + [(1,[1],"#Given",Const ("Descript.equality","bool => Tools.una"),
76.1134 + [Const # $ (# $ #) $ Free (#,#)]),
76.1135 + (2,[1],"#Given",Const ("Descript.solveFor","RealDef.real => Tools.una"),
76.1136 + [Free ("x","RealDef.real")]),
76.1137 + (3,[1],"#Find",
76.1138 + Const ("Descript.solutions","bool List.list => Tools.toreall"),
76.1139 + [Free ("x_i","bool List.list")])] : ori list*)
76.1140 +
76.1141 +(*.report part of the error-msg which is not available in match_args.*)
76.1142 +fun match_ags_msg pI stac ags =
76.1143 + let val s = !show_types
76.1144 + val _ = show_types:= true
76.1145 + val pats = (#ppc o get_pbt) pI
76.1146 + val msg = (dots 70^"\n"
76.1147 + ^"*** problem "^strs2str pI^" has the ...\n"
76.1148 + ^"*** model-pattern "^pats2str pats^"\n"
76.1149 + ^"*** stac '"^term2str stac^"' has the ...\n"
76.1150 + ^"*** arg-list "^terms2str ags^"\n"
76.1151 + ^dashs 70)
76.1152 + val _ = show_types:= s
76.1153 + in writeln msg end;
76.1154 +
76.1155 +
76.1156 +(*get the variables out of a pbl_; FIXME.WN.0311: is_copy_named ...obscure!!!*)
76.1157 +fun vars_of_pbl_ pbl_ =
76.1158 + let fun var_of_pbl_ (gfr,(dsc,t)) = t
76.1159 + in ((map var_of_pbl_) o (filter_out is_copy_named)) pbl_ end;
76.1160 +fun vars_of_pbl_' pbl_ =
76.1161 + let fun var_of_pbl_ (gfr,(dsc,t)) = t:term
76.1162 + in ((map var_of_pbl_)(* o (filter_out is_copy_named)*)) pbl_ end;
76.1163 +
76.1164 +fun overwrite_ppc thy itm ppc =
76.1165 + let
76.1166 + fun repl ppc' (_,_,_,_,itm_) [] =
76.1167 + raise error ("overwrite_ppc: "^(itm__2str thy itm_)^" not found")
76.1168 + | repl ppc' itm (p::ppc) =
76.1169 + if (#1 itm) = (#1 (p:itm)) then ppc' @ [itm] @ ppc
76.1170 + else repl (ppc' @ [p]) itm ppc
76.1171 + in repl [] itm ppc end;
76.1172 +
76.1173 +(*10.3.00: insert the already compiled itm into model;
76.1174 + ev. filter_out untouched (in FE: (0,...)) item related to insert-item *)
76.1175 +(* val ppc=pbl;
76.1176 + *)
76.1177 +fun insert_ppc thy itm ppc =
76.1178 + let
76.1179 + fun eq_untouched d ((0,_,_,_,itm_):itm) = (d = d_in itm_)
76.1180 + | eq_untouched _ _ = false;
76.1181 + val ppc' =
76.1182 + (
76.1183 + (*writeln("### insert_ppc: itm= "^(itm2str itm));*)
76.1184 + case seek_ppc (#1 itm) ppc of
76.1185 + (* val Some xxx = seek_ppc (#1 itm) ppc;
76.1186 + *)
76.1187 + Some _ => (*itm updated in is_notyet_input WN.11.03*)
76.1188 + overwrite_ppc thy itm ppc
76.1189 + | None => (ppc @ [itm]));
76.1190 + in filter_out (eq_untouched ((d_in o #5) itm)) ppc' end;
76.1191 +
76.1192 +(*from Isabelle/src/Pure/library.ML, _appends_ a new element*)
76.1193 +fun gen_ins' eq (x, xs) = if gen_mem eq (x, xs) then xs else xs @ [x];
76.1194 +
76.1195 +fun eq_dsc ((_,_,_,_,itm_):itm, (_,_,_,_,iitm_):itm) =
76.1196 + (d_in itm_) = (d_in iitm_);
76.1197 +(*insert_ppc = insert_ppc' for appl_add', input_icalhd 11.03,
76.1198 + handles superfluous items carelessly*)
76.1199 +fun insert_ppc' itm itms = gen_ins' eq_dsc (itm, itms);
76.1200 +(* val eee = op=;
76.1201 + > gen_ins' eee (4,[1,3,5,7]);
76.1202 +val it = [1, 3, 5, 7, 4] : int list*)
76.1203 +
76.1204 +
76.1205 +(*. output the headline to a ppc .*)
76.1206 +fun header p_ pI mI =
76.1207 + case p_ of Pbl => Problem (if pI = e_pblID then [] else pI)
76.1208 + | Met => Method mI
76.1209 + | pos => raise error ("header called with "^ pos_2str pos);
76.1210 +
76.1211 +
76.1212 +
76.1213 +(* test-printouts ---
76.1214 +val _=writeln("### insert_ppc: (d,ts)="^(string_of_cterm(comp_dts thy(d,ts))));
76.1215 + val _=writeln("### insert_ppc: pts= "^
76.1216 +(strs2str' o map (Sign.string_of_term (sign_of thy))) pts);
76.1217 +
76.1218 +
76.1219 + val sel = "#Given"; val Add_Given' ct = m;
76.1220 +
76.1221 + val sel = "#Find"; val Add_Find' (ct,_) = m;
76.1222 + val (p,_) = p;
76.1223 + val (_,_,f,nxt',_,pt')= specify_additem sel (ct,[]) (p,Pbl(*!!!!!!!*)) c pt;
76.1224 +--------------
76.1225 + val sel = "#Given"; val Add_Given' (ct,_) = nxt; val (p,_) = p;
76.1226 + *)
76.1227 +fun specify_additem sel (ct,_) (p,Met) c pt =
76.1228 + let
76.1229 + val (PblObj{meth=met,origin=(oris,(dI',pI',mI'),_),
76.1230 + probl=pbl,spec=(dI,pI,mI),...}) = get_obj I pt p;
76.1231 + val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
76.1232 + (*val ppt = if pI = e_pblID then get_pbt pI' else get_pbt pI;*)
76.1233 + val cpI = if pI = e_pblID then pI' else pI;
76.1234 + val cmI = if mI = e_metID then mI' else mI;
76.1235 + val {ppc,pre,prls,...} = get_met cmI
76.1236 + in case appl_add thy sel oris met ppc ct of
76.1237 + Add itm (*..union old input *) =>
76.1238 + let (* val Add itm = appl_add thy sel oris met (#ppc (get_met cmI)) ct;
76.1239 + *)
76.1240 + val met' = insert_ppc thy itm met;
76.1241 + (*val pt' = update_met pt p met';*)
76.1242 + val ((p,Met),_,_,pt') =
76.1243 + generate1 thy (case sel of
76.1244 + "#Given" => Add_Given' (ct, met')
76.1245 + | "#Find" => Add_Find' (ct, met')
76.1246 + | "#Relate"=> Add_Relation'(ct, met'))
76.1247 + Uistate (p,Met) pt
76.1248 + val pre' = check_preconds thy prls pre met'
76.1249 + val pb = foldl and_ (true, map fst pre')
76.1250 + (*val _=writeln("@@@ specify_additem: Met Add before nxt_spec")*)
76.1251 + val (p_,nxt) =
76.1252 + nxt_spec Met pb oris (dI',pI',mI') (pbl,met')
76.1253 + ((#ppc o get_pbt) cpI,ppc) (dI,pI,mI);
76.1254 + in ((p,p_), ((p,p_),Uistate),
76.1255 + Form' (PpcKF (0,EdUndef,(length p),Nundef,
76.1256 + (Method cmI, itms2itemppc thy met' pre'))),
76.1257 + nxt,Safe,pt') end
76.1258 + | Err msg =>
76.1259 + let val pre' = check_preconds thy prls pre met
76.1260 + val pb = foldl and_ (true, map fst pre')
76.1261 + (*val _=writeln("@@@ specify_additem: Met Err before nxt_spec")*)
76.1262 + val (p_,nxt) =
76.1263 + nxt_spec Met pb oris (dI',pI',mI') (pbl,met)
76.1264 + ((#ppc o get_pbt) cpI,(#ppc o get_met) cmI) (dI,pI,mI);
76.1265 + in ((p,p_), ((p,p_),Uistate), Error' (Error_ msg), nxt, Safe,pt) end
76.1266 + end
76.1267 +(* val (p,_) = p;
76.1268 + *)
76.1269 +| specify_additem sel (ct,_) (p,_(*Frm, Pbl*)) c pt =
76.1270 + let
76.1271 + val (PblObj{meth=met,origin=(oris,(dI',pI',mI'),_),
76.1272 + probl=pbl,spec=(dI,pI,mI),...}) = get_obj I pt p;
76.1273 + val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
76.1274 + val cpI = if pI = e_pblID then pI' else pI;
76.1275 + val cmI = if mI = e_metID then mI' else mI;
76.1276 + val {ppc,where_,prls,...} = get_pbt cpI;
76.1277 + in case appl_add thy sel oris pbl ppc ct of
76.1278 + Add itm (*..union old input *) =>
76.1279 + (* val Add itm = appl_add thy sel oris pbl ppc ct;
76.1280 + *)
76.1281 + let
76.1282 + (*val _= writeln("###specify_additem: itm= "^(itm2str itm));*)
76.1283 + val pbl' = insert_ppc thy itm pbl
76.1284 + val ((p,Pbl),_,_,pt') =
76.1285 + generate1 thy (case sel of
76.1286 + "#Given" => Add_Given' (ct, pbl')
76.1287 + | "#Find" => Add_Find' (ct, pbl')
76.1288 + | "#Relate"=> Add_Relation'(ct, pbl'))
76.1289 + Uistate (p,Pbl) pt
76.1290 + val pre = check_preconds thy prls where_ pbl'
76.1291 + val pb = foldl and_ (true, map fst pre)
76.1292 + (*val _=writeln("@@@ specify_additem: Pbl Add before nxt_spec")*)
76.1293 + val (p_,nxt) =
76.1294 + nxt_spec Pbl pb oris (dI',pI',mI') (pbl',met)
76.1295 + (ppc,(#ppc o get_met) cmI) (dI,pI,mI);
76.1296 + val ppc = if p_= Pbl then pbl' else met;
76.1297 + in ((p,p_), ((p,p_),Uistate),
76.1298 + Form' (PpcKF (0,EdUndef,(length p),Nundef,
76.1299 + (header p_ pI cmI,
76.1300 + itms2itemppc thy ppc pre))), nxt,Safe,pt') end
76.1301 +
76.1302 + | Err msg =>
76.1303 + let val pre = check_preconds thy prls where_ pbl
76.1304 + val pb = foldl and_ (true, map fst pre)
76.1305 + (*val _=writeln("@@@ specify_additem: Pbl Err before nxt_spec")*)
76.1306 + val (p_,nxt) =
76.1307 + nxt_spec Pbl pb oris (dI',pI',mI') (pbl,met)
76.1308 + (ppc,(#ppc o get_met) cmI) (dI,pI,mI);
76.1309 + in ((p,p_), ((p,p_),Uistate), Error' (Error_ msg), nxt, Safe,pt) end
76.1310 + end;
76.1311 +(* val sel = "#Find"; val (p,_) = p; val Add_Find' ct = nxt;
76.1312 + val (_,_,f,nxt',_,pt')= specify_additem sel ct (p,Met) c pt;
76.1313 + *)
76.1314 +
76.1315 +(* ori
76.1316 +val (msg,itm) = appl_add thy sel oris ppc ct;
76.1317 +val (Cor(d,ts)) = #5 itm;
76.1318 +map (atomty) ts;
76.1319 +
76.1320 +pre
76.1321 +*)
76.1322 +
76.1323 +
76.1324 +(* val Init_Proof' (fmz,(dI',pI',mI')) = m;
76.1325 + specify (Init_Proof' (fmz,(dI',pI',mI'))) e_pos' [] EmptyPtree;
76.1326 + *)
76.1327 +fun specify (Init_Proof' (fmz,(dI',pI',mI'))) (_:pos') (_:cid) (_:ptree)=
76.1328 + let (* either """"""""""""""" all empty or complete *)
76.1329 + val thy = assoc_thy dI';
76.1330 + val oris = if dI' = e_domID orelse pI' = e_pblID then ([]:ori list)
76.1331 + else prep_ori fmz thy ((#ppc o get_pbt) pI');
76.1332 + val (pt,c) = cappend_problem e_ptree [] e_istate (fmz,(dI',pI',mI'))
76.1333 + (oris,(dI',pI',mI'),e_term);
76.1334 + val {ppc,prls,where_,...} = get_pbt pI'
76.1335 + (*val pbl = init_pbl ppc; WN.9.03: done in Model/Refine_Problem
76.1336 + val pt = update_pbl pt [] pbl;
76.1337 + val pre = check_preconds thy prls where_ pbl
76.1338 + val pb = foldl and_ (true, map fst pre)*)
76.1339 + val (pbl, pre, pb) = ([], [], false)
76.1340 + in case mI' of
76.1341 + ["no_met"] =>
76.1342 + (([],Pbl), (([],Pbl),Uistate),
76.1343 + Form' (PpcKF (0,EdUndef,(length []),Nundef,
76.1344 + (Problem [], itms2itemppc (assoc_thy dI') pbl pre))),
76.1345 + Refine_Tacitly pI', Safe,pt)
76.1346 + | _ =>
76.1347 + (([],Pbl), (([],Pbl),Uistate),
76.1348 + Form' (PpcKF (0,EdUndef,(length []),Nundef,
76.1349 + (Problem [], itms2itemppc (assoc_thy dI') pbl pre))),
76.1350 + Model_Problem,
76.1351 + Safe,pt)
76.1352 + end
76.1353 + (*ONLY for STARTING modeling phase*)
76.1354 + | specify (Model_Problem' (_,pbl,met)) (pos as (p,p_)) c pt =
76.1355 + let (* val (Model_Problem' (_,pbl), pos as (p,p_)) = (m, (p,p_));
76.1356 + *)
76.1357 + val (PblObj{origin=(oris,(dI',pI',mI'),_), spec=(dI,_,_),...}) =
76.1358 + get_obj I pt p
76.1359 + val thy' = if dI = e_domID then dI' else dI
76.1360 + val thy = assoc_thy thy'
76.1361 + val {ppc,prls,where_,...} = get_pbt pI'
76.1362 + val pre = check_preconds thy prls where_ pbl
76.1363 + val pb = foldl and_ (true, map fst pre)
76.1364 + val ((p,_),_,_,pt) =
76.1365 + generate1 thy (Model_Problem'([],pbl,met)) Uistate pos pt
76.1366 + val (_,nxt) = nxt_spec Pbl pb oris (dI',pI',mI') (pbl,met)
76.1367 + (ppc,(#ppc o get_met) mI') (dI',pI',mI');
76.1368 + in ((p,Pbl), ((p,p_),Uistate),
76.1369 + Form' (PpcKF (0,EdUndef,(length p),Nundef,
76.1370 + (Problem pI', itms2itemppc (assoc_thy dI') pbl pre))),
76.1371 + nxt, Safe, pt) end
76.1372 +
76.1373 +(*. called only if no_met is specified .*)
76.1374 + | specify (Refine_Tacitly' (pI,pIre,_,_,_)) (pos as (p,_)) c pt =
76.1375 + let (* val Refine_Tacitly' (pI,pIre,_,_,_) = m;
76.1376 + *)
76.1377 + val (PblObj{origin=(oris,(dI',pI',mI'),_), meth=met, ...}) =
76.1378 + get_obj I pt p;
76.1379 + val {prls,met,ppc,thy,where_,...} = get_pbt pIre
76.1380 + (*val pbl = init_pbl ppc --- Model_Problem recognizes probl=[]*)
76.1381 + (*val pt = update_pbl pt p pbl;
76.1382 + val pt = update_orispec pt p
76.1383 + (string_of_thy thy, pIre,
76.1384 + if length met = 0 then e_metID else hd met);*)
76.1385 + val (domID, metID) = (string_of_thy thy,
76.1386 + if length met = 0 then e_metID else hd met)
76.1387 + val ((p,_),_,_,pt) =
76.1388 + generate1 thy (Refine_Tacitly'(pI,pIre,domID,metID,(*pbl*)[]))
76.1389 + Uistate pos pt
76.1390 + (*val pre = check_preconds thy prls where_ pbl
76.1391 + val pb = foldl and_ (true, map fst pre)*)
76.1392 + val (pbl, pre, pb) = ([], [], false)
76.1393 + in ((p,Pbl), (pos,Uistate),
76.1394 + Form' (PpcKF (0,EdUndef,(length p),Nundef,
76.1395 + (Problem pIre, itms2itemppc (assoc_thy dI') pbl pre))),
76.1396 + Model_Problem, Safe, pt) end
76.1397 +
76.1398 + | specify (Refine_Problem' (rfd as (pI,_))) pos c pt =
76.1399 + let val (pos,_,_,pt) = generate1 (assoc_thy "Isac.thy")
76.1400 + (Refine_Problem' rfd) Uistate pos pt
76.1401 + in (pos(*p,Pbl*), (pos(*p,Pbl*),Uistate), Problems (RefinedKF rfd),
76.1402 + Model_Problem, Safe, pt) end
76.1403 +
76.1404 +(* val (Specify_Problem' (pI, (ok, (itms, pre)))) = nxt; val (p,_) = p;
76.1405 + val (Specify_Problem' (pI, (ok, (itms, pre)))) = m; val (p,_) = p;
76.1406 + *)
76.1407 + | specify (Specify_Problem' (pI, (ok, (itms, pre)))) (pos as (p,_)) c pt =
76.1408 + let val (PblObj {origin=(oris,(dI',pI',mI'),_), spec=(dI,_,mI),
76.1409 + meth=met, ...}) = get_obj I pt p;
76.1410 + (*val pt = update_pbl pt p itms;
76.1411 + val pt = update_pblID pt p pI;*)
76.1412 + val ((p,Pbl),_,_,pt)=
76.1413 + generate1 thy (Specify_Problem' (pI, (ok, (itms, pre)))) Uistate pos pt
76.1414 + val dI'' = assoc_thy (if dI=e_domID then dI' else dI);
76.1415 + val mI'' = if mI=e_metID then mI' else mI;
76.1416 + (*val _=writeln("@@@ specify (Specify_Problem) before nxt_spec")*)
76.1417 + val (_,nxt) = nxt_spec Pbl ok oris (dI',pI',mI') (itms, met)
76.1418 + ((#ppc o get_pbt) pI,(#ppc o get_met) mI'') (dI,pI,mI);
76.1419 + in ((p,Pbl), (pos,Uistate),
76.1420 + Form' (PpcKF (0,EdUndef,(length p),Nundef,
76.1421 + (Problem pI, itms2itemppc dI'' itms pre))),
76.1422 + nxt, Safe, pt) end
76.1423 +(* val Specify_Method' mID = nxt; val (p,_) = p;
76.1424 + val Specify_Method' mID = m;
76.1425 + specify (Specify_Method' mID) (p,p_) c pt;
76.1426 + *)
76.1427 + | specify (Specify_Method' (mID,_,_)) (pos as (p,_)) c pt =
76.1428 + let val (PblObj {origin=(oris,(dI',pI',mI'),_), probl=pbl, spec=(dI,pI,mI),
76.1429 + meth=met, ...}) = get_obj I pt p;
76.1430 + val {ppc,pre,prls,...} = get_met mID
76.1431 + val thy = assoc_thy dI
76.1432 + val oris = add_field' thy ppc oris;
76.1433 + (*val pt = update_oris pt p oris; 20.3.02: repl. "#undef"*)
76.1434 + val dI'' = if dI=e_domID then dI' else dI;
76.1435 + val pI'' = if pI = e_pblID then pI' else pI;
76.1436 + val met = if met=[] then pbl else met;
76.1437 + val (ok, (itms, pre')) = match_itms_oris thy met (ppc,pre,prls ) oris;
76.1438 + (*val pt = update_met pt p itms;
76.1439 + val pt = update_metID pt p mID*)
76.1440 + val (pos,_,_,pt)=
76.1441 + generate1 thy (Specify_Method' (mID, oris, itms)) Uistate pos pt
76.1442 + (*val _=writeln("@@@ specify (Specify_Method) before nxt_spec")*)
76.1443 + val (_,nxt) = nxt_spec Met (*ok*)true oris (dI',pI',mI') (pbl, itms)
76.1444 + ((#ppc o get_pbt) pI'',ppc) (dI'',pI'',mID);
76.1445 + in (pos, (pos,Uistate),
76.1446 + Form' (PpcKF (0,EdUndef,(length p),Nundef,
76.1447 + (Method mID, itms2itemppc (assoc_thy dI'') itms pre'))),
76.1448 + nxt, Safe, pt) end
76.1449 +(* val Add_Find' ct = nxt; val sel = "#Find";
76.1450 + *)
76.1451 + | specify (Add_Given' ct) p c pt = specify_additem "#Given" ct p c pt
76.1452 + | specify (Add_Find' ct) p c pt = specify_additem "#Find" ct p c pt
76.1453 + | specify (Add_Relation' ct) p c pt=specify_additem"#Relate"ct p c pt
76.1454 +(* val Specify_Theory' domID = m;
76.1455 + val (Specify_Theory' domID, (p,p_)) = (m, pos);
76.1456 + *)
76.1457 + | specify (Specify_Theory' domID) (pos as (p,p_)) c pt =
76.1458 + let val p_ = case p_ of Met => Met | _ => Pbl
76.1459 + val thy = assoc_thy domID;
76.1460 + val (PblObj{origin=(oris,(dI',pI',mI'),_), meth=met,
76.1461 + probl=pbl, spec=(dI,pI,mI),...}) = get_obj I pt p;
76.1462 + val mppc = case p_ of Met => met | _ => pbl;
76.1463 + val cpI = if pI = e_pblID then pI' else pI;
76.1464 + val {prls=per,ppc,where_=pwh,...} = get_pbt cpI
76.1465 + val cmI = if mI = e_metID then mI' else mI;
76.1466 + val {prls=mer,ppc=mpc,pre=mwh,...} = get_met cmI
76.1467 + val pre =
76.1468 + case p_ of
76.1469 + Met => (check_preconds thy mer mwh met)
76.1470 + | _ => (check_preconds thy per pwh pbl)
76.1471 + val pb = foldl and_ (true, map fst pre)
76.1472 + in if domID = dI
76.1473 + then let
76.1474 + (*val _=writeln("@@@ specify (Specify_Theory) THEN before nxt_spec")*)
76.1475 + val (p_,nxt) = nxt_spec p_ pb oris (dI',pI',mI')
76.1476 + (pbl,met) (ppc,mpc) (dI,pI,mI);
76.1477 + in ((p,p_), (pos,Uistate),
76.1478 + Form'(PpcKF (0,EdUndef,(length p), Nundef,
76.1479 + (header p_ pI cmI, itms2itemppc thy mppc pre))),
76.1480 + nxt,Safe,pt) end
76.1481 + else (*FIXME: check ppc wrt. (new!) domID ..? still parsable?*)
76.1482 + let
76.1483 + (*val pt = update_domID pt p domID;11.8.03*)
76.1484 + val ((p,p_),_,_,pt) = generate1 thy (Specify_Theory' domID)
76.1485 + Uistate (p,p_) pt
76.1486 + (*val _=writeln("@@@ specify (Specify_Theory) ELSE before nxt_spec")*)
76.1487 + val (p_,nxt) = nxt_spec p_ pb oris (dI',pI',mI') (pbl,met)
76.1488 + (ppc,mpc) (domID,pI,mI);
76.1489 + in ((p,p_), (pos,Uistate),
76.1490 + Form' (PpcKF (0, EdUndef, (length p),Nundef,
76.1491 + (header p_ pI cmI, itms2itemppc thy mppc pre))),
76.1492 + nxt, Safe,pt) end
76.1493 + end
76.1494 +(* itms2itemppc thy [](*mpc*) pre
76.1495 + *)
76.1496 + | specify m' _ _ _ =
76.1497 + raise error ("specify: not impl. for "^tac_2str m');
76.1498 +
76.1499 +(* val (sel, Add_Given ct, ptp as (pt,(p,Pbl))) = ("#Given", tac, ptp);
76.1500 + val (sel, Add_Find ct, ptp as (pt,(p,Pbl))) = ("#Find", tac, ptp);
76.1501 + *)
76.1502 +fun nxt_specif_additem sel ct (ptp as (pt,(p,Pbl))) =
76.1503 + let
76.1504 + val (PblObj{meth=met,origin=(oris,(dI',pI',_),_),
76.1505 + probl=pbl,spec=(dI,pI,_),...}) = get_obj I pt p;
76.1506 + val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
76.1507 + val cpI = if pI = e_pblID then pI' else pI;
76.1508 + in case appl_add thy sel oris pbl ((#ppc o get_pbt) cpI) ct of
76.1509 + Add itm (*..union old input *) =>
76.1510 +(* val Add itm = appl_add thy sel oris pbl ppc ct;
76.1511 + *)
76.1512 + let
76.1513 + (*val _=writeln("###nxt_specif_additem: itm= "^(itm2str itm));*)
76.1514 + val pbl' = insert_ppc thy itm pbl
76.1515 + val (tac,tac_) =
76.1516 + case sel of
76.1517 + "#Given" => (Add_Given ct, Add_Given' (ct, pbl'))
76.1518 + | "#Find" => (Add_Find ct, Add_Find' (ct, pbl'))
76.1519 + | "#Relate"=> (Add_Relation ct, Add_Relation'(ct, pbl'))
76.1520 + val ((p,Pbl),c,_,pt') =
76.1521 + generate1 thy tac_ Uistate (p,Pbl) pt
76.1522 + in ([(tac,tac_,((p,Pbl),Uistate))], c, (pt',(p,Pbl))):calcstate' end
76.1523 +
76.1524 + | Err msg =>
76.1525 + (*TODO.WN03 pass error-msgs to the frontend..
76.1526 + FIXME ..and dont abuse a tactic for that purpose*)
76.1527 + ([(Tac msg,
76.1528 + Tac_ (ProtoPure.thy, msg,msg,msg),
76.1529 + (e_pos', e_istate))], [], ptp)
76.1530 + end
76.1531 +
76.1532 +(* val sel = "#Find"; val (p,_) = p; val Add_Find' ct = nxt;
76.1533 + val (_,_,f,nxt',_,pt')= nxt_specif_additem sel ct (p,Met) c pt;
76.1534 + *)
76.1535 + | nxt_specif_additem sel ct (ptp as (pt,(p,Met))) =
76.1536 + let
76.1537 + val (PblObj{meth=met,origin=(oris,(dI',pI',mI'),_),
76.1538 + probl=pbl,spec=(dI,pI,mI),...}) = get_obj I pt p;
76.1539 + val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
76.1540 + val cmI = if mI = e_metID then mI' else mI;
76.1541 + in case appl_add thy sel oris met ((#ppc o get_met) cmI) ct of
76.1542 + Add itm (*..union old input *) =>
76.1543 + let (* val Add itm = appl_add thy sel oris met (#ppc (get_met cmI)) ct;
76.1544 + *)
76.1545 + val met' = insert_ppc thy itm met;
76.1546 + val (tac,tac_) =
76.1547 + case sel of
76.1548 + "#Given" => (Add_Given ct, Add_Given' (ct, met'))
76.1549 + | "#Find" => (Add_Find ct, Add_Find' (ct, met'))
76.1550 + | "#Relate"=> (Add_Relation ct, Add_Relation'(ct, met'))
76.1551 + val ((p,Met),c,_,pt') =
76.1552 + generate1 thy tac_ Uistate (p,Met) pt
76.1553 + in ([(tac,tac_,((p,Met), Uistate))], c, (pt',(p,Met))) end
76.1554 +
76.1555 + | Err msg => ([(*tacis*)], [], ptp)
76.1556 + (*nxt_me collects tacis until not hide; here just no progress*)
76.1557 + end;
76.1558 +
76.1559 +(* ori
76.1560 +val (msg,itm) = appl_add thy sel oris ppc ct;
76.1561 +val (Cor(d,ts)) = #5 itm;
76.1562 +map (atomty) ts;
76.1563 +
76.1564 +pre
76.1565 +*)
76.1566 +fun ori2Coritm pbt ((i,v,f,d,ts):ori) =
76.1567 + (i,v,true,f, Cor ((d,ts),(((snd o snd o the o (find_first (eq1 d))) pbt)
76.1568 + handle _ => raise error ("ori2Coritm: dsc "^
76.1569 + term2str d^
76.1570 + "in ori, but not in pbt")
76.1571 + ,ts))):itm;
76.1572 +fun ori2Coritm (pbt:pat list) ((i,v,f,d,ts):ori) =
76.1573 + ((i,v,true,f, Cor ((d,ts),((snd o snd o the o
76.1574 + (find_first (eq1 d))) pbt,ts))):itm)
76.1575 + handle _ => (*dsc in oris, but not in pbl pat list: keep this dsc*)
76.1576 + ((i,v,true,f, Cor ((d,ts),(d,ts))):itm);
76.1577 +
76.1578 +
76.1579 +(*filter out oris which have same description in itms*)
76.1580 +fun filter_outs oris [] = oris
76.1581 + | filter_outs oris (i::itms) =
76.1582 + let val ors = filter_out ((curry op= ((d_in o #5) (i:itm))) o
76.1583 + (#4:ori -> term)) oris;
76.1584 + in filter_outs ors itms end;
76.1585 +
76.1586 +fun memI a b = b mem a;
76.1587 +(*filter oris which are in pbt, too*)
76.1588 +fun filter_pbt oris pbt =
76.1589 + let val dscs = map (fst o snd) pbt
76.1590 + in filter ((memI dscs) o (#4: ori -> term)) oris end;
76.1591 +
76.1592 +(*.combine itms from pbl + met and complete them wrt. pbt.*)
76.1593 +(*FIXXXME.WN031205 complete_metitms doesnt handle incorrect itms !*)
76.1594 +fun complete_metitms (oris:ori list) (pits:itm list) (mits:itm list) met =
76.1595 +(* val met = (#ppc o get_met) ["DiffApp","max_by_calculus"];
76.1596 + *)
76.1597 + let val vat = max_vt pits;
76.1598 + val itms = pits @
76.1599 + (filter ((curry (op mem) vat) o (#2:itm -> int list)) mits);
76.1600 + val ors = filter ((curry (op mem) vat) o (#2:ori -> int list)) oris;
76.1601 + val os = filter_outs ors itms;
76.1602 + (*WN.12.03?: does _NOT_ add itms from met ?!*)
76.1603 + in itms @ (map (ori2Coritm met) os) end;
76.1604 +
76.1605 +
76.1606 +
76.1607 +(*.complete model and guard of a calc-head .*)
76.1608 +fun complete_mod_ (oris, mpc, ppc, probl) =
76.1609 + let val pits = filter_out ((curry op= false) o (#3: itm -> bool)) probl
76.1610 + val vat = if probl = [] then 1 else max_vt probl
76.1611 + val pors = filter ((curry (op mem) vat) o (#2:ori -> int list)) oris
76.1612 + val pors = filter_outs pors pits (*which are in pbl already*)
76.1613 + val pors = (filter_pbt pors ppc) (*which are in pbt, too*)
76.1614 +
76.1615 + val pits = pits @ (map (ori2Coritm ppc) pors)
76.1616 + val mits = complete_metitms oris pits [] mpc
76.1617 + in (pits, mits) end;
76.1618 +
76.1619 +fun some_spec ((odI, opI, omI):spec) ((dI, pI, mI):spec) =
76.1620 + (if dI = e_domID then odI else dI,
76.1621 + if pI = e_pblID then opI else pI,
76.1622 + if mI = e_metID then omI else mI):spec;
76.1623 +
76.1624 +
76.1625 +(*.find a next applicable tac (for calcstate) and update ptree
76.1626 + (for ev. finding several more tacs due to hide).*)
76.1627 +(*FIXXXME: unify ... fun nxt_specif = nxt_spec + applicable_in + specify !!*)
76.1628 +(*WN.24.10.03 ~~~~~~~~~~~~~~ -> tac -> tac_ -> -"- as arg*)
76.1629 +(*WN.24.10.03 fun nxt_solv = ...................................??*)
76.1630 +fun nxt_specif (tac as Model_Problem) (pt, pos as (p,p_)) =
76.1631 + let
76.1632 + val (PblObj{origin=(oris,ospec,_),probl,spec,...}) = get_obj I pt p
76.1633 + val (dI,pI,mI) = some_spec ospec spec
76.1634 + val mpc = (#ppc o get_met) mI (*just for reuse complete_mod_*)
76.1635 + val {cas,ppc,...} = get_pbt pI
76.1636 + val pbl = init_pbl ppc (*fill in descriptions*)
76.1637 + (*--------------if you think, this should be done by the Dialog
76.1638 + in the java front-end, search there for WN060225-modelProblem----*)
76.1639 + val (pbl,met) = case cas of None => (pbl,[])
76.1640 + | _ => complete_mod_ (oris, mpc, ppc, probl)
76.1641 + (*----------------------------------------------------------------*)
76.1642 + val tac_ = Model_Problem' (pI, pbl, met)
76.1643 + val (pos,c,_,pt) = generate1 thy tac_ Uistate pos pt
76.1644 + in ([(tac,tac_, (pos, Uistate))], c, (pt,pos)):calcstate' end
76.1645 +
76.1646 +(* val Add_Find ct = tac;
76.1647 + *)
76.1648 + | nxt_specif (Add_Given ct) ptp = nxt_specif_additem "#Given" ct ptp
76.1649 + | nxt_specif (Add_Find ct) ptp = nxt_specif_additem "#Find" ct ptp
76.1650 + | nxt_specif (Add_Relation ct) ptp = nxt_specif_additem"#Relate" ct ptp
76.1651 +
76.1652 +(*. called only if no_met is specified .*)
76.1653 + | nxt_specif (Refine_Tacitly pI) (ptp as (pt, pos as (p,_))) =
76.1654 + let val (PblObj {origin = (oris, (dI,_,_),_), ...}) = get_obj I pt p
76.1655 + val opt = refine_ori oris pI
76.1656 + in case opt of
76.1657 + Some pI' =>
76.1658 + let val {met,ppc,...} = get_pbt pI'
76.1659 + val pbl = init_pbl ppc
76.1660 + (*val pt = update_pbl pt p pbl ..done by Model_Problem*)
76.1661 + val mI = if length met = 0 then e_metID else hd met
76.1662 + val (pos,c,_,pt) =
76.1663 + generate1 thy (Refine_Tacitly' (pI,pI',dI,mI,(*pbl*)[]))
76.1664 + Uistate pos pt
76.1665 + in ([(Refine_Tacitly pI, Refine_Tacitly' (pI,pI',dI,mI,(*pbl*)[]),
76.1666 + (pos, Uistate))], c, (pt,pos)) end
76.1667 + | None => ([], [], ptp)
76.1668 + end
76.1669 +
76.1670 + | nxt_specif (Refine_Problem pI) (ptp as (pt, pos as (p,_))) =
76.1671 + let val (PblObj {origin=(_,(dI,_,_),_),spec=(dI',_,_),
76.1672 + probl, ...}) = get_obj I pt p
76.1673 + val thy = if dI' = e_domID then dI else dI'
76.1674 + in case refine_pbl (assoc_thy thy) pI probl of
76.1675 + None => ([], [], ptp)
76.1676 + | Some (rfd as (pI',_)) =>
76.1677 + let val (pos,c,_,pt) =
76.1678 + generate1 (assoc_thy thy)
76.1679 + (Refine_Problem' rfd) Uistate pos pt
76.1680 + in ([(Refine_Problem pI, Refine_Problem' rfd,
76.1681 + (pos, Uistate))], c, (pt,pos)) end
76.1682 + end
76.1683 +
76.1684 + | nxt_specif (Specify_Problem pI) (pt, pos as (p,_)) =
76.1685 + let val (PblObj {origin=(oris,(dI,_,_),_),spec=(dI',pI',_),
76.1686 + probl, ...}) = get_obj I pt p;
76.1687 + val thy = assoc_thy (if dI' = e_domID then dI else dI');
76.1688 + val {ppc,where_,prls,...} = get_pbt pI
76.1689 + val pbl as (_,(itms,_)) =
76.1690 + if pI'=e_pblID andalso pI=e_pblID
76.1691 + then (false, (init_pbl ppc, []))
76.1692 + else match_itms_oris thy probl (ppc,where_,prls) oris(*FIXXXXXME?*)
76.1693 + (*FIXXXME~~~~~~~~~~~~~~~: take pbl and compare with new pI WN.8.03*)
76.1694 + val ((p,Pbl),c,_,pt)=
76.1695 + generate1 thy (Specify_Problem' (pI, pbl)) Uistate pos pt
76.1696 + in ([(Specify_Problem pI, Specify_Problem' (pI, pbl),
76.1697 + (pos,Uistate))], c, (pt,pos)) end
76.1698 +
76.1699 + (*transfers oris (not required in pbl) to met-model for script-env
76.1700 + FIXME.WN.8.03: application of several mIDs to SAME model?*)
76.1701 + | nxt_specif (Specify_Method mID) (ptp as (pt, pos as (p,_))) =
76.1702 + let val (PblObj {origin=(oris,(dI',pI',mI'),_), probl=pbl, spec=(dI,pI,mI),
76.1703 + meth=met, ...}) = get_obj I pt p;
76.1704 + val {ppc,pre,prls,...} = get_met mID
76.1705 + val thy = assoc_thy dI
76.1706 + val oris = add_field' thy ppc oris;
76.1707 + val dI'' = if dI=e_domID then dI' else dI;
76.1708 + val pI'' = if pI = e_pblID then pI' else pI;
76.1709 + val met = if met=[] then pbl else met;(*WN0602 what if more itms in met?*)
76.1710 + val (ok, (itms, pre')) = match_itms_oris thy met (ppc,pre,prls ) oris;
76.1711 + val (pos,c,_,pt)=
76.1712 + generate1 thy (Specify_Method' (mID, oris, itms)) Uistate pos pt
76.1713 + in ([(Specify_Method mID, Specify_Method' (mID, oris, itms),
76.1714 + (pos,Uistate))], c, (pt,pos)) end
76.1715 +
76.1716 + | nxt_specif (Specify_Theory dI) (pt, pos as (p,Pbl)) =
76.1717 + let val (dI',_,_) = get_obj g_spec pt p
76.1718 + val (pos,c,_,pt) =
76.1719 + generate1 (assoc_thy "Isac.thy") (Specify_Theory' dI)
76.1720 + Uistate pos pt
76.1721 + in (*FIXXXME: check if pbl can still be parsed*)
76.1722 + ([(Specify_Theory dI, Specify_Theory' dI, (pos,Uistate))], c,
76.1723 + (pt, pos)) end
76.1724 +
76.1725 + | nxt_specif (Specify_Theory dI) (pt, pos as (p,Met)) =
76.1726 + let val (dI',_,_) = get_obj g_spec pt p
76.1727 + val (pos,c,_,pt) =
76.1728 + generate1 (assoc_thy "Isac.thy") (Specify_Theory' dI)
76.1729 + Uistate pos pt
76.1730 + in (*FIXXXME: check if met can still be parsed*)
76.1731 + ([(Specify_Theory dI, Specify_Theory' dI, (pos,Uistate))], c,
76.1732 + (pt, pos)) end
76.1733 +
76.1734 + | nxt_specif m' _ =
76.1735 + raise error ("nxt_specif: not impl. for "^tac2str m');
76.1736 +
76.1737 +(*.get the values from oris; handle the term list w.r.t. penv.*)
76.1738 +fun vals_of_oris oris =
76.1739 + ((map (mkval' o (#5:ori -> term list))) o
76.1740 + (filter ((curry (op mem) 1) o (#2:ori -> int list)))) oris;
76.1741 +
76.1742 +
76.1743 +
76.1744 +(*.create a calc-tree with oris via an cas.refined pbl.*)
76.1745 +fun nxt_specify_init_calc (([],(dI,pI,mI)): fmz) =
76.1746 +(* val ([],(dI,pI,mI)) = (fmz, sp);
76.1747 + *)
76.1748 + if pI <> [] then (*comes from pbl-browser*)
76.1749 + let val {cas,met,ppc,thy,...} = get_pbt pI
76.1750 + val dI = if dI = "" then theory2theory' thy else dI
76.1751 + val thy = assoc_thy dI
76.1752 + val mI = if mI = [] then hd met else mI
76.1753 + val hdl = case cas of None => pblterm dI pI | Some t => t
76.1754 + val (pt,_) = cappend_problem e_ptree [] e_istate ([], (dI,pI,mI))
76.1755 + ([], (dI,pI,mI), hdl)
76.1756 + val pt = update_spec pt [] (dI,pI,mI)
76.1757 + val pits = init_pbl' ppc
76.1758 + val pt = update_pbl pt [] pits
76.1759 + in ((pt,([],Pbl)), []): calcstate end
76.1760 + else if mI <> [] then (*comes from met-browser*)
76.1761 + let val {ppc,...} = get_met mI
76.1762 + val dI = if dI = "" then "Isac.thy" else dI
76.1763 + val thy = assoc_thy dI
76.1764 + val (pt,_) = cappend_problem e_ptree [] e_istate ([], (dI,pI,mI))
76.1765 + ([], (dI,pI,mI), e_term(*FIXME met*))
76.1766 + val pt = update_spec pt [] (dI,pI,mI)
76.1767 + val mits = init_pbl' ppc
76.1768 + val pt = update_met pt [] mits
76.1769 + in ((pt,([],Met)), []) end
76.1770 + else (*completely new example*)
76.1771 + let val (pt,_) = cappend_problem e_ptree [] e_istate ([], e_spec)
76.1772 + ([], e_spec, e_term)
76.1773 + in ((pt,([],Pbl)), []) end
76.1774 +(* val (fmz, (dI,pI,mI)) = (fmz, sp);
76.1775 + *)
76.1776 + | nxt_specify_init_calc (fmz:fmz_,(dI,pI,mI):spec) =
76.1777 + let (* either """"""""""""""" all empty or complete *)
76.1778 + val thy = assoc_thy dI
76.1779 + val (pI, pors, mI) =
76.1780 + if mI = ["no_met"]
76.1781 + then let val pors = prep_ori fmz thy ((#ppc o get_pbt) pI)
76.1782 + val pI' = refine_ori' pors pI;
76.1783 + in (pI', pors (*refinement over models with diff.prec only*),
76.1784 + (hd o #met o get_pbt) pI') end
76.1785 + else (pI, prep_ori fmz thy ((#ppc o get_pbt) pI), mI)
76.1786 + val {cas,ppc,thy=thy',...} = get_pbt pI (*take dI from _refined_ pbl*)
76.1787 + val dI = theory2theory' (maxthy thy thy');
76.1788 + val hdl = case cas of
76.1789 + None => pblterm dI pI
76.1790 + | Some t => subst_atomic ((vars_of_pbl_' ppc)
76.1791 + ~~~ vals_of_oris pors) t
76.1792 + val (pt,_) = cappend_problem e_ptree [] e_istate (fmz,(dI,pI,mI))
76.1793 + (pors,(dI,pI,mI),hdl)
76.1794 + (*val pbl = init_pbl ppc WN.9.03: done by Model/Refine_Problem
76.1795 + val pt = update_pbl pt [] pbl*)
76.1796 + in ((pt,([],Pbl)), fst3 (nxt_specif Model_Problem (pt, ([],Pbl))))
76.1797 + end;
76.1798 +
76.1799 +
76.1800 +
76.1801 +(*18.12.99*)
76.1802 +fun get_spec_form (m:tac_) ((p,p_):pos') (pt:ptree) =
76.1803 +(* case appl_spec p pt m of /// 19.1.00
76.1804 + Notappl e => Error' (Error_ e)
76.1805 + | Appl =>
76.1806 +*) let val (_,_,f,_,_,_) = specify m (p,p_) [] pt
76.1807 + in f end;
76.1808 +
76.1809 +
76.1810 +
76.1811 +
76.1812 +
76.1813 +
76.1814 +(* --------------------- ME --------------------- *)
76.1815 +fun tag_form thy (formal, given) = cterm_of (sign_of thy)
76.1816 + (((head_of o term_of) given) $ (term_of formal));
76.1817 +(* val formal = (the o (parse thy)) "[R::real]";
76.1818 +> val given = (the o (parse thy)) "fixed_values (cs::real list)";
76.1819 +> tag_form thy (formal, given);
76.1820 +val it = "fixed_values [R]" : cterm
76.1821 +*)
76.1822 +fun chktyp thy (n, fs, gs) =
76.1823 + ((writeln o string_of_cterm o (nth n)) fs;
76.1824 + (writeln o string_of_cterm o (nth n)) gs;
76.1825 + tag_form thy (nth n fs, nth n gs));
76.1826 +
76.1827 +fun chktyps thy (fs, gs) = map (tag_form thy) (fs ~~ gs);
76.1828 +
76.1829 +(* #####################################################
76.1830 + find the failing item:
76.1831 +> val n = 2;
76.1832 +> val tag__form = chktyp (n,formals,givens);
76.1833 +> (type_of o term_of o (nth n)) formals;
76.1834 +> (type_of o term_of o (nth n)) givens;
76.1835 +> atomty ((term_of o (nth n)) formals);
76.1836 +> atomty ((term_of o (nth n)) givens);
76.1837 +> atomty (term_of tag__form);
76.1838 +> use_thy"isa-98-1-HOL-plus/knowl-base/DiffAppl";
76.1839 + ##################################################### *)
76.1840 +
76.1841 +(* #####################################################
76.1842 + testdata setup
76.1843 +val origin = ["sqrt(9+4*x)=sqrt x + sqrt(5+x)","x::rat","(+0)"];
76.1844 +val formals = map (the o (parse thy)) origin;
76.1845 +
76.1846 +val given = ["equation (lhs=rhs)",
76.1847 + "bound_variable bdv", (* TODO type *)
76.1848 + "error_bound apx"];
76.1849 +val where_ = ["e is_root_equation_in bdv",
76.1850 + "bdv is_var",
76.1851 + "apx is_const_expr"];
76.1852 +val find = ["L::rat set"];
76.1853 +val with_ = ["L = {bdv. || ((%x. lhs) bdv) - ((%x. rhs) bdv) || < apx}"];
76.1854 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
76.1855 +val givens = map (the o (parse thy)) given;
76.1856 +
76.1857 +val tag__forms = chktyps (formals, givens);
76.1858 +map ((atomty) o term_of) tag__forms;
76.1859 + ##################################################### *)
76.1860 +
76.1861 +
76.1862 +(* check pbltypes, announces one failure a time *)
76.1863 +fun chk_vars ctppc =
76.1864 + let val {Given=gi,Where=wh,Find=fi,With=wi,Relate=re} =
76.1865 + appc flat (mappc (vars o term_of) ctppc)
76.1866 + in if (wh\\gi) <> [] then ("wh\\gi",wh\\gi)
76.1867 + else if (re\\(gi union fi)) <> []
76.1868 + then ("re\\(gi union fi)",re\\(gi union fi))
76.1869 + else ("ok",[]) end;
76.1870 +
76.1871 +(* check a new pbltype: variables (Free) unbound by given, find*)
76.1872 +fun unbound_ppc ctppc =
76.1873 + let val {Given=gi,Find=fi,Relate=re,...} =
76.1874 + appc flat (mappc (vars o term_of) ctppc)
76.1875 + in distinct (re\\(gi union fi)) end;
76.1876 +(*
76.1877 +> val org = {Given=["[R=(R::real)]"],Where=[],
76.1878 + Find=["[A::real]"],With=[],
76.1879 + Relate=["[A=#2*a*b - a^^^#2, (a//#2)^^^#2 + (b//#2)^^^#2 = R^^^#2]"]
76.1880 + }:string ppc;
76.1881 +> val ctppc = mappc (the o (parse thy)) org;
76.1882 +> unbound_ppc ctppc;
76.1883 +val it = [("a","RealDef.real"),("b","RealDef.real")] : (string * typ) list
76.1884 +*)
76.1885 +
76.1886 +
76.1887 +(* f, a binary operator, is nested rightassociative *)
76.1888 +fun foldr1 f xs =
76.1889 + let
76.1890 + fun fld f (x::[]) = x
76.1891 + | fld f (x::x'::[]) = f (x',x)
76.1892 + | fld f (x::x'::xs) = f (fld f (x'::xs),x);
76.1893 + in ((fld f) o rev) xs end;
76.1894 +(*
76.1895 +> val (Some ct) = parse thy "[a=b,c=d,e=f]";
76.1896 +> val ces = map (cterm_of (sign_of thy)) (isalist2list (term_of ct));
76.1897 +> val conj = foldr1 HOLogic.mk_conj (isalist2list (term_of ct));
76.1898 +> cterm_of (sign_of thy) conj;
76.1899 +val it = "(a = b & c = d) & e = f" : cterm
76.1900 +*)
76.1901 +
76.1902 +(* f, a binary operator, is nested leftassociative *)
76.1903 +fun foldl1 f (x::[]) = x
76.1904 + | foldl1 f (x::x'::[]) = f (x,x')
76.1905 + | foldl1 f (x::x'::xs) = f (x,foldl1 f (x'::xs));
76.1906 +(*
76.1907 +> val (Some ct) = parse thy "[a=b,c=d,e=f,g=h]";
76.1908 +> val ces = map (cterm_of (sign_of thy)) (isalist2list (term_of ct));
76.1909 +> val conj = foldl1 HOLogic.mk_conj (isalist2list (term_of ct));
76.1910 +> cterm_of (sign_of thy) conj;
76.1911 +val it = "a = b & c = d & e = f & g = h" : cterm
76.1912 +*)
76.1913 +
76.1914 +
76.1915 +(* called only once, if a Subproblem has been located in the script*)
76.1916 +fun nxt_model_pbl (Subproblem'((_,pblID,metID),_,_,_,_)) ptp =
76.1917 +(* val (Subproblem'((_,pblID,metID),_,_,_,_),ptp) = (m', (pt,(p,p_)));
76.1918 + *)
76.1919 + (case metID of
76.1920 + ["no_met"] =>
76.1921 + (snd3 o hd o fst3) (nxt_specif (Refine_Tacitly pblID) ptp)
76.1922 + | _ => (snd3 o hd o fst3) (nxt_specif Model_Problem ptp))
76.1923 + (*all stored in tac_ itms ^^^^^^^^^^*)
76.1924 + | nxt_model_pbl tac_ _ =
76.1925 + raise error ("nxt_model_pbl: called by tac= "^tac_2str tac_);
76.1926 +(* run subp_rooteq.sml ''
76.1927 + until nxt=("Subproblem",Subproblem ("SqRoot.thy",["univariate","equation"]))
76.1928 +> val (_, (Subproblem'((_,pblID,metID),_,_,_,_),_,_,_,_,_)) =
76.1929 + (last_elem o drop_last) ets'';
76.1930 +> val mst = (last_elem o drop_last) ets'';
76.1931 +> nxt_model_pbl mst;
76.1932 +val it = Refine_Tacitly ["univariate","equation"] : tac
76.1933 +*)
76.1934 +
76.1935 +(*fun eq1 d (_,(d',_)) = (d = d'); ---modspec.sml*)
76.1936 +fun eq4 v (_,vts,_,_,_) = v mem vts;
76.1937 +(*((curry (op mem)) (vat:int)) o (#2:ori -> int list);*)
76.1938 +fun eq5 (_,_,_,_,itm_) (_,_,_,d,_) = d_in itm_ = d;
76.1939 +
76.1940 +
76.1941 +
76.1942 +(*
76.1943 + writeln (oris2str pors);
76.1944 +
76.1945 + writeln (itms2str thy pits);
76.1946 + writeln (itms2str thy mits);
76.1947 + *)
76.1948 +
76.1949 +
76.1950 +(*.complete _NON_empty calc-head for autocalc (sub-)pbl from oris
76.1951 + + met from fmz; assumes pos on PblObj, meth = [].*)
76.1952 +fun complete_mod (pt, pos as (p, p_):pos') =
76.1953 +(* val (pt, (p, _)) = (pt, p);
76.1954 + val (pt, (p, _)) = (pt, pos);
76.1955 + *)
76.1956 + let val _= if p_ <> Pbl
76.1957 + then writeln("###complete_mod: only impl.for Pbl, called with "^
76.1958 + pos'2str pos) else ()
76.1959 + val (PblObj{origin=(oris, ospec, hdl), probl, spec,...}) =
76.1960 + get_obj I pt p
76.1961 + val (dI,pI,mI) = some_spec ospec spec
76.1962 + val mpc = (#ppc o get_met) mI
76.1963 + val ppc = (#ppc o get_pbt) pI
76.1964 + val (pits, mits) = complete_mod_ (oris, mpc, ppc, probl)
76.1965 + val pt = update_pblppc pt p pits
76.1966 + val pt = update_metppc pt p mits
76.1967 + in (pt, (p,Met):pos') end
76.1968 +;
76.1969 +(*| complete_mod (pt, pos as (p, Met):pos') =
76.1970 + raise error ("###complete_mod: only impl.for Pbl, called with "^
76.1971 + pos'2str pos);*)
76.1972 +
76.1973 +(*.complete _EMPTY_ calc-head for autocalc (sub-)pbl from oris(+met from fmz);
76.1974 + oris and spec (incl. pbl-refinement) given from init_calc or SubProblem .*)
76.1975 +fun all_modspec (pt, (p,_):pos') =
76.1976 +(* val (pt, (p,_)) = ptp;
76.1977 + *)
76.1978 + let val (PblObj{fmz=(fmz_,_), origin=(pors, spec as (dI,pI,mI), hdl),
76.1979 + ...}) = get_obj I pt p;
76.1980 + val thy = assoc_thy dI;
76.1981 + val {ppc,...} = get_met mI;
76.1982 + val mors = prep_ori fmz_ thy ppc;
76.1983 + val pt = update_pblppc pt p (map (ori2Coritm ppc) pors);
76.1984 + val pt = update_metppc pt p (map (ori2Coritm ppc) mors);
76.1985 + val pt = update_spec pt p (dI,pI,mI);
76.1986 + in (pt, (p,Met): pos') end;
76.1987 +
76.1988 +(*WN.12.03: use in nxt_spec, too ? what about variants ???*)
76.1989 +fun is_complete_mod_ ([]: itm list) = false
76.1990 + | is_complete_mod_ itms =
76.1991 + foldl and_ (true, (map #3 itms));
76.1992 +fun is_complete_mod (pt, pos as (p, Pbl): pos') =
76.1993 + if (is_pblobj o (get_obj I pt)) p
76.1994 + then (is_complete_mod_ o (get_obj g_pbl pt)) p
76.1995 + else raise error ("is_complete_mod: called by PrfObj at "^pos'2str pos)
76.1996 + | is_complete_mod (pt, pos as (p, Met)) =
76.1997 + if (is_pblobj o (get_obj I pt)) p
76.1998 + then (is_complete_mod_ o (get_obj g_met pt)) p
76.1999 + else raise error ("is_complete_mod: called by PrfObj at "^pos'2str pos)
76.2000 + | is_complete_mod (_, pos) =
76.2001 + raise error ("is_complete_mod called by "^pos'2str pos^
76.2002 + " (should be Pbl or Met)");
76.2003 +
76.2004 +(*.have (thy, pbl, met) _all_ been specified explicitly ?.*)
76.2005 +fun is_complete_spec (pt, pos as (p,_): pos') =
76.2006 + if (not o is_pblobj o (get_obj I pt)) p
76.2007 + then raise error ("is_complete_spec: called by PrfObj at "^pos'2str pos)
76.2008 + else let val (dI,pI,mI) = get_obj g_spec pt p
76.2009 + in dI<>e_domID andalso pI<>e_pblID andalso mI<>e_metID end;
76.2010 +(*.complete empty items in specification from origin (pbl, met ev.refined);
76.2011 + assumes 'is_complete_mod'.*)
76.2012 +fun complete_spec (pt, pos as (p,_): pos') =
76.2013 + let val PblObj {origin = (_,ospec,_), spec,...} = get_obj I pt p
76.2014 + val pt = update_spec pt p (some_spec ospec spec)
76.2015 + in (pt, pos) end;
76.2016 +
76.2017 +fun is_complete_modspec ptp =
76.2018 + is_complete_mod ptp andalso is_complete_spec ptp;
76.2019 +
76.2020 +
76.2021 +
76.2022 +
76.2023 +fun pt_model (PblObj {meth,spec,origin=(_,spec',hdl),...}) Met =
76.2024 +(* val ((PblObj {meth,spec,origin=(_,spec',hdl),...}), Met) = (ppobj, p_);
76.2025 + *)
76.2026 + let val (_,_,metID) = get_somespec' spec spec'
76.2027 + val pre =
76.2028 + if metID = e_metID then []
76.2029 + else let val {prls,pre=where_,...} = get_met metID
76.2030 + val pre = check_preconds' prls where_ meth 0
76.2031 + in pre end
76.2032 + val allcorrect = is_complete_mod_ meth
76.2033 + andalso foldl and_ (true, (map #1 pre))
76.2034 + in ModSpec (allcorrect, Met, hdl, meth, pre, spec) end
76.2035 + | pt_model (PblObj {probl,spec,origin=(_,spec',hdl),...}) _(*Frm,Pbl*) =
76.2036 +(* val ((PblObj {probl,spec,origin=(_,spec',hdl),...}),_) = (ppobj, p_);
76.2037 + *)
76.2038 + let val (_,pI,_) = get_somespec' spec spec'
76.2039 + val pre =
76.2040 + if pI = e_pblID then []
76.2041 + else let val {prls,where_,cas,...} = get_pbt pI
76.2042 + val pre = check_preconds' prls where_ probl 0
76.2043 + in pre end
76.2044 + val allcorrect = is_complete_mod_ probl
76.2045 + andalso foldl and_ (true, (map #1 pre))
76.2046 + in ModSpec (allcorrect, Pbl, hdl, probl, pre, spec) end;
76.2047 +
76.2048 +
76.2049 +fun pt_form (PrfObj {form,...}) = Form form
76.2050 + | pt_form (PblObj {probl,spec,origin=(_,spec',_),...}) =
76.2051 + let val (dI, pI, _) = get_somespec' spec spec'
76.2052 + val {cas,...} = get_pbt pI
76.2053 + in case cas of
76.2054 + None => Form (pblterm dI pI)
76.2055 + | Some t => Form (subst_atomic (mk_env probl) t)
76.2056 + end;
76.2057 +(*vvv takes the tac _generating_ the formula=result, asm ok....
76.2058 +fun pt_result (PrfObj {result=(t,asm), tac,...}) =
76.2059 + (Form t,
76.2060 + if null asm then None else Some asm,
76.2061 + Some tac)
76.2062 + | pt_result (PblObj {result=(t,asm), origin = (_,ospec,_), spec,...}) =
76.2063 + let val (_,_,metID) = some_spec ospec spec
76.2064 + in (Form t,
76.2065 + if null asm then None else Some asm,
76.2066 + if metID = e_metID then None else Some (Apply_Method metID)) end;
76.2067 +-------------------------------------------------------------------------*)
76.2068 +
76.2069 +
76.2070 +(*.pt_extract returns
76.2071 + # the formula at pos
76.2072 + # the tactic applied to this formula
76.2073 + # the list of assumptions generated at this formula
76.2074 + (by application of another tac to the preceding formula !)
76.2075 + pos is assumed to come from the frontend, ie. generated by moveDown.*)
76.2076 +(*cannot be in ctree.sml, because ModSpec has to be calculated*)
76.2077 +fun pt_extract (pt,([],Res)) =
76.2078 +(* val (pt,([],Res)) = ptp;
76.2079 + *)
76.2080 + let val (f, asm) = get_obj g_result pt []
76.2081 + in (Form f, None, asm) end
76.2082 +(* val p = [3,2];
76.2083 + *)
76.2084 + | pt_extract (pt,(p,Res)) =
76.2085 +(* val (pt,(p,Res)) = ptp;
76.2086 + *)
76.2087 + let val (f, asm) = get_obj g_result pt p
76.2088 + val tac = if last_onlev pt p
76.2089 + then if is_pblobj' pt (lev_up p)
76.2090 + then let val (PblObj{spec=(_,pI,_),...}) =
76.2091 + get_obj I pt (lev_up p)
76.2092 + in if pI = e_pblID then None
76.2093 + else Some (Check_Postcond pI) end
76.2094 + else Some End_Trans (*WN0502 TODO for other branches*)
76.2095 + else let val p' = lev_on p
76.2096 + in if is_pblobj' pt p'
76.2097 + then let val (PblObj{origin = (_,(dI,pI,_),_),...}) =
76.2098 + get_obj I pt p'
76.2099 + in Some (Subproblem (dI, pI)) end
76.2100 + else if f = get_obj g_form pt p'
76.2101 + then Some (get_obj g_tac pt p')
76.2102 + (*because this Frm ~~~is not on worksheet*)
76.2103 + else Some (Take (term2str (get_obj g_form pt p')))
76.2104 + end
76.2105 + in (Form f, tac, asm) end
76.2106 +
76.2107 + | pt_extract (pt, pos as (p,p_(*Frm,Pbl*))) =
76.2108 +(* val (pt, pos as (p,p_(*Frm,Pbl*))) = ptp;
76.2109 + val (pt, pos as (p,p_(*Frm,Pbl*))) = (pt, p);
76.2110 + *)
76.2111 + let val ppobj = get_obj I pt p
76.2112 + val f = if is_pblobj ppobj then pt_model ppobj p_
76.2113 + else get_obj pt_form pt p
76.2114 + val tac = g_tac ppobj
76.2115 + in (f, Some tac, []) end;
76.2116 +
76.2117 +
76.2118 +(**. get the formula from a ctree-node:
76.2119 + take form+res from PblObj and 1.PrfObj and (PrfObj after PblObj)
76.2120 + take res from all other PrfObj's .**)
76.2121 +(*designed for interSteps, outcommented 04 in favour of calcChangedEvent*)
76.2122 +fun formres p (Nd (PblObj {origin = (_,_, h), result = (r, _),...}, _)) =
76.2123 + [("headline", (p, Frm), h),
76.2124 + ("stepform", (p, Res), r)]
76.2125 + | formres p (Nd (PrfObj {form, result = (r, _),...}, _)) =
76.2126 + [("stepform", (p, Frm), form),
76.2127 + ("stepform", (p, Res), r)];
76.2128 +
76.2129 +fun form p (Nd (PrfObj {result = (r, _),...}, _)) =
76.2130 + [("stepform", (p, Res), r)]
76.2131 +
76.2132 +(*assumes to take whole level, in particular hd -- for use in interSteps*)
76.2133 +fun get_formress fs p [] = flat fs
76.2134 + | get_formress fs p (nd::nds) =
76.2135 + (* start with 'form+res' and continue with trying 'res' only*)
76.2136 + get_forms (fs @ [formres p nd]) (lev_on p) nds
76.2137 +and get_forms fs p [] = flat fs
76.2138 + | get_forms fs p (nd::nds) =
76.2139 + if is_pblnd nd
76.2140 + (* start again with 'form+res' ///ugly repeat with Check_elementwise
76.2141 + then get_formress (fs @ [formres p nd]) (lev_on p) nds *)
76.2142 + then get_forms (fs @ [formres p nd]) (lev_on p) nds
76.2143 + (* continue with trying 'res' only*)
76.2144 + else get_forms (fs @ [form p nd]) (lev_on p) nds;
76.2145 +
76.2146 +(**.get an 'interval' 'from' 'to' of formulae from a ptree.**)
76.2147 +(*WN050219 made robust against _'to' below or after Complete nodes
76.2148 + by handling exn caused by move_dn*)
76.2149 +(*WN0401 this functionality belongs to ctree.sml,
76.2150 +but fetching a calc_head requires calculations defined in modspec.sml
76.2151 +transfer to ME/me.sml !!!
76.2152 +WN051224 ^^^ doesnt hold any longer, since only the headline of a calc_head
76.2153 +is returned !!!!!!!!!!!!!
76.2154 +*)
76.2155 +fun eq_pos' (p1,Frm) (p2,Frm) = p1 = p2
76.2156 + | eq_pos' (p1,Res) (p2,Res) = p1 = p2
76.2157 + | eq_pos' (p1,Pbl) (p2,p2_) = p1 = p2 andalso (case p2_ of
76.2158 + Pbl => true
76.2159 + | Met => true
76.2160 + | _ => false)
76.2161 + | eq_pos' (p1,Met) (p2,p2_) = p1 = p2 andalso (case p2_ of
76.2162 + Pbl => true
76.2163 + | Met => true
76.2164 + | _ => false)
76.2165 + | eq_pos' _ _ = false;
76.2166 +
76.2167 +(*.get an 'interval' from the ctree; 'interval' is w.r.t. the
76.2168 + total ordering Position#compareTo(Position p) in the java-code
76.2169 +val get_interval = fn
76.2170 + : pos' -> : from is "move_up 1st-element" to return
76.2171 + pos' -> : to the last element to be returned; from < to
76.2172 + int -> : level: 0 gets the flattest sub-tree possible
76.2173 + >999 gets the deepest sub-tree possible
76.2174 + ptree -> :
76.2175 + (pos' * : of the formula
76.2176 + Term.term) : the formula
76.2177 + list
76.2178 +.*)
76.2179 +fun get_interval from to level pt =
76.2180 +(* val (from,level) = (f,lev);
76.2181 + val (from, to, level) = (([3, 2, 1], Res), ([],Res), 9999);
76.2182 + *)
76.2183 + let fun get_inter c (from:pos') (to:pos') lev pt =
76.2184 +(* val (c, from, to, lev) = ([], from, to, level);
76.2185 + ------for recursion.......
76.2186 + val (c, from:pos', to:pos') = (c @ [(from, f)], move_dn [] pt from, to);
76.2187 + *)
76.2188 + if eq_pos' from to orelse from = ([],Res)
76.2189 + (*orelse ... avoids Exception- PTREE "end of calculation" raised,
76.2190 + if 'to' has values NOT generated by move_dn, see systest/me.sml
76.2191 + TODO.WN0501: introduce an order on pos' and check "from > to"..
76.2192 + ...there is an order in Java!
76.2193 + WN051224 the hack got worse with returning term instead ptform*)
76.2194 + then let val (f,_,_) = pt_extract (pt, from)
76.2195 + in case f of
76.2196 + ModSpec (_,_,headline,_,_,_) => c @ [(from, headline)]
76.2197 + | Form t => c @ [(from, t)]
76.2198 + end
76.2199 + else
76.2200 + if lev < lev_of from
76.2201 + then (get_inter c (move_dn [] pt from) to lev pt)
76.2202 + handle (PTREE _(*from move_dn too far*)) => c
76.2203 + else let val (f,_,_) = pt_extract (pt, from)
76.2204 + val term = case f of
76.2205 + ModSpec (_,_,headline,_,_,_)=> headline
76.2206 + | Form t => t
76.2207 + in (get_inter (c @ [(from, term)])
76.2208 + (move_dn [] pt from) to lev pt)
76.2209 + handle (PTREE _(*from move_dn too far*))
76.2210 + => c @ [(from, term)] end
76.2211 + in get_inter [] from to level pt end;
76.2212 +
76.2213 +(*for tests*)
76.2214 +fun posform2str (pos:pos', form) =
76.2215 + "("^ pos'2str pos ^", "^
76.2216 + (case form of
76.2217 + Form f => term2str f
76.2218 + | ModSpec c => term2str (#3 c(*the headline*)))
76.2219 + ^")";
76.2220 +fun posforms2str pfs = (strs2str' o (map (curry op ^ "\n")) o
76.2221 + (map posform2str)) pfs;
76.2222 +fun posterm2str (pos:pos', t) =
76.2223 + "("^ pos'2str pos ^", "^term2str t^")";
76.2224 +fun posterms2str pfs = (strs2str' o (map (curry op ^ "\n")) o
76.2225 + (map posterm2str)) pfs;
76.2226 +
76.2227 +
76.2228 +(*WN050225 omits the last step, if pt is incomplete*)
76.2229 +fun show_pt pt =
76.2230 + writeln (posterms2str (get_interval ([],Frm) ([],Res) 99999 pt));
76.2231 +
76.2232 +(*.get a calchead from a PblObj-node in the ctree;
76.2233 + preconditions must be calculated.*)
76.2234 +fun get_ocalhd (pt, pos' as (p,Pbl):pos') =
76.2235 + let val PblObj {origin = (oris, ospec, hdf'), spec, probl,...} =
76.2236 + get_obj I pt p
76.2237 + val {prls,where_,...} = get_pbt (#2 (some_spec ospec spec))
76.2238 + val pre = check_preconds (assoc_thy"Isac.thy") prls where_ probl
76.2239 + in (ocalhd_complete probl pre spec, Pbl, hdf', probl, pre, spec):ocalhd end
76.2240 +| get_ocalhd (pt, pos' as (p,Met):pos') =
76.2241 + let val PblObj {fmz = fmz as (fmz_,_), origin = (oris, ospec, hdf'),
76.2242 + spec, meth,...} =
76.2243 + get_obj I pt p
76.2244 + val {prls,pre,...} = get_met (#3 (some_spec ospec spec))
76.2245 + val pre = check_preconds (assoc_thy"Isac.thy") prls pre meth
76.2246 + in (ocalhd_complete meth pre spec, Met, hdf', meth, pre, spec):ocalhd end;
76.2247 +
76.2248 +(*.at the activeFormula set the Model, the Guard and the Specification
76.2249 + to empty and return a CalcHead;
76.2250 + the 'origin' remains (for reconstructing all that).*)
76.2251 +fun reset_calchead (pt, pos' as (p,_):pos') =
76.2252 + let val PblObj {origin = (_, _, hdf'),...} = get_obj I pt p
76.2253 + val pt = update_pbl pt p []
76.2254 + val pt = update_met pt p []
76.2255 + val pt = update_spec pt p e_spec
76.2256 + in (pt, (p,Pbl):pos') end;
76.2257 +
76.2258 +(*---------------------------------------------------------------------*)
76.2259 +end
76.2260 +
76.2261 +open CalcHead;
76.2262 +(*---------------------------------------------------------------------*)
76.2263 +
77.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
77.2 +++ b/src/Pure/isac/ME/ctree.sml Wed Jul 21 13:53:39 2010 +0200
77.3 @@ -0,0 +1,2159 @@
77.4 +(* use"../ME/ctree.sml";
77.5 + use"ME/ctree.sml";
77.6 + use"ctree.sml";
77.7 + W.N.26.10.99
77.8 +
77.9 +writeln (pr_ptree pr_short pt);
77.10 +
77.11 +val Nd ( _, ns) = pt;
77.12 +
77.13 +*)
77.14 +
77.15 +(*structure Ptree (**): PTREE (**) = ###### outcommented ######*)
77.16 +signature PTREE =
77.17 +sig
77.18 + type ptree
77.19 + type envp
77.20 + val e_ptree : ptree
77.21 + exception PTREE of string
77.22 + type branch
77.23 + type ostate
77.24 + type cellID
77.25 + type cid
77.26 + type posel
77.27 + type pos
77.28 + type pos'
77.29 + type loc
77.30 + type domID
77.31 + type pblID
77.32 + type metID
77.33 + type spec
77.34 + type 'a ppc
77.35 + type con
77.36 + type subs
77.37 + type subst
77.38 + type env
77.39 + type ets
77.40 + val ets2str : ets -> string
77.41 + type item
77.42 + type tac
77.43 + type tac_
77.44 + val tac_2str : tac_ -> string
77.45 + type safe
77.46 + val safe2str : safe -> string
77.47 +
77.48 + type meth
77.49 + val cappend_atomic : ptree -> pos -> loc -> cterm' -> tac
77.50 + -> cterm' -> ostate -> cid -> ptree * posel list * cid
77.51 + val cappend_form : ptree
77.52 + -> pos -> loc -> cterm' -> cid -> ptree * pos * cid
77.53 + val cappend_parent : ptree -> pos -> loc -> cterm' -> tac
77.54 + -> branch -> cid -> ptree * int list * cid
77.55 + val cappend_problem : ptree -> posel list(*FIXME*) -> loc
77.56 + -> cterm' list * spec -> cid -> ptree * int list * cellID list
77.57 + val append_result : ptree -> pos -> cterm' -> ostate -> ptree * pos
77.58 +
77.59 + type ppobj
77.60 + val g_branch : ppobj -> branch
77.61 + val g_cell : ppobj -> cid
77.62 + val g_args : ppobj -> (int * (term list)) list (*args of scr*)
77.63 + val g_form : ppobj -> cterm'
77.64 + val g_loc : ppobj -> loc
77.65 + val g_met : ppobj -> meth
77.66 + val g_domID : ppobj -> domID
77.67 + val g_metID : ppobj -> metID
77.68 + val g_model : ppobj -> cterm' ppc
77.69 + val g_tac : ppobj -> tac
77.70 + val g_origin : ppobj -> cterm' list * spec
77.71 + val g_ostate : ppobj -> ostate
77.72 + val g_pbl : ppobj -> pblID * item ppc
77.73 + val g_result : ppobj -> cterm'
77.74 + val g_spec : ppobj -> spec
77.75 +(* val get_all : (ppobj -> 'a) -> ptree -> 'a list
77.76 + val get_alls : (ppobj -> 'a) -> ptree list -> 'a list *)
77.77 + val get_obj : (ppobj -> 'a) -> ptree -> pos -> 'a
77.78 + val gpt_cell : ptree -> cid
77.79 + val par_pblobj : ptree -> pos -> pos
77.80 + val pre_pos : pos -> pos
77.81 + val lev_dn : int list -> int list
77.82 + val lev_on : pos -> posel list
77.83 + val lev_pred : pos -> pos
77.84 + val lev_up : pos -> pos
77.85 +(* val pr_cell : pos -> ppobj -> string
77.86 + val pr_pos : int list -> string *)
77.87 + val pr_ptree : (pos -> ppobj -> string) -> ptree -> string
77.88 + val pr_short : pos -> ppobj -> string
77.89 +(* val repl : 'a list -> int -> 'a -> 'a list
77.90 + val repl_app : 'a list -> int -> 'a -> 'a list
77.91 + val repl_branch : branch -> ppobj -> ppobj
77.92 + val repl_domID : domID -> ppobj -> ppobj
77.93 + val repl_form : cterm' -> ppobj -> ppobj
77.94 + val repl_met : item ppc -> ppobj -> ppobj
77.95 + val repl_metID : metID -> ppobj -> ppobj
77.96 + val repl_model : cterm' list -> ppobj -> ppobj
77.97 + val repl_tac : tac -> ppobj -> ppobj
77.98 + val repl_pbl : item ppc -> ppobj -> ppobj
77.99 + val repl_pblID : pblID -> ppobj -> ppobj
77.100 + val repl_result : cterm' -> ostate -> ppobj -> ppobj
77.101 + val repl_spec : spec -> ppobj -> ppobj
77.102 + val repl_subs : (string * string) list -> ppobj -> ppobj *)
77.103 + val rootthy : ptree -> domID
77.104 +(* val test_trans : ppobj -> bool
77.105 + val uni__asm : (string * pos) list -> ppobj -> ppobj
77.106 + val uni__cid : cellID list -> ppobj -> ppobj *)
77.107 + val union_asm : ptree -> pos -> (string * pos) list -> ptree
77.108 + val union_cid : ptree -> pos -> cellID list -> ptree
77.109 + val update_branch : ptree -> pos -> branch -> ptree
77.110 + val update_domID : ptree -> pos -> domID -> ptree
77.111 + val update_met : ptree -> pos -> meth -> ptree
77.112 + val update_metppc : ptree -> pos -> item ppc -> ptree
77.113 + val update_metID : ptree -> pos -> metID -> ptree
77.114 + val update_tac : ptree -> pos -> tac -> ptree
77.115 + val update_pbl : ptree -> pos -> pblID * item ppc -> ptree
77.116 + val update_pblppc : ptree -> pos -> item ppc -> ptree
77.117 + val update_pblID : ptree -> pos -> pblID -> ptree
77.118 + val update_spec : ptree -> pos -> spec -> ptree
77.119 + val update_subs : ptree -> pos -> (string * string) list -> ptree
77.120 +
77.121 + val rep_pblobj : ppobj
77.122 + -> {branch:branch, cell:cid, env:envp, loc:loc, meth:meth, model:cterm' ppc,
77.123 + origin:cterm' list * spec, ostate:ostate, probl:pblID * item ppc,
77.124 + result:cterm', spec:spec}
77.125 + val rep_prfobj : ppobj
77.126 + -> {branch:branch, cell:cid, form:cterm', loc:loc, tac:tac,
77.127 + ostate:ostate, result:cterm'}
77.128 +end
77.129 +
77.130 +(* --------------
77.131 +structure Ptree (**): PTREE (**) =
77.132 +struct
77.133 + -------------- *)
77.134 +
77.135 +type env = (term * term) list;
77.136 +
77.137 +
77.138 +datatype branch =
77.139 + NoBranch | AndB | OrB
77.140 + | TransitiveB (* FIXXXME.8.03: set branch from met in Apply_Method
77.141 + FIXXXME.0402: -"- in Begin_Trans'*)
77.142 + | SequenceB | IntersectB | CollectB | MapB;
77.143 +fun branch2str NoBranch = "NoBranch"
77.144 + | branch2str AndB = "AndB"
77.145 + | branch2str OrB = "OrB"
77.146 + | branch2str TransitiveB = "TransitiveB"
77.147 + | branch2str SequenceB = "SequenceB"
77.148 + | branch2str IntersectB = "IntersectB"
77.149 + | branch2str CollectB = "CollectB"
77.150 + | branch2str MapB = "MapB";
77.151 +
77.152 +datatype ostate =
77.153 + Incomplete | Complete | Inconsistent(*WN041020 latter unused*);
77.154 +fun ostate2str Incomplete = "Incomplete"
77.155 + | ostate2str Complete = "Complete"
77.156 + | ostate2str Inconsistent = "Inconsistent";
77.157 +
77.158 +type cellID = int;
77.159 +type cid = cellID list;
77.160 +
77.161 +type posel = int; (* roundabout for (some of) nice signatures *)
77.162 +type pos = posel list;
77.163 +val pos2str = ints2str';
77.164 +datatype pos_ =
77.165 + Pbl (*PblObj-position: problem-type*)
77.166 + | Met (*PblObj-position: method*)
77.167 + | Frm (*PblObj-position: -> Pbl in ME (not by moveDown !)
77.168 + | PrfObj-position: formula*)
77.169 + | Res (*PblObj | PrfObj-position: result*)
77.170 + | Und; (*undefined*)
77.171 +fun pos_2str Pbl = "Pbl"
77.172 + | pos_2str Met = "Met"
77.173 + | pos_2str Frm = "Frm"
77.174 + | pos_2str Res = "Res"
77.175 + | pos_2str Und = "Und";
77.176 +
77.177 +type pos' = pos * pos_;
77.178 +(*WN.12.03 remembering interator (pos * pos_) for ptree
77.179 + pos : lev_on, lev_dn, lev_up,
77.180 + lev_onFrm, lev_dnRes (..see solve Apply_Method !)
77.181 + pos_:
77.182 +# generate1 sets pos_ if possible ...?WN0502?NOT...
77.183 +# generate1 does NOT set pos, because certain nodes can be lev_on OR lev_dn
77.184 + exceptions: Begin/End_Trans
77.185 +# thus generate(1) called in
77.186 +.# assy, locate_gen
77.187 +.# nxt_solv (tac_ -cases); general case:
77.188 + val pos' = case pos' of (p,Res) => (lev_on p',Res) | _ => pos'
77.189 +# WN050220, S(604):
77.190 + generate1...(Rewrite(f,..,res))..(pos, pos_)
77.191 + cappend_atomic.................pos ////// gets f+res always!!!
77.192 + cut_tree....................pos, pos_
77.193 +*)
77.194 +fun pos'2str (p,p_) = pair2str (ints2str' p, pos_2str p_);
77.195 +fun pos's2str ps = (strs2str' o (map pos'2str)) ps;
77.196 +val e_pos' = ([],Und):pos';
77.197 +
77.198 +fun res2str (t, ts) = pair2str (term2str t, terms2str ts);
77.199 +fun asm2str (t, p:pos) = pair2str (term2str t, ints2str' p);
77.200 +fun asms2str asms = (strs2str' o (map asm2str)) asms;
77.201 +
77.202 +
77.203 +
77.204 +(*26.4.02: never used after introduction of scripts !!!
77.205 +type loc = loc_ * (* + interpreter-state *)
77.206 + (loc_ * rls') (* -"- for script of the ruleset*)
77.207 + option;
77.208 +val e_loc = ([],None):loc;
77.209 +val ee_loc = (e_loc,e_loc);*)
77.210 +
77.211 +
77.212 +datatype safe = Sundef | Safe | Unsafe | Helpless;
77.213 +fun safe2str Sundef = "Sundef"
77.214 + | safe2str Safe = "Safe"
77.215 + | safe2str Unsafe = "Unsafe"
77.216 + | safe2str Helpless = "Helpless";
77.217 +
77.218 +type subs = cterm' list; (*16.11.00 for FE-KE*)
77.219 +val e_subs = ["(bdv, x)"];
77.220 +
77.221 +(*._sub_stitution as strings of _e_qualities.*)
77.222 +type sube = cterm' list;
77.223 +val e_sube = []:cterm' list;
77.224 +fun sube2str s = strs2str s;
77.225 +
77.226 +(*._sub_stitution as _t_erms of _e_qualities.*)
77.227 +type subte = term list;
77.228 +val e_subte = []:term list;
77.229 +fun subte2str ss = terms2str ss;
77.230 +
77.231 +fun subte2sube ss = map term2str ss;
77.232 +
77.233 +(*fun subst2str' thy' (s:subst) =
77.234 + (strs2str o
77.235 + (map (pair2str o
77.236 + (apsnd (Sign.string_of_term (sign_of (assoc_thy thy')))) o
77.237 + (apfst (Sign.string_of_term (sign_of (assoc_thy thy'))))))) s;*)
77.238 +fun subst2subs s = map (pair2str o
77.239 + (apfst (Sign.string_of_term (sign_of thy))) o
77.240 + (apsnd (Sign.string_of_term (sign_of thy)))) s;
77.241 +fun subst2subs' s = map ((apfst (Sign.string_of_term (sign_of thy))) o
77.242 + (apsnd (Sign.string_of_term (sign_of thy)))) s;
77.243 +fun subs2subst thy s = map (isapair2pair o term_of o the o (parse thy)) s;
77.244 +(*> subs2subst thy ["(bdv,x)","(err,#0)"];
77.245 +val it =
77.246 + [(Free ("bdv","RealDef.real"),Free ("x","RealDef.real")),
77.247 + (Free ("err","RealDef.real"),Free ("#0","RealDef.real"))]
77.248 + : (term * term) list*)
77.249 +(*["bdv=x","err=0"] ---> [(bdv,x), (err,0)]*)
77.250 +fun sube2subst thy s = map (dest_equals' o term_of o the o (parse thy)) s;
77.251 +(* val ts = sube2subst thy ["bdv=x","err=0"];
77.252 + subst2str' ts;
77.253 + *)
77.254 +fun sube2subte ss = map str2term ss;
77.255 +
77.256 +
77.257 +fun isasub2subst isasub = ((map isapair2pair) o isalist2list) isasub;
77.258 +
77.259 +
77.260 +type scrstate = (*state for script interpreter*)
77.261 + env(*stack*) (*used to instantiate tac for checking assod
77.262 + 12.03.noticed: e_ not updated during execution ?!?*)
77.263 + * loc_ (*location of tac in script*)
77.264 + * term option(*argument of curried functions*)
77.265 + * term (*value obtained by tac executed
77.266 + updated also after a derivation by 'new_val'*)
77.267 + * safe (*estimation of how result will be obtained*)
77.268 + * bool; (*true = strongly .., false = weakly associated:
77.269 + only used during ass_dn/up*)
77.270 +val e_scrstate = ([],[],None,e_term,Sundef,false):scrstate;
77.271 +
77.272 +
77.273 +(*21.8.02 ---> definitions.sml for datatype scr
77.274 +type rrlsstate = (*state for reverse rewriting*)
77.275 + (term * (*the current formula*)
77.276 + rule list (*of reverse rewrite set (#1#)*)
77.277 + list * (*may be serveral, eg. in norm_rational*)
77.278 + (rule * (*Thm (+ Thm generated from Calc) resulting in ...*)
77.279 + (term * (*... rewrite with ...*)
77.280 + term list)) (*... assumptions*)
77.281 + list); (*derivation from given term to normalform
77.282 + in reverse order with sym_thm;
77.283 + (#1#) could be extracted from here #1*) --------*)
77.284 +
77.285 +datatype istate = (*interpreter state*)
77.286 + Uistate (*undefined in modspec, in '_deriv'ation*)
77.287 + | ScrState of scrstate (*for script interpreter*)
77.288 + | RrlsState of rrlsstate; (*for reverse rewriting*)
77.289 +val e_istate = (ScrState ([],[],None,e_term,Sundef,false)):istate;
77.290 +
77.291 +type iist = istate option * istate option;
77.292 +(*val e_iist = (e_istate, e_istate); --- sinnlos f"ur NICHT-equality-type*)
77.293 +
77.294 +
77.295 +fun rta2str (r,(t,a)) = "\n("^(rule2str r)^",("^(term2str t)^", "^
77.296 + (terms2str a)^"))";
77.297 +fun istate2str Uistate = "Uistate"
77.298 + | istate2str (ScrState (e,l,to,t,s,b):istate) =
77.299 + "ScrState ("^ subst2str e ^",\n "^
77.300 + loc_2str l ^", "^ termopt2str to ^",\n "^
77.301 + term2str t ^", "^ safe2str s ^", "^ bool2str b ^")"
77.302 + | istate2str (RrlsState (t,t1,rss,rtas)) =
77.303 + "RrlsState ("^(term2str t)^", "^(term2str t1)^", "^
77.304 + ((strs2str o (map (strs2str o (map rule2str)))) rss)^", "^
77.305 + ((strs2str o (map rta2str)) rtas)^")";
77.306 +fun istates2str (None, None) = "(#None, #None)"
77.307 + | istates2str (None, Some ist) = "(#None,\n#Some "^istate2str ist^")"
77.308 + | istates2str (Some ist, None) = "(#Some "^istate2str ist^",\n #None)"
77.309 + | istates2str (Some i1, Some i2) = "(#Some "^istate2str i1^",\n #Some "^
77.310 + istate2str i2^")";
77.311 +
77.312 +fun new_val v (ScrState (env, loc_, topt, _, safe, bool)) =
77.313 + (ScrState (env, loc_, topt, v, safe, bool))
77.314 + | new_val _ _ = raise error "new_val: only for ScrState";
77.315 +
77.316 +datatype con = land | lor;
77.317 +
77.318 +
77.319 +type spec =
77.320 + domID * (*WN.12.03: is replaced by thy from get_met ?FIXME? in:
77.321 + specify (Init_Proof..), nxt_specify_init_calc,
77.322 + assod (.SubProblem...), stac2tac (.SubProblem...)*)
77.323 + pblID *
77.324 + metID;
77.325 +fun spec2str ((dom,pbl,met)(*:spec*)) =
77.326 + "(" ^ (quote dom) ^ ", " ^ (strs2str pbl) ^
77.327 + ", " ^ (strs2str met) ^ ")";
77.328 +(*> spec2str empty_spec;
77.329 +val it = "(\"\", [], (\"\", \"\"))" : string *)
77.330 +val empty_spec = (e_domID,e_pblID,e_metID):spec;
77.331 +val e_spec = empty_spec;
77.332 +
77.333 +
77.334 +
77.335 +(*.tactics propagate the construction of the calc-tree;
77.336 + there are
77.337 + (a) 'specsteps' for the specify-phase, and others for the solve-phase
77.338 + (b) those of the solve-phase are 'initac's and others;
77.339 + initacs start with a formula different from the preceding formula.
77.340 + see 'type tac_' for the internal representation of tactics.*)
77.341 +datatype tac =
77.342 + Init_Proof of ((cterm' list) * spec)
77.343 +(*'specsteps'...*)
77.344 +| Model_Problem
77.345 +| Refine_Problem of pblID | Refine_Tacitly of pblID
77.346 +
77.347 +| Add_Given of cterm' | Del_Given of cterm'
77.348 +| Add_Find of cterm' | Del_Find of cterm'
77.349 +| Add_Relation of cterm' | Del_Relation of cterm'
77.350 +
77.351 +| Specify_Theory of domID | Specify_Problem of pblID
77.352 +| Specify_Method of metID
77.353 +(*...'specsteps'*)
77.354 +| Apply_Method of metID
77.355 +(*.creates an 'istate' in PblObj.env; in case of 'init_form'
77.356 + creates a formula at ((lev_on o lev_dn) p, Frm) and in this ppobj.'loc'
77.357 + 'Some istate' (at fst of 'loc').
77.358 + As each step (in the solve-phase) has a resulting formula (at the front-end)
77.359 + Apply_Method also does the 1st step in the script (an 'initac') if there
77.360 + is no 'init_form' .*)
77.361 +| Check_Postcond of pblID
77.362 +| Free_Solve
77.363 +
77.364 +| Rewrite_Inst of ( subs * thm') | Rewrite of thm'
77.365 + | Rewrite_Asm of thm'
77.366 +| Rewrite_Set_Inst of ( subs * rls') | Rewrite_Set of rls'
77.367 +| Detail_Set_Inst of ( subs * rls') | Detail_Set of rls'
77.368 +| End_Detail (*end of script from next_tac,
77.369 + in solve: switches back to parent script WN0509 drop!*)
77.370 +| Derive of rls' (*an input formula using rls WN0509 drop!*)
77.371 +| Calculate of string (* plus | minus | times | cancel | pow | sqrt *)
77.372 +| End_Ruleset
77.373 +| Substitute of sube | Apply_Assumption of cterm' list
77.374 +
77.375 +| Take of cterm' (*an 'initac'*)
77.376 +| Take_Inst of cterm'
77.377 +| Group of (con * int list )
77.378 +| Subproblem of (domID * pblID) (*an 'initac'*)
77.379 +| CAScmd of cterm' (*6.6.02 URD: Function formula; WN0509 drop!*)
77.380 +| End_Subproblem (*WN0509 drop!*)
77.381 +
77.382 +| Split_And | Conclude_And
77.383 +| Split_Or | Conclude_Or
77.384 +| Begin_Trans | End_Trans
77.385 +| Begin_Sequ | End_Sequ(* substitute root.env *)
77.386 +| Split_Intersect | End_Intersect
77.387 +| Check_elementwise of cterm' | Collect_Trues
77.388 +| Or_to_List
77.389 +
77.390 +| Empty_Tac (*TODO.11.6.03 ... of string: could carry msg of (Notappl msg)
77.391 + in 'helpless'*)
77.392 +| Tac of string(* eg.'repeat'*WN0509 drop!*)
77.393 +| User (*internal, for ets*WN0509 drop!*)
77.394 +| End_Proof';(* inout*)
77.395 +
77.396 +(* tac2str /--> library.sml: needed in dialog.sml for 'separable *)
77.397 +fun tac2str (ma:tac) = case ma of
77.398 + Init_Proof (ppc, spec) =>
77.399 + "Init_Proof "^(pair2str (strs2str ppc, spec2str spec))
77.400 + | Model_Problem => "Model_Problem "
77.401 + | Refine_Tacitly pblID => "Refine_Tacitly "^(strs2str pblID)
77.402 + | Refine_Problem pblID => "Refine_Problem "^(strs2str pblID)
77.403 + | Add_Given cterm' => "Add_Given "^cterm'
77.404 + | Del_Given cterm' => "Del_Given "^cterm'
77.405 + | Add_Find cterm' => "Add_Find "^cterm'
77.406 + | Del_Find cterm' => "Del_Find "^cterm'
77.407 + | Add_Relation cterm' => "Add_Relation "^cterm'
77.408 + | Del_Relation cterm' => "Del_Relation "^cterm'
77.409 +
77.410 + | Specify_Theory domID => "Specify_Theory "^(quote domID )
77.411 + | Specify_Problem pblID => "Specify_Problem "^(strs2str pblID )
77.412 + | Specify_Method metID => "Specify_Method "^(strs2str metID)
77.413 + | Apply_Method metID => "Apply_Method "^(strs2str metID)
77.414 + | Check_Postcond pblID => "Check_Postcond "^(strs2str pblID)
77.415 + | Free_Solve => "Free_Solve"
77.416 +
77.417 + | Rewrite_Inst (subs,thm')=>
77.418 + "Rewrite_Inst "^(pair2str (subs2str subs, spair2str thm'))
77.419 + | Rewrite thm' => "Rewrite "^(spair2str thm')
77.420 + | Rewrite_Asm thm' => "Rewrite_Asm "^(spair2str thm')
77.421 + | Rewrite_Set_Inst (subs, rls) =>
77.422 + "Rewrite_Set_Inst "^(pair2str (subs2str subs, quote rls))
77.423 + | Rewrite_Set rls => "Rewrite_Set "^(quote rls )
77.424 + | Detail_Set rls => "Detail_Set "^(quote rls )
77.425 + | Detail_Set_Inst (subs, rls) =>
77.426 + "Detail_Set_Inst "^(pair2str (subs2str subs, quote rls))
77.427 + | End_Detail => "End_Detail"
77.428 + | Derive rls' => "Derive "^rls'
77.429 + | Calculate op_ => "Calculate "^op_
77.430 + | Substitute sube => "Substitute "^sube2str sube
77.431 + | Apply_Assumption ct's => "Apply_Assumption "^(strs2str ct's)
77.432 +
77.433 + | Take cterm' => "Take "^(quote cterm' )
77.434 + | Take_Inst cterm' => "Take_Inst "^(quote cterm' )
77.435 + | Group (con, ints) =>
77.436 + "Group "^(pair2str (con2str con, ints2str ints))
77.437 + | Subproblem (domID, pblID) =>
77.438 + "Subproblem "^(pair2str (domID, strs2str pblID))
77.439 +(*| Subproblem_Full (spec, cts') =>
77.440 + "Subproblem_Full "^(pair2str (spec2str spec, strs2str cts'))*)
77.441 + | End_Subproblem => "End_Subproblem"
77.442 + | CAScmd cterm' => "CAScmd "^(quote cterm')
77.443 +
77.444 + | Check_elementwise cterm'=> "Check_elementwise "^(quote cterm')
77.445 + | Or_to_List => "Or_to_List "
77.446 + | Collect_Trues => "Collect_Trues"
77.447 +
77.448 + | Empty_Tac => "Empty_Tac"
77.449 + | Tac string => "Tac "^string
77.450 + | User => "User"
77.451 + | End_Proof' => "tac End_Proof'"
77.452 + | _ => "tac2str not impl. for ?!";
77.453 +
77.454 +fun is_rewset (Rewrite_Set_Inst _) = true
77.455 + | is_rewset (Rewrite_Set _) = true
77.456 + | is_rewset _ = false;
77.457 +fun is_rewtac (Rewrite _) = true
77.458 + | is_rewtac (Rewrite_Inst _) = true
77.459 + | is_rewtac (Rewrite_Asm _) = true
77.460 + | is_rewtac tac = is_rewset tac;
77.461 +
77.462 +fun tac2IDstr (ma:tac) = case ma of
77.463 + Model_Problem => "Model_Problem"
77.464 + | Refine_Tacitly pblID => "Refine_Tacitly"
77.465 + | Refine_Problem pblID => "Refine_Problem"
77.466 + | Add_Given cterm' => "Add_Given"
77.467 + | Del_Given cterm' => "Del_Given"
77.468 + | Add_Find cterm' => "Add_Find"
77.469 + | Del_Find cterm' => "Del_Find"
77.470 + | Add_Relation cterm' => "Add_Relation"
77.471 + | Del_Relation cterm' => "Del_Relation"
77.472 +
77.473 + | Specify_Theory domID => "Specify_Theory"
77.474 + | Specify_Problem pblID => "Specify_Problem"
77.475 + | Specify_Method metID => "Specify_Method"
77.476 + | Apply_Method metID => "Apply_Method"
77.477 + | Check_Postcond pblID => "Check_Postcond"
77.478 + | Free_Solve => "Free_Solve"
77.479 +
77.480 + | Rewrite_Inst (subs,thm')=> "Rewrite_Inst"
77.481 + | Rewrite thm' => "Rewrite"
77.482 + | Rewrite_Asm thm' => "Rewrite_Asm"
77.483 + | Rewrite_Set_Inst (subs, rls) => "Rewrite_Set_Inst"
77.484 + | Rewrite_Set rls => "Rewrite_Set"
77.485 + | Detail_Set rls => "Detail_Set"
77.486 + | Detail_Set_Inst (subs, rls) => "Detail_Set_Inst"
77.487 + | Derive rls' => "Derive "
77.488 + | Calculate op_ => "Calculate "
77.489 + | Substitute subs => "Substitute"
77.490 + | Apply_Assumption ct's => "Apply_Assumption"
77.491 +
77.492 + | Take cterm' => "Take"
77.493 + | Take_Inst cterm' => "Take_Inst"
77.494 + | Group (con, ints) => "Group"
77.495 + | Subproblem (domID, pblID) => "Subproblem"
77.496 + | End_Subproblem => "End_Subproblem"
77.497 + | CAScmd cterm' => "CAScmd"
77.498 +
77.499 + | Check_elementwise cterm'=> "Check_elementwise"
77.500 + | Or_to_List => "Or_to_List "
77.501 + | Collect_Trues => "Collect_Trues"
77.502 +
77.503 + | Empty_Tac => "Empty_Tac"
77.504 + | Tac string => "Tac "
77.505 + | User => "User"
77.506 + | End_Proof' => "End_Proof'"
77.507 + | _ => "tac2str not impl. for ?!";
77.508 +
77.509 +fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
77.510 + | rls_of (Rewrite_Set rls) = rls
77.511 + | rls_of tac = raise error ("rls_of: called with tac '"^tac2IDstr tac^"'");
77.512 +
77.513 +fun thm_of_rew (Rewrite_Inst (subs,(thmID,_))) =
77.514 + (thmID, Some ((subs2subst (assoc_thy "Isac.thy") subs):subst))
77.515 + | thm_of_rew (Rewrite (thmID,_)) = (thmID, None)
77.516 + | thm_of_rew (Rewrite_Asm (thmID,_)) = (thmID, None);
77.517 +
77.518 +fun rls_of_rewset (Rewrite_Set_Inst (subs,rls)) =
77.519 + (rls, Some ((subs2subst (assoc_thy "Isac.thy") subs):subst))
77.520 + | rls_of_rewset (Rewrite_Set rls) = (rls, None)
77.521 + | rls_of_rewset (Detail_Set rls) = (rls, None)
77.522 + | rls_of_rewset (Detail_Set_Inst (subs, rls)) =
77.523 + (rls, Some ((subs2subst (assoc_thy "Isac.thy") subs):subst));
77.524 +
77.525 +fun rule2tac _ (Calc (opID, thm)) = Calculate (calID2calcID opID)
77.526 + | rule2tac [] (Thm (thmID, thm)) = Rewrite (thmID, string_of_thmI thm)
77.527 + | rule2tac subst (Thm (thmID, thm)) =
77.528 + Rewrite_Inst (subst2subs subst, (thmID, string_of_thmI thm))
77.529 + | rule2tac [] (Rls_ rls) = Rewrite_Set (id_rls rls)
77.530 + | rule2tac subst (Rls_ rls) =
77.531 + Rewrite_Set_Inst (subst2subs subst, (id_rls rls))
77.532 + | rule2tac _ rule =
77.533 + raise error ("rule2tac: called with '" ^ rule2str rule ^ "'");
77.534 +
77.535 +type fmz_ = cterm' list;
77.536 +
77.537 +(*.a formalization of an example containing data
77.538 + sufficient for mechanically finding the solution for the example.*)
77.539 +(*FIXME.WN051014: dont store fmz = (_,spec) in the PblObj,
77.540 + this is done in origin*)
77.541 +type fmz = fmz_ * spec;
77.542 +val e_fmz = ([],e_spec);
77.543 +
77.544 +(*tac_ is made from tac in applicable_in,
77.545 + and carries all data necessary for generate;*)
77.546 +datatype tac_ =
77.547 +(* datatype tac = *)
77.548 + Init_Proof' of ((cterm' list) * spec)
77.549 + (* ori list !: code specify -> applicable*)
77.550 +| Model_Problem' of pblID *
77.551 + itm list * (*the 'untouched' pbl*)
77.552 + itm list (*the casually completed met*)
77.553 +| Refine_Tacitly' of pblID * (*input*)
77.554 + pblID * (*the refined from applicable_in*)
77.555 + domID * (*from new pbt?! filled in specify*)
77.556 + metID * (*from new pbt?! filled in specify*)
77.557 + itm list (*drop ! 9.03: remains [] for
77.558 + Model_Problem recognizing its activation*)
77.559 +| Refine_Problem' of (pblID * (itm list * (bool * Term.term) list))
77.560 + (*FIXME?040215 drop: done automatically in init_proof + Subproblem'*)
77.561 +| Add_Given' of cterm' *
77.562 + itm list (*updated with input in fun specify_additem*)
77.563 +| Add_Find' of cterm' *
77.564 + itm list (*updated with input in fun specify_additem*)
77.565 +| Add_Relation' of cterm' *
77.566 + itm list (*updated with input in fun specify_additem*)
77.567 +| Del_Given' of cterm' | Del_Find' of cterm' | Del_Relation' of cterm'
77.568 + (*4.00.: all.. term: in applicable_in ..? Syn ?only for FormFK?*)
77.569 +
77.570 +| Specify_Theory' of domID
77.571 +| Specify_Problem' of (pblID * (* *)
77.572 + (bool * (* matches *)
77.573 + (itm list * (* ppc *)
77.574 + (bool * term) list))) (* preconditions *)
77.575 +| Specify_Method' of metID *
77.576 + ori list * (*repl. "#undef"*)
77.577 + itm list (*... updated from pbl to met*)
77.578 +| Apply_Method' of metID *
77.579 + (term option) * (*init_form*)
77.580 + istate
77.581 +| Check_Postcond' of
77.582 + pblID *
77.583 + (term * (*returnvalue of script in solve*)
77.584 + cterm' list)(*collect by get_assumptions_ in applicable_in, except if
77.585 + butlast tac is Check_elementwise: take only these asms*)
77.586 +| Free_Solve'
77.587 +
77.588 +| Rewrite_Inst' of theory' * rew_ord' * rls
77.589 + * bool * subst * thm' * term * (term * term list)
77.590 +| Rewrite' of theory' * rew_ord' * rls * bool * thm' *
77.591 + term * (term * term list)
77.592 +| Rewrite_Asm' of theory' * rew_ord' * rls * bool * thm' *
77.593 + term * (term * term list)
77.594 +| Rewrite_Set_Inst' of theory' * bool * subst * rls *
77.595 + term * (term * term list)
77.596 +| Detail_Set_Inst' of theory' * bool * subst * rls *
77.597 + term * (term * term list)
77.598 +| Rewrite_Set' of theory' * bool * rls * term * (term * term list)
77.599 +| Detail_Set' of theory' * bool * rls * term * (term * term list)
77.600 +| End_Detail' of (term * (term list)) (*see End_Trans'*)
77.601 +| End_Ruleset' of term
77.602 +| Derive' of rls
77.603 +| Calculate' of theory' * string * term * (term * thm')
77.604 + (*WN.29.4.03 asm?: * term list??*)
77.605 +| Substitute' of subte (*the 'substitution': terms of type bool*)
77.606 + * term (*to be substituted in*)
77.607 + * term (*resulting from the substitution*)
77.608 +| Apply_Assumption' of term list * term
77.609 +
77.610 +| Take' of term | Take_Inst' of term
77.611 +| Group' of (con * int list * term)
77.612 +| Subproblem' of (spec *
77.613 + (ori list) * (*filled in assod Subproblem'*)
77.614 + term * (*-"-, headline of calc-head *)
77.615 + fmz_ *
77.616 + term) (*Subproblem(dom,pbl)*)
77.617 +| CAScmd' of term
77.618 +| End_Subproblem' of term (*???*)
77.619 +| Split_And' of term | Conclude_And' of term
77.620 +| Split_Or' of term | Conclude_Or' of term
77.621 +| Begin_Trans' of term | End_Trans' of (term * (term list))
77.622 +| Begin_Sequ' | End_Sequ'(* substitute root.env*)
77.623 +| Split_Intersect' of term | End_Intersect' of term
77.624 +| Check_elementwise' of (*special case:*)
77.625 + term * (*(1)the current formula: [x=1,x=...]*)
77.626 + string * (*(2)the pred from Check_elementwise *)
77.627 + (term * (*(3)composed from (1) and (2): {x. pred}*)
77.628 + term list) (*20.5.03 assumptions*)
77.629 +
77.630 +| Or_to_List' of term * term (* (a | b, [a,b]) *)
77.631 +| Collect_Trues' of term
77.632 +
77.633 +| Empty_Tac_ | Tac_ of (*for dummies*)
77.634 + theory *
77.635 + string * (*form*)
77.636 + string * (*in Tac*)
77.637 + string (*result of Tac".."*)
77.638 +| User' (*internal for ets*) | End_Proof'';(*End_Proof:inout*)
77.639 +
77.640 +fun tac_2str ma = case ma of
77.641 + Init_Proof' (ppc, spec) =>
77.642 + "Init_Proof' "^(pair2str (strs2str ppc, spec2str spec))
77.643 + | Model_Problem' (pblID,_,_) => "Model_Problem' "^(strs2str pblID )
77.644 + | Refine_Tacitly'(p,prefin,domID,metID,itms)=>
77.645 + "Refine_Tacitly' ("
77.646 + ^(strs2str p)^", "^(strs2str prefin)^", "
77.647 + ^domID^", "^(strs2str metID)^", pbl-itms)"
77.648 + | Refine_Problem' ms => "Refine_Problem' ("^(*matchs2str ms*)"..."^")"
77.649 +(*| Match_Problem' (pI, (ok, (itms, pre))) =>
77.650 + "Match_Problem' "^(spair2str (strs2str pI,
77.651 + spair2str (bool2str ok,
77.652 + spair2str ("itms2str itms",
77.653 + "items2str pre"))))*)
77.654 + | Add_Given' cterm' => "Add_Given' "(*^cterm'*)
77.655 + | Del_Given' cterm' => "Del_Given' "(*^cterm'*)
77.656 + | Add_Find' cterm' => "Add_Find' "(*^cterm'*)
77.657 + | Del_Find' cterm' => "Del_Find' "(*^cterm'*)
77.658 + | Add_Relation' cterm' => "Add_Relation' "(*^cterm'*)
77.659 + | Del_Relation' cterm' => "Del_Relation' "(*^cterm'*)
77.660 +
77.661 + | Specify_Theory' domID => "Specify_Theory' "^(quote domID )
77.662 + | Specify_Problem' (pI, (ok, (itms, pre))) =>
77.663 + "Specify_Problem' "^(spair2str (strs2str pI,
77.664 + spair2str (bool2str ok,
77.665 + spair2str ("itms2str itms",
77.666 + "items2str pre"))))
77.667 + | Specify_Method' (pI,oris,itms) =>
77.668 + "Specify_Method' ("^metID2str pI^", "^oris2str oris^", )"
77.669 +
77.670 + | Apply_Method' (metID,_,_) => "Apply_Method' "^(strs2str metID)
77.671 + | Check_Postcond' (pblID,(scval,asm)) =>
77.672 + "Check_Postcond' "^(spair2str(strs2str pblID,
77.673 + spair2str (term2str scval, strs2str asm)))
77.674 +
77.675 + | Free_Solve' => "Free_Solve'"
77.676 +
77.677 + | Rewrite_Inst' (*subs,thm'*) _ =>
77.678 + "Rewrite_Inst' "(*^(pair2str (subs2str subs, spair2str thm'))*)
77.679 + | Rewrite' thm' => "Rewrite' "(*^(spair2str thm')*)
77.680 + | Rewrite_Asm' thm' => "Rewrite_Asm' "(*^(spair2str thm')*)
77.681 + | Rewrite_Set_Inst' (*subs,thm'*) _ =>
77.682 + "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
77.683 + | Rewrite_Set'(thy',pasm,rls',f,(f',asm))
77.684 + => "Rewrite_Set' ("^thy'^","^(bool2str pasm)^","^(id_rls rls')^","
77.685 + ^(Sign.string_of_term (sign_of thy) f)^",("^(Sign.string_of_term (sign_of thy) f')
77.686 + ^","^((strs2str o (map (Sign.string_of_term (sign_of thy)))) asm)^"))"
77.687 +
77.688 + | End_Detail' _ => "End_Detail' xxx"
77.689 + | Detail_Set' _ => "Detail_Set' xxx"
77.690 + | Detail_Set_Inst' _ => "Detail_Set_Inst' xxx"
77.691 +
77.692 + | Derive' rls => "Derive' "^id_rls rls
77.693 + | Calculate' _ => "Calculate' "
77.694 + | Substitute' subs => "Substitute' "(*^(subs2str subs)*)
77.695 + | Apply_Assumption' ct's => "Apply_Assumption' "(*^(strs2str ct's)*)
77.696 +
77.697 + | Take' cterm' => "Take' "(*^(quote cterm' )*)
77.698 + | Take_Inst' cterm' => "Take_Inst' "(*^(quote cterm' )*)
77.699 + | Group' (con, ints, _) =>
77.700 + "Group' "^(pair2str (con2str con, ints2str ints))
77.701 + | Subproblem' (spec, oris, _,_,pbl_form) =>
77.702 + "Subproblem' "(*^(pair2str (domID, strs2str ,...))*)
77.703 + | End_Subproblem' _ => "End_Subproblem'"
77.704 + | CAScmd' cterm' => "CAScmd' "(*^(quote cterm')*)
77.705 +
77.706 + | Empty_Tac_ => "Empty_Tac_"
77.707 + | User' => "User'"
77.708 + | Tac_ (_,form,id,result) => "Tac_ (thy,"^form^","^id^","^result^")"
77.709 + | _ => "tac_2str not impl. for arg";
77.710 +
77.711 +(*'executed tactics' (tac_s) with local environment etc.;
77.712 + used for continuing eval script + for generate*)
77.713 +type ets =
77.714 + (loc_ * (* of tactic in scr, tactic (weakly) associated with tac_*)
77.715 + (tac_ * (* (for generate) *)
77.716 + env * (* with 'tactic=result' as a rule, tactic ev. _not_ ready:
77.717 + for handling 'parallel let'*)
77.718 + env * (* with results of (ready) tacs *)
77.719 + term * (* itr_arg of tactic, for upd. env at Repeat, Try*)
77.720 + term * (* result value of the tac *)
77.721 + safe))
77.722 + list;
77.723 +val Ets = []:ets;
77.724 +
77.725 +
77.726 +fun ets2s (l,(m,eno,env,iar,res,s)) =
77.727 + "\n("^(loc_2str l)^",("^(tac_2str m)^
77.728 + ",\n ens= "^(subst2str eno)^
77.729 + ",\n env= "^(subst2str env)^
77.730 + ",\n iar= "^(Sign.string_of_term (sign_of thy) iar)^
77.731 + ",\n res= "^(Sign.string_of_term (sign_of thy) res)^
77.732 + ",\n "^(safe2str s)^"))";
77.733 +fun ets2str (ets:ets) = (strs2str o (map ets2s)) ets;
77.734 +
77.735 +
77.736 +type envp =(*9.5.03: unused, delete with field in ptree.PblObj FIXXXME*)
77.737 + (int * term list) list * (*assoc-list: args of met*)
77.738 + (int * rls) list * (*assoc-list: tacs already done ///15.9.00*)
77.739 + (int * ets) list * (*assoc-list: tacs etc. already done*)
77.740 + (string * pos) list; (*asms * from where*)
77.741 +val empty_envp = ([],[],[],[]):envp;
77.742 +
77.743 +datatype ppobj =
77.744 + PrfObj of {cell : lrd option, (*where in form tac has been applied*)
77.745 + (*^^^FIXME.WN0607 rename this field*)
77.746 + form : term,
77.747 + tac : tac, (* also in istate*)
77.748 + loc : istate option * istate option, (*for form, result
77.749 +13.8.02: (None,None) <==> e_istate ! see update_loc, get_loc*)
77.750 + branch: branch,
77.751 + result: term * term list,
77.752 + ostate: ostate} (*Complete <=> result is OK*)
77.753 + | PblObj of {cell : lrd option,(*unused: meaningful only for some _Prf_Obj*)
77.754 + fmz : fmz, (*from init:FIXME never use this spec;-drop*)
77.755 + origin: (ori list) * (*representation from fmz+pbt
77.756 + for efficiently adding items in probl, meth*)
77.757 + spec * (*updated by Refine_Tacitly*)
77.758 + term, (*headline of calc-head, as calculated
77.759 + initially(!)*)
77.760 + (*# the origin of a root-pbl is created from fmz
77.761 + (thus providing help for input to the user),
77.762 + # the origin of a sub-pbl is created from the argument
77.763 + -list of a script-tac 'SubProblem (spec) [arg-list]'
77.764 + by 'match_ags'*)
77.765 + spec : spec, (*explicitly input*)
77.766 + probl : itm list, (*itms explicitly input*)
77.767 + meth : itm list, (*itms automatically added to copy of probl
77.768 + TODO: input like to 'probl'*)
77.769 + env : istate option,(*for problem with initac in script*)
77.770 + loc : istate option * istate option, (*for pbl+met * result*)
77.771 + branch: branch,
77.772 + result: term * term list,
77.773 + ostate: ostate}; (*Complete <=> result is _proven_ OK*)
77.774 +
77.775 +(*.this tree contains isac's calculations; TODO.WN03 rename to ctree;
77.776 + the structure has been copied from an early version of Theorema(c);
77.777 + it has the disadvantage, that there is no space
77.778 + for the first tactic in a script generating the first formula at (p,Frm);
77.779 + this trouble has been covered by 'init_form' and 'Take' so far,
77.780 + but it is crucial if the first tactic in a script is eg. 'Subproblem';
77.781 + see 'type tac ', Apply_Method.
77.782 +.*)
77.783 +datatype ptree =
77.784 + EmptyPtree
77.785 + | Nd of ppobj * (ptree list);
77.786 +val e_ptree = EmptyPtree;
77.787 +
77.788 +fun rep_prfobj (PrfObj {cell,form,tac,loc,branch,result,ostate}) =
77.789 + {cell=cell,form=form,tac=tac,loc=loc,branch=branch,result=result,ostate=ostate};
77.790 +fun rep_pblobj (PblObj {cell,origin,fmz,spec,probl,meth,env,
77.791 + loc,branch,result,ostate}) =
77.792 + {cell=cell,origin=origin,fmz=fmz,spec=spec,probl=probl,meth=meth,
77.793 + env=env,loc=loc,branch=branch,result=result,ostate=ostate};
77.794 +fun is_prfobj (PrfObj _) = true
77.795 + | is_prfobj _ =false;
77.796 +(*val is_prfobj' = get_obj is_prfobj; *)
77.797 +fun is_pblobj (PblObj _) = true
77.798 + | is_pblobj _ = false;
77.799 +(*val is_pblobj' = get_obj is_pblobj; 'Error: unbound constructor get_obj'*)
77.800 +
77.801 +
77.802 +exception PTREE of string;
77.803 +fun nth _ [] = raise PTREE "nth _ []"
77.804 + | nth 1 (x::xs) = x
77.805 + | nth n (x::xs) = nth (n-1) xs;
77.806 +(*> nth 2 [11,22,33]; -->> val it = 22 : int*)
77.807 +
77.808 +fun lev_up ([]:pos) = raise PTREE "lev_up []"
77.809 + | lev_up p = (drop_last p):pos;
77.810 +fun lev_on ([]:pos) = raise PTREE "lev_on []"
77.811 + | lev_on pos =
77.812 + let val len = length pos
77.813 + in (drop_last pos) @ [(nth len pos)+1] end;
77.814 +fun lev_onFrm ((p,_):pos') = (lev_on p,Frm):pos'
77.815 + | lev_onFrm p = raise PTREE ("*** lev_onFrm: pos'="^(pos'2str p));
77.816 +(*040216: for inform --> embed_deriv: remains on same level*)
77.817 +fun lev_back (([],_):pos') = raise PTREE "lev_on_back: called by ([],_)"
77.818 + | lev_back (p,_) =
77.819 + if last_elem p <= 1 then (p, Frm):pos'
77.820 + else ((drop_last p) @ [(nth (length p) p) - 1], Res);
77.821 +(*.increase pos by n within a level.*)
77.822 +fun pos_plus 0 pos = pos
77.823 + | pos_plus n ((p,Frm):pos') = pos_plus (n-1) (p, Res)
77.824 + | pos_plus n ((p, _):pos') = pos_plus (n-1) (lev_on p, Res);
77.825 +
77.826 +
77.827 +
77.828 +fun lev_pred ([]:pos) = raise PTREE "lev_pred []"
77.829 + | lev_pred (pos:pos) =
77.830 + let val len = length pos
77.831 + in ((drop_last pos) @ [(nth len pos)-1]):pos end;
77.832 +(*lev_pred [1,2,3];
77.833 +val it = [1,2,2] : pos
77.834 +> lev_pred [1];
77.835 +val it = [0] : pos *)
77.836 +
77.837 +fun lev_dn p = p @ [0];
77.838 +(*> (lev_dn o lev_on) [1,2,3];
77.839 +val it = [1,2,4,0] : pos *)
77.840 +(*fun lev_dn' ((p,p_):pos') = (lev_dn p, Frm):pos'; WN.3.12.03: never used*)
77.841 +fun lev_dnRes ((p,_):pos') = (lev_dn p, Res):pos';
77.842 +
77.843 +(*4.4.00*)
77.844 +fun lev_up_ ((p,Res):pos') = (lev_up p,Res):pos'
77.845 + | lev_up_ p' = raise error ("lev_up_: called for "^(pos'2str p'));
77.846 +fun lev_dn_ ((p,_):pos') = (lev_dn p,Res):pos'
77.847 +fun ind ((p,_):pos') = length p; (*WN050108 deprecated in favour of lev_of*)
77.848 +fun lev_of ((p,_):pos') = length p;
77.849 +
77.850 +
77.851 +(** convert ptree to a string **)
77.852 +
77.853 +(* convert a pos from list to string *)
77.854 +fun pr_pos ps = (space_implode "." (map string_of_int ps))^". ";
77.855 +(* show hd origin or form only *)
77.856 +fun pr_short (p:pos) (PblObj {origin = (ori,_,_),...}) =
77.857 + ((pr_pos p) ^ " ----- pblobj -----\n")
77.858 +(* ((((Sign.string_of_term (sign_of thy)) o #4 o hd) ori)^" "^
77.859 + (((Sign.string_of_term (sign_of thy)) o hd(*!?!*) o #5 o hd) ori))^
77.860 + "\n") *)
77.861 + | pr_short p (PrfObj {form = form,...}) =
77.862 + ((pr_pos p) ^ (term2str form) ^ "\n");
77.863 +(*
77.864 +fun pr_cell (p:pos) (PblObj {cell = c, origin = (ori,_,_),...}) =
77.865 + ((ints2str c) ^" "^
77.866 + ((((Sign.string_of_term (sign_of thy)) o #4 o hd) ori)^" "^
77.867 + (((Sign.string_of_term (sign_of thy)) o hd(*!?!*) o #5 o hd) ori))^
77.868 + "\n")
77.869 + | pr_cell p (PrfObj {cell = c, form = form,...}) =
77.870 + ((ints2str c) ^" "^ (term2str form) ^ "\n");
77.871 +*)
77.872 +
77.873 +(* convert ptree *)
77.874 +fun pr_ptree f pt =
77.875 + let
77.876 + fun pr_pt pfn _ EmptyPtree = ""
77.877 + | pr_pt pfn ps (Nd (b, [])) = pfn ps b
77.878 + | pr_pt pfn ps (Nd (b, ts)) = (pfn ps b)^
77.879 + (prts pfn (ps:pos) 1 ts)
77.880 + and prts pfn ps p [] = ""
77.881 + | prts pfn ps p (t::ts) = (pr_pt pfn (ps @ [p]) t)^
77.882 + (prts pfn ps (p+1) ts)
77.883 + in pr_pt f [] pt end;
77.884 +(*
77.885 +> fun prfn ps b = (pr_pos ps)^" "^b(*TODO*)^"\n";
77.886 +> val pt = ref EmptyPtree;
77.887 +> pt:=Nd("root",
77.888 + [Nd("xx1",[]),
77.889 + Nd("xx2",
77.890 + [Nd("xx2.1.",[]),
77.891 + Nd("xx2.2.",[])]),
77.892 + Nd("xx3",[])]);
77.893 +> writeln (pr_ptree prfn (!pt));
77.894 +*)
77.895 +
77.896 +
77.897 +(** access the branches of ptree **)
77.898 +
77.899 +fun ins_nth 1 e l = e::l
77.900 + | ins_nth n e [] = raise PTREE "ins_nth n e []"
77.901 + | ins_nth n e (l::ls) = l::(ins_nth (n-1) e ls);
77.902 +fun repl [] _ _ = raise PTREE "repl [] _ _"
77.903 + | repl (l::ls) 1 e = e::ls
77.904 + | repl (l::ls) n e = l::(repl ls (n-1) e);
77.905 +fun repl_app ls n e =
77.906 + let val lim = 1 + length ls
77.907 + in if n > lim then raise PTREE "repl_app: n > lim"
77.908 + else if n = lim then ls @ [e]
77.909 + else repl ls n e end;
77.910 +(*
77.911 +> repl [1,2,3] 2 22222;
77.912 +val it = [1,22222,3] : int list
77.913 +> repl_app [1,2,3,4] 5 5555;
77.914 +val it = [1,2,3,4,5555] : int list
77.915 +> repl_app [1,2,3] 2 22222;
77.916 +val it = [1,22222,3] : int list
77.917 +> repl_app [1] 2 22222 ;
77.918 +val it = [1,22222] : int list
77.919 +*)
77.920 +
77.921 +
77.922 +(*.get from obj at pos by f : ppobj -> 'a.*)
77.923 +fun get_obj f EmptyPtree (_:pos) = raise PTREE "get_obj f EmptyPtree"
77.924 + | get_obj f (Nd (b, _)) [] = f b
77.925 + | get_obj f (Nd (b, bs)) (p::ps) =
77.926 +(* val (f, Nd (b, bs), (p::ps)) = (I, pt, p);
77.927 + *)
77.928 + let val _ = (nth p bs) handle _ => raise PTREE ("get_obj: pos = "^
77.929 + (ints2str' (p::ps))^" does not exist");
77.930 + in (get_obj f (nth p bs) (ps:pos))
77.931 + (*before WN050419: 'wrong type..' raised also if pos doesn't exist*)
77.932 + handle _ => raise PTREE (*"get_obj: at pos = "^
77.933 + (ints2str' (p::ps))^" wrong type of ppobj"*)
77.934 + ("get_obj: pos = "^
77.935 + (ints2str' (p::ps))^" does not exist")
77.936 + end;
77.937 +fun get_nd EmptyPtree _ = raise PTREE "get_nd EmptyPtree"
77.938 + | get_nd n [] = n
77.939 + | get_nd (Nd (_,nds)) (pos as p::(ps:pos)) = (get_nd (nth p nds) ps)
77.940 + handle _ => raise PTREE ("get_nd: not existent pos = "^(ints2str' pos));
77.941 +
77.942 +
77.943 +(* for use by get_obj *)
77.944 +fun g_cell (PblObj {cell = c,...}) = None
77.945 + | g_cell (PrfObj {cell = c,...}) = c;(*WN0607 hack for quick introduction of lrd + rewrite-at (thms, calcs)*)
77.946 +fun g_form (PrfObj {form = f,...}) = f
77.947 + | g_form (PblObj {origin=(_,_,f),...}) = f;
77.948 +fun g_form' (Nd (PrfObj {form = f,...}, _)) = f
77.949 + | g_form' (Nd (PblObj {origin=(_,_,f),...}, _)) = f;
77.950 +(* | g_form _ = raise PTREE "g_form not for PblObj";*)
77.951 +fun g_origin (PblObj {origin = ori,...}) = ori
77.952 + | g_origin _ = raise PTREE "g_origin not for PrfObj";
77.953 +fun g_fmz (PblObj {fmz = f,...}) = f
77.954 + | g_fmz _ = raise PTREE "g_fmz not for PrfObj";
77.955 +fun g_spec (PblObj {spec = s,...}) = s
77.956 + | g_spec _ = raise PTREE "g_spec not for PrfObj";
77.957 +fun g_pbl (PblObj {probl = p,...}) = p
77.958 + | g_pbl _ = raise PTREE "g_pbl not for PrfObj";
77.959 +fun g_met (PblObj {meth = p,...}) = p
77.960 + | g_met _ = raise PTREE "g_met not for PrfObj";
77.961 +fun g_domID (PblObj {spec = (d,_,_),...}) = d
77.962 + | g_domID _ = raise PTREE "g_metID not for PrfObj";
77.963 +fun g_metID (PblObj {spec = (_,_,m),...}) = m
77.964 + | g_metID _ = raise PTREE "g_metID not for PrfObj";
77.965 +fun g_env (PblObj {env,...}) = env
77.966 + | g_env _ = raise PTREE "g_env not for PrfObj";
77.967 +fun g_loc (PblObj {loc = l,...}) = l
77.968 + | g_loc (PrfObj {loc = l,...}) = l;
77.969 +fun g_branch (PblObj {branch = b,...}) = b
77.970 + | g_branch (PrfObj {branch = b,...}) = b;
77.971 +fun g_tac (PblObj {spec = (d,p,m),...}) = Apply_Method m
77.972 + | g_tac (PrfObj {tac = m,...}) = m;
77.973 +fun g_result (PblObj {result = r,...}) = r
77.974 + | g_result (PrfObj {result = r,...}) = r;
77.975 +fun g_res (PblObj {result = (r,_),...}) = r
77.976 + | g_res (PrfObj {result = (r,_),...}) = r;
77.977 +fun g_res' (Nd (PblObj {result = (r,_),...}, _)) = r
77.978 + | g_res' (Nd (PrfObj {result = (r,_),...}, _)) = r;
77.979 +fun g_ostate (PblObj {ostate = r,...}) = r
77.980 + | g_ostate (PrfObj {ostate = r,...}) = r;
77.981 +fun g_ostate' (Nd (PblObj {ostate = r,...}, _)) = r
77.982 + | g_ostate' (Nd (PrfObj {ostate = r,...}, _)) = r;
77.983 +
77.984 +fun gpt_cell (Nd (PblObj {cell = c,...},_)) = None
77.985 + | gpt_cell (Nd (PrfObj {cell = c,...},_)) = c;
77.986 +
77.987 +(*in CalcTree/Subproblem an 'just_created_' model is created;
77.988 + this is filled to 'untouched' by Model/Refine_Problem*)
77.989 +fun just_created_ (PblObj {meth, probl, spec, ...}) =
77.990 + null meth andalso null probl andalso spec = e_spec;
77.991 +val e_origin = ([],e_spec,e_term): (ori list) * spec * term;
77.992 +
77.993 +fun just_created (pt,(p,_):pos') =
77.994 + let val ppobj = get_obj I pt p
77.995 + in is_pblobj ppobj andalso just_created_ ppobj end;
77.996 +
77.997 +(*.does the pos in the ctree exist ?.*)
77.998 +fun existpt pos pt = can (get_obj I pt) pos;
77.999 +(*.does the pos' in the ctree exist, ie. extra check for result in the node.*)
77.1000 +fun existpt' ((p,p_):pos') pt =
77.1001 + if can (get_obj I pt) p
77.1002 + then case p_ of
77.1003 + Res => get_obj g_ostate pt p = Complete
77.1004 + | _ => true
77.1005 + else false;
77.1006 +
77.1007 +(*.is this position appropriate for calculating intermediate steps?.*)
77.1008 +fun is_interpos ((_, Res):pos') = true
77.1009 + | is_interpos _ = false;
77.1010 +
77.1011 +fun last_onlev pt pos = not (existpt (lev_on pos) pt);
77.1012 +
77.1013 +
77.1014 +(*.find the position of the next parent which is a PblObj in ptree.*)
77.1015 +fun par_pblobj pt ([]:pos) = ([]:pos)
77.1016 + | par_pblobj pt p =
77.1017 + let fun par pt [] = []
77.1018 + | par pt p = if is_pblobj (get_obj I pt p) then p
77.1019 + else par pt (lev_up p)
77.1020 + in par pt (lev_up p) end;
77.1021 +(* lev_up for hard_gen operating with pos = [...,0] *)
77.1022 +
77.1023 +(*.find the position and the children of the next parent which is a PblObj.*)
77.1024 +fun par_children (Nd (PblObj _, children)) ([]:pos) = (children, []:pos)
77.1025 + | par_children (pt as Nd (PblObj _, children)) p =
77.1026 + let fun par [] = (children, [])
77.1027 + | par p = let val Nd (obj, children) = get_nd pt p
77.1028 + in if is_pblobj obj then (children, p) else par (lev_up p)
77.1029 + end;
77.1030 + in par (lev_up p) end;
77.1031 +
77.1032 +(*.get the children of a node in ptree.*)
77.1033 +fun children (Nd (PblObj _, cn)) = cn
77.1034 + | children (Nd (PrfObj _, cn)) = cn;
77.1035 +
77.1036 +
77.1037 +(*.find the next parent, which is either a PblObj (return true)
77.1038 + or a PrfObj with tac = Detail_Set (return false).*)
77.1039 +(*FIXME.3.4.03:re-organize par_pbl_det after rls' --> rls*)
77.1040 +fun par_pbl_det pt ([]:pos) = (true, []:pos, Erls)
77.1041 + | par_pbl_det pt p =
77.1042 + let fun par pt [] = (true, [], Erls)
77.1043 + | par pt p = if is_pblobj (get_obj I pt p) then (true, p, Erls)
77.1044 + else case get_obj g_tac pt p of
77.1045 + (*Detail_Set rls' => (false, p, assoc_rls rls')
77.1046 + (*^^^--- before 040206 after ---vvv*)
77.1047 + |*)Rewrite_Set rls' => (false, p, assoc_rls rls')
77.1048 + | Rewrite_Set_Inst (_, rls') =>
77.1049 + (false, p, assoc_rls rls')
77.1050 + | _ => par pt (lev_up p)
77.1051 + in par pt (lev_up p) end;
77.1052 +
77.1053 +
77.1054 +
77.1055 +
77.1056 +(*.get from the whole ptree by f : ppobj -> 'a.*)
77.1057 +fun get_all f EmptyPtree = []
77.1058 + | get_all f (Nd (b, [])) = [f b]
77.1059 + | get_all f (Nd (b, bs)) = [f b] @ (get_alls f bs)
77.1060 +and get_alls f [] = []
77.1061 + | get_alls f pts = flat (map (get_all f) pts);
77.1062 +
77.1063 +
77.1064 +(*.insert obj b into ptree at pos, ev.overwriting this pos.*)
77.1065 +fun insert b EmptyPtree ([]:pos) = Nd (b, [])
77.1066 + | insert b EmptyPtree _ = raise PTREE "insert b Empty _"
77.1067 + | insert b (Nd ( _, _)) [] = raise PTREE "insert b _ []"
77.1068 + | insert b (Nd (b', bs)) (p::[]) =
77.1069 + Nd (b', repl_app bs p (Nd (b,[])))
77.1070 + | insert b (Nd (b', bs)) (p::ps) =
77.1071 + Nd (b', repl_app bs p (insert b (nth p bs) ps));
77.1072 +(*
77.1073 +> type ppobj = string;
77.1074 +> writeln (pr_ptree prfn (!pt));
77.1075 + val pt = ref Empty;
77.1076 + pt:= insert ("root":ppobj) EmptyPtree [];
77.1077 + pt:= insert ("xx1":ppobj) (!pt) [1];
77.1078 + pt:= insert ("xx2":ppobj) (!pt) [2];
77.1079 + pt:= insert ("xx3":ppobj) (!pt) [3];
77.1080 + pt:= insert ("xx2.1":ppobj) (!pt) [2,1];
77.1081 + pt:= insert ("xx2.2":ppobj) (!pt) [2,2];
77.1082 + pt:= insert ("xx2.1.1":ppobj) (!pt) [2,1,1];
77.1083 + pt:= insert ("xx2.1.2":ppobj) (!pt) [2,1,2];
77.1084 + pt:= insert ("xx2.1.3":ppobj) (!pt) [2,1,3];
77.1085 +*)
77.1086 +
77.1087 +(*.insert children to a node without children.*)
77.1088 +(*compare: fun insert*)
77.1089 +fun ins_chn _ EmptyPtree (_:pos) = raise PTREE "ins_chn: EmptyPtree"
77.1090 + | ins_chn ns (Nd _) [] = raise PTREE "ins_chn: pos = []"
77.1091 + | ins_chn ns (Nd (b, bs)) (p::[]) =
77.1092 + if p > length bs then raise PTREE "ins_chn: pos not existent"
77.1093 + else let val Nd (b', bs') = nth p bs
77.1094 + in if null bs' then Nd (b, repl_app bs p (Nd (b', ns)))
77.1095 + else raise PTREE "ins_chn: pos mustNOT be overwritten" end
77.1096 + | ins_chn ns (Nd (b, bs)) (p::ps) =
77.1097 + Nd (b, repl_app bs p (ins_chn ns (nth p bs) ps));
77.1098 +
77.1099 +(* print_depth 11;ins_chn;print_depth 3; ###insert#########################*);
77.1100 +
77.1101 +
77.1102 +(** apply f to obj at pos, f: ppobj -> ppobj **)
77.1103 +
77.1104 +fun appl_to_node f (Nd (b,bs)) = Nd (f b, bs);
77.1105 +fun appl_obj f EmptyPtree [] = EmptyPtree
77.1106 + | appl_obj f EmptyPtree _ = raise PTREE "appl_obj f Empty _"
77.1107 + | appl_obj f (Nd (b, bs)) [] = Nd (f b, bs)
77.1108 + | appl_obj f (Nd (b, bs)) (p::[]) =
77.1109 + Nd (b, repl_app bs p (((appl_to_node f) o (nth p)) bs))
77.1110 + | appl_obj f (Nd (b, bs)) (p::ps) =
77.1111 + Nd (b, repl_app bs p (appl_obj f (nth p bs) (ps:pos)));
77.1112 +
77.1113 +(* for use by appl_obj *)
77.1114 +fun repl_form f (PrfObj {cell=c,form= _,tac=tac,loc=loc,
77.1115 + branch=branch,result=result,ostate=ostate}) =
77.1116 + PrfObj {cell=c,form= f,tac=tac,loc=loc,
77.1117 + branch=branch,result=result,ostate=ostate}
77.1118 + | repl_form _ _ = raise PTREE "repl_form takes no PblObj";
77.1119 +fun repl_pbl x (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1120 + spec=spec,probl=_,meth=meth,env=env,loc=loc,
77.1121 + branch=branch,result=result,ostate=ostate}) =
77.1122 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=spec,probl= x,
77.1123 + meth=meth,env=env,loc=loc,branch=branch,result=result,ostate=ostate}
77.1124 + | repl_pbl _ _ = raise PTREE "repl_pbl takes no PrfObj";
77.1125 +fun repl_met x (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1126 + spec=spec,probl=probl,meth=_,env=env,loc=loc,
77.1127 + branch=branch,result=result,ostate=ostate}) =
77.1128 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=spec,probl=probl,
77.1129 + meth= x,env=env,loc=loc,branch=branch,result=result,ostate=ostate}
77.1130 + | repl_met _ _ = raise PTREE "repl_pbl takes no PrfObj";
77.1131 +
77.1132 +fun repl_spec x (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1133 + spec= _,probl=probl,meth=meth,env=env,loc=loc,
77.1134 + branch=branch,result=result,ostate=ostate}) =
77.1135 + PblObj {cell=cell,origin=origin,fmz=fmz,spec= x,probl=probl,
77.1136 + meth=meth,env=env,loc=loc,branch=branch,result=result,ostate=ostate}
77.1137 + | repl_spec _ _ = raise PTREE "repl_domID takes no PrfObj";
77.1138 +fun repl_domID x (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1139 + spec=(_,p,m),probl=probl,meth=meth,env=env,loc=loc,
77.1140 + branch=branch,result=result,ostate=ostate}) =
77.1141 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=(x,p,m),probl=probl,
77.1142 + meth=meth,env=env,loc=loc,branch=branch,result=result,ostate=ostate}
77.1143 + | repl_domID _ _ = raise PTREE "repl_domID takes no PrfObj";
77.1144 +fun repl_pblID x (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1145 + spec=(d,_,m),probl=probl,meth=meth,env=env,loc=loc,
77.1146 + branch=branch,result=result,ostate=ostate}) =
77.1147 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=(d,x,m),probl=probl,
77.1148 + meth=meth,env=env,loc=loc,branch=branch,result=result,ostate=ostate}
77.1149 + | repl_pblID _ _ = raise PTREE "repl_pblID takes no PrfObj";
77.1150 +fun repl_metID x (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1151 + spec=(d,p,_),probl=probl,meth=meth,env=env,loc=loc,
77.1152 + branch=branch,result=result,ostate=ostate}) =
77.1153 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=(d,p,x),probl=probl,
77.1154 + meth=meth,env=env,loc=loc,branch=branch,result=result,ostate=ostate}
77.1155 + | repl_metID _ _ = raise PTREE "repl_metID takes no PrfObj";
77.1156 +
77.1157 +fun repl_result l f' s (PrfObj {cell=cell,form=form,tac=tac,loc=_,
77.1158 + branch=branch,result = _ ,ostate = _}) =
77.1159 + PrfObj {cell=cell,form=form,tac=tac,loc= l,
77.1160 + branch=branch,result = f',ostate = s}
77.1161 + | repl_result l f' s (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1162 + spec=spec,probl=probl,meth=meth,env=env,loc=_,
77.1163 + branch=branch,result= _ ,ostate= _}) =
77.1164 + PblObj {cell=cell,origin=origin,fmz=fmz,
77.1165 + spec=spec,probl=probl,meth=meth,env=env,loc= l,
77.1166 + branch=branch,result= f',ostate= s};
77.1167 +
77.1168 +fun repl_tac x (PrfObj {cell=cell,form=form,tac= _,loc=loc,
77.1169 + branch=branch,result=result,ostate=ostate}) =
77.1170 + PrfObj {cell=cell,form=form,tac= x,loc=loc,
77.1171 + branch=branch,result=result,ostate=ostate}
77.1172 + | repl_tac _ _ = raise PTREE "repl_tac takes no PblObj";
77.1173 +
77.1174 +fun repl_branch b (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1175 + spec=spec,probl=probl,meth=meth,env=env,loc=loc,
77.1176 + branch= _,result=result,ostate=ostate}) =
77.1177 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=spec,probl=probl,
77.1178 + meth=meth,env=env,loc=loc,branch= b,result=result,ostate=ostate}
77.1179 + | repl_branch b (PrfObj {cell=cell,form=form,tac=tac,loc=loc,
77.1180 + branch= _,result=result,ostate=ostate}) =
77.1181 + PrfObj {cell=cell,form=form,tac=tac,loc=loc,
77.1182 + branch= b,result=result,ostate=ostate};
77.1183 +
77.1184 +fun repl_env e
77.1185 + (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1186 + spec=spec,probl=probl,meth=meth,env=_,loc=loc,
77.1187 + branch=branch,result=result,ostate=ostate}) =
77.1188 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=spec,probl=probl,
77.1189 + meth=meth,env=e,loc=loc,branch=branch,
77.1190 + result=result,ostate=ostate}
77.1191 + | repl_env _ _ = raise PTREE "repl_ets takes no PrfObj";
77.1192 +
77.1193 +fun repl_oris oris
77.1194 + (PblObj {cell=cell,origin=(_,spe,hdf),fmz=fmz,
77.1195 + spec=spec,probl=probl,meth=meth,env=env,loc=loc,
77.1196 + branch=branch,result=result,ostate=ostate}) =
77.1197 + PblObj{cell=cell,origin=(oris,spe,hdf),fmz=fmz,spec=spec,probl=probl,
77.1198 + meth=meth,env=env,loc=loc,branch=branch,
77.1199 + result=result,ostate=ostate}
77.1200 + | repl_oris _ _ = raise PTREE "repl_oris takes no PrfObj";
77.1201 +fun repl_orispec spe
77.1202 + (PblObj {cell=cell,origin=(oris,_,hdf),fmz=fmz,
77.1203 + spec=spec,probl=probl,meth=meth,env=env,loc=loc,
77.1204 + branch=branch,result=result,ostate=ostate}) =
77.1205 + PblObj{cell=cell,origin=(oris,spe,hdf),fmz=fmz,spec=spec,probl=probl,
77.1206 + meth=meth,env=env,loc=loc,branch=branch,
77.1207 + result=result,ostate=ostate}
77.1208 + | repl_orispec _ _ = raise PTREE "repl_orispec takes no PrfObj";
77.1209 +
77.1210 +fun repl_loc l (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1211 + spec=spec,probl=probl,meth=meth,env=env,loc=_,
77.1212 + branch=branch,result=result,ostate=ostate}) =
77.1213 + PblObj {cell=cell,origin=origin,fmz=fmz,spec=spec,probl=probl,
77.1214 + meth=meth,env=env,loc=l,branch=branch,result=result,ostate=ostate}
77.1215 + | repl_loc l (PrfObj {cell=cell,form=form,tac=tac,loc=_,
77.1216 + branch=branch,result=result,ostate=ostate}) =
77.1217 + PrfObj {cell=cell,form=form,tac=tac,loc= l,
77.1218 + branch=branch,result=result,ostate=ostate};
77.1219 +(*
77.1220 +fun uni__cid cell'
77.1221 + (PblObj {cell=cell,origin=origin,fmz=fmz,
77.1222 + spec=spec,probl=probl,meth=meth,env=env,loc=loc,
77.1223 + branch=branch,result=result,ostate=ostate}) =
77.1224 + PblObj {cell=cell union cell',origin=origin,fmz=fmz,spec=spec,probl=probl,
77.1225 + meth=meth,env=env,loc=loc,branch=branch,
77.1226 + result=result,ostate=ostate}
77.1227 + | uni__cid cell'
77.1228 + (PrfObj {cell=cell,form=form,tac=tac,loc=loc,
77.1229 + branch=branch,result=result,ostate=ostate}) =
77.1230 + PrfObj {cell=cell union cell',form=form,tac=tac,loc=loc,
77.1231 + branch=branch,result=result,ostate=ostate};
77.1232 +*)
77.1233 +
77.1234 +(*WN050219 put here for interpreting code for cut_tree below...*)
77.1235 +type ocalhd =
77.1236 + bool * (*ALL itms+preconds true*)
77.1237 + pos_ * (*model belongs to Problem | Method*)
77.1238 + term * (*header: Problem... or Cas
77.1239 + FIXXXME.12.03: item! for marking syntaxerrors*)
77.1240 + itm list * (*model: given, find, relate*)
77.1241 + ((bool * term) list) *(*model: preconds*)
77.1242 + spec; (*specification*)
77.1243 +val e_ocalhd = (false, Und, e_term, [e_itm], [(false, e_term)], e_spec);
77.1244 +
77.1245 +datatype ptform =
77.1246 + Form of term
77.1247 + | ModSpec of ocalhd;
77.1248 +val e_ptform = Form e_term;
77.1249 +val e_ptform' = ModSpec e_ocalhd;
77.1250 +
77.1251 +
77.1252 +
77.1253 +(*.applies (snd f) to the branches at a pos if ((fst f) b),
77.1254 + f : (ppobj -> bool) * (int -> ptree list -> ptree list).*)
77.1255 +
77.1256 +fun appl_branch f EmptyPtree [] = (EmptyPtree, false)
77.1257 + | appl_branch f EmptyPtree _ = raise PTREE "appl_branch f Empty _"
77.1258 + | appl_branch f (Nd ( _, _)) [] = raise PTREE "appl_branch f _ []"
77.1259 + | appl_branch f (Nd (b, bs)) (p::[]) =
77.1260 + if (fst f) b then (Nd (b, (snd f) (p:posel) bs), true)
77.1261 + else (Nd (b, bs), false)
77.1262 + | appl_branch f (Nd (b, bs)) (p::ps) =
77.1263 + let val (b',bool) = appl_branch f (nth p bs) ps
77.1264 + in (Nd (b, repl_app bs p b'), bool) end;
77.1265 +
77.1266 +(* for cut_level; appl_branch(deprecated) *)
77.1267 +fun test_trans (PrfObj{branch = Transitive,...}) = true
77.1268 + | test_trans (PblObj{branch = Transitive,...}) = true
77.1269 + | test_trans _ = false;
77.1270 +
77.1271 +fun is_pblobj' pt (p:pos) =
77.1272 + let val ppobj = get_obj I pt p
77.1273 + in is_pblobj ppobj end;
77.1274 +
77.1275 +
77.1276 +fun delete_result pt (p:pos) =
77.1277 + (appl_obj (repl_result (fst (get_obj g_loc pt p), None)
77.1278 + (e_term,[]) Incomplete) pt p);
77.1279 +
77.1280 +fun del_res (PblObj {cell, fmz, origin, spec, probl, meth,
77.1281 + env, loc=(l1,_), branch, result, ostate}) =
77.1282 + PblObj {cell=cell,fmz=fmz,origin=origin,spec=spec,probl=probl,meth=meth,
77.1283 + env=env, loc=(l1,None), branch=branch, result=(e_term,[]),
77.1284 + ostate=Incomplete}
77.1285 +
77.1286 + | del_res (PrfObj {cell, form, tac, loc=(l1,_), branch, result, ostate}) =
77.1287 + PrfObj {cell=cell,form=form,tac=tac, loc=(l1,None), branch=branch,
77.1288 + result=(e_term,[]), ostate=Incomplete};
77.1289 +
77.1290 +
77.1291 +(*
77.1292 +fun update_fmz pt pos x = appl_obj (repl_fmz x) pt pos;
77.1293 + 1.00 not used anymore*)
77.1294 +
77.1295 +(*FIXME.WN.12.03: update_X X pos pt -> pt could be chained by o (efficiency?)*)
77.1296 +fun update_env pt pos x = appl_obj (repl_env x) pt pos;
77.1297 +fun update_domID pt pos x = appl_obj (repl_domID x) pt pos;
77.1298 +fun update_pblID pt pos x = appl_obj (repl_pblID x) pt pos;
77.1299 +fun update_metID pt pos x = appl_obj (repl_metID x) pt pos;
77.1300 +fun update_spec pt pos x = appl_obj (repl_spec x) pt pos;
77.1301 +
77.1302 +fun update_pbl pt pos x = appl_obj (repl_pbl x) pt pos;
77.1303 +fun update_pblppc pt pos x = appl_obj (repl_pbl x) pt pos;
77.1304 +
77.1305 +fun update_met pt pos x = appl_obj (repl_met x) pt pos;
77.1306 +(*1.09.01 ----
77.1307 +fun update_metppc pt pos x =
77.1308 + let val {rew_ord'=od,rls'=rs,asm_thm=at,asm_rls=ar,...} =
77.1309 + get_obj g_met pt pos
77.1310 + in appl_obj (repl_met
77.1311 + {rew_ord'=od,rls'=rs,asm_thm=at,asm_rls=ar,ppc=x})
77.1312 + pt pos end;*)
77.1313 +fun update_metppc pt pos x = appl_obj (repl_met x) pt pos;
77.1314 +
77.1315 +(*fun union_cid pt pos x = appl_obj (uni__cid x) pt pos;*)
77.1316 +
77.1317 +fun update_branch pt pos x = appl_obj (repl_branch x) pt pos;
77.1318 +fun update_tac pt pos x = appl_obj (repl_tac x) pt pos;
77.1319 +
77.1320 +fun update_oris pt pos x = appl_obj (repl_oris x) pt pos;
77.1321 +fun update_orispec pt pos x = appl_obj (repl_orispec x) pt pos;
77.1322 +
77.1323 + (*done by append_* !! 3.5.02; ununsed WN050305 thus outcommented
77.1324 +fun update_loc pt (p,_) (ScrState ([],[],None,
77.1325 + Const ("empty",_),Sundef,false)) =
77.1326 + appl_obj (repl_loc (None,None)) pt p
77.1327 + | update_loc pt (p,Res) x =
77.1328 + let val (lform,_) = get_obj g_loc pt p
77.1329 + in appl_obj (repl_loc (lform,Some x)) pt p end
77.1330 +
77.1331 + | update_loc pt (p,_) x =
77.1332 + let val (_,lres) = get_obj g_loc pt p
77.1333 + in appl_obj (repl_loc (Some x,lres)) pt p end;-------------*)
77.1334 +
77.1335 +(*WN050305 for handling cut_tree in cappend_atomic -- TODO redesign !*)
77.1336 +fun update_loc' pt p iss = appl_obj (repl_loc iss) pt p;
77.1337 +
77.1338 +(*13.8.02---------------------------
77.1339 +fun get_loc EmptyPtree _ = None
77.1340 + | get_loc pt (p,Res) =
77.1341 + let val (lfrm,lres) = get_obj g_loc pt p
77.1342 + in if lres = e_istate then lfrm else lres end
77.1343 + | get_loc pt (p,_) =
77.1344 + let val (lfrm,lres) = get_obj g_loc pt p
77.1345 + in if lfrm = e_istate then lres else lfrm end; 5.10.00: too liberal ?*)
77.1346 +(*13.8.02: options, because istate is no equalitype any more*)
77.1347 +fun get_loc EmptyPtree _ = e_istate
77.1348 + | get_loc pt (p,Res) =
77.1349 + (case get_obj g_loc pt p of
77.1350 + (Some i, None) => i
77.1351 + | (None , None) => e_istate
77.1352 + | (_ , Some i) => i)
77.1353 + | get_loc pt (p,_) =
77.1354 + (case get_obj g_loc pt p of
77.1355 + (None , Some i) => i (*13.8.02 just copied from ^^^: too liberal ?*)
77.1356 + | (None , None) => e_istate
77.1357 + | (Some i, _) => i);
77.1358 +val get_istate = get_loc; (*3.5.02*)
77.1359 +
77.1360 +(*.collect the assumptions within a problem up to a certain position.*)
77.1361 +type asms = (term * pos) list;(*WN0502 should be (pos' * term) list
77.1362 + ...........===^===*)
77.1363 +
77.1364 +fun get_asm (b:pos, p:pos) (Nd (PblObj {result=(_,asm),...},_)) =
77.1365 + ((*writeln ("### get_asm PblObj:(b,p)= "^
77.1366 + (pair2str(ints2str b, ints2str p)));*)
77.1367 + (map (rpair b) asm):asms)
77.1368 + | get_asm (b, p) (Nd (PrfObj {result=(_,asm),...}, [])) =
77.1369 + ((*writeln ("### get_asm PrfObj []:(b,p)= "^
77.1370 + (pair2str(ints2str b, ints2str p)));*)
77.1371 + (map (rpair b) asm))
77.1372 + | get_asm (b, p:pos) (Nd (PrfObj _, nds)) =
77.1373 + let (*val _= writeln ("### get_asm PrfObj nds:(b,p)= "^
77.1374 + (pair2str(ints2str b, ints2str p)));*)
77.1375 + val levdn =
77.1376 + if p <> [] then (b @ [hd p]:pos, tl p:pos)
77.1377 + else (b @ [1], [99999]) (*_deeper_ nesting is always _before_ p*)
77.1378 + in gets_asm levdn 1 nds end
77.1379 +and gets_asm _ _ [] = []
77.1380 + | gets_asm (b, p' as p::ps) i (nd::nds) =
77.1381 + if p < i then []
77.1382 + else ((*writeln ("### gets_asm: (b,p')= "^(pair2str(ints2str b,
77.1383 + ints2str p')));*)
77.1384 + (get_asm (b @ [i], ps) nd) @ (gets_asm (b, p') (i + 1) nds));
77.1385 +
77.1386 +fun get_assumptions_ (Nd (PblObj {result=(r,asm),...}, cn)) (([], _):pos') =
77.1387 + if r = e_term then gets_asm ([], [99999]) 1 cn
77.1388 + else map (rpair []) asm
77.1389 + | get_assumptions_ pt (p,p_) =
77.1390 + let val (cn, base) = par_children pt p
77.1391 + val offset = drop (length base, p)
77.1392 + val base' = replicate (length base) 1
77.1393 + val offset' = case p_ of
77.1394 + Frm => let val (qs,q) = split_last offset
77.1395 + in qs @ [q - 1] end
77.1396 + | _ => offset
77.1397 + (*val _= writeln ("... get_assumptions: (b,o)= "^
77.1398 + (pair2str(ints2str base',ints2str offset)))*)
77.1399 + in gets_asm (base', offset) 1 cn end;
77.1400 +
77.1401 +
77.1402 +(*---------
77.1403 +end
77.1404 +
77.1405 +open Ptree;
77.1406 +----------*)
77.1407 +
77.1408 +(*pos of the formula on FE relative to the current pos,
77.1409 + which is the next writepos*)
77.1410 +fun pre_pos ([]:pos) = []:pos
77.1411 + | pre_pos pp =
77.1412 + let val (ps,p) = split_last pp
77.1413 + in case p of 1 => ps | n => ps @ [n-1] end;
77.1414 +
77.1415 +(*WN.20.5.03 ... but not used*)
77.1416 +fun posless [] (_::_) = true
77.1417 + | posless (_::_) [] = false
77.1418 + | posless (p::ps) (q::qs) = if p = q then posless ps qs else p < q;
77.1419 +(* posless [2,3,4] [3,4,5];
77.1420 +true
77.1421 +> posless [2,3,4] [1,2,3];
77.1422 +false
77.1423 +> posless [2,3] [2,3,4];
77.1424 +true
77.1425 +> posless [2,3,4] [2,3];
77.1426 +false
77.1427 +> posless [6] [6,5,2];
77.1428 +true
77.1429 ++++ see Isabelle/../library.ML*)
77.1430 +
77.1431 +
77.1432 +(**.development for extracting an 'interval' from ptree.**)
77.1433 +
77.1434 +(*version 1 stopped 8.03 in favour of get_interval with !!!move_dn
77.1435 + actually used (inefficient) version with move_dn: see modspec.sml*)
77.1436 +local
77.1437 +
77.1438 +fun hdp [] = 1 | hdp [0] = 1 | hdp x = hd x;(*start with first*)
77.1439 +fun hdq [] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
77.1440 +fun tlp [] = [0] | tlp [_] = [0] | tlp x = tl x;
77.1441 +fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
77.1442 +
77.1443 +fun getnd i (b,p) q (Nd (po, nds)) =
77.1444 + (if i <= 0 then [[b]] else []) @
77.1445 + (getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
77.1446 + (take_fromto (hdp p) (hdq q) nds))
77.1447 +
77.1448 +and getnds _ _ _ _ [] = [] (*no children*)
77.1449 + | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
77.1450 +
77.1451 + | getnds i true (b,p) q [n1, n2] = (*l-margin, r-margin*)
77.1452 + (getnd i ( b, p ) [99999] n1) @
77.1453 + (getnd ~99999 (lev_on b,[0]) q n2)
77.1454 +
77.1455 + | getnds i _ (b,p) q [n1, n2] = (*intern, r-margin*)
77.1456 + (getnd i ( b,[0]) [99999] n1) @
77.1457 + (getnd ~99999 (lev_on b,[0]) q n2)
77.1458 +
77.1459 + | getnds i true (b,p) q (nd::(nds as _::_)) = (*l-margin, intern*)
77.1460 + (getnd i ( b, p ) [99999] nd) @
77.1461 + (getnds ~99999 false (lev_on b,[0]) q nds)
77.1462 +
77.1463 + | getnds i _ (b,p) q (nd::(nds as _::_)) = (*intern, ...*)
77.1464 + (getnd i ( b,[0]) [99999] nd) @
77.1465 + (getnds ~99999 false (lev_on b,[0]) q nds);
77.1466 +in
77.1467 +(*get an 'interval from to' from a ptree as 'intervals f t' of respective nodes
77.1468 + where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
77.1469 +(1) the 'f' are given
77.1470 +(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
77.1471 +(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
77.1472 +(2) the 't' ar given
77.1473 +(2a) by 'to' if 't' = the respective element of 'to' (right margin)
77.1474 +(2b) inifinity, if 't' < the respective element of 'to (internal node)'
77.1475 +the 'f' and 't' are set by hdp,... *)
77.1476 +fun get_trace pt p q =
77.1477 + (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q)))
77.1478 + (take_fromto (hdp p) (hdq q) (children pt));
77.1479 +end;
77.1480 +(*WN0510 stoppde this development;
77.1481 + actually used (inefficient) version with move_dn: getFormulaeFromTo*)
77.1482 +
77.1483 +
77.1484 +
77.1485 +
77.1486 +fun get_somespec ((dI,pI,mI):spec) ((dI',pI',mI'):spec) =
77.1487 + let val domID = if dI = e_domID
77.1488 + then if dI' = e_domID
77.1489 + then raise error"pt_extract: no domID in probl,origin"
77.1490 + else dI'
77.1491 + else dI
77.1492 + val pblID = if pI = e_pblID
77.1493 + then if pI' = e_pblID
77.1494 + then raise error"pt_extract: no pblID in probl,origin"
77.1495 + else pI'
77.1496 + else pI
77.1497 + val metID = if mI = e_metID
77.1498 + then if pI' = e_metID
77.1499 + then raise error"pt_extract: no metID in probl,origin"
77.1500 + else mI'
77.1501 + else mI
77.1502 + in (domID, pblID, metID):spec end;
77.1503 +fun get_somespec' ((dI,pI,mI):spec) ((dI',pI',mI'):spec) =
77.1504 + let val domID = if dI = e_domID then dI' else dI
77.1505 + val pblID = if pI = e_pblID then pI' else pI
77.1506 + val metID = if mI = e_metID then mI' else mI
77.1507 + in (domID, pblID, metID):spec end;
77.1508 +
77.1509 +(*extract a formula or model from ptree for itms2itemppc or model2xml*)
77.1510 +fun preconds2str bts =
77.1511 + (strs2str o (map (linefeed o pair2str o
77.1512 + (apsnd term2str) o
77.1513 + (apfst bool2str)))) bts;
77.1514 +fun ocalhd2str ((b, p, hdf, itms, prec, spec):ocalhd) =
77.1515 + "("^bool2str b^", "^pos_2str p^", "^term2str hdf^
77.1516 + ", "^itms2str (assoc_thy "Isac.thy") itms^
77.1517 + ", "^preconds2str prec^", \n"^spec2str spec^" )";
77.1518 +
77.1519 +
77.1520 +
77.1521 +fun is_pblnd (Nd (ppobj, _)) = is_pblobj ppobj;
77.1522 +
77.1523 +
77.1524 +(**.functions for the 'ptree iterator' as seen from the FE-Kernel interface.**)
77.1525 +
77.1526 +(*move one step down into existing nodes of ptree; regard TransitiveB
77.1527 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~##################
77.1528 +fun move_dn _ (Nd (c, ns)) ([],p_) = (*root problem*)
77.1529 +(* val (Nd (c, ns), ([],p_)) = (pt, get_pos cI uI);
77.1530 + *)
77.1531 + if is_pblobj c
77.1532 + then case p_ of (*Frm => ([], Pbl) 1.12.03
77.1533 + |*) Res => raise PTREE "move_dn: end of calculation"
77.1534 + | _ => if null ns (*go down from Pbl + Met*)
77.1535 + then raise PTREE "move_dn: solve problem not started"
77.1536 + else ([1], Frm)
77.1537 + else (case p_ of Res => raise PTREE "move_dn: end of (sub-)tree"
77.1538 + | _ => if null ns
77.1539 + then raise PTREE "move_dn: pos not existent 1"
77.1540 + else ([1], Frm))
77.1541 +
77.1542 + (*iterate towards end of pos*)
77.1543 +(* val (P,(Nd (_, ns)),(p::(ps as (_::_)),p_)) = ([]:pos, pt, get_pos cI uI);
77.1544 + val (P,(Nd (_, ns)),(p::(ps as (_::_)),p_)) = ((P@[p]),(nth p ns),(ps, p_));
77.1545 + *)
77.1546 + | move_dn P (Nd (_, ns)) (p::(ps as (_::_)),p_) =
77.1547 + if p > length ns then raise PTREE "move_dn: pos not existent 2"
77.1548 + else move_dn ((P@[p]): pos) (nth p ns) (ps, p_)
77.1549 +(* val (P, (Nd (c, ns)), ([p], p_)) = ((P@[p]), (nth p ns), (ps, p_));
77.1550 + val (P, (Nd (c, ns)), ([p], p_)) = ([],pt,get_pos cI uI);
77.1551 + *)
77.1552 + | move_dn P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
77.1553 + if p > length ns then raise PTREE "move_dn: pos not existent 3"
77.1554 + else if is_pblnd (nth p ns) then
77.1555 + ((*writeln("### move_dn: is_pblnd (nth p ns), P= "^ints2str' P^", \n"^
77.1556 + "length ns= "^((string_of_int o length) ns)^
77.1557 + ", p= "^string_of_int p^", p_= "^pos_2str p_);*)
77.1558 + case p_ of Res => if p = length ns
77.1559 + then if g_ostate c = Complete then (P, Res)
77.1560 + else raise PTREE (ints2str' P^" not complete")
77.1561 + (*FIXME here handle not-sequent-branches*)
77.1562 + else if g_branch c = TransitiveB
77.1563 + andalso (not o is_pblnd o (nth (p+1))) ns
77.1564 + then (P@[p+1], Res)
77.1565 + else (P@[p+1], if is_pblnd (nth (p+1) ns)
77.1566 + then Pbl else Frm)
77.1567 + | _ => if (null o children o (nth p)) ns (*go down from Pbl*)
77.1568 + then raise PTREE "move_dn: solve subproblem not started"
77.1569 + else (P @ [p, 1],
77.1570 + if (is_pblnd o hd o children o (nth p)) ns
77.1571 + then Pbl else Frm)
77.1572 + )
77.1573 + (* val (P, Nd (c, ns), ([p], p_)) = ([], pt, ([1], Frm));
77.1574 + *)
77.1575 + else case p_ of Frm => if (null o children o (nth p)) ns
77.1576 + (*then if g_ostate c = Complete then (P@[p],Res)*)
77.1577 + then if g_ostate' (nth p ns) = Complete
77.1578 + then (P@[p],Res)
77.1579 + else raise PTREE "move_dn: pos not existent 4"
77.1580 + else (P @ [p, 1], (*go down*)
77.1581 + if (is_pblnd o hd o children o (nth p)) ns
77.1582 + then Pbl else Frm)
77.1583 + | Res => if p = length ns
77.1584 + then
77.1585 + if g_ostate c = Complete then (P, Res)
77.1586 + else raise PTREE (ints2str' P^" not complete")
77.1587 + else
77.1588 + if g_branch c = TransitiveB
77.1589 + andalso (not o is_pblnd o (nth (p+1))) ns
77.1590 + then if (null o children o (nth (p+1))) ns
77.1591 + then (P@[p+1], Res)
77.1592 + else (P@[p+1,1], Frm)(*040221*)
77.1593 + else (P@[p+1], if is_pblnd (nth (p+1) ns)
77.1594 + then Pbl else Frm);
77.1595 +*)
77.1596 +(*.move one step down into existing nodes of ptree; skip Res = Frm.nxt;
77.1597 + move_dn at the end of the calc-tree raises PTREE.*)
77.1598 +fun move_dn _ (Nd (c, ns)) ([],p_) = (*root problem*)
77.1599 + (case p_ of
77.1600 + Res => raise PTREE "move_dn: end of calculation"
77.1601 + | _ => if null ns (*go down from Pbl + Met*)
77.1602 + then raise PTREE "move_dn: solve problem not started"
77.1603 + else ([1], Frm))
77.1604 + | move_dn P (Nd (_, ns)) (p::(ps as (_::_)),p_) =(*iterate to end of pos*)
77.1605 + if p > length ns then raise PTREE "move_dn: pos not existent 2"
77.1606 + else move_dn ((P@[p]): pos) (nth p ns) (ps, p_)
77.1607 +
77.1608 + | move_dn P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
77.1609 + if p > length ns then raise PTREE "move_dn: pos not existent 3"
77.1610 + else case p_ of
77.1611 + Res =>
77.1612 + if p = length ns (*last Res on this level: go a level up*)
77.1613 + then if g_ostate c = Complete then (P, Res)
77.1614 + else raise PTREE (ints2str' P^" not complete 1")
77.1615 + else (*go to the next Nd on this level, or down into the next Nd*)
77.1616 + if is_pblnd (nth (p+1) ns) then (P@[p+1], Pbl)
77.1617 + else
77.1618 + if g_res' (nth p ns) = g_form' (nth (p+1) ns)
77.1619 + then if (null o children o (nth (p+1))) ns
77.1620 + then (*take the Res if Complete*)
77.1621 + if g_ostate' (nth (p+1) ns) = Complete
77.1622 + then (P@[p+1], Res)
77.1623 + else raise PTREE (ints2str' (P@[p+1])^
77.1624 + " not complete 2")
77.1625 + else (P@[p+1,1], Frm)(*go down into the next PrfObj*)
77.1626 + else (P@[p+1], Frm)(*take Frm: exists if the Nd exists*)
77.1627 + | Frm => (*go down or to the Res of this Nd*)
77.1628 + if (null o children o (nth p)) ns
77.1629 + then if g_ostate' (nth p ns) = Complete then (P @ [p], Res)
77.1630 + else raise PTREE (ints2str' (P @ [p])^" not complete 3")
77.1631 + else (P @ [p, 1], Frm)
77.1632 + | _ => (*is Pbl or Met*)
77.1633 + if (null o children o (nth p)) ns
77.1634 + then raise PTREE "move_dn:solve subproblem not startd"
77.1635 + else (P @ [p, 1],
77.1636 + if (is_pblnd o hd o children o (nth p)) ns
77.1637 + then Pbl else Frm);
77.1638 +
77.1639 +
77.1640 +(*.go one level down into ptree.*)
77.1641 +fun movelevel_dn [] (Nd (c, ns)) ([],p_) = (*root problem*)
77.1642 + if is_pblobj c
77.1643 + then if null ns
77.1644 + then raise PTREE "solve problem not started"
77.1645 + else ([1], if (is_pblnd o hd) ns then Pbl else Frm)
77.1646 + else raise PTREE "pos not existent 1"
77.1647 +
77.1648 + (*iterate towards end of pos*)
77.1649 + | movelevel_dn P (Nd (_, ns)) (p::(ps as (_::_)),p_) =
77.1650 + if p > length ns then raise PTREE "pos not existent 2"
77.1651 + else movelevel_dn (P@[p]) (nth p ns) (ps, p_)
77.1652 +
77.1653 + | movelevel_dn P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
77.1654 + if p > length ns then raise PTREE "pos not existent 3" else
77.1655 + case p_ of Res =>
77.1656 + if p = length ns
77.1657 + then raise PTREE "no children"
77.1658 + else
77.1659 + if g_branch c = TransitiveB
77.1660 + then if (null o children o (nth (p+1))) ns
77.1661 + then raise PTREE "no children"
77.1662 + else (P @ [p+1, 1],
77.1663 + if (is_pblnd o hd o children o (nth (p+1))) ns
77.1664 + then Pbl else Frm)
77.1665 + else if (null o children o (nth p)) ns
77.1666 + then raise PTREE "no children"
77.1667 + else (P @ [p, 1], if (is_pblnd o hd o children o (nth p)) ns
77.1668 + then Pbl else Frm)
77.1669 + | _ => if (null o children o (nth p)) ns
77.1670 + then raise PTREE "no children"
77.1671 + else (P @ [p, 1], (*go down*)
77.1672 + if (is_pblnd o hd o children o (nth p)) ns
77.1673 + then Pbl else Frm);
77.1674 +
77.1675 +
77.1676 +
77.1677 +(*.go to the previous position in ptree; regard TransitiveB.*)
77.1678 +fun move_up _ (Nd (c, ns)) (([],p_):pos') = (*root problem*)
77.1679 + if is_pblobj c
77.1680 + then case p_ of Res => if null ns then ([], Pbl) (*Res -> Pbl (not Met)!*)
77.1681 + else ([length ns], Res)
77.1682 + | _ => raise PTREE "begin of calculation"
77.1683 + else raise PTREE "pos not existent"
77.1684 +
77.1685 + | move_up P (Nd (_, ns)) (p::(ps as (_::_)),p_) = (*iterate to end of pos*)
77.1686 + if p > length ns then raise PTREE "pos not existent"
77.1687 + else move_up (P@[p]) (nth p ns) (ps,p_)
77.1688 +
77.1689 + | move_up P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
77.1690 + if p > length ns then raise PTREE "pos not existent"
77.1691 + else if is_pblnd (nth p ns) then
77.1692 + case p_ of Res =>
77.1693 + let val nc = (length o children o (nth p)) ns
77.1694 + in if nc = 0 then (P@[p], Pbl) (*Res -> Pbl (not Met)!*)
77.1695 + else (P @ [p, nc], Res) end (*go down*)
77.1696 + | _ => if p = 1 then (P, Pbl) else (P@[p-1], Res)
77.1697 + else case p_ of Frm => if p <> 1 then (P, Frm)
77.1698 + else if is_pblobj c then (P, Pbl) else (P, Frm)
77.1699 + | Res =>
77.1700 + let val nc = (length o children o (nth p)) ns
77.1701 + in if nc = 0 (*cannot go down*)
77.1702 + then if g_branch c = TransitiveB andalso p <> 1
77.1703 + then (P@[p-1], Res) else (P@[p], Frm)
77.1704 + else (P @ [p, nc], Res) end; (*go down*)
77.1705 +
77.1706 +
77.1707 +
77.1708 +(*.go one level up in ptree; sets the position on Frm.*)
77.1709 +fun movelevel_up _ (Nd (c, ns)) (([],p_):pos') = (*root problem*)
77.1710 + raise PTREE "pos not existent"
77.1711 +
77.1712 + (*iterate towards end of pos*)
77.1713 + | movelevel_up P (Nd (_, ns)) (p::(ps as (_::_)),p_) =
77.1714 + if p > length ns then raise PTREE "pos not existent"
77.1715 + else movelevel_up (P@[p]) (nth p ns) (ps,p_)
77.1716 +
77.1717 + | movelevel_up P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
77.1718 + if p > length ns then raise PTREE "pos not existent"
77.1719 + else if is_pblobj c then (P, Pbl) else (P, Frm);
77.1720 +
77.1721 +
77.1722 +(*.go to the next calc-head up in the calc-tree.*)
77.1723 +fun movecalchd_up pt ((p, Res):pos') =
77.1724 + (par_pblobj pt p, Pbl):pos'
77.1725 + | movecalchd_up pt (p, _) =
77.1726 + if is_pblobj (get_obj I pt p)
77.1727 + then (p, Pbl) else (par_pblobj pt p, Pbl);
77.1728 +
77.1729 +(*.determine the previous pos' on the same level.*)
77.1730 +(*WN0502 made for interSteps; _only_ works for branch TransitiveB*)
77.1731 +fun lev_pred' pt (pos:pos' as ([],Res)) = ([],Pbl):pos'
77.1732 + | lev_pred' pt (pos:pos' as (p, Res)) =
77.1733 + let val (p', last) = split_last p
77.1734 + in if last = 1
77.1735 + then if (is_pblobj o (get_obj I pt)) p then (p,Pbl) else (p, Frm)
77.1736 + else if get_obj g_res pt (p' @ [last - 1]) = get_obj g_form pt p
77.1737 + then (p' @ [last - 1], Res) (*TransitiveB*)
77.1738 + else if (is_pblobj o (get_obj I pt)) p then (p,Pbl) else (p, Frm)
77.1739 + end;
77.1740 +
77.1741 +(*.determine the next pos' on the same level.*)
77.1742 +fun lev_on' pt (([],Pbl):pos') = ([],Res):pos'
77.1743 + | lev_on' pt (p, Res) =
77.1744 + if get_obj g_res pt p = get_obj g_form pt (lev_on p)(*TransitiveB*)
77.1745 + then if existpt' (lev_on p, Res) pt then (lev_on p, Res)
77.1746 + else raise error ("lev_on': (p, Res) -> (p, Res) not existent, \
77.1747 + \p = "^ints2str' (lev_on p))
77.1748 + else (lev_on p, Frm)
77.1749 + | lev_on' pt (p, _) =
77.1750 + if existpt' (p, Res) pt then (p, Res)
77.1751 + else raise error ("lev_on': (p, Frm) -> (p, Res) not existent, \
77.1752 + \p = "^ints2str' p);
77.1753 +
77.1754 +fun exist_lev_on' pt p = (lev_on' pt p; true) handle _ => false;
77.1755 +
77.1756 +(*.is the pos' at the last element of a calulation _AND_ can be continued.*)
77.1757 +(* val (pt, pos as (p,p_)) = (pt, ([1],Frm));
77.1758 + *)
77.1759 +fun is_curr_endof_calc pt (([],Res) : pos') = false
77.1760 + | is_curr_endof_calc pt (pos as (p,_)) =
77.1761 + not (exist_lev_on' pt pos)
77.1762 + andalso get_obj g_ostate pt (lev_up p) = Incomplete;
77.1763 +
77.1764 +
77.1765 +(**.insert into ctree and cut branches accordingly.**)
77.1766 +
77.1767 +(*.get all positions of certain intervals on the ctree.*)
77.1768 +(*OLD VERSION without move_dn; kept for occasional redesign
77.1769 + get all pos's to be cut in a ptree
77.1770 + below a pos or from a ptree list after i-th element (NO level_up).*)
77.1771 +fun get_allpos' (_:pos, _:posel) EmptyPtree = ([]:pos' list)
77.1772 + | get_allpos' (p, 1) (Nd (b, bs)) = (*p is pos of Nd*)
77.1773 + if g_ostate b = Incomplete
77.1774 + then ((*writeln("get_allpos' (p, 1) Incomplete: p="^ints2str' p);*)
77.1775 + [(p,Frm)] @ (get_allpos's (p, 1) bs)
77.1776 + )
77.1777 + else ((*writeln("get_allpos' (p, 1) else: p="^ints2str' p);*)
77.1778 + [(p,Frm)] @ (get_allpos's (p, 1) bs) @ [(p,Res)]
77.1779 + )
77.1780 + (*WN041020 here we assume what is presented on the worksheet ?!*)
77.1781 + | get_allpos' (p, i) (Nd (b, bs)) = (*p is pos of Nd*)
77.1782 + if length bs > 0 orelse is_pblobj b
77.1783 + then if g_ostate b = Incomplete
77.1784 + then [(p,Frm)] @ (get_allpos's (p, 1) bs)
77.1785 + else [(p,Frm)] @ (get_allpos's (p, 1) bs) @ [(p,Res)]
77.1786 + else
77.1787 + if g_ostate b = Incomplete
77.1788 + then []
77.1789 + else [(p,Res)]
77.1790 +(*WN041020 here we assume what is presented on the worksheet ?!*)
77.1791 +and get_allpos's _ [] = []
77.1792 + | get_allpos's (p, i) (pt::pts) = (*p is pos of parent-Nd*)
77.1793 + (get_allpos' (p@[i], i) pt) @ (get_allpos's (p, i+1) pts);
77.1794 +
77.1795 +(*.get all positions of certain intervals on the ctree.*)
77.1796 +(*NEW version WN050225*)
77.1797 +
77.1798 +
77.1799 +(*.cut branches.*)
77.1800 +(*before WN041019......
77.1801 +val cut_branch = (test_trans, curry take):
77.1802 + (ppobj -> bool) * (int -> ptree list -> ptree list);
77.1803 +.. formlery used for ...
77.1804 +fun cut_tree''' _ [] = EmptyPtree
77.1805 + | cut_tree''' pt pos =
77.1806 + let val (pt',cut) = appl_branch cut_branch pt pos
77.1807 + in if cut andalso length pos > 1 then cut_tree''' pt' (lev_up pos)
77.1808 + else pt' end;
77.1809 +*)
77.1810 +(*OLD version before WN050225*)
77.1811 +(*WN050106 like cut_level, but deletes exactly 1 node --- for tests ONLY*)
77.1812 +fun cut_level_'_ (_:pos' list) (_:pos) EmptyPtree (_:pos') =
77.1813 + raise PTREE "cut_level_'_ Empty _"
77.1814 + | cut_level_'_ _ _ (Nd ( _, _)) ([],_) = raise PTREE "cut_level_'_ _ []"
77.1815 + | cut_level_'_ cuts P (Nd (b, bs)) (p::[],p_) =
77.1816 + if test_trans b
77.1817 + then (Nd (b, drop_nth [] (p:posel, bs)),
77.1818 + (* ~~~~~~~~~~~*)
77.1819 + cuts @
77.1820 + (if p_ = Frm then [(P@[p],Res)] else ([]:pos' list)) @
77.1821 + (*WN041020 here we assume what is presented on the worksheet ?!*)
77.1822 + (get_allpos's (P, p+1) (drop_nth [] (p, bs))))
77.1823 + (* ~~~~~~~~~~~*)
77.1824 + else (Nd (b, bs), cuts)
77.1825 + | cut_level_'_ cuts P (Nd (b, bs)) ((p::ps),p_) =
77.1826 + let val (bs',cuts') = cut_level_'_ cuts P (nth p bs) (ps, p_)
77.1827 + in (Nd (b, repl_app bs p bs'), cuts @ cuts') end;
77.1828 +
77.1829 +(*before WN050219*)
77.1830 +fun cut_level (_:pos' list) (_:pos) EmptyPtree (_:pos') =
77.1831 + raise PTREE "cut_level EmptyPtree _"
77.1832 + | cut_level _ _ (Nd ( _, _)) ([],_) = raise PTREE "cut_level _ []"
77.1833 +
77.1834 + | cut_level cuts P (Nd (b, bs)) (p::[],p_) =
77.1835 + if test_trans b
77.1836 + then (Nd (b, take (p:posel, bs)),
77.1837 + cuts @
77.1838 + (if p_ = Frm andalso (*#*) g_ostate b = Complete
77.1839 + then [(P@[p],Res)] else ([]:pos' list)) @
77.1840 + (*WN041020 here we assume what is presented on the worksheet ?!*)
77.1841 + (get_allpos's (P, p+1) (takerest (p, bs))))
77.1842 + else (Nd (b, bs), cuts)
77.1843 +
77.1844 + | cut_level cuts P (Nd (b, bs)) ((p::ps),p_) =
77.1845 + let val (bs',cuts') = cut_level cuts P (nth p bs) (ps, p_)
77.1846 + in (Nd (b, repl_app bs p bs'), cuts @ cuts') end;
77.1847 +
77.1848 +(*OLD version before WN050219, overwritten below*)
77.1849 +fun cut_tree _ (([],_):pos') = raise PTREE "cut_tree _ ([],_)"
77.1850 + | cut_tree pt (pos as ([p],_)) =
77.1851 + let val (pt', cuts) = cut_level ([]:pos' list) [] pt pos
77.1852 + in (pt', cuts @ (if get_obj g_ostate pt [] = Incomplete
77.1853 + then [] else [([],Res)])) end
77.1854 + | cut_tree pt (p,p_) =
77.1855 + let
77.1856 + fun cutfn pt cuts (p,p_) =
77.1857 + let val (pt', cuts') = cut_level [] (lev_up p) pt (p,p_)
77.1858 + val cuts'' = if get_obj g_ostate pt (lev_up p) = Incomplete
77.1859 + then [] else [(lev_up p, Res)]
77.1860 + in if length cuts' > 0 andalso length p > 1
77.1861 + then cutfn pt' (cuts @ cuts') (lev_up p, Frm(*-->(p,Res)*))
77.1862 + else (pt',cuts @ cuts') end
77.1863 + val (pt', cuts) = cutfn pt [] (p,p_)
77.1864 + in (pt', cuts @ (if get_obj g_ostate pt [] = Incomplete
77.1865 + then [] else [([], Res)])) end;
77.1866 +
77.1867 +
77.1868 +(*########/ inserted from ctreeNEW.sml \#################################**)
77.1869 +
77.1870 +(*.get all positions in a ptree until ([],Res) or ostate=Incomplete
77.1871 +val get_allp = fn :
77.1872 + pos' list -> : accumulated, start with []
77.1873 + pos -> : the offset for subtrees wrt the root
77.1874 + ptree -> : (sub)tree
77.1875 + pos' : initialization (the last pos' before ...)
77.1876 + -> pos' list : of positions in this (sub) tree (relative to the root)
77.1877 +.*)
77.1878 +(* val (cuts, P, pt, pos) = ([], [3], get_nd pt [3], ([], Frm):pos');
77.1879 + val (cuts, P, pt, pos) = ([], [2], get_nd pt [2], ([], Frm):pos');
77.1880 + length (children pt);
77.1881 + *)
77.1882 +fun get_allp (cuts:pos' list) (P:pos, pos:pos') pt =
77.1883 + (let val nxt = move_dn [] pt pos (*exn if Incomplete reached*)
77.1884 + in if nxt <> ([],Res)
77.1885 + then get_allp (cuts @ [nxt]) (P, nxt) pt
77.1886 + else (map (apfst (curry op@ P)) (cuts @ [nxt])): pos' list
77.1887 + end) handle PTREE _ => (map (apfst (curry op@ P)) cuts);
77.1888 +
77.1889 +
77.1890 +(*the pts are assumed to be on the same level*)
77.1891 +fun get_allps (cuts: pos' list) (P:pos) [] = cuts
77.1892 + | get_allps cuts P (pt::pts) =
77.1893 + let val below = get_allp [] (P, ([], Frm)) pt
77.1894 + val levfrm =
77.1895 + if is_pblnd pt
77.1896 + then (P, Pbl)::below
77.1897 + else if last_elem P = 1
77.1898 + then (P, Frm)::below
77.1899 + else (*Trans*) below
77.1900 + val levres = levfrm @ (if null below then [(P, Res)] else [])
77.1901 + in get_allps (cuts @ levres) (lev_on P) pts end;
77.1902 +
77.1903 +
77.1904 +(**.these 2 funs decide on how far cut_tree goes.**)
77.1905 +(*.shall the nodes _after_ the pos to be inserted at be deleted?.*)
77.1906 +fun test_trans (PrfObj{branch = Transitive,...}) = true
77.1907 + | test_trans (PrfObj{branch = NoBranch,...}) = true
77.1908 + | test_trans (PblObj{branch = Transitive,...}) = true
77.1909 + | test_trans (PblObj{branch = NoBranch,...}) = true
77.1910 + | test_trans _ = false;
77.1911 +(*.shall cutting be continued on the higher level(s)?
77.1912 + the Nd regarded will NOT be changed.*)
77.1913 +fun cutlevup (PblObj _) = false (*for tests of LK0502*)
77.1914 + | cutlevup _ = true;
77.1915 +val cutlevup = test_trans;(*WN060727 after summerterm tests.LK0502 withdrawn*)
77.1916 +
77.1917 +(*cut_bottom new sml603..608
77.1918 +cut the level at the bottom of the pos (used by cappend_...)
77.1919 +and handle the parent in order to avoid extra case for root
77.1920 +fn: ptree -> : the _whole_ ptree for cut_levup
77.1921 + pos * posel -> : the pos after split_last
77.1922 + ptree -> : the parent of the Nd to be cut
77.1923 +return
77.1924 + (ptree * : the updated ptree
77.1925 + pos' list) * : the pos's cut
77.1926 + bool : cutting shall be continued on the higher level(s)
77.1927 +*)
77.1928 +fun cut_bottom _ (pt' as Nd (b, [])) = ((pt', []), cutlevup b)
77.1929 + | cut_bottom (P:pos, p:posel) (Nd (b, bs)) =
77.1930 + let (*divide level into 3 parts...*)
77.1931 + val keep = take (p - 1, bs)
77.1932 + val pt' as Nd (_,bs') = nth p bs
77.1933 + (*^^^^^_here_ will be 'insert'ed by 'append_..'*)
77.1934 + val (tail, tp) = (takerest (p, bs),
77.1935 + if null (takerest (p, bs)) then 0 else p + 1)
77.1936 + val (children, cuts) =
77.1937 + if test_trans b
77.1938 + then (keep,
77.1939 + (if is_pblnd pt' then [(P @ [p], Pbl)] else [])
77.1940 + @ (get_allp [] (P @ [p], (P, Frm)) pt')
77.1941 + @ (get_allps [] (P @ [p+1]) tail))
77.1942 + else (keep @ [(*'insert'ed by 'append_..'*)] @ tail,
77.1943 + get_allp [] (P @ [p], (P, Frm)) pt')
77.1944 + val (pt'', cuts) =
77.1945 + if cutlevup b
77.1946 + then (Nd (del_res b, children),
77.1947 + cuts @ (if g_ostate b = Incomplete then [] else [(P,Res)]))
77.1948 + else (Nd (b, children), cuts)
77.1949 + (*val _= writeln("####cut_bottom (P, p)="^pos2str (P @ [p])^
77.1950 + ", Nd=.............................................")
77.1951 + val _= show_pt pt''
77.1952 + val _= writeln("####cut_bottom form='"^
77.1953 + term2str (get_obj g_form pt'' []))
77.1954 + val _= writeln("####cut_bottom cuts#="^string_of_int (length cuts)^
77.1955 + ", cuts="^pos's2str cuts)*)
77.1956 + in ((pt'', cuts:pos' list), cutlevup b) end;
77.1957 +
77.1958 +
77.1959 +(*.go all levels from the bottom of 'pos' up to the root,
77.1960 + on each level compose the children of a node and accumulate the cut Nds
77.1961 +args
77.1962 + pos' list -> : for accumulation
77.1963 + bool -> : cutting shall be continued on the higher level(s)
77.1964 + ptree -> : the whole ptree for 'get_nd pt P' on each level
77.1965 + ptree -> : the Nd from the lower level for insertion at path
77.1966 + pos * posel -> : pos=path split for convenience
77.1967 + ptree -> : Nd the children of are under consideration on this call
77.1968 +returns :
77.1969 + ptree * pos' list : the updated parent-Nd and the pos's of the Nds cut
77.1970 +.*)
77.1971 +fun cut_levup (cuts:pos' list) clevup pt pt' (P:pos, p:posel) (Nd (b, bs)) =
77.1972 + let (*divide level into 3 parts...*)
77.1973 + val keep = take (p - 1, bs)
77.1974 + (*val pt' comes as argument from below*)
77.1975 + val (tail, tp) = (takerest (p, bs),
77.1976 + if null (takerest (p, bs)) then 0 else p + 1)
77.1977 + val (children, cuts') =
77.1978 + if clevup
77.1979 + then (keep @ [pt'], get_allps [] (P @ [p+1]) tail)
77.1980 + else (keep @ [pt'] @ tail, [])
77.1981 + val clevup' = if clevup then cutlevup b else false
77.1982 + (*the first Nd with false stops cutting on all levels above*)
77.1983 + val (pt'', cuts') =
77.1984 + if clevup'
77.1985 + then (Nd (del_res b, children),
77.1986 + cuts' @ (if g_ostate b = Incomplete then [] else [(P,Res)]))
77.1987 + else (Nd (b, children), cuts')
77.1988 + (*val _= writeln("#####cut_levup clevup= "^bool2str clevup)
77.1989 + val _= writeln("#####cut_levup cutlevup b= "^bool2str (cutlevup b))
77.1990 + val _= writeln("#####cut_levup (P, p)="^pos2str (P @ [p])^
77.1991 + ", Nd=.............................................")
77.1992 + val _= show_pt pt''
77.1993 + val _= writeln("#####cut_levup form='"^
77.1994 + term2str (get_obj g_form pt'' []))
77.1995 + val _= writeln("#####cut_levup cuts#="^string_of_int (length cuts)^
77.1996 + ", cuts="^pos's2str cuts)*)
77.1997 + in if null P then (pt'', (cuts @ cuts'):pos' list)
77.1998 + else let val (P, p) = split_last P
77.1999 + in cut_levup (cuts @ cuts') clevup' pt pt'' (P, p) (get_nd pt P)
77.2000 + end
77.2001 + end;
77.2002 +
77.2003 +(*.cut nodes after and below an inserted node in the ctree;
77.2004 + the cuts range is limited by the predicate 'fun cutlevup'.*)
77.2005 +fun cut_tree pt (pos,_) =
77.2006 + if not (existpt pos pt)
77.2007 + then (pt,[]) (*appending a formula never cuts anything*)
77.2008 + else let val (P, p) = split_last pos
77.2009 + val ((pt', cuts), clevup) = cut_bottom (P, p) (get_nd pt P)
77.2010 + (* pt' is the updated parent of the Nd to cappend_..*)
77.2011 + in if null P then (pt', cuts)
77.2012 + else let val (P, p) = split_last P
77.2013 + in cut_levup cuts clevup pt pt' (P, p) (get_nd pt P)
77.2014 + end
77.2015 + end;
77.2016 +
77.2017 +fun append_atomic p l f r f' s pt =
77.2018 + let (**val _= writeln("#@append_atomic: pos ="^pos2str p)**)
77.2019 + val (iss, f) = if existpt p pt andalso get_obj g_tac pt p=Empty_Tac
77.2020 + then (*after Take*)
77.2021 + ((fst (get_obj g_loc pt p), Some l),
77.2022 + get_obj g_form pt p)
77.2023 + else ((None, Some l), f)
77.2024 + in insert (PrfObj {cell = None,
77.2025 + form = f,
77.2026 + tac = r,
77.2027 + loc = iss,
77.2028 + branch= NoBranch,
77.2029 + result= f',
77.2030 + ostate= s}) pt p end;
77.2031 +
77.2032 +
77.2033 +(*20.8.02: cappend_* FIXXXXME cut branches below cannot be decided here:
77.2034 + detail - generate - cappend: inserted, not appended !!!
77.2035 +
77.2036 + cut decided in applicable_in !?!
77.2037 +*)
77.2038 +fun cappend_atomic pt p loc f r f' s =
77.2039 +(* val (pt, p, loc, f, r, f', s) =
77.2040 + (pt,p,l,f,Rewrite_Set_Inst (subst2subs subs',id_rls rls'),
77.2041 + (f',asm),Complete);
77.2042 + *)
77.2043 +((*writeln("##@cappend_atomic: pos ="^pos2str p);*)
77.2044 + apfst (append_atomic p loc f r f' s) (cut_tree pt (p,Frm))
77.2045 +);
77.2046 +(*TODO.WN050305 redesign the handling of istates*)
77.2047 +fun cappend_atomic pt p ist_res f r f' s =
77.2048 + if existpt p pt andalso get_obj g_tac pt p=Empty_Tac
77.2049 + then (*after Take: transfer Frm and respective istate*)
77.2050 + let val (ist_form, f) = (get_loc pt (p,Frm),
77.2051 + get_obj g_form pt p)
77.2052 + val (pt, cs) = cut_tree pt (p,Frm)
77.2053 + val pt = append_atomic p e_istate f r f' s pt
77.2054 + val pt = update_loc' pt p (Some ist_form, Some ist_res)
77.2055 + in (pt, cs) end
77.2056 + else apfst (append_atomic p ist_res f r f' s) (cut_tree pt (p,Frm));
77.2057 +
77.2058 +
77.2059 +(* called by Take *)
77.2060 +fun append_form p l f pt =
77.2061 +((*writeln("##@append_form: pos ="^pos2str p);*)
77.2062 + insert (PrfObj {cell = None,
77.2063 + form = (*if existpt p pt
77.2064 + andalso get_obj g_tac pt p = Empty_Tac
77.2065 + (*distinction from 'old' (+complete!) pobjs*)
77.2066 + then get_obj g_form pt p else*) f,
77.2067 + tac = Empty_Tac,
77.2068 + loc = (Some l, None),
77.2069 + branch= NoBranch,
77.2070 + result= (e_term,[]),
77.2071 + ostate= Incomplete}) pt p
77.2072 +);
77.2073 +(* val (p,loc,f) = ([1], e_istate, str2term "x + 1 = 2");
77.2074 + val (p,loc,f) = (fst p, e_istate, str2term "-1 + x = 0");
77.2075 + *)
77.2076 +fun cappend_form pt p loc f =
77.2077 +((*writeln("##@cappend_form: pos ="^pos2str p);*)
77.2078 + apfst (append_form p loc f) (cut_tree pt (p,Frm))
77.2079 +);
77.2080 +fun cappend_form pt p loc f =
77.2081 +let (*val _= writeln("##@cappend_form: pos ="^pos2str p)
77.2082 + val _= writeln("##@cappend_form before cut_tree: loc ="^istate2str loc)*)
77.2083 + val (pt', cs) = cut_tree pt (p,Frm)
77.2084 + val pt'' = append_form p loc f pt'
77.2085 + (*val _= writeln("##@cappend_form after append: loc ="^
77.2086 + istates2str (get_obj g_loc pt'' p))*)
77.2087 +in (pt'', cs) end;
77.2088 +
77.2089 +
77.2090 +
77.2091 +fun append_result pt p l f s =
77.2092 +((*writeln("##@append_result: pos ="^pos2str p);*)
77.2093 + (appl_obj (repl_result (fst (get_obj g_loc pt p),
77.2094 + Some l) f s) pt p, [])
77.2095 +);
77.2096 +
77.2097 +
77.2098 +(*WN041022 deprecated, still for kbtest/diffapp.sml, /systest/root-equ.sml*)
77.2099 +fun append_parent p l f r b pt =
77.2100 + let (*val _= writeln("###append_parent: pos ="^pos2str p);*)
77.2101 + val (ll,f) = if existpt p pt andalso get_obj g_tac pt p=Empty_Tac
77.2102 + then ((fst (get_obj g_loc pt p), Some l),
77.2103 + get_obj g_form pt p)
77.2104 + else ((Some l, None), f)
77.2105 + in insert (PrfObj
77.2106 + {cell = None,
77.2107 + form = f,
77.2108 + tac = r,
77.2109 + loc = ll,
77.2110 + branch= b,
77.2111 + result= (e_term,[]),
77.2112 + ostate= Incomplete}) pt p end;
77.2113 +fun cappend_parent pt p loc f r b =
77.2114 +((*writeln("###cappend_parent: pos ="^pos2str p);*)
77.2115 + apfst (append_parent p loc f r b) (cut_tree pt (p,Und))
77.2116 +);
77.2117 +
77.2118 +
77.2119 +fun append_problem [] l fmz (strs,spec,hdf) _ =
77.2120 +((*writeln("###append_problem: pos = []");*)
77.2121 + (Nd (PblObj
77.2122 + {cell = None,
77.2123 + origin= (strs,spec,hdf),
77.2124 + fmz = fmz,
77.2125 + spec = empty_spec,
77.2126 + probl = []:itm list,
77.2127 + meth = []:itm list,
77.2128 + env = None,
77.2129 + loc = (Some l, None),
77.2130 + branch= TransitiveB,(*FIXXXXXME.27.8.03: for equations only*)
77.2131 + result= (e_term,[]),
77.2132 + ostate= Incomplete},[]))
77.2133 +)
77.2134 + | append_problem p l fmz (strs,spec,hdf) pt =
77.2135 +((*writeln("###append_problem: pos ="^pos2str p);*)
77.2136 + insert (PblObj
77.2137 + {cell = None,
77.2138 + origin= (strs,spec,hdf),
77.2139 + fmz = fmz,
77.2140 + spec = empty_spec,
77.2141 + probl = []:itm list,
77.2142 + meth = []:itm list,
77.2143 + env = None,
77.2144 + loc = (Some l, None),
77.2145 + branch= TransitiveB,
77.2146 + result= (e_term,[]),
77.2147 + ostate= Incomplete}) pt p
77.2148 +);
77.2149 +fun cappend_problem _ [] loc fmz ori =
77.2150 +((*writeln("###cappend_problem: pos = []");*)
77.2151 + (append_problem [] loc fmz ori EmptyPtree,[])
77.2152 +)
77.2153 + | cappend_problem pt p loc fmz ori =
77.2154 +((*writeln("###cappend_problem: pos ="^pos2str p);*)
77.2155 + apfst (append_problem p (loc:istate) fmz ori) (cut_tree pt (p,Frm))
77.2156 +);
77.2157 +
77.2158 +(*.get the theory explicitly specified for the rootpbl;
77.2159 + thus use this function _after_ finishing specification.*)
77.2160 +fun rootthy (Nd (PblObj {spec=(thyID, _, _),...}, _)) = assoc_thy thyID
77.2161 + | rootthy _ = raise error "rootthy";
77.2162 +
78.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
78.2 +++ b/src/Pure/isac/ME/generate.sml Wed Jul 21 13:53:39 2010 +0200
78.3 @@ -0,0 +1,586 @@
78.4 +(* use"ME/generate.sml";
78.5 + use"generate.sml";
78.6 + *)
78.7 +
78.8 +(*.initialize istate for Detail_Set.*)
78.9 +(*
78.10 +fun init_istate (Rewrite_Set rls) =
78.11 +(* val (Rewrite_Set rls) = (get_obj g_tac pt p);
78.12 + *)
78.13 + (case assoc_rls rls of
78.14 + Rrls {scr=sc as Rfuns {init_state=ii,...},...} => (RrlsState (ii t))
78.15 +(* val Rrls {scr=sc as Rfuns {init_state=ii,...},...} = assoc_rls rls;
78.16 + *)
78.17 + | Rls {scr=EmptyScr,...} =>
78.18 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.19 + ^"use prep_rls for storing rule-sets !")
78.20 + | Rls {scr=Script s,...} =>
78.21 +(* val Rls {scr=Script s,...} = assoc_rls rls;
78.22 + *)
78.23 + (ScrState ([(one_scr_arg s, t)], [], None, e_term, Sundef, true))
78.24 + | Seq {scr=EmptyScr,...} =>
78.25 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.26 + ^"use prep_rls for storing rule-sets !")
78.27 + | Seq {srls=srls,scr=Script s,...} =>
78.28 + (ScrState ([(one_scr_arg s, t)], [], None, e_term, Sundef, true)))
78.29 + | init_istate (Rewrite_Set_Inst (subs, rls)) =
78.30 +(* val (Rewrite_Set_Inst (subs, rls)) = (get_obj g_tac pt p);
78.31 + *)
78.32 + let val (_, v)::_ = subs2subst (assoc_thy "Isac.thy") subs
78.33 + in case assoc_rls rls of
78.34 + Rls {scr=EmptyScr,...} =>
78.35 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.36 + ^"use prep_rls for storing rule-sets !")
78.37 + | Rls {scr=Script s,...} =>
78.38 + let val (a1, a2) = two_scr_arg s
78.39 + in (ScrState ([(a1, v), (a2, t)],[], None, e_term, Sundef,true)) end
78.40 + | Seq {scr=EmptyScr,...} =>
78.41 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.42 + ^"use prep_rls for storing rule-sets !")
78.43 +(* val Seq {scr=Script s,...} = assoc_rls rls;
78.44 + *)
78.45 + | Seq {scr=Script s,...} =>
78.46 + let val (a1, a2) = two_scr_arg s
78.47 + in (ScrState ([(a1, v), (a2, t)],[], None, e_term, Sundef,true)) end
78.48 + end;
78.49 +*)
78.50 +(*~~~~~~~~~~~~~~~~~~~~~~copy for dev. until del.~~~~~~~~~~~~~~~~~~~~~~~~~*)
78.51 +fun init_istate (Rewrite_Set rls) t =
78.52 +(* val (Rewrite_Set rls) = (get_obj g_tac pt p);
78.53 + *)
78.54 + (case assoc_rls rls of
78.55 + Rrls {scr=sc as Rfuns {init_state=ii,...},...} => (RrlsState (ii t))
78.56 +(* val Rrls {scr=sc as Rfuns {init_state=ii,...},...} = assoc_rls rls;
78.57 + *)
78.58 + | Rls {scr=EmptyScr,...} =>
78.59 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.60 + ^"use prep_rls for storing rule-sets !")
78.61 + | Rls {scr=Script s,...} =>
78.62 +(* val Rls {scr=Script s,...} = assoc_rls rls;
78.63 + *)
78.64 + (ScrState ([(one_scr_arg s, t)], [], None, e_term, Sundef, true))
78.65 + | Seq {scr=EmptyScr,...} =>
78.66 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.67 + ^"use prep_rls for storing rule-sets !")
78.68 + | Seq {srls=srls,scr=Script s,...} =>
78.69 + (ScrState ([(one_scr_arg s, t)], [], None, e_term, Sundef, true)))
78.70 +(* val ((Rewrite_Set_Inst (subs, rls)), t) = ((get_obj g_tac pt p), t);
78.71 + *)
78.72 + | init_istate (Rewrite_Set_Inst (subs, rls)) t =
78.73 + let val (_, v)::_ = subs2subst (assoc_thy "Isac.thy") subs
78.74 + (*...we suppose the substitution of only _one_ bound variable*)
78.75 + in case assoc_rls rls of
78.76 + Rls {scr=EmptyScr,...} =>
78.77 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.78 + ^"use prep_rls for storing rule-sets !")
78.79 + | Rls {scr=Script s,...} =>
78.80 + let val (form, bdv) = two_scr_arg s
78.81 + in (ScrState ([(form, t), (bdv, v)],[], None, e_term, Sundef,true))
78.82 + end
78.83 + | Seq {scr=EmptyScr,...} =>
78.84 + raise error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr."
78.85 + ^"use prep_rls for storing rule-sets !")
78.86 +(* val Seq {scr=Script s,...} = assoc_rls rls;
78.87 + *)
78.88 + | Seq {scr=Script s,...} =>
78.89 + let val (form, bdv) = two_scr_arg s
78.90 + in (ScrState ([(form, t), (bdv, v)],[], None, e_term, Sundef,true))
78.91 + end
78.92 + end;
78.93 +
78.94 +
78.95 +(*.a taci holds alle information required to build a node in the calc-tree;
78.96 + a taci is assumed to be used efficiently such that the calc-tree
78.97 + resulting from applying a taci need not be stored separately;
78.98 + see "type calcstate".*)
78.99 +(*TODO.WN0504 redesign ??? or redesign generate ?? see "fun generate"
78.100 + TODO.WN0512 ? redesign this _list_:
78.101 + # only used for [Apply_Method + (Take or Subproblem)], i.e. for initacs
78.102 + # the latter problem may be resolved automatically if "fun autocalc" is
78.103 + not any more used for the specify-phase and for changing the phases*)
78.104 +type taci =
78.105 + (tac * (*for comparison with input tac*)
78.106 + tac_ * (*for ptree generation*)
78.107 + (pos' * (*after applying tac_, for ptree generation*)
78.108 + istate)); (*after applying tac_, for ptree generation*)
78.109 +val e_taci = (Empty_Tac, Empty_Tac_, (e_pos', e_istate)): taci;
78.110 +(* val (tac, tac_, (pos', istate))::_ = tacis';
78.111 + *)
78.112 +fun taci2str ((tac, tac_, (pos', istate)):taci) =
78.113 + "( "^tac2str tac^", "^tac_2str tac_^", ( "^pos'2str pos'
78.114 + ^", "^istate2str istate^" ))";
78.115 +fun tacis2str tacis = (strs2str o (map (linefeed o taci2str))) tacis;
78.116 +
78.117 +datatype pblmet = (*%^%*)
78.118 + Upblmet (*undefined*)
78.119 + | Problem of pblID (*%^%*)
78.120 + | Method of metID; (*%^%*)
78.121 +fun pblmet2str (Problem pblID) = "Problem "^(strs2str pblID)(*%^%*)
78.122 + | pblmet2str (Method metID) = "Method "^(metID2str metID);(*%^%*)
78.123 + (*%^%*) (*26.6. moved to sequent.sml: fun ~~~~~~~~~; was here below*)
78.124 +
78.125 +
78.126 +(* copy from 03.60.usecases.sml 15.11.99 *)
78.127 +datatype user_cmd =
78.128 + Accept | NotAccept | Example
78.129 +| YourTurn | MyTurn (* internal use only 7.6.02 java-sml*)
78.130 +| Rules
78.131 +| DontKnow (*| HowComes | WhatFor 7.6.02 java-sml*)
78.132 +| Undo (*| Back | Forward 7.6.02 java-sml*)
78.133 +| EndProof | EndSession
78.134 +| ActivePlus | ActiveMinus | SpeedPlus | SpeedMinus
78.135 + (*Stepwidth...7.6.02 java-sml*)
78.136 +| Auto | NotAuto | Details;
78.137 +(* for test-print-outs *)
78.138 +fun user_cmd2str Accept ="Accept"
78.139 + | user_cmd2str NotAccept ="NotAccept"
78.140 + | user_cmd2str Example ="Example"
78.141 + | user_cmd2str MyTurn ="MyTurn"
78.142 + | user_cmd2str YourTurn ="YourTurn"
78.143 + | user_cmd2str Rules ="Rules"
78.144 +(*| user_cmd2str HowComes ="HowComes"*)
78.145 + | user_cmd2str DontKnow ="DontKnow"
78.146 +(*| user_cmd2str WhatFor ="WhatFor"
78.147 + | user_cmd2str Back ="Back"*)
78.148 + | user_cmd2str Undo ="Undo"
78.149 +(*| user_cmd2str Forward ="Forward"*)
78.150 + | user_cmd2str EndProof ="EndProof"
78.151 + | user_cmd2str EndSession ="EndSession"
78.152 + | user_cmd2str ActivePlus = "ActivePlus"
78.153 + | user_cmd2str ActiveMinus = "ActiveMinus"
78.154 + | user_cmd2str SpeedPlus = "SpeedPlus"
78.155 + | user_cmd2str SpeedMinus = "SpeedMinus"
78.156 + | user_cmd2str Auto = "Auto"
78.157 + | user_cmd2str NotAuto = "NotAuto"
78.158 + | user_cmd2str Details = "Details";
78.159 +
78.160 +
78.161 +
78.162 +(*3.5.00: TODO: foppFK eliminated in interface FE-KE !!!*)
78.163 +datatype foppFK = (* in DG cases div 2 *)
78.164 + EmptyFoppFK (*DG internal*)
78.165 +| FormFK of cterm'
78.166 +| PpcFK of cterm' ppc;
78.167 +fun foppFK2str (FormFK ct') ="FormFK "^ct'
78.168 + | foppFK2str (PpcFK ppc) ="PpcFK "^(ppc2str ppc)
78.169 + | foppFK2str EmptyFoppFK ="EmptyFoppFK";
78.170 +
78.171 +
78.172 +datatype nest = Open | Closed | Nundef;
78.173 +fun nest2str Open = "Open"
78.174 + | nest2str Closed = "Closed"
78.175 + | nest2str Nundef = "Nundef";
78.176 +
78.177 +type indent = int;
78.178 +datatype edit = EdUndef | Write | Protect;
78.179 + (* bridge --> kernel *)
78.180 + (* bridge <-> kernel *)
78.181 +(* needed in dialog.sml *) (* bridge <-- kernel *)
78.182 +fun edit2str EdUndef = "EdUndef"
78.183 + | edit2str Write = "Write"
78.184 + | edit2str Protect = "Protect";
78.185 +
78.186 +
78.187 +datatype inout =
78.188 + New_User | End_User (*<->*)
78.189 +| New_Proof | End_Proof (*<->*)
78.190 +| Command of user_cmd (*-->*)
78.191 +| Request of string | Message of string (*<--*)
78.192 +| Error_ of string | System of string (*<--*)
78.193 +| FoPpcFK of foppFK (*-->*)
78.194 +| FormKF of cellID * edit * indent * nest * cterm' (*<--*)
78.195 +| PpcKF of cellID * edit * indent * nest * (pblmet * item ppc) (*<--*)
78.196 +| RuleFK of tac (*-->*)
78.197 +| RuleKF of edit * tac (*<--*)
78.198 +| RefinedKF of (pblID * ((itm list) * ((bool * term) list))) (*<--*)
78.199 +| Select of tac list (*<--*)
78.200 +| RefineKF of match list (*<--*)
78.201 +| Speed of int (*<--*)
78.202 +| Active of int (*<--*)
78.203 +| Domain of domID; (*<--*)
78.204 +
78.205 +fun inout2str End_Proof = "End_Proof"
78.206 + | inout2str (Command user_cmd) = "Command "^(user_cmd2str user_cmd)
78.207 + | inout2str (Request s) = "Request "^s
78.208 + | inout2str (Message s) = "Message "^s
78.209 + | inout2str (Error_ s) = "Error_ "^s
78.210 + | inout2str (System s) = "System "^s
78.211 + | inout2str (FoPpcFK foppFK) = "FoPpcFK "^(foppFK2str foppFK)
78.212 + | inout2str (FormKF (cellID, edit, indent, nest, ct')) =
78.213 + "FormKF ("^(string_of_int cellID)^","
78.214 + ^(edit2str edit)^","^(string_of_int indent)^","
78.215 + ^(nest2str nest)^",("
78.216 + ^ct' ^")"
78.217 + | inout2str (PpcKF (cellID, edit, indent, nest, (pm,itemppc))) =
78.218 + "PpcKF ("^(string_of_int cellID)^","
78.219 + ^(edit2str edit)^","^(string_of_int indent)^","
78.220 + ^(nest2str nest)^",("
78.221 + ^(pblmet2str pm)^","^(itemppc2str itemppc)^"))"
78.222 + | inout2str (RuleKF (edit,tac)) = "RuleKF "^
78.223 + pair2str(edit2str edit,tac2str tac)
78.224 + | inout2str (RuleFK tac) = "RuleFK "^(tac2str tac)
78.225 + | inout2str (Select tacs)=
78.226 + "Select "^((strs2str' o (map tac2str)) tacs)
78.227 + | inout2str (RefineKF ms) = "RefineKF "^(matchs2str ms)
78.228 + | inout2str (Speed i) = "Speed "^(string_of_int i)
78.229 + | inout2str (Active i) = "Active "^(string_of_int i)
78.230 + | inout2str (Domain dI) = "Domain "^dI;
78.231 +fun inouts2str ios = (strs2str' o (map inout2str)) ios;
78.232 +
78.233 +datatype mout =
78.234 + Form' of inout (* packing cterm' | cterm' ppc *)
78.235 +| Problems of inout (* passes specify (and solve) *)
78.236 +| Error' of inout
78.237 +| EmptyMout;
78.238 +
78.239 +fun mout2str (Form' inout) ="Form' "^(inout2str inout)
78.240 + | mout2str (Error' inout) ="Error' "^(inout2str inout)
78.241 + | mout2str (EmptyMout ) ="EmptyMout";
78.242 +
78.243 +(*fun Form'2str (Form' )*)
78.244 +
78.245 +
78.246 +
78.247 +
78.248 +
78.249 +(* init pbl with ...,dsc,empty | [] *)
78.250 +fun init_pbl pbt =
78.251 + let
78.252 + fun pbt2itm (f,(d,t)) =
78.253 + ((0,[],false,f,Inc((d,[]),(e_term,[]))):itm);
78.254 + in map pbt2itm pbt end;
78.255 +(*take formal parameters from pbt, for transfer from pbl/met-hierarchy*)
78.256 +fun init_pbl' pbt =
78.257 + let
78.258 + fun pbt2itm (f,(d,t)) =
78.259 + ((0,[],false,f,Inc((d,[t]),(e_term,[]))):itm);
78.260 + in map pbt2itm pbt end;
78.261 +
78.262 +
78.263 +(*generate 1 ppobj in ptree*)
78.264 +(*TODO.WN0501: take calcstate as an argument (see embed_derive etc.)?specify?*)
78.265 +fun generate1 thy (Add_Given' (_, itmlist)) Uistate (pos as (p,p_)) pt =
78.266 + (pos:pos',[],Form' (PpcKF (0,EdUndef,0,Nundef,
78.267 + (Upblmet,itms2itemppc thy [][]))),
78.268 + case p_ of Pbl => update_pbl pt p itmlist
78.269 + | Met => update_met pt p itmlist)
78.270 + | generate1 thy (Add_Find' (_, itmlist)) Uistate (pos as (p,p_)) pt =
78.271 + (pos,[],Form' (PpcKF (0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),
78.272 + case p_ of Pbl => update_pbl pt p itmlist
78.273 + | Met => update_met pt p itmlist)
78.274 + | generate1 thy (Add_Relation' (_, itmlist)) Uistate (pos as (p,p_)) pt =
78.275 + (pos,[],Form' (PpcKF (0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),
78.276 + case p_ of Pbl => update_pbl pt p itmlist
78.277 + | Met => update_met pt p itmlist)
78.278 +
78.279 + | generate1 thy (Specify_Theory' domID) Uistate (pos as (p,_)) pt =
78.280 + (pos,[],Form' (PpcKF (0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),
78.281 + update_domID pt p domID)
78.282 +
78.283 + | generate1 thy (Specify_Problem' (pI, (ok, (itms, pre)))) Uistate
78.284 + (pos as (p,_)) pt =
78.285 + let val pt = update_pbl pt p itms
78.286 + val pt = update_pblID pt p pI
78.287 + in ((p,Pbl),[],
78.288 + Form' (PpcKF (0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),
78.289 + pt) end
78.290 +
78.291 + | generate1 thy (Specify_Method' (mID, oris, itms)) Uistate
78.292 + (pos as (p,_)) pt =
78.293 + let val pt = update_oris pt p oris
78.294 + val pt = update_met pt p itms
78.295 + val pt = update_metID pt p mID
78.296 + in ((p,Met),[],
78.297 + Form' (PpcKF (0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),
78.298 + pt) end
78.299 +
78.300 + | generate1 thy (Model_Problem' (_, itms, met)) Uistate (pos as (p,_)) pt =
78.301 +(* val (itms,pos as (p,_)) = (pbl, pos);
78.302 + *)
78.303 + let val pt = update_pbl pt p itms
78.304 + val pt = update_met pt p met
78.305 + in (pos,[],Form'(PpcKF(0,EdUndef,0,Nundef,
78.306 + (Upblmet,itms2itemppc thy [][]))), pt) end
78.307 +
78.308 + | generate1 thy (Refine_Tacitly' (pI,pIre,domID,metID,pbl))
78.309 + Uistate (pos as (p,_)) pt =
78.310 + let val pt = update_pbl pt p pbl
78.311 + val pt = update_orispec pt p (domID,pIre,metID)
78.312 + in (pos,[],
78.313 + Form'(PpcKF(0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),
78.314 + pt) end
78.315 +
78.316 + | generate1 thy (Refine_Problem' (pI,_)) Uistate (pos as (p,_)) pt =
78.317 + let val (dI,_,mI) = get_obj g_spec pt p
78.318 + val pt = update_spec pt p (dI, pI, mI)
78.319 + in (pos,[],
78.320 + Form'(PpcKF(0,EdUndef,0,Nundef,(Upblmet,itms2itemppc thy [][]))),pt)
78.321 + end
78.322 +
78.323 + | generate1 thy (Apply_Method' (_,topt, is)) _ (pos as (p,p_)) pt =
78.324 + ((*writeln("###generate1 Apply_Method': pos = "^pos'2str (p,p_));
78.325 + writeln("###generate1 Apply_Method': topt= "^termopt2str topt);
78.326 + writeln("###generate1 Apply_Method': is = "^istate2str is);*)
78.327 + case topt of
78.328 + Some t =>
78.329 + let val (pt,c) = cappend_form pt p is t
78.330 + (*val _= writeln("###generate1 Apply_Method: after cappend")*)
78.331 + in (pos,c, EmptyMout,pt)
78.332 + end
78.333 + | None =>
78.334 + (pos,[],EmptyMout,update_env pt p (Some is)))
78.335 +(* val (thy, (Take' t), l, (p,p_), pt) =
78.336 + ((assoc_thy "Isac.thy"), tac_, is, pos, pt);
78.337 + *)
78.338 + | generate1 thy (Take' t) l (p,p_) pt = (* val (Take' t) = m; *)
78.339 + let (*val _=writeln("### generate1: Take' pos="^pos'2str (p,p_));*)
78.340 + val p = let val (ps,p') = split_last p(*no connex to prev.ppobj*)
78.341 + in if p'=0 then ps@[1] else p end;
78.342 + val (pt,c) = cappend_form pt p l t;
78.343 + in ((p,Frm):pos', c,
78.344 + Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str t)), pt) end
78.345 +
78.346 +(* val (l, (p,p_)) = (RrlsState is, p);
78.347 +
78.348 + val (thy, Begin_Trans' t, l, (p,Frm), pt) =
78.349 + (assoc_thy "Isac.thy", tac_, is, p, pt);
78.350 + *)
78.351 + | generate1 thy (Begin_Trans' t) l (p,Frm) pt =
78.352 + let (* print_depth 99;
78.353 + map fst (get_interval ([],Pbl) ([],Res) 9999 pt);print_depth 3;
78.354 + *)
78.355 + val (pt,c) = cappend_form pt p l t
78.356 + (* print_depth 99;
78.357 + map fst (get_interval ([],Pbl) ([],Res) 9999 pt);print_depth 3;
78.358 + *)
78.359 + val pt = update_branch pt p TransitiveB (*040312*)
78.360 + (*replace the old PrfOjb ~~~~~*)
78.361 + val p = (lev_on o lev_dn(*starts with [...,0]*)) p;
78.362 + val (pt,c') = cappend_form pt p l t(*FIXME.0402 same istate ???*);
78.363 + in ((p,Frm), c @ c', Form' (FormKF (~1,EdUndef,(length p), Nundef,
78.364 + term2str t)), pt) end
78.365 +
78.366 + (* val (thy, Begin_Trans' t, l, (p,Res), pt) =
78.367 + (assoc_thy "Isac.thy", tac_, is, p, pt);
78.368 + *)
78.369 + | generate1 thy (Begin_Trans' t) l (p ,Res) pt =
78.370 + (*append after existing PrfObj _________*)
78.371 + generate1 thy (Begin_Trans' t) l (lev_on p,Frm) pt
78.372 +
78.373 + | generate1 thy (End_Trans' tasm) l (p,p_) pt =
78.374 + let val p' = lev_up p
78.375 + val (pt,c) = append_result pt p' l tasm Complete;
78.376 + in ((p',Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str t)),
78.377 + pt) end
78.378 +
78.379 + | generate1 thy (Rewrite_Inst' (_,_,_,_,subs',thm',f,(f',asm))) l (p,p_) pt =
78.380 + let (*val _= writeln("###generate1 Rewrite_Inst': pos= "^pos'2str (p,p_));*)
78.381 + val (pt,c) = cappend_atomic pt p l f
78.382 + (Rewrite_Inst (subst2subs subs',thm')) (f',asm) Complete;
78.383 + val pt = update_branch pt p TransitiveB (*040312*)
78.384 + (*val pt = union_asm pt (par_pblobj pt p) (map (rpair p) asm);9.6.03??*)
78.385 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str f')),
78.386 + pt) end
78.387 +
78.388 + | generate1 thy (Rewrite' (thy',ord',rls',pa,thm',f,(f',asm))) l (p,p_) pt =
78.389 + let (*val _= writeln("###generate1 Rewrite': pos= "^pos'2str (p,p_))*)
78.390 + val (pt,c) = cappend_atomic pt p l f (Rewrite thm') (f',asm) Complete
78.391 + val pt = update_branch pt p TransitiveB (*040312*)
78.392 + (*val pt = union_asm pt (par_pblobj pt p) (map (rpair p) asm);9.6.03??*)
78.393 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str f')),
78.394 + pt)end
78.395 +
78.396 + | generate1 thy (Rewrite_Asm' all) l p pt =
78.397 + generate1 thy (Rewrite' all) l p pt
78.398 +
78.399 + | generate1 thy (Rewrite_Set_Inst' (_,_,subs',rls',f,(f',asm))) l (p,p_) pt =
78.400 +(* val (thy, Rewrite_Set_Inst' (_,_,subs',rls',f,(f',asm)), l, (p,p_), pt) =
78.401 + (assoc_thy "Isac.thy", tac_, is, pos, pt);
78.402 + *)
78.403 + let (*val _=writeln("###generate1 Rewrite_Set_Inst': pos= "^pos'2str(p,p_))*)
78.404 + val (pt,c) = cappend_atomic pt p l f
78.405 + (Rewrite_Set_Inst (subst2subs subs',id_rls rls')) (f',asm) Complete
78.406 + val pt = update_branch pt p TransitiveB (*040312*)
78.407 + (*val pt = union_asm pt (par_pblobj pt p) (map (rpair p) asm');9.6.03??*)
78.408 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str f')),
78.409 + pt) end
78.410 +
78.411 + | generate1 thy (Detail_Set_Inst' (_,_,subs,rls,f,(f',asm))) l (p,p_) pt =
78.412 + let val (pt,c) = cappend_form pt p l f
78.413 + val pt = update_branch pt p TransitiveB (*040312*)
78.414 +
78.415 + val is = init_istate (Rewrite_Set_Inst (subst2subs subs, id_rls rls)) f
78.416 + val tac_ = Apply_Method' (e_metID, Some t, is)
78.417 + val pos' = ((lev_on o lev_dn) p, Frm)
78.418 + in (*implicit Take*) generate1 thy tac_ is pos' pt end
78.419 +
78.420 + | generate1 thy (Rewrite_Set' (_,_,rls',f,(f',asm))) l (p,p_) pt =
78.421 + let (*val _= writeln("###generate1 Rewrite_Set': pos= "^pos'2str (p,p_))*)
78.422 + val (pt,c) = cappend_atomic pt p l f
78.423 + (Rewrite_Set (id_rls rls')) (f',asm) Complete
78.424 + val pt = update_branch pt p TransitiveB (*040312*)
78.425 + (*val pt = union_asm pt (par_pblobj pt p) (map (rpair p) asm');9.6.03??*)
78.426 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str f')),
78.427 + pt) end
78.428 +
78.429 + | generate1 thy (Detail_Set' (_,_,rls,f,(f',asm))) l (p,p_) pt =
78.430 + let val (pt,c) = cappend_form pt p l f
78.431 + val pt = update_branch pt p TransitiveB (*040312*)
78.432 +
78.433 + val is = init_istate (Rewrite_Set (id_rls rls)) f
78.434 + val tac_ = Apply_Method' (e_metID, Some t, is)
78.435 + val pos' = ((lev_on o lev_dn) p, Frm)
78.436 + in (*implicit Take*) generate1 thy tac_ is pos' pt end
78.437 +
78.438 + | generate1 thy (Check_Postcond' (pI,(scval,asm))) l (p,p_) pt =
78.439 + let (*val _=writeln("###generate1 Check_Postcond': pos= "^pos'2str(p,p_))*)
78.440 + (*val (l',_) = get_obj g_loc pt p..don't overwrite with l from subpbl*)
78.441 + val (pt,c) = append_result pt p l (scval,map str2term asm) Complete
78.442 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p),
78.443 + Nundef, term2str scval)), pt) end
78.444 +
78.445 + | generate1 thy (Calculate' (thy',op_,f,(f',thm'))) l (p,p_) pt =
78.446 + let val (pt,c) = cappend_atomic pt p l f (Calculate op_) (f',[]) Complete;
78.447 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str f')),
78.448 + pt) end
78.449 +
78.450 + | generate1 thy (Check_elementwise' (consts,pred,(f',asm))) l (p,p_) pt =
78.451 + let(*val _=writeln("###generate1 Check_elementwise': p= "^pos'2str(p,p_))*)
78.452 + val (pt,c) = cappend_atomic pt p l consts
78.453 + (Check_elementwise pred) (f',asm) Complete;
78.454 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, term2str f')),
78.455 + pt) end
78.456 +
78.457 + | generate1 thy (Or_to_List' (ors,list)) l (p,p_) pt =
78.458 + let val (pt,c) = cappend_atomic pt p l ors
78.459 + Or_to_List (list,[]) Complete;
78.460 + in ((p,Res), c, Form' (FormKF(~1,EdUndef,(length p), Nundef, term2str list)),
78.461 + pt) end
78.462 +
78.463 + | generate1 thy (Substitute' (subte, t, t')) l (p,p_) pt =
78.464 + let val (pt,c) = cappend_atomic pt p l t (Substitute (subte2sube subte))
78.465 + (t',[]) Complete;
78.466 + in ((p,Res), c, Form' (FormKF(~1,EdUndef,(length p), Nundef,
78.467 + term2str t')), pt)
78.468 + end
78.469 +
78.470 + | generate1 thy (Tac_ (_,f,id,f')) l (p,p_) pt =
78.471 + let val (pt,c) = cappend_atomic pt p l (str2term f)
78.472 + (Tac id) (str2term f',[]) Complete;
78.473 + in ((p,Res), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, f')), pt)end
78.474 +
78.475 + | generate1 thy (Subproblem' ((domID, pblID, metID), oris, hdl, fmz_, f))
78.476 + l (p,p_) pt =
78.477 + let (*val _=writeln("###generate1 Subproblem': pos= "^pos'2str (p,p_))*)
78.478 + val (pt,c) = cappend_problem pt p l (fmz_, (domID, pblID, metID))
78.479 + (oris, (domID, pblID, metID), hdl);
78.480 + (*val pbl = init_pbl ((#ppc o get_pbt) pblID);
78.481 + val pt = update_pblppc pt p pbl;--------4.9.03->Model_Problem*)
78.482 + (*val _= writeln("### generate1: is([3],Frm)= "^
78.483 + (istate2str (get_istate pt ([3],Frm))));*)
78.484 + val f = Sign.string_of_term (sign_of thy) f;
78.485 + in ((p,Pbl), c, Form' (FormKF (~1,EdUndef,(length p), Nundef, f)), pt) end
78.486 +
78.487 + | generate1 thy m' _ _ _ =
78.488 + raise error ("generate1: not impl.for "^(tac_2str m'))
78.489 +;
78.490 +
78.491 +
78.492 +fun generate_hard thy m' (p,p_) pt =
78.493 + let
78.494 + val p = case p_ of Frm => p | Res => lev_on p
78.495 + | _ => raise error ("generate_hard: call by "^(pos'2str (p,p_)));
78.496 + in generate1 thy m' e_istate (p,p_) pt end;
78.497 +
78.498 +
78.499 +
78.500 +(*tacis are in reverse order from nxt_solve_/specify_: last = fst to insert*)
78.501 +(* val (tacis, (pt, _)) = (tacis, ptp);
78.502 +
78.503 + val (tacis, (pt, c, _)) = (rev tacis, (pt, [], (p, Res)));
78.504 + *)
78.505 +fun generate ([]: taci list) ptp = ptp
78.506 + | generate tacis (pt, c, _:pos'(*!dropped!WN0504redesign generate/tacis?*))=
78.507 + let val (tacis', (_, tac_, (p, is))) = split_last tacis
78.508 + (* for recursion ...
78.509 + (tacis', (_, tac_, (p, is))) = split_last tacis';
78.510 + *)
78.511 + val (p',c',_,pt') = generate1 (assoc_thy "Isac.thy") tac_ is p pt
78.512 + in generate tacis' (pt', c@c', p') end;
78.513 +
78.514 +
78.515 +
78.516 +(*. a '_deriv'ation is constructed during 'reverse rewring' by an Rrls *
78.517 + * of for connecting a user-input formula with the current calc-state. *
78.518 + *# It is somewhat incompatible with the rest of the math-engine: *
78.519 + * (1) it is not created by a script *
78.520 + * (2) thus there cannot be another user-input within a derivation *
78.521 + *# It suffers particularily from the not-well-foundedness of the math-engine*
78.522 + * (1) FIXME other branchtyptes than Transitive will change 'embed_deriv' *
78.523 + * (2) FIXME and eventually 'compare_step' (ie. the script interpreter) *
78.524 + * (3) FIXME and eventually 'lev_back' *
78.525 + *# Some improvements are evident FIXME.040215 '_deriv'ation: *
78.526 + * (1) FIXME nest Rls_ in 'make_deriv' *
78.527 + * (2) FIXME do the not-reversed part in 'make_deriv' by scripts -- thus *
78.528 + * user-input will become possible in this part of a derivation *
78.529 + * (3) FIXME do (2) only if a derivation has been found -- for efficiency, *
78.530 + * while a non-derivable inform requires to step until End_Proof' *
78.531 + * (4) FIXME find criteria on when _not_ to step until End_Proof' *
78.532 + * (5) FIXME
78.533 +.*)
78.534 +(*.update pos in tacis for embedding by generate.*)
78.535 +(* val
78.536 + *)
78.537 +fun insert_pos _ [] = []
78.538 + | insert_pos (p:pos) (((tac,tac_,(_, ist))::tacis):taci list) =
78.539 + ((tac,tac_,((p, Res), ist)):taci)
78.540 + ::((insert_pos (lev_on p) tacis):taci list);
78.541 +
78.542 +fun res_from_taci (_, Rewrite'(_,_,_,_,_,_,(res, asm)), _) = (res, asm)
78.543 + | res_from_taci (_, Rewrite_Set'(_,_,_,_,(res, asm)), _) = (res, asm)
78.544 + | res_from_taci (_, tac_, _) =
78.545 + raise error ("res_from_taci: called with" ^ tac_2str tac_);
78.546 +
78.547 +(*.embed the tacis created by a '_deriv'ation; sys.form <> input.form
78.548 + tacis are in order, thus are reverted for generate.*)
78.549 +(* val (tacis, (pt, pos as (p, Frm))) = (tacis', ptp);
78.550 + *)
78.551 +fun embed_deriv (tacis:taci list) (pt, pos as (p, Frm):pos') =
78.552 + (*inform at Frm: replace the whole PrfObj by a Transitive-ProfObj FIXME?0402
78.553 + and transfer the istate (from _after_ compare_deriv) from Frm to Res*)
78.554 + let val (res, asm) = (res_from_taci o last_elem) tacis
78.555 + val (Some ist,_) = get_obj g_loc pt p
78.556 + val form = get_obj g_form pt p
78.557 + (*val p = lev_on p; ---------------only difference to (..,Res) below*)
78.558 + val tacis = (Begin_Trans, Begin_Trans' form, (pos, Uistate))
78.559 + ::(insert_pos ((lev_on o lev_dn) p) tacis)
78.560 + @ [(End_Trans, End_Trans' (res, asm),
78.561 + (pos_plus (length tacis) (lev_dn p, Res),
78.562 + new_val res ist))]
78.563 + val {nrls,...} = get_met (get_obj g_metID pt (par_pblobj pt p))
78.564 + val (pt, c, pos as (p,_)) = generate (rev tacis) (pt, [], (p, Res))
78.565 + val pt = update_tac pt p (Derive (id_rls nrls))
78.566 + (*FIXME.040216 struct.ctree*)
78.567 + val pt = update_branch pt p TransitiveB
78.568 + in (c, (pt, pos:pos')) end
78.569 +
78.570 +(* val (tacis, (pt, (p, Res))) = (tacis', ptp);
78.571 + *)
78.572 + | embed_deriv tacis (pt, (p, Res)) =
78.573 + (*inform at Res: append a Transitive-PrfObj FIXME?0402 other branch-types ?
78.574 + and transfer the istate (from _after_ compare_deriv) from Res to new Res*)
78.575 + let val (res, asm) = (res_from_taci o last_elem) tacis
78.576 + val (_, Some ist) = get_obj g_loc pt p
78.577 + val (f,a) = get_obj g_result pt p
78.578 + val p = lev_on p(*---------------only difference to (..,Frm) above*);
78.579 + val tacis = (Begin_Trans, Begin_Trans' f, ((p, Frm), Uistate))
78.580 + ::(insert_pos ((lev_on o lev_dn) p) tacis)
78.581 + @ [(End_Trans, End_Trans' (res, asm),
78.582 + (pos_plus (length tacis) (lev_dn p, Res),
78.583 + new_val res ist))];
78.584 + val {nrls,...} = get_met (get_obj g_metID pt (par_pblobj pt p))
78.585 + val (pt, c, pos as (p,_)) = generate (rev tacis) (pt, [], (p, Res))
78.586 + val pt = update_tac pt p (Derive (id_rls nrls))
78.587 + (*FIXME.040216 struct.ctree*)
78.588 + val pt = update_branch pt p TransitiveB
78.589 + in (c, (pt, pos)) end;
79.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
79.2 +++ b/src/Pure/isac/ME/inform.sml Wed Jul 21 13:53:39 2010 +0200
79.3 @@ -0,0 +1,734 @@
79.4 +(* Handle user-input during the specify- and the solve-phase.
79.5 + author: Walther Neuper
79.6 + 0603
79.7 + (c) due to copyright terms
79.8 +
79.9 +use"ME/inform.sml";
79.10 +use"inform.sml";
79.11 +*)
79.12 +
79.13 +signature INFORM =
79.14 + sig
79.15 +
79.16 + type castab
79.17 + type icalhd
79.18 +
79.19 + (* type iitem *)
79.20 + datatype
79.21 + iitem =
79.22 + Find of cterm' list
79.23 + | Given of cterm' list
79.24 + | Relate of cterm' list
79.25 + type imodel
79.26 + val imodel2fstr : iitem list -> (string * cterm') list
79.27 +
79.28 +
79.29 + val Isac : 'a -> Theory.theory
79.30 + val appl_add' :
79.31 + theory' ->
79.32 + SpecifyTools.ori list ->
79.33 + SpecifyTools.itm list ->
79.34 + ('a * (Term.term * Term.term)) list ->
79.35 + string * cterm' -> SpecifyTools.itm
79.36 + (* val appl_adds :
79.37 + theory' ->
79.38 + SpecifyTools.ori list ->
79.39 + SpecifyTools.itm list ->
79.40 + (string * (Term.term * Term.term)) list ->
79.41 + (string * string) list -> SpecifyTools.itm list *)
79.42 + (* val cas_input : string -> ptree * ocalhd *)
79.43 + (* val cas_input_ :
79.44 + spec ->
79.45 + (Term.term * Term.term list) list ->
79.46 + pblID * SpecifyTools.itm list * metID * SpecifyTools.itm list *
79.47 + (bool * Term.term) list *)
79.48 + val castab : castab ref
79.49 + val compare_step :
79.50 + calcstate' -> Term.term -> string * calcstate'
79.51 + (* val concat_deriv :
79.52 + 'a * ((Term.term * Term.term) list -> Term.term * Term.term -> bool)
79.53 + ->
79.54 + rls ->
79.55 + rule list ->
79.56 + Term.term ->
79.57 + Term.term ->
79.58 + bool * (Term.term * rule * (Term.term * Term.term list)) list *)
79.59 + val dropwhile' : (* systest/auto-inform.sml *)
79.60 + ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list
79.61 + (* val dtss2itm_ :
79.62 + pbt_ list ->
79.63 + Term.term * Term.term list ->
79.64 + int list * bool * string * SpecifyTools.itm_ *)
79.65 + (* val e_icalhd : icalhd *)
79.66 + val eq7 : ''a * ''b -> ''a * (''b * 'c) -> bool
79.67 + val equal : ''a -> ''a -> bool
79.68 + (* val filter_dsc :
79.69 + SpecifyTools.ori list -> SpecifyTools.itm -> SpecifyTools.ori list *)
79.70 + (* val filter_sep : ('a -> bool) -> 'a list -> 'a list * 'a list *)
79.71 + (* val flattup2 : 'a * ('b * 'c * 'd * 'e) -> 'a * 'b * 'c * 'd * 'e *)
79.72 + (* val fstr2itm_ :
79.73 + Theory.theory ->
79.74 + (''a * (Term.term * Term.term)) list ->
79.75 + ''a * string -> int list * bool * ''a * SpecifyTools.itm_ *)
79.76 + val inform :
79.77 + calcstate' -> cterm' -> string * calcstate'
79.78 + val input_icalhd : ptree -> icalhd -> ptree * ocalhd
79.79 + (* val is_Par : SpecifyTools.itm -> bool *)
79.80 + (* val is_casinput : cterm' -> fmz -> bool *)
79.81 + (* val is_e_ts : Term.term list -> bool *)
79.82 + (* val itms2fstr : SpecifyTools.itm -> string * string *)
79.83 + (* val mk_tacis :
79.84 + rew_ord' * 'a ->
79.85 + rls ->
79.86 + Term.term * rule * (Term.term * Term.term list) ->
79.87 + tac * tac_ * (pos' * istate) *)
79.88 + val oris2itms :
79.89 + 'a -> int -> SpecifyTools.ori list -> SpecifyTools.itm list
79.90 + (* val par2fstr : SpecifyTools.itm -> string * cterm' *)
79.91 + (* val parsitm : Theory.theory -> SpecifyTools.itm -> SpecifyTools.itm *)
79.92 + val rev_deriv' : 'a * rule * ('b * 'c) -> 'b * rule * ('a * 'c)
79.93 + (* val unknown_expl :
79.94 + theory' ->
79.95 + (string * (Term.term * Term.term)) list ->
79.96 + (string * string) list -> SpecifyTools.itm list *)
79.97 + end
79.98 +
79.99 +
79.100 +
79.101 +
79.102 +
79.103 +
79.104 +(***. handle an input calc-head .***)
79.105 +
79.106 +(*------------------------------------------------------------------(**)
79.107 +structure inform :INFORM =
79.108 +struct
79.109 +(**)------------------------------------------------------------------*)
79.110 +
79.111 +datatype iitem =
79.112 + Given of cterm' list
79.113 +(*Where is never input*)
79.114 +| Find of cterm' list
79.115 +| Relate of cterm' list;
79.116 +
79.117 +type imodel = iitem list;
79.118 +
79.119 +(*calc-head as input*)
79.120 +type icalhd =
79.121 + pos' * (*the position of the calc-head in the calc-tree
79.122 + pos' as (p,p_) where p_ is neglected due to pos_ below*)
79.123 + cterm' * (*the headline*)
79.124 + imodel * (*the model (without Find) of the calc-head*)
79.125 + pos_ * (*model belongs to Pbl or Met*)
79.126 + spec; (*specification: domID, pblID, metID*)
79.127 +val e_icalhd = (e_pos', "", [Given [""]], Pbl, e_spec): icalhd;
79.128 +
79.129 +fun is_casinput (hdf: cterm') ((fmz_, spec): fmz) =
79.130 + hdf <> "" andalso fmz_ = [] andalso spec = e_spec;
79.131 +
79.132 +(*.handle an input as into an algebra system.*)
79.133 +fun dtss2itm_ ppc (d, ts) =
79.134 + let val (f, (d, id)) = the (find_first ((curry op= d) o
79.135 + (#1: (term * term) -> term) o
79.136 + (#2: pbt_ -> (term * term))) ppc)
79.137 + in ([1], true, f, Cor ((d, ts), (id, ts))) end;
79.138 +
79.139 +fun flattup2 (a,(b,c,d,e)) = (a,b,c,d,e);
79.140 +
79.141 +
79.142 +
79.143 +(*.association list with cas-commands, for generating a complete calc-head.*)
79.144 +type castab =
79.145 + (term * (*cas-command, eg. 'solve'*)
79.146 + (spec * (*theory, problem, method*)
79.147 +
79.148 + (*the function generating a kind of formalization*)
79.149 + (term list -> (*the arguments of the cas-command, eg. (x+1=2, x)*)
79.150 + (term * (*description of an element*)
79.151 + term list) (*value of the element (always put into a list)*)
79.152 + list))) (*of elements in the formalization*)
79.153 + list; (*of cas-entries in the association list*)
79.154 +
79.155 +val castab = ref ([]: castab);
79.156 +
79.157 +
79.158 +(*..*)
79.159 +(* val (dI,pI,mI) = spec;
79.160 + *)
79.161 +(*fun cas_input_ ((dI,pI,mI): spec) dtss =
79.162 + let val thy = assoc_thy dI
79.163 + val {ppc,...} = get_pbt pI
79.164 + val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
79.165 + val its = add_id its_
79.166 + val pits = map flattup2 its
79.167 + val (pI, mI) = if mI <> ["no_met"] then (pI, mI)
79.168 + else let val Some (pI,_) = refine_pbl thy pI pits
79.169 + in (pI, (hd o #met o get_pbt) pI) end
79.170 + val {ppc,pre,prls,...} = get_met mI
79.171 + val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
79.172 + val its = add_id its_
79.173 + val mits = map flattup2 its
79.174 + val pre = check_preconds thy prls pre mits
79.175 +in (pI, pits: itm list, mI, mits: itm list, pre) end;*)
79.176 +
79.177 +(* val (dI,pI,mI) = spec;
79.178 + *)
79.179 +fun cas_input_ ((dI,pI,mI): spec) dtss =
79.180 + let val thy = assoc_thy dI
79.181 + val {ppc,...} = get_pbt pI
79.182 + val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
79.183 + val its = add_id its_
79.184 + val pits = map flattup2 its
79.185 + val (pI, mI) = if mI <> ["no_met"] then (pI, mI)
79.186 + else case refine_pbl thy pI pits of
79.187 + Some (pI,_) => (pI, (hd o #met o get_pbt) pI)
79.188 + | None => (pI, (hd o #met o get_pbt) pI)
79.189 + val {ppc,pre,prls,...} = get_met mI
79.190 + val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
79.191 + val its = add_id its_
79.192 + val mits = map flattup2 its
79.193 + val pre = check_preconds thy prls pre mits
79.194 +in (pI, pits: itm list, mI, mits: itm list, pre) end;
79.195 +
79.196 +
79.197 +(*.check if the input term is a CAScmd and return a ptree with
79.198 + a _complete_ calchead.*)
79.199 +(* val hdt = ifo;
79.200 + *)
79.201 +fun cas_input hdt =
79.202 + let val (h,argl) = strip_comb hdt
79.203 + in case assoc (!castab, h) of
79.204 + None => None
79.205 + (*let val (pt,_) =
79.206 + cappend_problem e_ptree [] e_istate
79.207 + ([], e_spec) ([], e_spec, e_term)
79.208 + in (pt, (false, Pbl, e_term(*FIXXME031:'not found'*),
79.209 + [], [], e_spec)) end*)
79.210 + | Some (spec as (dI,_,_), argl2dtss) =>
79.211 + (* val Some (spec as (dI,_,_), argl2dtss ) = assoc (!castab, h);
79.212 + *)
79.213 + let val dtss = argl2dtss argl
79.214 + val (pI, pits, mI, mits, pre) = cas_input_ spec dtss
79.215 + val spec = (dI, pI, mI)
79.216 + val (pt,_) =
79.217 + cappend_problem e_ptree [] e_istate ([], e_spec)
79.218 + ([], e_spec, hdt)
79.219 + val pt = update_spec pt [] spec
79.220 + val pt = update_pbl pt [] pits
79.221 + val pt = update_met pt [] mits
79.222 + in Some (pt, (true, Met, hdt, mits, pre, spec):ocalhd) end
79.223 + end;
79.224 +
79.225 +(*lazy evaluation for Isac.thy*)
79.226 +fun Isac _ = assoc_thy "Isac.thy";
79.227 +
79.228 +(*re-parse itms with a new thy and prepare for checking with ori list*)
79.229 +fun parsitm dI (itm as (i,v,b,f, Cor ((d,ts),_)):itm) =
79.230 +(* val itm as (i,v,b,f, Cor ((d,ts),_)) = hd probl;
79.231 + *)
79.232 + (let val t = (term_of o comp_dts (Isac "delay")) (d,ts);
79.233 + val s = Sign.string_of_term (sign_of dI) t;
79.234 + (*this ^ should raise the exn on unability of re-parsing dts*)
79.235 + in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
79.236 + | parsitm dI (itm as (i,v,b,f, Syn str)) =
79.237 + (let val t = (term_of o the o (parse dI)) str
79.238 + in (i,v,b,f, Par str) end handle _ => (i,v,b,f, Syn str))
79.239 + | parsitm dI (itm as (i,v,b,f, Typ str)) =
79.240 + (let val t = (term_of o the o (parse dI)) str
79.241 + in (i,v,b,f, Par str) end handle _ => (i,v,b,f, Syn str))
79.242 + | parsitm dI (itm as (i,v,_,f, Inc ((d,ts),_))) =
79.243 + (let val t = (term_of o comp_dts (Isac "delay")) (d,ts);
79.244 + val s = Sign.string_of_term (sign_of dI) t;
79.245 + (*this ^ should raise the exn on unability of re-parsing dts*)
79.246 + in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
79.247 + | parsitm dI (itm as (i,v,_,f, Sup (d,ts))) =
79.248 + (let val t = (term_of o comp_dts (Isac"delay" )) (d,ts);
79.249 + val s = Sign.string_of_term (sign_of dI) t;
79.250 + (*this ^ should raise the exn on unability of re-parsing dts*)
79.251 + in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
79.252 + | parsitm dI (itm as (i,v,_,f, Mis (d,t'))) =
79.253 + (let val t = d $ t';
79.254 + val s = Sign.string_of_term (sign_of dI) t;
79.255 + (*this ^ should raise the exn on unability of re-parsing dts*)
79.256 + in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
79.257 + | parsitm dI (itm as (i,v,_,f, Par _)) =
79.258 + raise error ("parsitm ("^itm2str dI itm^
79.259 + "): Par should be internal");
79.260 +
79.261 +(*separate a list to a pair of elements that do NOT satisfy the predicate,
79.262 + and of elements that satisfy the predicate, i.e. (false, true)*)
79.263 +fun filter_sep pred xs =
79.264 + let fun filt ab [] = ab
79.265 + | filt (a,b) (x :: xs) = if pred x
79.266 + then filt (a,b@[x]) xs
79.267 + else filt (a@[x],b) xs
79.268 + in filt ([],[]) xs end;
79.269 +fun is_Par ((_,_,_,_,Par _):itm) = true
79.270 + | is_Par _ = false;
79.271 +
79.272 +fun is_e_ts [] = true
79.273 + | is_e_ts [Const ("List.list.Nil", _)] = true
79.274 + | is_e_ts _ = false;
79.275 +
79.276 +(*WN.9.11.03 copied from fun appl_add (in modspec.sml)*)
79.277 +(* val (sel,ct) = selct;
79.278 + val (dI, oris, ppc, pbt, (sel, ct))=
79.279 + (#1 (some_spec ospec spec), oris, []:itm list,
79.280 + ((#ppc o get_pbt) (#2 (some_spec ospec spec))),
79.281 + hd (imodel2fstr imodel));
79.282 + *)
79.283 +fun appl_add' dI oris ppc pbt (sel, ct) =
79.284 + let
79.285 + val thy = assoc_thy dI;
79.286 + in case parse thy ct of
79.287 + None => (0,[],false,sel, Syn ct):itm
79.288 + | Some ct => (* val Some ct = parse thy ct;
79.289 + *)
79.290 + (case is_known thy sel oris (term_of ct) of
79.291 + (* val ("",ori'(*ts='ct'*), all) = is_known thy sel oris (term_of ct);
79.292 + *)
79.293 + ("",ori'(*ts='ct'*), all) =>
79.294 + (case is_notyet_input thy ppc all ori' pbt of
79.295 + (* val ("",itm) = is_notyet_input thy ppc all ori' pbt;
79.296 + *)
79.297 + ("",itm) => itm
79.298 + (* val (msg,xx) = is_notyet_input thy ppc all ori' pbt;
79.299 + *)
79.300 + | (msg,_) => raise error ("appl_add': "^msg))
79.301 + (* val (msg,(_,_,_,d,ts),all) = is_known thy sel oris (term_of ct);
79.302 + *)
79.303 + | (msg,(i,v,_,d,ts),_) =>
79.304 + if is_e_ts ts then (i,v,false, sel, Inc ((d,ts),(e_term,[])))
79.305 + else (i,v,false,sel, Sup (d,ts)))
79.306 + end;
79.307 +
79.308 +(*.generate preliminary itm_ from a strin (with field "#Given" etc.).*)
79.309 +(* val (f, str) = hd selcts;
79.310 + *)
79.311 +fun eq7 (f, d) (f', (d', _)) = f=f' andalso d=d';
79.312 +fun fstr2itm_ thy pbt (f, str) =
79.313 + let val topt = parse thy str
79.314 + in case topt of
79.315 + None => ([], false, f, Syn str)
79.316 + | Some ct =>
79.317 +(* val Some ct = parse thy str;
79.318 + *)
79.319 + let val (d,ts) = ((split_dts thy) o term_of) ct
79.320 + val popt = find_first (eq7 (f,d)) pbt
79.321 + in case popt of
79.322 + None => ([1](*??*), true(*??*), f, Sup (d,ts))
79.323 + | Some (f, (d, id)) => ([1], true, f, Cor ((d,ts), (id, ts)))
79.324 + end
79.325 + end;
79.326 +
79.327 +
79.328 +(*.input into empty PblObj, i.e. empty fmz+origin (unknown example).*)
79.329 +fun unknown_expl dI pbt selcts =
79.330 + let
79.331 + val thy = assoc_thy dI
79.332 + val its_ = map (fstr2itm_ thy pbt) selcts (*([1],true,"#Given",Cor (...))*)
79.333 + val its = add_id its_
79.334 +in (map flattup2 its): itm list end;
79.335 +
79.336 +
79.337 +
79.338 +
79.339 +(*WN.11.03 for input_icalhd, ~ specify_additem for Add_Given/_Find/_Relation
79.340 + appl_add': generate 1 item
79.341 + appl_add' . is_known: parse, get data from oris (vats, all (elems if list)..)
79.342 + appl_add' . is_notyet_input: compare with items in model already input
79.343 + insert_ppc': insert this 1 item*)
79.344 +(* val (dI,oris,ppc,pbt,selcts) =((#1 (some_spec ospec spec)),oris,[(*!!*)],
79.345 + ((#ppc o get_pbt) (#2 (some_spec ospec spec))),
79.346 + (imodel2fstr imodel));
79.347 + *)
79.348 +fun appl_adds dI [] _ pbt selcts = unknown_expl dI pbt selcts
79.349 + (*already present itms in model are being overwritten*)
79.350 + | appl_adds dI oris ppc pbt [] = ppc
79.351 + | appl_adds dI oris ppc pbt (selct::ss) =
79.352 + (* val selct = (sel, string_of_cterm ct);
79.353 + *)
79.354 + let val itm = appl_add' dI oris ppc pbt selct;
79.355 + in appl_adds dI oris (insert_ppc' itm ppc) pbt ss end;
79.356 +(* val (dI, oris, ppc, pbt, selct::ss) =
79.357 + (dI, pors, probl, ppc, map itms2fstr probl);
79.358 + ...vvv
79.359 + *)
79.360 +(* val (dI, oris, ppc, pbt, (selct::ss))=
79.361 + (#1 (some_spec ospec spec), oris, []:itm list,
79.362 + ((#ppc o get_pbt) (#2 (some_spec ospec spec))),(imodel2fstr imodel));
79.363 + val iii = appl_adds dI oris ppc pbt (selct::ss);
79.364 + writeln(itms2str thy iii);
79.365 +
79.366 + val itm = appl_add' dI oris ppc pbt selct;
79.367 + val ppc = insert_ppc' itm ppc;
79.368 +
79.369 + val _::selct::ss = (selct::ss);
79.370 + val itm = appl_add' dI oris ppc pbt selct;
79.371 + val ppc = insert_ppc' itm ppc;
79.372 +
79.373 + val _::selct::ss = (selct::ss);
79.374 + val itm = appl_add' dI oris ppc pbt selct;
79.375 + val ppc = insert_ppc' itm ppc;
79.376 + writeln(itms2str thy ppc);
79.377 +
79.378 + val _::selct::ss = (selct::ss);
79.379 + val itm = appl_add' dI oris ppc pbt selct;
79.380 + val ppc = insert_ppc' itm ppc;
79.381 + *)
79.382 +
79.383 +
79.384 +fun oris2itms _ _ ([]:ori list) = ([]:itm list)
79.385 + | oris2itms pbt vat ((i,v,f,d,ts)::(os: ori list)) =
79.386 + if vat mem v
79.387 + then (i,v,true,f,Cor ((d,ts),(e_term,[])))::(oris2itms pbt vat os)
79.388 + else oris2itms pbt vat os;
79.389 +
79.390 +fun filter_dsc oris itm =
79.391 + filter_out ((curry op= ((d_in o #5) (itm:itm))) o
79.392 + (#4:ori -> term)) oris;
79.393 +
79.394 +
79.395 +
79.396 +
79.397 +fun par2fstr ((_,_,_,f, Par s):itm) = (f, s)
79.398 + | par2fstr itm = raise error ("par2fstr: called with "^
79.399 + itm2str (assoc_thy "Isac.thy") itm);
79.400 +fun itms2fstr ((_,_,_,f, Cor ((d,ts),_)):itm) = (f, comp_dts'' (d,ts))
79.401 + | itms2fstr (_,_,_,f, Syn str) = (f, str)
79.402 + | itms2fstr (_,_,_,f, Typ str) = (f, str)
79.403 + | itms2fstr (_,_,_,f, Inc ((d,ts),_)) = (f, comp_dts'' (d,ts))
79.404 + | itms2fstr (_,_,_,f, Sup (d,ts)) = (f, comp_dts'' (d,ts))
79.405 + | itms2fstr (_,_,_,f, Mis (d,t)) = (f, term2str (d $ t))
79.406 + | itms2fstr (itm as (_,_,_,f, Par _)) =
79.407 + raise error ("parsitm ("^itm2str (assoc_thy "Isac.thy") itm^
79.408 + "): Par should be internal");
79.409 +
79.410 +fun imodel2fstr iitems =
79.411 + let fun xxx is [] = is
79.412 + | xxx is ((Given strs)::iis) =
79.413 + xxx (is @ (map (pair "#Given") strs)) iis
79.414 + | xxx is ((Find strs)::iis) =
79.415 + xxx (is @ (map (pair "#Find") strs)) iis
79.416 + | xxx is ((Relate strs)::iis) =
79.417 + xxx (is @ (map (pair "#Relate") strs)) iis
79.418 + in xxx [] iitems end;
79.419 +
79.420 +(*.input a CAS-command via a whole calchead;
79.421 + dWN0602 ropped due to change of design in the front-end.*)
79.422 +(*since previous calc-head _only_ has changed:
79.423 + EITHER _1_ part of the specification OR some items in the model;
79.424 + the hdform is left as is except in cas_input .*)
79.425 +(*FIXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX___Met___XXXXXXXXXXXME.TODO.WN:11.03*)
79.426 +(* val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) =
79.427 + (p, "xxx", empty_model, Pbl, e_spec);
79.428 + val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) =
79.429 + (p,"", [Given ["fixedValues [r=Arbfix]"],
79.430 + Find ["maximum A", "valuesFor [a,b]"],
79.431 + Relate ["relations [A=a*b, a/2=r*sin alpha, \
79.432 + \b/2=r*cos alpha]"]], Pbl, e_spec);
79.433 + val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) =
79.434 + (([],Pbl), "not used here",
79.435 + [Given ["fixedValues [r=Arbfix]"],
79.436 + Find ["maximum A", "valuesFor [a,b]"(*new input*)],
79.437 + Relate ["relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]"]], Pbl,
79.438 + ("DiffApp.thy", ["e_pblID"], ["e_metID"]));
79.439 + val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) = ichd;
79.440 + *)
79.441 +fun input_icalhd pt (((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)):icalhd) =
79.442 + let val PblObj {fmz = fmz as (fmz_,_), origin = (oris, ospec, hdf'),
79.443 + spec = sspec as (sdI,spI,smI), probl, meth,...} =
79.444 + get_obj I pt p;
79.445 + in if is_casinput hdf fmz then the (cas_input (str2term hdf))
79.446 + else (*hacked WN0602 ~~~ ~~~~~~~~~, ..dropped !*)
79.447 + let val (pos_, pits, mits) =
79.448 + if dI <> sdI
79.449 + then let val its = map (parsitm (assoc_thy dI)) probl;
79.450 + val (its, trms) = filter_sep is_Par its;
79.451 + val pbt = (#ppc o get_pbt) (#2(some_spec ospec sspec));
79.452 + in (Pbl, appl_adds dI oris its pbt
79.453 + (map par2fstr trms), meth) end else
79.454 + if pI <> spI
79.455 + then if pI = snd3 ospec then (Pbl, probl, meth) else
79.456 + let val pbt = (#ppc o get_pbt) pI
79.457 + val dI' = #1 (some_spec ospec spec)
79.458 + val oris = if pI = #2 ospec then oris
79.459 + else prep_ori fmz_(assoc_thy"Isac.thy") pbt;
79.460 + in (Pbl, appl_adds dI' oris probl pbt
79.461 + (map itms2fstr probl), meth) end else
79.462 + if mI <> smI (*FIXME.WN0311: what if probl is incomplete?!*)
79.463 + then let val met = (#ppc o get_met) mI
79.464 + val mits = complete_metitms oris probl meth met
79.465 + in if foldl and_ (true, map #3 mits)
79.466 + then (Pbl, probl, mits) else (Met, probl, mits)
79.467 + end else
79.468 + (Pbl, appl_adds (#1 (some_spec ospec spec)) oris [(*!!!*)]
79.469 + ((#ppc o get_pbt) (#2 (some_spec ospec spec)))
79.470 + (imodel2fstr imodel), meth);
79.471 + val pt = update_spec pt p spec;
79.472 + in if pos_ = Pbl
79.473 + then let val {prls,where_,...} = get_pbt (#2 (some_spec ospec spec))
79.474 + val pre =check_preconds(assoc_thy"Isac.thy")prls where_ pits
79.475 + in (update_pbl pt p pits,
79.476 + (ocalhd_complete pits pre spec,
79.477 + Pbl, hdf', pits, pre, spec):ocalhd) end
79.478 + else let val {prls,pre,...} = get_met (#3 (some_spec ospec spec))
79.479 + val pre = check_preconds (assoc_thy"Isac.thy") prls pre mits
79.480 + in (update_met pt p mits,
79.481 + (ocalhd_complete mits pre spec,
79.482 + Met, hdf', mits, pre, spec):ocalhd) end
79.483 + end end
79.484 + | input_icalhd pt ((p,_), hdf, imodel, _(*Met*), spec as (dI,pI,mI)) =
79.485 + raise error "input_icalhd Met not impl.";
79.486 +
79.487 +
79.488 +(***. handle an input formula .***)
79.489 +(*
79.490 +Untersuchung zur Formeleingabe (appendFormula, replaceFormla) zu einer Anregung von Alan Krempler:
79.491 +Welche RICHTIGEN Formeln koennen NICHT abgeleitet werden,
79.492 +wenn Abteilungen nur auf gleichem Level gesucht werden ?
79.493 +WN.040216
79.494 +
79.495 +Beispiele zum Equationsolver von Richard Lang aus /src/sml/kbtest/rlang.sml
79.496 +
79.497 +------------------------------------------------------------------------------
79.498 +"Schalk I s.87 Bsp 52a ((5*x)/(x - 2) - x/(x+2)=4)";
79.499 +------------------------------------------------------------------------------
79.500 +1. "5 * x / (x - 2) - x / (x + 2) = 4"
79.501 +...
79.502 +4. "12 * x + 4 * x ^^^ 2 = 4 * (-4 + x ^^^ 2)",Subproblem["normalize", "poly"..
79.503 +...
79.504 +4.3. "16 + 12 * x = 0", Subproblem["degree_1", "polynomial", "univariate"..
79.505 +...
79.506 +4.3.3. "[x = -4 / 3]")), Check_elementwise "Assumptions"
79.507 +...
79.508 +"[x = -4 / 3]"
79.509 +------------------------------------------------------------------------------
79.510 +(1)..(6): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 4.3.n]
79.511 +
79.512 +(4.1)..(4.3): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 4.3.n]
79.513 +------------------------------------------------------------------------------
79.514 +
79.515 +
79.516 +------------------------------------------------------------------------------
79.517 +"Schalk I s.87 Bsp 55b (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)";
79.518 +------------------------------------------------------------------------------
79.519 +1. "x / (x ^^^ 2 - 6 * x + 9) - 1 / (x ^^^ 2 - 3 * x) = 1 / x"
79.520 +...
79.521 +4. "(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))"
79.522 + Subproblem["normalize", "polynomial", "univariate"..
79.523 +...
79.524 +4.4. "-6 * x + 5 * x ^^^ 2 = 0", Subproblem["bdv_only", "degree_2", "poly"..
79.525 +...
79.526 +4.4.4. "[x = 0, x = 6 / 5]", Check_elementwise "Assumptions"
79.527 +4.4.5. "[x = 0, x = 6 / 5]"
79.528 +...
79.529 +5. "[x = 0, x = 6 / 5]", Check_elementwise "Assumptions"
79.530 + "[x = 6 / 5]"
79.531 +------------------------------------------------------------------------------
79.532 +(1)..(4): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite schiebt [Ableitung waere in 4.4.x]
79.533 +
79.534 +(4.1)..(4.4.5): keine 'richtige' Eingabe kann abgeleitet werden, die dem Ergebnis "[x = 6 / 5]" aequivalent ist [Ableitung waere in 5.]
79.535 +------------------------------------------------------------------------------
79.536 +
79.537 +
79.538 +------------------------------------------------------------------------------
79.539 +"Schalk II s.56 Bsp 73b (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))";
79.540 +------------------------------------------------------------------------------
79.541 +1. "sqrt (x + 1) + sqrt (4 * x + 4) = sqrt (9 * x + 9)"
79.542 +...
79.543 +6. "13 + 13 * x + -2 * sqrt ((4 + 4 * x) * (9 + 9 * x)) = 1 + x"
79.544 + Subproblem["sq", "root", "univariate", "equation"]
79.545 +...
79.546 +6.6. "144 + 288 * x + 144 * x ^^^ 2 = 144 + x ^^^ 2 + 288 * x + 143 * x ^^^ 2"
79.547 + Subproblem["normalize", "polynomial", "univariate", "equation"]
79.548 +...
79.549 +6.6.3 "0 = 0" Subproblem["degree_0", "polynomial", "univariate", "equation"]
79.550 +... Or_to_List
79.551 +6.6.3.2 "UniversalList"
79.552 +------------------------------------------------------------------------------
79.553 +(1)..(6): keine 'richtige' Eingabe kann abgeleitet werden, die eine der Wurzeln auf die andere Seite verschieb [Ableitung ware in 6.6.n]
79.554 +
79.555 +(6.1)..(6.3): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 6.6.n]
79.556 +------------------------------------------------------------------------------
79.557 +*)
79.558 +(*sh. comments auf 498*)
79.559 +
79.560 +fun equal a b = a=b;
79.561 +
79.562 +(*the lists contain eq-al elem-pairs at the beginning;
79.563 + return first list reverted (again) - ie. in order as required subsequently*)
79.564 +fun dropwhile' equal (f1::f2::fs) (i1::i2::is) =
79.565 + if equal f1 i1 then
79.566 + if equal f2 i2 then dropwhile' equal (f2::fs) (i2::is)
79.567 + else (rev (f1::f2::fs), i1::i2::is)
79.568 + else raise error "dropwhile': did not start with equal elements"
79.569 + | dropwhile' equal (f::fs) [i] =
79.570 + if equal f i then (rev (f::fs), [i])
79.571 + else raise error "dropwhile': did not start with equal elements"
79.572 + | dropwhile' equal [f] (i::is) =
79.573 + if equal f i then ([f], i::is)
79.574 + else raise error "dropwhile': did not start with equal elements";
79.575 +(*
79.576 + fun equal a b = a=b;
79.577 + val foder = [0,1,2,3,4,5]; val ifoder = [11,12,3,4,5];
79.578 + val r_foder = rev foder; val r_ifoder = rev ifoder;
79.579 + dropwhile' equal r_foder r_ifoder;
79.580 +> vval it = ([0, 1, 2, 3], [3, 12, 11]) : int list * int list
79.581 +
79.582 + val foder = [3,4,5]; val ifoder = [11,12,3,4,5];
79.583 + val r_foder = rev foder; val r_ifoder = rev ifoder;
79.584 + dropwhile' equal r_foder r_ifoder;
79.585 +> val it = ([3], [3, 12, 11]) : int list * int list
79.586 +
79.587 + val foder = [5]; val ifoder = [11,12,3,4,5];
79.588 + val r_foder = rev foder; val r_ifoder = rev ifoder;
79.589 + dropwhile' equal r_foder r_ifoder;
79.590 +> val it = ([5], [5, 4, 3, 12, 11]) : int list * int list
79.591 +
79.592 + val foder = [10,11,12,13,14,15]; val ifoder = [11,12,3,4,5];
79.593 + val r_foder = rev foder; val r_ifoder = rev ifoder;
79.594 + dropwhile' equal r_foder r_ifoder;
79.595 +> *** dropwhile': did not start with equal elements*)
79.596 +
79.597 +(*040214: version for concat_deriv*)
79.598 +fun rev_deriv' (t, r, (t', a)) = (t', sym_Thm r, (t, a));
79.599 +
79.600 +fun mk_tacis ro erls (t, r as Thm _, (t', a)) =
79.601 + (Rewrite (rule2thm' r),
79.602 + Rewrite' ("Isac.thy", fst ro, erls, false,
79.603 + rule2thm' r, t, (t', a)),
79.604 + (e_pos'(*to be updated before generate tacis!!!*), Uistate))
79.605 + | mk_tacis ro erls (t, r as Rls_ rls, (t', a)) =
79.606 + (Rewrite_Set (rule2rls' r),
79.607 + Rewrite_Set' ("Isac.thy", false, rls, t, (t', a)),
79.608 + (e_pos'(*to be updated before generate tacis!!!*), Uistate));
79.609 +
79.610 +(*fo = ifo excluded already in inform*)
79.611 +fun concat_deriv rew_ord erls rules fo ifo =
79.612 + let fun derivat ([]:(term * rule * (term * term list)) list) = e_term
79.613 + | derivat dt = (#1 o #3 o last_elem) dt
79.614 + fun equal (_,_,(t1, _)) (_,_,(t2, _)) = t1=t2
79.615 + val fod = make_deriv (Isac"") erls rules (snd rew_ord) None fo
79.616 + val ifod = make_deriv (Isac"") erls rules (snd rew_ord) None ifo
79.617 + in case (fod, ifod) of
79.618 + ([], []) => if fo = ifo then (true, [])
79.619 + else (false, [])
79.620 + | (fod, []) => if derivat fod = ifo
79.621 + then (true, fod) (*ifo is normal form*)
79.622 + else (false, [])
79.623 + | ([], ifod) => if fo = derivat ifod
79.624 + then (true, ((map rev_deriv') o rev) ifod)
79.625 + else (false, [])
79.626 + | (fod, ifod) =>
79.627 + if derivat fod = derivat ifod (*common normal form found*)
79.628 + then let val (fod', rifod') =
79.629 + dropwhile' equal (rev fod) (rev ifod)
79.630 + in (true, fod' @ (map rev_deriv' rifod')) end
79.631 + else (false, [])
79.632 + end;
79.633 +(*
79.634 + val ({rew_ord, erls, rules,...}, fo, ifo) =
79.635 + (rep_rls Test_simplify, str2term "x+1+ -1*2=0", str2term "-2*1+(x+1)=0");
79.636 + (writeln o trtas2str) fod';
79.637 +> ["
79.638 +(x + 1 + -1 * 2 = 0, Thm ("radd_commute","?m + ?n = ?n + ?m"), (-1 * 2 + (x + 1) = 0, []))","
79.639 +(-1 * 2 + (x + 1) = 0, Thm ("radd_commute","?m + ?n = ?n + ?m"), (-1 * 2 + (1 + x) = 0, []))","
79.640 +(-1 * 2 + (1 + x) = 0, Thm ("radd_left_commute","?x + (?y + ?z) = ?y + (?x + ?z)"), (1 + (-1 * 2 + x) = 0, []))","
79.641 +(1 + (-1 * 2 + x) = 0, Thm ("#mult_Float ((~1,0), (0,0)) __ ((2,0), (0,0))","-1 * 2 = -2"), (1 + (-2 + x) = 0, []))"]
79.642 +val it = () : unit
79.643 + (writeln o trtas2str) (map rev_deriv' rifod');
79.644 +> ["
79.645 +(1 + (-2 + x) = 0, Thm ("sym_#mult_Float ((~2,0), (0,0)) __ ((1,0), (0,0))","-2 = -2 * 1"), (1 + (-2 * 1 + x) = 0, []))","
79.646 +(1 + (-2 * 1 + x) = 0, Thm ("sym_radd_left_commute","?y + (?x + ?z) = ?x + (?y + ?z)"), (-2 * 1 + (1 + x) = 0, []))","
79.647 +(-2 * 1 + (1 + x) = 0, Thm ("sym_radd_commute","?n + ?m = ?m + ?n"), (-2 * 1 + (x + 1) = 0, []))"]
79.648 +val it = () : unit
79.649 +*)
79.650 +
79.651 +
79.652 +(*.compare inform with ctree.form at current pos by nrls;
79.653 + if found, embed the derivation generated during comparison
79.654 + if not, let the mat-engine compute the next ctree.form.*)
79.655 +(*structure copied from complete_solve
79.656 + CAUTION: tacis in returned calcstate' do NOT construct resulting ptp --
79.657 + all_modspec etc. has to be inserted at Subproblem'*)
79.658 +(* val (tacis, c, ptp as (pt, pos as (p,p_))) = (tacis, ptp);
79.659 + val (tacis, c, ptp as (pt, pos as (p,p_))) = cs';
79.660 +
79.661 + val (tacis, c, ptp as (pt, pos as (p,p_))) = ([],[],(pt, lev_back pos));
79.662 + -----rec.call:
79.663 + val (tacis, c, ptp as (pt, pos as (p,p_))) = cs';
79.664 + *)
79.665 +fun compare_step ((tacis, c, ptp as (pt, pos as (p,p_))): calcstate') ifo =
79.666 + let val fo = case p_ of Frm => get_obj g_form pt p
79.667 + | Res => (fst o (get_obj g_result pt)) p
79.668 + | _ => e_term (*on PblObj is fo <> ifo*);
79.669 + val {nrls,...} = get_met (get_obj g_metID pt (par_pblobj pt p))
79.670 + val {rew_ord, erls, rules,...} = rep_rls nrls
79.671 + val (found, der) = concat_deriv rew_ord erls rules fo ifo;
79.672 + in if found
79.673 + then let val tacis' = map (mk_tacis rew_ord erls) der;
79.674 + val (c', ptp) = embed_deriv tacis' ptp;
79.675 + in ("ok", (tacis (*@ tacis'?WN050408*), c @ c', ptp)) end
79.676 + else
79.677 + if pos = ([], Res)
79.678 + then ("no derivation found", (tacis, c, ptp): calcstate')
79.679 + else let val cs' as (tacis, c', ptp) = nxt_solve_ ptp;
79.680 + val cs' as (tacis, c'', ptp) =
79.681 + case tacis of
79.682 + ((Subproblem _, _, _)::_) =>
79.683 + let val ptp as (pt, (p,_)) = all_modspec ptp
79.684 + val mI = get_obj g_metID pt p
79.685 + in nxt_solv (Apply_Method' (mI, None, e_istate))
79.686 + e_istate ptp end
79.687 + | _ => cs';
79.688 + in compare_step (tacis, c @ c' @ c'', ptp) ifo end
79.689 + end;
79.690 +(* writeln (trtas2str der);
79.691 + *)
79.692 +
79.693 +(*.handle a user-input formula, which may be a CAS-command, too.
79.694 +CAS-command:
79.695 + create a calchead, and do 1 step
79.696 + TOOODO.WN0602 works only for the root-problem !!!
79.697 +formula, which is no CAS-command:
79.698 + compare iform with calc-tree.form at pos by equ_nrls and all subsequent pos;
79.699 + collect all the tacs applied by the way.*)
79.700 +(*structure copied from autocalc*)
79.701 +(* val (cs as (_, _, (pt, pos as (p, p_))): calcstate') = cs';
79.702 + val ifo = str2term ifo;
79.703 +
79.704 + val ((cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate'), istr) =
79.705 + (cs', encode ifo);
79.706 + val ((cs as (_, _, ptp as (pt, pos as (p, p_)))), istr)=(cs', (encode ifo));
79.707 + val ((cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate'), istr) =
79.708 + (([],[],(pt,p)), (encode ifo));
79.709 + *)
79.710 +fun inform (cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate') istr =
79.711 + case parse (assoc_thy "Isac.thy") istr of
79.712 +(* val Some ifo = parse (assoc_thy "Isac.thy") istr;
79.713 + *)
79.714 + Some ifo =>
79.715 + let val ifo = term_of ifo
79.716 + val fo = case p_ of Frm => get_obj g_form pt p
79.717 + | Res => (fst o (get_obj g_result pt)) p
79.718 + | _ => #3 (get_obj g_origin pt p)
79.719 + in if fo = ifo
79.720 + then ("same-formula", cs)
79.721 + (*thus ctree not cut with replaceFormula!*)
79.722 + else case cas_input ifo of
79.723 +(* val Some (pt, _) = cas_input ifo;
79.724 + *)
79.725 + Some (pt, _) => ("ok",([],[],(pt, (p, Met))))
79.726 + | None =>
79.727 + compare_step ([],[],(pt,
79.728 + (*last step re-calc in compare_step TODO*)
79.729 + lev_back pos)) ifo
79.730 + end
79.731 + | None => ("syntax error in '"^istr^"'", e_calcstate');
79.732 +
79.733 +
79.734 +(*------------------------------------------------------------------(**)
79.735 +end
79.736 +open inform;
79.737 +(**)------------------------------------------------------------------*)
80.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
80.2 +++ b/src/Pure/isac/ME/mathengine.sml Wed Jul 21 13:53:39 2010 +0200
80.3 @@ -0,0 +1,506 @@
80.4 +(* The _functional_ mathematics engine, ie. without a state.
80.5 + Input and output are Isabelle's formulae as strings.
80.6 + authors: Walther Neuper 2000
80.7 + (c) due to copyright terms
80.8 +
80.9 +use"mathengine.sml";
80.10 +*)
80.11 +
80.12 +signature MATHENGINE =
80.13 + sig
80.14 + type nxt_
80.15 + (* datatype nxt_ = HElpless | Nexts of CalcHead.calcstate *)
80.16 + type NEW
80.17 + type lOc_
80.18 + (*datatype
80.19 + lOc_ =
80.20 + ERror of string
80.21 + | UNsafe of CalcHead.calcstate'
80.22 + | Updated of CalcHead.calcstate' *)
80.23 +
80.24 + val CalcTreeTEST :
80.25 + fmz list ->
80.26 + pos' * NEW * mout * (string * tac) * safe * ptree
80.27 +
80.28 + val TESTg_form : ptree * (int list * pos_) -> mout
80.29 + val autocalc :
80.30 + pos' list ->
80.31 + pos' ->
80.32 + (ptree * pos') * taci list ->
80.33 + auto -> string * pos' list * (ptree * pos')
80.34 + val detailstep : ptree -> pos' -> string * ptree * pos'
80.35 + (* val e_tac_ : tac_ *)
80.36 + val f2str : mout -> cterm'
80.37 + (* val get_pblID : ptree * pos' -> pblID Library.option *)
80.38 + val initmatch : ptree -> pos' -> ptform
80.39 + (* val loc_solve_ :
80.40 + string * tac_ -> ptree * (int list * pos_) -> lOc_ *)
80.41 + (* val loc_specify_ : tac_ -> ptree * pos' -> lOc_ *)
80.42 + val locatetac : (*tests only*)
80.43 + tac ->
80.44 + ptree * (posel list * pos_) ->
80.45 + string * (taci list * pos' list * (ptree * (posel list * pos_)))
80.46 + val me :
80.47 + tac'_ ->
80.48 + pos' ->
80.49 + NEW ->
80.50 + ptree -> pos' * NEW * mout * tac'_ * safe * ptree
80.51 +
80.52 + val nxt_specify_ : ptree * (int list * pos_) -> calcstate'(*tests only*)
80.53 + val set_method : metID -> ptree * pos' -> ptree * ocalhd
80.54 + val set_problem : pblID -> ptree * pos' -> ptree * ocalhd
80.55 + val set_theory : thyID -> ptree * pos' -> ptree * ocalhd
80.56 + val step : pos' -> calcstate -> string * calcstate'
80.57 + val trymatch : pblID -> ptree -> pos' -> ptform
80.58 + val tryrefine : pblID -> ptree -> pos' -> ptform
80.59 + end
80.60 +
80.61 +
80.62 +
80.63 +(*------------------------------------------------------------------(**)
80.64 +structure MathEngine : MATHENGINE =
80.65 +struct
80.66 +(**)------------------------------------------------------------------*)
80.67 +
80.68 +fun get_pblID (pt, (p,_):pos') =
80.69 + let val p' = par_pblobj pt p
80.70 + val (_,pI,_) = get_obj g_spec pt p'
80.71 + val (_,(_,oI,_),_) = get_obj g_origin pt p'
80.72 + in if pI <> e_pblID then Some pI
80.73 + else if oI <> e_pblID then Some oI
80.74 + else None end;
80.75 +(*fun get_pblID (pt, (p,_):pos') =
80.76 + ((snd3 o (get_obj g_spec pt)) (par_pblobj pt p));*)
80.77 +
80.78 +
80.79 +(*--vvv--dummies for test*)
80.80 +val e_tac_ = Tac_ (Pure.thy,"","","");
80.81 +datatype lOc_ =
80.82 + ERror of string (*after loc_specify, loc_solve*)
80.83 +| UNsafe of calcstate' (*after loc_specify, loc_solve*)
80.84 +| Updated of calcstate'; (*after loc_specify, loc_solve*)
80.85 +fun loc_specify_ m (pt,pos) =
80.86 +(* val pos = ip;
80.87 + *)
80.88 + let val (p,_,f,_,s,pt) = specify m pos [] pt;
80.89 +(* val (_,_,_,_,_,pt')= specify m pos [] pt;
80.90 + *)
80.91 + in case f of
80.92 + (Error' (Error_ e)) => ERror e
80.93 + | _ => Updated ([], [], (pt,p)) end;
80.94 +
80.95 +(*. TODO push return-value cs' into solve and rename solve->loc_solve?_? .*)
80.96 +(* val (m, pos) = ((mI,m), ip);
80.97 + val (m,(pt,pos) ) = ((mI,m), ptp);
80.98 + *)
80.99 +fun loc_solve_ m (pt,pos) =
80.100 + let val (msg, cs') = solve m (pt, pos);
80.101 +(* val (tacis,dels,(pt',p')) = cs';
80.102 + (writeln o istate2str) (get_istate pt' p');
80.103 + (term2str o fst) (get_obj g_result pt' (fst p'));
80.104 + *)
80.105 + in case msg of
80.106 + "ok" => Updated cs'
80.107 + | msg => ERror msg
80.108 + end;
80.109 +
80.110 +datatype nxt_ =
80.111 + HElpless (**)
80.112 + | Nexts of calcstate; (**)
80.113 +
80.114 +(*. locate a tactic in a script and apply it if possible .*)
80.115 +(*report applicability of tac in tacis; pt is dropped in setNextTactic*)
80.116 +fun locatetac _ (ptp as (_,([],Res))) = ("end-of-calculation", ([], [], ptp))
80.117 +(* val ptp as (pt, p) = (pt, p);
80.118 + val ptp as (pt, p) = (pt, ip);
80.119 + *)
80.120 + | locatetac tac (ptp as (pt, p)) =
80.121 + let val (mI,m) = mk_tac'_ tac;
80.122 + in case applicable_in p pt m of
80.123 + Notappl e => ("not-applicable", ([],[], ptp):calcstate')
80.124 + | Appl m =>
80.125 +(* val Appl m = applicable_in p pt m;
80.126 + *)
80.127 + let val x = if mI mem specsteps
80.128 + then loc_specify_ m ptp else loc_solve_ (mI,m) ptp
80.129 + in case x of
80.130 + ERror e => ("failure", ([], [], ptp))
80.131 + (*FIXXXXXME: loc_specify_, loc_solve_ TOGETHER with dropping meOLD+detail.sml*)
80.132 + | UNsafe cs' => ("unsafe-ok", cs')
80.133 + | Updated (cs' as (_,_,(_,p'))) =>
80.134 + (*ev.SEVER.tacs like Begin_Trans*)
80.135 + (if p' = ([],Res) then "end-of-calculation" else "ok",
80.136 + cs')(*for -"- user to ask ? *)
80.137 + end
80.138 + end;
80.139 +
80.140 +
80.141 +(*------------------------------------------------------------------
80.142 +fun init_detail ptp = e_calcstate;(*15.8.03.MISSING-->solve.sml!?*)
80.143 +(*----------------------------------------------------from solve.sml*)
80.144 + | nxt_solv (Detail_Set'(thy', rls, t)) (pt, p) =
80.145 + let (*val rls = the (assoc(!ruleset',rls'))
80.146 + handle _ => raise error ("solve: '"^rls'^"' not known");*)
80.147 + val thy = assoc_thy thy';
80.148 + val (srls, sc, is) =
80.149 + case rls of
80.150 + Rrls {scr=sc as Rfuns {init_state=ii,...},...} =>
80.151 + (e_rls, sc, RrlsState (ii t))
80.152 + | Rls {srls=srls,scr=sc as Script s,...} =>
80.153 + (srls, sc, ScrState ([(one_scr_arg s,t)], [],
80.154 + None, e_term, Sundef, true));
80.155 + val pt = update_tac pt (fst p) (Detail_Set (id_rls rls));
80.156 + val (p,cid,_,pt) = generate1 thy (Begin_Trans' t) is p pt;
80.157 + val nx = (tac_2tac o fst3) (next_tac (thy',srls) (pt,p) sc is);
80.158 + val aopt = applicable_in p pt nx;
80.159 + in case aopt of
80.160 + Notappl s => raise error ("solve Detail_Set: "^s)
80.161 + (* val Appl m = aopt;
80.162 + *)
80.163 + | Appl m => solve ("discardFIXME",m) p pt end
80.164 +------------------------------------------------------------------*)
80.165 +
80.166 +
80.167 +(*iterated by nxt_me; there (the resulting) ptp dropped
80.168 + may call nxt_solve Apply_Method --- thus evaluated here after solve.sml*)
80.169 +(* val (ptp as (pt, pos as (p,p_))) = ptp;
80.170 + val (ptp as (pt, pos as (p,p_))) = (pt,ip);
80.171 + *)
80.172 +fun nxt_specify_ (ptp as (pt, pos as (p,p_))) =
80.173 + let val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
80.174 + probl,spec=(dI,pI,mI),...}) = get_obj I pt p;
80.175 + in if just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin
80.176 + then case mI' of
80.177 + ["no_met"] => nxt_specif (Refine_Tacitly pI') (pt, (p,Pbl))
80.178 + | _ => nxt_specif Model_Problem (pt, (p,Pbl))
80.179 + else let val cpI = if pI = e_pblID then pI' else pI;
80.180 + val cmI = if mI = e_metID then mI' else mI;
80.181 + val {ppc,prls,where_,...} = get_pbt cpI;
80.182 + val pre = check_preconds thy prls where_ probl;
80.183 + val pb = foldl and_ (true, map fst pre);
80.184 + (*FIXME.WN0308: ~~~~~: just check true in itms of pbl/met?*)
80.185 + val (_,tac) =
80.186 + nxt_spec p_ pb oris (dI',pI',mI') (probl,meth)
80.187 + (ppc,(#ppc o get_met) cmI) (dI,pI,mI);
80.188 + in case tac of
80.189 + Apply_Method mI =>
80.190 +(* val Apply_Method mI = tac;
80.191 + *)
80.192 + nxt_solv (Apply_Method' (mI, None, e_istate)) e_istate ptp
80.193 + | _ => nxt_specif tac ptp end
80.194 + end;
80.195 +
80.196 +
80.197 +(*.specify a new method;
80.198 + WN0512 impl.incomplete, see 'nxt_specif (Specify_Method ' .*)
80.199 +fun set_method (mI:metID) ptp =
80.200 + let val ([(_, Specify_Method' (_, _, mits), _)], [], (pt, pos as (p,_))) =
80.201 + nxt_specif (Specify_Method mI) ptp
80.202 + val pre = [] (*...from Specify_Method'*)
80.203 + val complete = true (*...from Specify_Method'*)
80.204 + (*from Specify_Method' ? vvv, vvv ?*)
80.205 + val PblObj {origin = (_,_,hdf), spec,...} = get_obj I pt p
80.206 + in (pt, (complete, Met, hdf, mits, pre, spec):ocalhd) end;
80.207 +
80.208 +(* val ([(_, Specify_Method' (_, _, mits), _)], [],_) =
80.209 + nxt_specif (Specify_Method mI) ptp;
80.210 + *)
80.211 +
80.212 +(*.specify a new problem;
80.213 + WN0512 impl.incomplete, see 'nxt_specif (Specify_Problem ' .*)
80.214 +(* val (pI, ptp) = (pI, (pt, ip));
80.215 + *)
80.216 +fun set_problem pI (ptp: ptree * pos') =
80.217 + let val ([(_, Specify_Problem' (_, (complete, (pits, pre))),_)],
80.218 + _, (pt, pos as (p,_))) = nxt_specif (Specify_Problem pI) ptp
80.219 + (*from Specify_Problem' ? vvv, vvv ?*)
80.220 + val PblObj {origin = (_,_,hdf), spec,...} = get_obj I pt p
80.221 + in (pt, (complete, Pbl, hdf, pits, pre, spec):ocalhd) end;
80.222 +
80.223 +fun set_theory (tI:thyID) (ptp: ptree * pos') =
80.224 + let val ([(_, Specify_Problem' (_, (complete, (pits, pre))),_)],
80.225 + _, (pt, pos as (p,_))) = nxt_specif (Specify_Theory tI) ptp
80.226 + (*from Specify_Theory' ? vvv, vvv ?*)
80.227 + val PblObj {origin = (_,_,hdf), spec,...} = get_obj I pt p
80.228 + in (pt, (complete, Pbl, hdf, pits, pre, spec):ocalhd) end;
80.229 +
80.230 +(*.does a step forward; returns tactic used, ctree updated.
80.231 +TODO.WN0512 redesign after specify-phase became more separated from solve-phase
80.232 +arg ip:
80.233 + calcstate
80.234 +.*)
80.235 +(* val (ip as (_,p_), (ptp as (pt,p), tacis)) = (get_pos 1 1, get_calc 1);
80.236 + val (ip as (_,p_), (ptp as (pt,p), tacis)) = (pos, cs);
80.237 + val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'),[]));
80.238 + val (ip as (_,p_), (ptp as (pt,p), tacis)) = (ip,cs);
80.239 + *)
80.240 +fun step ((ip as (_,p_)):pos') ((ptp as (pt,p), tacis):calcstate) =
80.241 + let val pIopt = get_pblID (pt,ip);
80.242 + in if (*p = ([],Res) orelse*) ip = ([],Res)
80.243 + then ("end-of-calculation",(tacis, [], ptp):calcstate') else
80.244 + case tacis of
80.245 + (_::_) =>
80.246 +(* val((tac,_,_)::_) = tacis;
80.247 + *)
80.248 + if ip = p (*the request is done where ptp waits for*)
80.249 + then let val (pt',c',p') = generate tacis (pt,[],p)
80.250 + in ("ok", (tacis, c', (pt', p'))) end
80.251 + else (case (if p_ mem [Pbl,Met]
80.252 + then nxt_specify_ (pt,ip) else nxt_solve_ (pt,ip))
80.253 + handle _ => ([],[],ptp)(*e.g.by Add_Given "equality///"*)
80.254 + of cs as ([],_,_) => ("helpless", cs)
80.255 + | cs => ("ok", cs))
80.256 +(* val [] = tacis;
80.257 + *)
80.258 + | _ => (case pIopt of
80.259 + None => ("no-fmz-spec", ([], [], ptp))
80.260 + | Some pI =>
80.261 +(* val Some pI = pIopt;
80.262 + val cs = (if p_ mem [Pbl,Met] andalso is_none (get_obj g_env pt (fst p))
80.263 + then nxt_specify_ (pt,ip) else nxt_solve_ (pt,ip))
80.264 + handle _ => ([], ptp);
80.265 + *)
80.266 + (case (if p_ mem [Pbl,Met]
80.267 + andalso is_none (get_obj g_env pt (fst p))
80.268 + (*^^^^^^^^: Apply_Method without init_form*)
80.269 + then nxt_specify_ (pt,ip) else nxt_solve_ (pt,ip) )
80.270 + handle _ => ([],[],ptp)(*e.g.by Add_Giv"equality/"*)
80.271 + of cs as ([],_,_) =>("helpless", cs)(*FIXXMEdel.handle*)
80.272 + | cs => ("ok", cs)))
80.273 + end;
80.274 +
80.275 +(* (nxt_solve_ (pt,ip)) handle e => print_exn e ;
80.276 +
80.277 + *)
80.278 +
80.279 +
80.280 +
80.281 +
80.282 +(*.does several steps within one calculation as given by "type auto";
80.283 + the steps may arbitrarily go into and leave different phases,
80.284 + i.e. specify-phase and solve-phase.*)
80.285 +(*TODO.WN0512 ? redesign after the phases have been more separated
80.286 + at the fron-end in 05:
80.287 + eg. CompleteCalcHead could be done by a separate fun !!!*)
80.288 +(* val (ip, cs as (ptp as (pt,p),tacis)) = (get_pos cI 1, get_calc cI);
80.289 + val (ip, cs as (ptp as (pt,p),tacis)) = (pold, get_calc cI);
80.290 + val (c, ip, cs as (ptp as (_,p),tacis), Step s) =
80.291 + ([]:pos' list, pold, get_calc cI, auto);
80.292 + *)
80.293 +fun autocalc c ip (cs as (ptp as (_,p),tacis)) (Step s) =
80.294 + if s <= 1
80.295 + then let val (str, (_, c', ptp)) = step ip cs;(*1*)
80.296 + (*at least does 1 step, ev.1 too much*)
80.297 + in (str, c@c', ptp) end
80.298 + else let val (str, (_, c', ptp as (_, p))) = step ip cs;
80.299 + in if str = "ok"
80.300 + then autocalc (c@c') p (ptp,[]) (Step (s-1))
80.301 + else (str, c@c', ptp) end
80.302 +(*handles autoord <= 3, autoord > 3 handled by all_/complete_solve*)
80.303 + | autocalc c (pos as (_,p_)) ((pt,_), _(*tacis would help 1x in solve*))auto=
80.304 +(* val (c:pos' list, (pos as (_,p_)),((pt,_),_),auto) =
80.305 + ([], pold, get_calc cI, auto);
80.306 + *)
80.307 + if autoord auto > 3 andalso just_created (pt, pos)
80.308 + then let val ptp = all_modspec (pt, pos);
80.309 + in all_solve auto c ptp end
80.310 + else
80.311 + if p_ mem [Pbl, Met]
80.312 + then if not (is_complete_mod (pt, pos))
80.313 + then let val ptp = complete_mod (pt, pos)
80.314 + in if autoord auto < 3 then ("ok", c, ptp)
80.315 + else
80.316 + if not (is_complete_spec ptp)
80.317 + then let val ptp = complete_spec ptp
80.318 + in if autoord auto = 3 then ("ok", c, ptp)
80.319 + else all_solve auto c ptp
80.320 + end
80.321 + else if autoord auto = 3 then ("ok", c, ptp)
80.322 + else all_solve auto c ptp
80.323 + end
80.324 + else
80.325 + if not (is_complete_spec (pt,pos))
80.326 + then let val ptp = complete_spec (pt, pos)
80.327 + in if autoord auto = 3 then ("ok", c, ptp)
80.328 + else all_solve auto c ptp
80.329 + end
80.330 + else if autoord auto = 3 then ("ok", c, (pt, pos))
80.331 + else all_solve auto c (pt, pos)
80.332 + else complete_solve auto c (pt, pos);
80.333 +(* val pbl = get_obj g_pbl (fst ptp) [];
80.334 + val (oris,_,_) = get_obj g_origin (fst ptp) [];
80.335 +*)
80.336 +
80.337 +
80.338 +
80.339 +
80.340 +
80.341 +(*.initialiye matching; before 'tryMatch' get the pblID to match with:
80.342 + if no pbl has been specified, take the init from origin.*)
80.343 +(*fun initmatch pt (pos as (p,_):pos') =
80.344 + let val PblObj {probl,origin=(os,(_,pI,_),_),spec=(dI',pI',mI'),...} =
80.345 + get_obj I pt p
80.346 + val pblID = if pI' = e_pblID
80.347 + then (*TODO.WN051125 (#init o get_pbt) pI <<<*)
80.348 + takelast (2, pI) (*FIXME.WN051125 a hack, impl.^^^*)
80.349 + else pI'
80.350 + val spec = (dI',pblID,mI')
80.351 + val {ppc,where_,prls,...} = get_pbt pblID
80.352 + val (model_ok, (pbl, pre)) =
80.353 + match_itms_oris (assoc_thy "Isac.thy") probl (ppc,where_,prls) os
80.354 + in ModSpec (ocalhd_complete pbl pre spec,
80.355 + Pbl, e_term, pbl, pre, spec) end;*)
80.356 +fun initcontext_pbl pt (pos as (p,_):pos') =
80.357 + let val PblObj {probl,origin=(os,(_,pI,_),hdl),spec=(dI',pI',mI'),...} =
80.358 + get_obj I pt p
80.359 + val pblID = if pI' = e_pblID
80.360 + then (*TODO.WN051125 (#init o get_pbt) pI <<<*)
80.361 + takelast (2, pI) (*FIXME.WN051125 a hack, impl.^^^*)
80.362 + else pI'
80.363 + val {ppc,where_,prls,...} = get_pbt pblID
80.364 + val (model_ok, (pbl, pre)) =
80.365 + match_itms_oris (assoc_thy "Isac.thy") probl (ppc,where_,prls) os
80.366 + in (model_ok, pblID, hdl, pbl, pre) end;
80.367 +
80.368 +fun initcontext_met pt (pos as (p,_):pos') =
80.369 + let val PblObj {meth,origin=(os,(_,_,mI), _),spec=(_, _, mI'),...} =
80.370 + get_obj I pt p
80.371 + val metID = if mI' = e_metID
80.372 + then (*TODO.WN051125 (#init o get_pbt) pI <<<*)
80.373 + takelast (2, mI) (*FIXME.WN051125 a hack, impl.^^^*)
80.374 + else mI'
80.375 + val {ppc,pre,prls,scr,...} = get_met metID
80.376 + val (model_ok, (pbl, pre)) =
80.377 + match_itms_oris (assoc_thy "Isac.thy") meth (ppc,pre,prls) os
80.378 + in (model_ok, metID, scr, pbl, pre) end;
80.379 +
80.380 +(*.match the model of a problem at pos p
80.381 + with the model-pattern of the problem with pblID*)
80.382 +fun context_pbl pI pt (p:pos) =
80.383 + let val PblObj {probl,origin=(os,_,hdl),...} = get_obj I pt p
80.384 + val {ppc,where_,prls,...} = get_pbt pI
80.385 + val (model_ok, (pbl, pre)) =
80.386 + match_itms_oris (assoc_thy "Isac.thy") probl (ppc,where_,prls) os
80.387 + in (model_ok, pI, hdl, pbl, pre) end;
80.388 +
80.389 +fun context_met mI pt (p:pos) =
80.390 + let val PblObj {meth,origin=(os,_,hdl),...} = get_obj I pt p
80.391 + val {ppc,pre,prls,scr,...} = get_met mI
80.392 + val (model_ok, (pbl, pre)) =
80.393 + match_itms_oris (assoc_thy "Isac.thy") meth (ppc,pre,prls) os
80.394 + in (model_ok, mI, scr, pbl, pre) end
80.395 +
80.396 +
80.397 +(* val (pI, pt, pos as (p,_)) = (pblID, pt, p);
80.398 + *)
80.399 +fun tryrefine pI pt (pos as (p,_):pos') =
80.400 + let val PblObj {probl,origin=(os,_,hdl),...} = get_obj I pt p
80.401 + in case refine_pbl (assoc_thy "Isac.thy") pI probl of
80.402 + None => (*copy from context_pbl*)
80.403 + let val {ppc,where_,prls,...} = get_pbt pI
80.404 + val (_, (pbl, pre)) = match_itms_oris (assoc_thy "Isac.thy")
80.405 + probl (ppc,where_,prls) os
80.406 + in (false, pI, hdl, pbl, pre) end
80.407 + | Some (pI, (pbl, pre)) =>
80.408 + (true, pI, hdl, pbl, pre)
80.409 + end;
80.410 +
80.411 +(* val (pt, (pos as (p,p_):pos')) = (pt, ip);
80.412 + *)
80.413 +fun detailstep pt (pos as (p,p_):pos') =
80.414 + let val nd = get_nd pt p
80.415 + val cn = children nd
80.416 + in if null cn
80.417 + then if (is_rewset o (get_obj g_tac nd)) [(*root of nd*)]
80.418 + then detailrls pt pos
80.419 + else ("no-Rewrite_Set...", EmptyPtree, e_pos')
80.420 + else ("donesteps", pt(*, get_formress [] ((lev_on o lev_dn) p) cn*),
80.421 + (p @ [length (children (get_nd pt p))], Res) )
80.422 + end;
80.423 +
80.424 +
80.425 +
80.426 +(***. for mathematics authoring on sml-toplevel; no XML .***)
80.427 +
80.428 +type NEW = int list;
80.429 +(* val sp = (dI',pI',mI');
80.430 + *)
80.431 +
80.432 +(*15.8.03 for me with loc_specify/solve, nxt_specify/solve
80.433 + delete as soon as TESTg_form -> _mout_ dropped*)
80.434 +fun TESTg_form ptp =
80.435 +(* val ptp = (pt,p);
80.436 + *)
80.437 + let val (form,_,_) = pt_extract ptp
80.438 + in case form of
80.439 + Form t => Form' (FormKF (~1,EdUndef,0,Nundef,term2str t))
80.440 + | ModSpec (_,p_, head, gfr, pre, _) =>
80.441 + Form' (PpcKF (0,EdUndef,0,Nundef,
80.442 + (case p_ of Pbl => Problem[] | Met => Method[],
80.443 + itms2itemppc (assoc_thy"Isac.thy") gfr pre)))
80.444 + end;
80.445 +
80.446 +(*.create a calc-tree; for use within sml: thus ^^^ NOT decoded to ^;
80.447 + compare "fun CalcTree" which DOES decode.*)
80.448 +fun CalcTreeTEST [(fmz, sp):fmz] =
80.449 +(* val [(fmz, sp):fmz] = [(fmz, (dI',pI',mI'))];
80.450 + val [(fmz, sp):fmz] = [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
80.451 + *)
80.452 + let val cs as ((pt,p), tacis) = nxt_specify_init_calc (fmz, sp)
80.453 + val tac = case tacis of [] => Empty_Tac | _ => (#1 o hd) tacis
80.454 + val f = TESTg_form (pt,p)
80.455 + in (p, []:NEW, f, (tac2IDstr tac, tac), Sundef, pt) end;
80.456 +
80.457 +(*for tests > 15.8.03 after separation setnexttactic / nextTac:
80.458 + external view: me should be used by math-authors as done so far
80.459 + internal view: loc_specify/solve, nxt_specify/solve used
80.460 + i.e. same as in setnexttactic / nextTac*)
80.461 +(*ENDE TESTPHASE 08/10.03:
80.462 + NEW loeschen, eigene Version von locatetac, step
80.463 + meNEW, CalcTreeTEST: tac'_ -replace-> tac, remove [](cid) *)
80.464 +
80.465 +(* val ((_,tac), p, _, pt) = (nxt, p, c, pt);
80.466 + *)
80.467 +fun me ((_,tac):tac'_) (p:pos') (_:NEW(*remove*)) (pt:ptree) =
80.468 + let val (pt, p) =
80.469 +(* val (msg, (tacis, pos's, (pt',p'))) = locatetac tac (pt,p);
80.470 + p = ([1, 9], Res);
80.471 + (writeln o istate2str) (get_istate pt p);
80.472 + *)
80.473 + (*locatetac is here for testing by me; step would suffice in me*)
80.474 + case locatetac tac (pt,p) of
80.475 + ("ok", (_, _, ptp)) => ptp
80.476 + | ("unsafe-ok", (_, _, ptp)) => ptp
80.477 + | ("not-applicable",_) => (pt, p)
80.478 + | ("end-of-calculation", (_, _, ptp)) => ptp
80.479 + | ("failure",_) => raise error "sys-error";
80.480 + val (_, ts) =
80.481 +(* val (eee, (ts, _, (pt'',_))) = step p ((pt, e_pos'),[]);
80.482 + *)
80.483 + (case step p ((pt, e_pos'),[]) of
80.484 + ("ok", (ts as (tac,_,_)::_, _, _)) => ("",ts)
80.485 + | ("helpless",_) => ("helpless: cannot propose tac", [])
80.486 + | ("no-fmz-spec",_) => raise error "no-fmz-spec"
80.487 + | ("end-of-calculation", (ts, _, _)) => ("",ts))
80.488 + handle _ => raise error "sys-error";
80.489 + val tac = case ts of tacis as (_::_) =>
80.490 +(* val tacis as (_::_) = ts;
80.491 + *)
80.492 + let val (tac,_,_) = last_elem tacis
80.493 + in tac end
80.494 + | _ => if p = ([],Res) then End_Proof'
80.495 + else Empty_Tac;
80.496 + (*form output comes from locatetac*)
80.497 + in(p:pos',[]:NEW, TESTg_form (pt, p),
80.498 + (tac2IDstr tac, tac):tac'_, Sundef, pt) end;
80.499 +
80.500 +(*for quick test-print-out, until 'type inout' is removed*)
80.501 +fun f2str (Form' (FormKF (_, _, _, _, cterm'))) = cterm';
80.502 +
80.503 +
80.504 +
80.505 +(*------------------------------------------------------------------(**)
80.506 +end
80.507 +open MathEngine;
80.508 +(**)------------------------------------------------------------------*)
80.509 +
81.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
81.2 +++ b/src/Pure/isac/ME/mstools.sml Wed Jul 21 13:53:39 2010 +0200
81.3 @@ -0,0 +1,1068 @@
81.4 +(* Types and tools for 'modeling' und 'specifying' to be used in
81.5 + modspec.sml. The types are separated from calchead.sml into this file,
81.6 + because some of them are stored in the calc-tree, and thus are required
81.7 + _before_ ctree.sml.
81.8 + author: Walther Neuper
81.9 + (c) due to copyright terms
81.10 +
81.11 +use"ME/mstools.sml" (*re-evaluate sml/ from scratch!*);
81.12 +use"mstools.sml";
81.13 +*)
81.14 +
81.15 +signature SPECIFY_TOOLS =
81.16 + sig
81.17 + type envv
81.18 + datatype
81.19 + item =
81.20 + Correct of cterm'
81.21 + | False of cterm'
81.22 + | Incompl of cterm'
81.23 + | Missing of cterm'
81.24 + | Superfl of string
81.25 + | SyntaxE of string
81.26 + | TypeE of string
81.27 + val item2str : item -> string
81.28 + type itm
81.29 + val itm2str : Theory.theory -> itm -> string
81.30 + datatype
81.31 + itm_ =
81.32 + Cor of (Term.term * Term.term list) * (Term.term * Term.term list)
81.33 + | Inc of (Term.term * Term.term list) * (Term.term * Term.term list)
81.34 + | Mis of Term.term * Term.term
81.35 + | Par of cterm'
81.36 + | Sup of Term.term * Term.term list
81.37 + | Syn of cterm'
81.38 + | Typ of cterm'
81.39 + val itm_2str : itm_ -> string
81.40 + val itm__2str : Theory.theory -> itm_ -> string
81.41 + val itms2str : Theory.theory -> itm list -> string
81.42 + type 'a ppc
81.43 + val ppc2str :
81.44 + {Find: string list, With: string list, Given: string list,
81.45 + Where: string list, Relate: string list} -> string
81.46 + datatype
81.47 + match =
81.48 + Matches of pblID * item ppc
81.49 + | NoMatch of pblID * item ppc
81.50 + val match2str : match -> string
81.51 + datatype
81.52 + match_ =
81.53 + Match_ of pblID * (itm list * (bool * Term.term) list)
81.54 + | NoMatch_
81.55 + val matchs2str : match list -> string
81.56 + type ori
81.57 + val ori2str : ori -> string
81.58 + val oris2str : ori list -> string
81.59 + type preori
81.60 + val preori2str : preori -> string
81.61 + val preoris2str : preori list -> string
81.62 + type penv
81.63 + (* val penv2str : Theory.theory -> penv -> string *)
81.64 + type vats
81.65 + (*----------------------------------------------------------------------*)
81.66 + val all_ts_in : itm_ list -> Term.term list
81.67 + val check_preconds :
81.68 + 'a ->
81.69 + rls ->
81.70 + Term.term list -> itm list -> (bool * Term.term) list
81.71 + val check_preconds' :
81.72 + rls ->
81.73 + Term.term list ->
81.74 + itm list -> 'a -> (bool * Term.term) list
81.75 + (* val chkpre2item : rls -> Term.term -> bool * item *)
81.76 + val pres2str : (bool * Term.term) list -> string
81.77 + (* val evalprecond : rls -> Term.term -> bool * Term.term *)
81.78 + (* val cnt : itm list -> int -> int * int *)
81.79 + val comp_dts : Theory.theory -> Term.term * Term.term list -> Thm.cterm
81.80 + val comp_dts' : Term.term * Term.term list -> Term.term
81.81 + val comp_dts'' : Term.term * Term.term list -> string
81.82 + val comp_ts : Term.term * Term.term list -> Term.term
81.83 + val d_in : itm_ -> Term.term
81.84 + val de_item : item -> cterm'
81.85 + val dest_list : Term.term * Term.term list -> Term.term list (* for testing *)
81.86 + val dest_list' : Term.term -> Term.term list
81.87 + val dts2str : Term.term * Term.term list -> string
81.88 + val e_itm : itm
81.89 + (* val e_listBool : Term.term *)
81.90 + (* val e_listReal : Term.term *)
81.91 + val e_ori : ori
81.92 + val e_ori_ : ori
81.93 + val empty_ppc : item ppc
81.94 + (* val empty_ppc_ct' : cterm' ppc *)
81.95 + (* val getval : Term.term * Term.term list -> Term.term * Term.term *)
81.96 + (*val head_precond :
81.97 + domID * pblID * 'a ->
81.98 + Term.term Library.option ->
81.99 + rls ->
81.100 + Term.term list ->
81.101 + itm list -> 'b -> Term.term * (bool * Term.term) list*)
81.102 + (* val init_item : string -> item *)
81.103 + (* val is_matches : match -> bool *)
81.104 + (* val is_matches_ : match_ -> bool *)
81.105 + val is_var : Term.term -> bool
81.106 + (* val item_ppc :
81.107 + string ppc -> item ppc *)
81.108 + val itemppc2str : item ppc -> string
81.109 + val linefeed : string -> string
81.110 + (* val matches_pblID : match -> pblID *)
81.111 + val max2 : ('a * int) list -> 'a * int
81.112 + val max_vt : itm list -> int
81.113 + val mk_e : itm_ -> (Term.term * Term.term) list
81.114 + val mk_en : int -> itm -> (Term.term * Term.term) list
81.115 + val mk_env : itm list -> (Term.term * Term.term) list
81.116 + val mkval : 'a -> Term.term list -> Term.term
81.117 + val mkval' : Term.term list -> Term.term
81.118 + (* val pblID_of_match : match -> pblID *)
81.119 + val pbl_ids : Theory.theory -> Term.term -> Term.term -> Term.term list
81.120 + val pbl_ids' : 'a -> Term.term -> Term.term list -> Term.term list
81.121 + (* val pen2str : Theory.theory -> Term.term * Term.term list -> string *)
81.122 + val penvval_in : itm_ -> Term.term list
81.123 + val refined : match list -> pblID
81.124 + val refined_ :
81.125 + match_ list -> match_ Library.option
81.126 + (* val refined_IDitms :
81.127 + match list -> match Library.option *)
81.128 + val split_dts : 'a -> Term.term -> Term.term * Term.term list
81.129 + val split_dts' : Term.term * Term.term -> Term.term list
81.130 + (* val take_apart : Term.term -> Term.term list *)
81.131 + (* val take_apart_inv : Term.term list -> Term.term *)
81.132 + val ts_in : itm_ -> Term.term list
81.133 + (* val unique : Term.term *)
81.134 + val untouched : itm list -> bool
81.135 + val upd :
81.136 + Theory.theory ->
81.137 + (''a * (''b * Term.term list) list) list ->
81.138 + Term.term ->
81.139 + ''b * Term.term -> ''a -> ''a * (''b * Term.term list) list
81.140 + val upd_envv :
81.141 + Theory.theory ->
81.142 + envv ->
81.143 + vats ->
81.144 + Term.term -> Term.term -> Term.term -> envv
81.145 + val upd_penv :
81.146 + Theory.theory ->
81.147 + (''a * Term.term list) list ->
81.148 + Term.term -> ''a * Term.term -> (''a * Term.term list) list
81.149 + (* val upds_envv :
81.150 + Theory.theory ->
81.151 + envv ->
81.152 + (vats * Term.term * Term.term * Term.term) list ->
81.153 + envv *)
81.154 + val vts_cnt : int list -> itm list -> (int * int) list
81.155 + val vts_in : itm list -> int list
81.156 + (* val w_itms2str : Theory.theory -> itm list -> unit *)
81.157 + end
81.158 +
81.159 +(*----------------------------------------------------------*)
81.160 +structure SpecifyTools : SPECIFY_TOOLS =
81.161 +struct
81.162 +(*----------------------------------------------------------*)
81.163 +val e_listReal = (term_of o the o (parse Script.thy)) "[]::(real list)";
81.164 +val e_listBool = (term_of o the o (parse Script.thy)) "[]::(bool list)";
81.165 +
81.166 +(*.take list-term apart w.r.t. handling elementwise input.*)
81.167 +fun take_apart t =
81.168 + let val elems = isalist2list t
81.169 + in map ((list2isalist (type_of (hd elems))) o single) elems end;
81.170 +(*val t = str2term "[a, b]";
81.171 +> val ts = take_apart t; writeln (terms2str ts);
81.172 +["[a]","[b]"]
81.173 +
81.174 +> t = (take_apart_inv o take_apart) t;
81.175 +true*)
81.176 +fun take_apart_inv ts =
81.177 + let val elems = (flat o (map isalist2list)) ts;
81.178 + in list2isalist (type_of (hd elems)) elems end;
81.179 +(*val ts = [str2term "[a]", str2term "[b]"];
81.180 +> val t = take_apart_inv ts; term2str t;
81.181 +"[a, b]"
81.182 +
81.183 +ts = (take_apart o take_apart_inv) ts;
81.184 +true*)
81.185 +
81.186 +
81.187 +
81.188 +
81.189 +(*.revert split_dts only for ts; compare comp_dts.*)
81.190 +fun comp_ts (d, ts) =
81.191 + if is_list_dsc d
81.192 + then if is_list (hd ts)
81.193 + then if is_unl d
81.194 + then (hd ts) (*e.g. someList [1,3,2]*)
81.195 + else (take_apart_inv ts)
81.196 + (* SML[ [a], [b] ]SML --> [a,b] *)
81.197 + else (hd ts) (*a variable or metavariable for a list*)
81.198 + else (hd ts);
81.199 +(*.revert split_.
81.200 + WN050903 we do NOT know which is from subtheory, description or term;
81.201 + typecheck thus may lead to TYPE-error 'unknown constant';
81.202 + solution: typecheck with Isac.thy; i.e. arg 'thy' superfluous*)
81.203 +fun comp_dts thy (d,[]) =
81.204 + cterm_of ((sign_of o assoc_thy) "Isac.thy")
81.205 + (*comp_dts:FIXXME stay with term for efficiency !!!*)
81.206 + (if is_reall_dsc d then (d $ e_listReal)
81.207 + else if is_booll_dsc d then (d $ e_listBool)
81.208 + else d)
81.209 + | comp_dts thy (d,ts) =
81.210 + (cterm_of ((sign_of o assoc_thy) "Isac.thy")
81.211 + (*comp_dts:FIXXME stay with term for efficiency !!*)
81.212 + (d $ (comp_ts (d, ts)))
81.213 + handle _ => raise error ("comp_dts: "^(term2str d)^
81.214 + " $ "^(term2str (hd ts))));
81.215 +(*25.8.03*)
81.216 +fun comp_dts' (d,[]) =
81.217 + if is_reall_dsc d then (d $ e_listReal)
81.218 + else if is_booll_dsc d then (d $ e_listBool)
81.219 + else d
81.220 + | comp_dts' (d,ts) = (d $ (comp_ts (d, ts)))
81.221 + handle _ => raise error ("comp_dts': "^(term2str d)^
81.222 + " $ "^(term2str (hd ts)));
81.223 +(*val t = str2term "maximum A";
81.224 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.225 +val it = "maximum A" : cterm
81.226 +> val t = str2term "fixedValues [r=Arbfix]";
81.227 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.228 +"fixedValues [r = Arbfix]"
81.229 +> val t = str2term "valuesFor [a]";
81.230 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.231 +"valuesFor [a]"
81.232 +> val t = str2term "valuesFor [a,b]";
81.233 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.234 +"valuesFor [a, b]"
81.235 +> val t = str2term "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]";
81.236 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.237 +relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]"
81.238 +> val t = str2term "boundVariable a";
81.239 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.240 +"boundVariable a"
81.241 +> val t = str2term "interval {x::real. 0 <= x & x <= 2*r}";
81.242 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.243 +"interval {x. 0 <= x & x <= 2 * r}"
81.244 +
81.245 +> val t = str2term "equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))";
81.246 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.247 +"equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))"
81.248 +> val t = str2term "solveFor x";
81.249 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.250 +"solveFor x"
81.251 +> val t = str2term "errorBound (eps=0)";
81.252 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.253 +"errorBound (eps = 0)"
81.254 +> val t = str2term "solutions L";
81.255 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
81.256 +"solutions L"
81.257 +
81.258 +before 6.5.03:
81.259 +> val t = (term_of o the o (parse thy)) "testdscforlist [#1]";
81.260 +> val (d,ts) = split_dts t;
81.261 +> comp_dts thy (d,ts);
81.262 +val it = "testdscforlist [#1]" : cterm
81.263 +
81.264 +> val t = (term_of o the o (parse thy)) "(A::real)";
81.265 +> val (d,ts) = split_dts t;
81.266 +val d = Const ("empty","empty") : term
81.267 +val ts = [Free ("A","RealDef.real")] : term list
81.268 +> val t = (term_of o the o (parse thy)) "[R=(R::real)]";
81.269 +> val (d,ts) = split_dts t;
81.270 +val d = Const ("empty","empty") : term
81.271 +val ts = [Const # $ Free # $ Free (#,#)] : term list
81.272 +> val t = (term_of o the o (parse thy)) "[#1,#2]";
81.273 +> val (d,ts) = split_dts t;
81.274 +val ts = [Free ("#1","'a"),Free ("#2","'a")] : NOT WANTED
81.275 +*)
81.276 +
81.277 +(*for input_icalhd 11.03*)
81.278 +fun comp_dts'' (d,[]) =
81.279 + if is_reall_dsc d then term2str (d $ e_listReal)
81.280 + else if is_booll_dsc d then term2str (d $ e_listBool)
81.281 + else term2str d
81.282 + | comp_dts'' (d,ts) = term2str (d $ (comp_ts (d, ts)))
81.283 + handle _ => raise error ("comp_dts'': "^(term2str d)^
81.284 + " $ "^(term2str (hd ts)));
81.285 +
81.286 +
81.287 +
81.288 +
81.289 +
81.290 +
81.291 +(* this may decompose an object-language isa-list;
81.292 + use only, if description is not available, eg. not input ?WN:14.5.03 ??!?*)
81.293 +fun dest_list' t = if is_list t then isalist2list t else [t];
81.294 +
81.295 +(*fun is_metavar (Free (str, _)) =
81.296 + if (last_elem o explode) str = "_" then true else false
81.297 + | is_metavar _ = false;*)
81.298 +fun is_var (Free _) = true
81.299 + | is_var _ = false;
81.300 +
81.301 +(*.special handling for lists. ?WN:14.5.03 ??!?*)
81.302 +fun dest_list (d,ts) =
81.303 + let fun dest t =
81.304 + if is_list_dsc d andalso not (is_unl d)
81.305 + andalso not (is_var t) (*..for pbt*)
81.306 + then isalist2list t else [t]
81.307 + in (flat o (map dest)) ts end;
81.308 +
81.309 +
81.310 +(*.decompose an input into description, terms (ev. elems of lists),
81.311 + and the value for the problem-environment; inv to comp_dts .*)
81.312 +(*WN.8.6.03: corrected with minimal effort,
81.313 +fn : theory -> term ->
81.314 + term * description
81.315 + term list * lists decomposed for elementwise input
81.316 + term list pbl_ids not _HERE_: dont know which list-elems input*)
81.317 +fun split_dts thy (t as d $ arg) =
81.318 + if is_dsc d
81.319 + then if is_list_dsc d
81.320 + then if is_list arg
81.321 + then if is_unl d
81.322 + then (d, [arg]) (*e.g. someList [1,3,2]*)
81.323 + else (d, take_apart arg)(*[a,b] --> SML[ [a], [b] ]SML*)
81.324 + else (d, [arg]) (*a variable or metavariable for a list*)
81.325 + else (d, [arg])
81.326 + else (e_term, dest_list' t(*9.01 ???*))
81.327 + | split_dts thy t = (*either dsc or term*)
81.328 + let val (h,argl) = strip_comb t
81.329 + in if (not o is_dsc) h then (e_term, dest_list' t)
81.330 + else (h, dest_list (h,argl))
81.331 + end;
81.332 +(* tests see fun comp_dts
81.333 +
81.334 +> val t = str2term "someList []";
81.335 +> val (_,ts) = split_dts thy t; writeln (terms2str ts);
81.336 +["[]"]
81.337 +> val t = str2term "valuesFor []";
81.338 +> val (_,ts) = split_dts thy t; writeln (terms2str ts);
81.339 +["[]"]*)
81.340 +
81.341 +(*.version returning ts only.*)
81.342 +fun split_dts' (d, arg) =
81.343 + if is_dsc d
81.344 + then if is_list_dsc d
81.345 + then if is_list arg
81.346 + then if is_unl d
81.347 + then ([arg]) (*e.g. someList [1,3,2]*)
81.348 + else (take_apart arg)(*[a,b] --> SML[ [a], [b] ]SML*)
81.349 + else ([arg]) (*a variable or metavariable for a list*)
81.350 + else ([arg])
81.351 + else (dest_list' arg(*9.01 ???*))
81.352 + | split_dts' (d, t) = (*either dsc or term; 14.5.03 only copied*)
81.353 + let val (h,argl) = strip_comb t
81.354 + in if (not o is_dsc) h then (dest_list' t)
81.355 + else (dest_list (h,argl))
81.356 + end;
81.357 +
81.358 +
81.359 +
81.360 +
81.361 +
81.362 +(*27.8.01: problem-environment
81.363 +WN.6.5.03: FIXXME reconsider if penv is worth the effort --
81.364 + -- just rerun a whole expl with num/var may show the same ?!
81.365 +WN.9.5.03: penv-concept stalled, immediately generate script env !
81.366 + but [#0, epsilon] only outcommented for eventual reconsideration
81.367 +*)
81.368 +type penv = (term (*err_*)
81.369 + * (term list) (*[#0, epsilon] 9.5.03 outcommented*)
81.370 + ) list;
81.371 +fun pen2str thy (t, ts) =
81.372 + pair2str(Sign.string_of_term (sign_of thy) t,
81.373 + (strs2str' o map (Sign.string_of_term (sign_of thy))) ts);
81.374 +fun penv2str thy (penv:penv) = (strs2str' o (map (pen2str thy))) penv;
81.375 +
81.376 +(*
81.377 + 9.5.03: still unused, but left for eventual future development*)
81.378 +type envv = (int * penv) list; (*over variants*)
81.379 +
81.380 +(*. 14.9.01: not used after putting penv-values into itm_
81.381 + make the result of split_* a value of problem-environment .*)
81.382 +fun mkval dsc [] = raise error "mkval called with []"
81.383 + | mkval dsc [t] = t
81.384 + | mkval dsc ts = list2isalist ((type_of o hd) ts) ts;
81.385 +(*WN.12.12.03*)
81.386 +fun mkval' x = mkval e_term x;
81.387 +
81.388 +
81.389 +
81.390 +(*. get the constant value from a penv .*)
81.391 +fun getval (id, values) =
81.392 + case values of
81.393 + [] => raise error ("penv_value: no values in '"^
81.394 + (Sign.string_of_term (sign_of Tools.thy) id))
81.395 + | [v] => (id, v)
81.396 + | (v1::v2::_) => (case v1 of
81.397 + Const ("Script.Arbfix",_) => (id, v2)
81.398 + | _ => (id, v1));
81.399 +(*
81.400 + val e_ = (term_of o the o (parse thy)) "e_::bool";
81.401 + val ev = (term_of o the o (parse thy)) "#4 + #3 * x^^^#2 = #0";
81.402 + val v_ = (term_of o the o (parse thy)) "v_";
81.403 + val vv = (term_of o the o (parse thy)) "x";
81.404 + val r_ = (term_of o the o (parse thy)) "err_::bool";
81.405 + val rv1 = (term_of o the o (parse thy)) "#0";
81.406 + val rv2 = (term_of o the o (parse thy)) "eps";
81.407 +
81.408 + val penv = [(e_,[ev]),(v_,[vv]),(r_,[rv2,rv2])]:penv;
81.409 + map getval penv;
81.410 +[(Free ("e_","bool"),
81.411 + Const (#,#) $ (# $ # $ (# $ #)) $ Free ("#0","RealDef.real")),
81.412 + (Free ("v_","RealDef.real"),Free ("x","RealDef.real")),
81.413 + (Free ("err_","bool"),Free ("#0","RealDef.real"))] : (term * term) list
81.414 +*)
81.415 +
81.416 +
81.417 +(*23.3.02 TODO: ideas on redesign of type itm_,type item,type ori,type item ppc
81.418 +(1) kinds of itms:
81.419 + (1.1) untouched: for modeling only dsc displayed(impossible after match_itms)
81.420 + =(presently) Mis (? should be Inc initially, and Mis after match_itms?)
81.421 + (1.2) Syn,Typ,Sup: not related to oris
81.422 + Syn, Typ (presently) should be accepted in appl_add (instead Error')
81.423 + Sup (presently) should be accepted in appl_add (instead Error')
81.424 + _could_ be w.r.t current vat (and then _is_ related to vat
81.425 + Mis should _not_ be made Inc ((presently, by appl_add & match_itms)
81.426 +- dsc in itm_ is timeconsuming -- keep id for respective queries ?
81.427 +- order of items in ppc should be stable w.r.t order of itms
81.428 +
81.429 +- stepwise input of itms --- match_itms (in one go) ..not coordinated
81.430 + - unify code
81.431 + - match_itms / match_itms_oris ..2 versions ?!
81.432 + (fast, for refine / slow, for modeling)
81.433 +
81.434 +- clarify: efficiency <--> simplicity !!!
81.435 + ?: shift dsc itm_ -> itm | discard int in ori,itm | take int instead dsc
81.436 + | take int for perserving order of item ppc in itms
81.437 + | make all(!?) handling of itms stable against reordering(?)
81.438 + | field in ori ?? (not from fmz!) -- meant for efficiency (not doc!???)
81.439 + -"- "#undef" ?= not touched ?= (id,..)
81.440 +-----------------------------------------------------------------
81.441 +27.3.02:
81.442 +def: type pbt = (field, (dsc, pid))
81.443 +
81.444 +(1) fmz + pbt -> oris
81.445 +(2) input + oris -> itm
81.446 +(3) match_itms : schnell(?) f"ur refine
81.447 + match_itms_oris : r"uckmeldung f"ur item ppc
81.448 +
81.449 +(1.1) in oris fehlt daher pid: (i,v,f,d,ts,pid)
81.450 +---------- ^^^^^ --- dh. pbt meist als argument zu viel !!!
81.451 +
81.452 +(3.1) abwarten, wie das matchen mehr unterschiedlicher pbt's sich macht;
81.453 + wenn Problem pbt v"ollig neue, dann w"are eigentlich n"otig ????:
81.454 + (a) (_,_,d1,ts,_):ori + pbt -> (i,vt,d2,ts,pid) dh.vt neu ????
81.455 + (b)
81.456 +*)
81.457 +
81.458 +
81.459 +
81.460 +
81.461 +(*the internal representation of a models' item
81.462 +
81.463 + 4.9.01: not consistent:
81.464 + after Init_Proof 'Inc', but after copy_probl 'Mis' - for same situation
81.465 + (involves 'is_error');
81.466 + bool in itm really necessary ???*)
81.467 +datatype itm_ =
81.468 + Cor of (term * (* description *)
81.469 + (term list)) * (* for list: elem-wise input *)
81.470 + (*split_dts <-> comp_dts*)
81.471 + (term * (term list)) (* elem of penv *)
81.472 + (*9.5.03: ---- is already for script -- penv delayed to future*)
81.473 + | Syn of cterm'
81.474 + | Typ of cterm'
81.475 + | Inc of (term * (term list)) * (term * (term list)) (*lists,
81.476 + + init_pbl WN.11.03 FIXXME: empty penv .. bad
81.477 + init_pbl should return Mis !!!*)
81.478 + | Sup of (term * (term list)) (* user-input not found in pbt(+?oris?11.03)*)
81.479 + | Mis of (term * term) (* after re-specification pbt-item not found
81.480 + in pbl: only dsc, pid_*)
81.481 + | Par of cterm'; (*internal state from fun parsitm*)
81.482 +
81.483 +type vats = int list; (*variants in formalizations*)
81.484 +
81.485 +(*.data-type for working on pbl/met-ppc:
81.486 + in pbl initially holds descriptions (only) for user guidance.*)
81.487 +type itm =
81.488 + int * (* id =0 .. untouched - descript (only) from init
81.489 + 23.3.02: seems to correspond to ori (fun insert_ppc)
81.490 + <> maintain order in item ppc?*)
81.491 + vats * (* variants - copy from ori *)
81.492 + bool * (* input on this item is not/complete *)
81.493 + string * (* #Given | #Find | #Relate *)
81.494 + itm_; (* *)
81.495 +(* use"ME/sequent.sml";
81.496 + *)
81.497 +val e_itm = (0,[],false,"e_itm",Syn"e_itm"):itm;
81.498 +(*in CalcTree/Subproblem an 'untouched' model is created
81.499 + FIXME.WN.9.03 model should be filled to 'untouched' by Model/Refine_Problem*)
81.500 +fun untouched (itms: itm list) =
81.501 + foldl and_ (true ,map ((curry op= 0) o #1) itms);
81.502 +(*> untouched [];
81.503 +val it = true : bool
81.504 +> untouched [e_itm];
81.505 +val it = true : bool
81.506 +> untouched [e_itm, (1,[],false,"e_itm",Syn "e_itm")];
81.507 +val it = false : bool*)
81.508 +
81.509 +
81.510 +
81.511 +
81.512 +
81.513 +(* find most frequent variant v in itms *)
81.514 +
81.515 +fun vts_in itms = (distinct o flat o (map #2)) (itms:itm list);
81.516 +
81.517 +fun cnt itms v = (v,(length o (filter (curry op= v)) o
81.518 + flat o (map #2)) (itms:itm list));
81.519 +fun vts_cnt vts itms = map (cnt itms) vts;
81.520 +fun max2 [] = raise error "max2 of []"
81.521 + | max2 (y::ys) =
81.522 + let fun mx (a,x) [] = (a,x)
81.523 + | mx (a,x) ((b,y)::ys) =
81.524 + if x < y then mx (b,y) ys else mx (a,x) ys;
81.525 +in mx y ys end;
81.526 +
81.527 +(*. find the variant with most items already input .*)
81.528 +fun max_vt itms =
81.529 + let val vts = (vts_cnt (vts_in itms)) itms;
81.530 + in if vts = [] then 0 else (fst o max2) vts end;
81.531 +
81.532 +
81.533 +(* TODO ev. make more efficient by avoiding flat *)
81.534 +fun mk_e (Cor (_, iv)) = [getval iv]
81.535 + | mk_e (Syn _) = []
81.536 + | mk_e (Typ _) = []
81.537 + | mk_e (Inc (_, iv)) = [getval iv]
81.538 + | mk_e (Sup _) = []
81.539 + | mk_e (Mis _) = [];
81.540 +fun mk_en vt ((i,vts,b,f,itm_):itm) =
81.541 + if vt mem vts then mk_e itm_ else [];
81.542 +(*. extract the environment from an item list;
81.543 + takes the variant with most items .*)
81.544 +fun mk_env itms =
81.545 + let val vt = max_vt itms
81.546 + in (flat o (map (mk_en vt))) itms end;
81.547 +
81.548 +
81.549 +
81.550 +(*. example as provided by an author, complete w.r.t. pbt specified
81.551 + not touched by any user action .*)
81.552 +type ori = (int * (* id: 10.3.00ff impl. only <>0 .. touched
81.553 + 21.3.02: insert_ppc needs it ! ?:purpose maintain
81.554 + order in item ppc ???*)
81.555 + vats * (* variants 21.3.02: related to pbt..discard ?*)
81.556 + string * (* #Given | #Find | #Relate 21.3.02: discard ?*)
81.557 + term * (* description *)
81.558 + term list (* isalist2list t | [t] *)
81.559 + );
81.560 +val e_ori_ = (0,[],"",e_term,[e_term]):ori;
81.561 +val e_ori = (0,[],"",e_term,[e_term]):ori;
81.562 +
81.563 +fun ori2str ((i,vs,fi,t,ts):ori) =
81.564 + "("^(string_of_int i)^", "^((strs2str o (map string_of_int)) vs)^", "^fi^","^
81.565 + (term2str t)^", "^((strs2str o (map term2str)) ts)^")";
81.566 +val oris2str =
81.567 + let val s = !show_types
81.568 + val _ = show_types:= true
81.569 + val str = (strs2str' o (map (linefeed o ori2str)))
81.570 + val _ = show_types:= s
81.571 + in str end;
81.572 +
81.573 +(*.an or without leading integer.*)
81.574 +type preori = (vats *
81.575 + string *
81.576 + term *
81.577 + term list);
81.578 +fun preori2str ((vs,fi,t,ts):preori) =
81.579 + "("^((strs2str o (map string_of_int)) vs)^", "^fi^", "^
81.580 + (term2str t)^", "^((strs2str o (map term2str)) ts)^")";
81.581 +val preoris2str = (strs2str' o (map (linefeed o preori2str)));
81.582 +
81.583 +(*. given the input value (from split_dts)
81.584 + make the value in a problem-env according to description-type .*)
81.585 +(*28.8.01: .nam and .una impl. properly, others copied .. TODO*)
81.586 +(*9.5.03 penv-concept postponed *)
81.587 +fun pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.nam",_)]))) v =
81.588 + if is_list v
81.589 + then [v] (*eg. [r=Arbfix]*)
81.590 + else (case v of (*eg. eps=#0*)
81.591 + (Const ("op =",_) $ l $ r) => [r,l]
81.592 + | _ => raise error ("pbl_ids Tools.nam: no equality "
81.593 + ^(Sign.string_of_term (sign_of thy) v)))
81.594 + | pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.una",_)]))) v = [v]
81.595 + | pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.unl",_)]))) v = [v]
81.596 + | pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.str",_)]))) v = [v]
81.597 + | pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.toreal",_)]))) v = [v]
81.598 + | pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.toreall",_)])))v = [v]
81.599 + | pbl_ids thy (Const(_,Type("fun",[_,Type("Tools.unknown",_)])))v = [v]
81.600 + | pbl_ids thy _ v = raise error ("pbl_ids: not implemented for "
81.601 + ^(Sign.string_of_term (sign_of thy) v));
81.602 +(*
81.603 +val t as t1 $ t2 = str2term "antiDerivativeName M_b";
81.604 +pbl_ids thy t1 t2;
81.605 +
81.606 + val t = (term_of o the o (parse thy)) "fixedValues [r=Arbfix]";
81.607 + val (d,argl) = strip_comb t;
81.608 + is_dsc d; (*see split_dts*)
81.609 + dest_list (d,argl);
81.610 + val (_ $ v) = t;
81.611 + is_list v;
81.612 + pbl_ids thy d v;
81.613 +[Const ("List.list.Cons","[bool, bool List.list] => bool List.list") $
81.614 + (Const # $ Free # $ Const (#,#)) $ Const ("List.list.Nil","bool List..
81.615 +
81.616 + val (dsc,vl) = (split_dts o term_of o the o (parse thy)) "solveFor x";
81.617 +val dsc = Const ("Descript.solveFor","RealDef.real => Tools.una") : term
81.618 +val vl = Free ("x","RealDef.real") : term
81.619 +
81.620 + val (dsc,id) = (split_did o term_of o the o (parse thy)) "solveFor v_";
81.621 + pbl_ids thy dsc vl;
81.622 +val it = [Free ("x","RealDef.real")] : term list
81.623 +
81.624 + val (dsc,vl) = (split_dts o term_of o the o(parse thy))
81.625 + "errorBound (eps=#0)";
81.626 + val (dsc,id) = (split_did o term_of o the o(parse thy)) "errorBound err_";
81.627 + pbl_ids thy dsc vl;
81.628 +val it = [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")] : term list *)
81.629 +
81.630 +(*. given an already input itm, ((14.9.01: no difference to pbl_ids jet!!))
81.631 + make the value in a problem-env according to description-type .*)
81.632 +(*28.8.01: .nam and .una impl. properly, others copied .. TODO*)
81.633 +fun pbl_ids' (Const(_,Type("fun",[_,Type("Tools.nam",_)]))) vs =
81.634 + (case vs of
81.635 + [] => raise error ("pbl_ids' Tools.nam called with []")
81.636 + | [t] => (case t of (*eg. eps=#0*)
81.637 + (Const ("op =",_) $ l $ r) => [r,l]
81.638 + | _ => raise error ("pbl_ids' Tools.nam: no equality "
81.639 + ^(Sign.string_of_term (sign_of thy) t)))
81.640 + | vs' => vs (*14.9.01: ???TODO *))
81.641 + | pbl_ids' (Const(_,Type("fun",[_,Type("Tools.una",_)]))) vs = vs
81.642 + | pbl_ids' (Const(_,Type("fun",[_,Type("Tools.unl",_)]))) vs = vs
81.643 + | pbl_ids' (Const(_,Type("fun",[_,Type("Tools.str",_)]))) vs = vs
81.644 + | pbl_ids' (Const(_,Type("fun",[_,Type("Tools.toreal",_)]))) vs = vs
81.645 + | pbl_ids' (Const(_,Type("fun",[_,Type("Tools.toreall",_)])))vs = vs
81.646 + | pbl_ids' (Const(_,Type("fun",[_,Type("Tools.unknown",_)])))vs = vs
81.647 + | pbl_ids' _ vs =
81.648 + raise error ("pbl_ids': not implemented for "
81.649 + ^(terms2str vs));
81.650 +(*9.5.03 penv postponed: pbl_ids'*)
81.651 +fun pbl_ids' thy d vs = [comp_ts (d, vs)];
81.652 +
81.653 +
81.654 +(*14.9.01: not used after putting values for penv into itm_
81.655 + WN.5.5.03: used in upd .. upd_envv*)
81.656 +fun upd_penv thy penv dsc (id, vl) =
81.657 +(writeln"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
81.658 + writeln"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
81.659 + writeln"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
81.660 + overwrite (penv, (id, pbl_ids thy dsc vl))
81.661 +);
81.662 +(*
81.663 + val penv = [];
81.664 + val (dsc,vl) = (split_did o term_of o the o (parse thy)) "solveFor x";
81.665 + val (dsc,id) = (split_did o term_of o the o (parse thy)) "solveFor v_";
81.666 + val penv = upd_penv thy penv dsc (id, vl);
81.667 +[(Free ("v_","RealDef.real"),
81.668 + [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")])]
81.669 +: (term * term list) list
81.670 +
81.671 + val (dsc,vl) = (split_did o term_of o the o(parse thy))"errorBound (eps=#0)";
81.672 + val (dsc,id) = (split_did o term_of o the o(parse thy))"errorBound err_";
81.673 + upd_penv thy penv dsc (id, vl);
81.674 +[(Free ("v_","RealDef.real"),
81.675 + [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")]),
81.676 + (Free ("err_","bool"),
81.677 + [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")])]
81.678 +: (term * term list) list ^.........!!!!
81.679 +*)
81.680 +
81.681 +(*WN.9.5.03: not reconsidered; looks strange !!!*)
81.682 +fun upd thy envv dsc (id, vl) i =
81.683 + let val penv = case assoc (envv, i) of
81.684 + Some e => e
81.685 + | None => [];
81.686 + val penv' = upd_penv thy penv dsc (id, vl);
81.687 + in (i, penv') end;
81.688 +(*
81.689 + val i = 2;
81.690 + val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
81.691 + val (dsc,vl) = (split_did o term_of o the o(parse thy))"boundVariable b";
81.692 + val (dsc,id) = (split_did o term_of o the o(parse thy))"boundVariable v_";
81.693 + upd thy envv dsc (id, vl) i;
81.694 +val it = (2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])
81.695 + : int * (term * term list) list*)
81.696 +
81.697 +
81.698 +(*14.9.01: not used after putting pre-penv into itm_*)
81.699 +fun upd_envv thy (envv:envv) (vats:vats) dsc id vl =
81.700 + let val vats = if length vats = 0
81.701 + then (*unknown id to _all_ variants*)
81.702 + if length envv = 0 then [1]
81.703 + else (intsto o length) envv
81.704 + else vats
81.705 + fun isin vats (i,_) = i mem vats;
81.706 + val envs_notin_vat = filter_out (isin vats) envv;
81.707 + in ((map (upd thy envv dsc (id, vl)) vats) @ envs_notin_vat):envv end;
81.708 +(*
81.709 + val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
81.710 +
81.711 + val vats = [2]
81.712 + val (dsc,vl) = (split_did o term_of o the o(parse thy))"boundVariable b";
81.713 + val (dsc,id) = (split_did o term_of o the o(parse thy))"boundVariable v_";
81.714 + val envv = upd_envv thy envv vats dsc id vl;
81.715 +val envv = [(2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])]
81.716 + : (int * (term * term list) list) list
81.717 +
81.718 + val vats = [1,2,3];
81.719 + val (dsc,vl) = (split_did o term_of o the o(parse thy))"maximum A";
81.720 + val (dsc,id) = (split_did o term_of o the o(parse thy))"maximum m_";
81.721 + upd_envv thy envv vats dsc id vl;
81.722 +[(1,[(Free ("m_","bool"),[Free ("A","bool")])]),
81.723 + (2,
81.724 + [(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")]),
81.725 + (Free ("m_","bool"),[Free ("A","bool")])]),
81.726 + (3,[(Free ("m_","bool"),[Free ("A","bool")])])]
81.727 +: (int * (term * term list) list) list
81.728 +
81.729 +
81.730 + val env = []:envv;
81.731 + val (d,ts) = (split_dts o term_of o the o (parse thy))
81.732 + "fixedValues [r=Arbfix]";
81.733 + val (_,id) = (split_did o term_of o the o (parse thy))"fixedValues fix_";
81.734 + val vats = [1,2,3];
81.735 + val env = upd_envv thy env vats d id (mkval ts);
81.736 +*)
81.737 +
81.738 +(*. update envv by folding from a list of arguments .*)
81.739 +fun upds_envv thy envv [] = envv
81.740 + | upds_envv thy envv ((vs, dsc, id, vl)::ps) =
81.741 + upds_envv thy (upd_envv thy envv vs dsc id vl) ps;
81.742 +(* eval test-maximum.sml until Specify_Method ...
81.743 + val PblObj{probl=(_,pbl),origin=(_,(_,_,mI),_),...} = get_obj I pt [];
81.744 + val met = (#ppc o get_met) mI;
81.745 +
81.746 + val envv = [];
81.747 + val eargs = flat eargs;
81.748 + val (vs, dsc, id, vl) = hd eargs;
81.749 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
81.750 +
81.751 + val (vs, dsc, id, vl) = hd (tl eargs);
81.752 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
81.753 +
81.754 + val (vs, dsc, id, vl) = hd (tl (tl eargs));
81.755 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
81.756 +
81.757 + val (vs, dsc, id, vl) = hd (tl (tl (tl eargs)));
81.758 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
81.759 +[(1,
81.760 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
81.761 + (Free ("m_","bool"),[Free (#,#)]),
81.762 + (Free ("vs_","bool List.list"),[# $ # $ Const #]),
81.763 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
81.764 + (2,
81.765 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
81.766 + (Free ("m_","bool"),[Free (#,#)]),
81.767 + (Free ("vs_","bool List.list"),[# $ # $ Const #]),
81.768 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
81.769 + (3,
81.770 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
81.771 + (Free ("m_","bool"),[Free (#,#)]),
81.772 + (Free ("vs_","bool List.list"),[# $ # $ Const #])])] : envv *)
81.773 +
81.774 +(*for _output_ of the items of a Model*)
81.775 +datatype item =
81.776 + Correct of cterm' (*labels a correct formula (type cterm')*)
81.777 + | SyntaxE of string (**)
81.778 + | TypeE of string (**)
81.779 + | False of cterm' (*WN050618 notexistent in itm_: only used in Where*)
81.780 + | Incompl of cterm' (**)
81.781 + | Superfl of string (**)
81.782 + | Missing of cterm';
81.783 +fun item2str (Correct s) ="Correct "^s
81.784 + | item2str (SyntaxE s) ="SyntaxE "^s
81.785 + | item2str (TypeE s) ="TypeE "^s
81.786 + | item2str (False s) ="False "^s
81.787 + | item2str (Incompl s) ="Incompl "^s
81.788 + | item2str (Superfl s) ="Superfl "^s
81.789 + | item2str (Missing s) ="Missing "^s;
81.790 +(*make string for error-msgs*)
81.791 +fun itm__2str thy (Cor ((d,ts), penv)) =
81.792 + "Cor " ^ string_of_cterm (comp_dts thy(d,ts)) ^" ,"^ pen2str thy penv
81.793 + | itm__2str thy (Syn c) = "Syn "^c
81.794 + | itm__2str thy (Typ c) = "Typ "^c
81.795 + | itm__2str thy (Inc ((d,ts), penv)) =
81.796 + "Inc " ^ string_of_cterm (comp_dts thy(d,ts)) ^" ,"^ pen2str thy penv
81.797 + | itm__2str thy (Sup (d,ts)) = "Sup "^(string_of_cterm (comp_dts thy(d,ts)))
81.798 + | itm__2str thy (Mis (d,pid))=
81.799 + "Mis "^ Sign.string_of_term (sign_of thy) d ^
81.800 + " "^ Sign.string_of_term (sign_of thy) pid
81.801 + | itm__2str thy (Par s) = "Trm "^s;
81.802 +fun itm_2str t = itm__2str (assoc_thy "Isac.thy") t;
81.803 +fun itm2str thy ((i,is,b,s,itm_):itm) =
81.804 + "("^(string_of_int i)^" ,"^(ints2str' is)^" ,"^(bool2str b)^" ,"^
81.805 + s^" ,"^(itm__2str thy itm_)^")";
81.806 +val linefeed = (curry op^) "\n";
81.807 +fun itms2str thy itms = strs2str' (map (linefeed o (itm2str thy)) itms);
81.808 +fun w_itms2str thy itms = writeln (itms2str thy itms);
81.809 +
81.810 +fun init_item str = SyntaxE str;
81.811 +
81.812 +
81.813 +
81.814 +
81.815 +type 'a ppc =
81.816 + {Given : 'a list,
81.817 + Where: 'a list,
81.818 + Find : 'a list,
81.819 + With : 'a list,
81.820 + Relate: 'a list};
81.821 +fun ppc2str {Given=Given,Where=Where,Find=Find,With=With,Relate=Relate}=
81.822 + ("{Given =" ^ (strs2str Given ) ^
81.823 + ",Where=" ^ (strs2str Where) ^
81.824 + ",Find =" ^ (strs2str Find ) ^
81.825 + ",With =" ^ (strs2str With ) ^
81.826 + ",Relate=" ^ (strs2str Relate) ^ "}");
81.827 +
81.828 +
81.829 +
81.830 +
81.831 +fun item_ppc ({Given = gi,Where= wh,
81.832 + Find = fi,With = wi,Relate= re}: string ppc) =
81.833 + {Given = map init_item gi,Where= map init_item wh,
81.834 + Find = map init_item fi,With = map init_item wi,
81.835 + Relate= map init_item re}:item ppc;
81.836 +fun itemppc2str ({Given=Given,Where=Where,
81.837 + Find=Find,With=With,Relate=Relate}:item ppc)=
81.838 + ("{Given =" ^ ((strs2str' o (map item2str)) Given ) ^
81.839 + ",Where=" ^ ((strs2str' o (map item2str)) Where) ^
81.840 + ",Find =" ^ ((strs2str' o (map item2str)) Find ) ^
81.841 + ",With =" ^ ((strs2str' o (map item2str)) With ) ^
81.842 + ",Relate=" ^ ((strs2str' o (map item2str)) Relate) ^ "}");
81.843 +
81.844 +fun de_item (Correct x) = x
81.845 + | de_item (SyntaxE x) = x
81.846 + | de_item (TypeE x) = x
81.847 + | de_item (False x) = x
81.848 + | de_item (Incompl x) = x
81.849 + | de_item (Superfl x) = x
81.850 + | de_item (Missing x) = x;
81.851 +val empty_ppc ={Given = [],
81.852 + Where= [],
81.853 + Find = [],
81.854 + With = [],
81.855 + Relate= []}:item ppc;
81.856 +val empty_ppc_ct' ={Given = [],
81.857 + Where = [],
81.858 + Find = [],
81.859 + With = [],
81.860 + Relate= []}:cterm' ppc;
81.861 +
81.862 +
81.863 +datatype match =
81.864 + Matches of pblID * item ppc
81.865 +| NoMatch of pblID * item ppc;
81.866 +fun match2str (Matches (pI, ppc)) =
81.867 + "Matches ("^(strs2str pI)^", "^(itemppc2str ppc)^")"
81.868 + | match2str(NoMatch (pI, ppc)) =
81.869 + "NoMatch ("^(strs2str pI)^", "^(itemppc2str ppc)^")";
81.870 +fun matchs2str ms = (strs2str o (map match2str)) ms;
81.871 +fun pblID_of_match (Matches (pI,_)) = pI
81.872 + | pblID_of_match (NoMatch (pI,_)) = pI;
81.873 +
81.874 +(*10.03 for Refine_Problem*)
81.875 +datatype match_ =
81.876 + Match_ of pblID * ((itm list) * ((bool * term) list))
81.877 +| NoMatch_;
81.878 +
81.879 +(*. the refined pbt is the last_element Matches in the list .*)
81.880 +fun is_matches (Matches _) = true
81.881 + | is_matches _ = false;
81.882 +fun matches_pblID (Matches (pI,_)) = pI;
81.883 +fun refined ms = ((matches_pblID o the o (find_first is_matches) o rev) ms)
81.884 + handle _ => []:pblID;
81.885 +fun refined_IDitms ms = ((find_first is_matches) o rev) ms;
81.886 +
81.887 +(*. the refined pbt is the last_element Matches in the list,
81.888 + for Refine_Problem, tryrefine .*)
81.889 +fun is_matches_ (Match_ _) = true
81.890 + | is_matches_ _ = false;
81.891 +fun refined_ ms = ((find_first is_matches_) o rev) ms;
81.892 +
81.893 +
81.894 +fun ts_in (Cor ((_,ts),_)) = ts
81.895 + | ts_in (Syn (c)) = []
81.896 + | ts_in (Typ (c)) = []
81.897 + | ts_in (Inc ((_,ts),_)) = ts
81.898 + | ts_in (Sup (_,ts)) = ts
81.899 + | ts_in (Mis _) = [];
81.900 +(*WN050629 unused*)
81.901 +fun all_ts_in itm_s = (flat o (map ts_in)) itm_s;
81.902 +val unique = (term_of o the o (parse Real.thy)) "UnIqE_tErM";
81.903 +fun d_in (Cor ((d,_),_)) = d
81.904 + | d_in (Syn (c)) = (writeln("*** d_in: Syn ("^c^")"); unique)
81.905 + | d_in (Typ (c)) = (writeln("*** d_in: Typ ("^c^")"); unique)
81.906 + | d_in (Inc ((d,_),_)) = d
81.907 + | d_in (Sup (d,_)) = d
81.908 + | d_in (Mis (d,_)) = d;
81.909 +
81.910 +fun dts2str (d,ts) = pair2str (term2str d, terms2str ts);
81.911 +fun penvval_in (Cor ((d,_),(_,ts))) = [comp_ts (d,ts)]
81.912 + | penvval_in (Syn (c)) = (writeln("*** penvval_in: Syn ("^c^")"); [])
81.913 + | penvval_in (Typ (c)) = (writeln("*** penvval_in: Typ ("^c^")"); [])
81.914 + | penvval_in (Inc (_,(_,ts))) = ts
81.915 + | penvval_in (Sup dts) = (writeln("*** penvval_in: Sup "^(dts2str dts)); [])
81.916 + | penvval_in (Mis (d,t)) = (writeln("*** penvval_in: Mis "^
81.917 + (pair2str(term2str d, term2str t))); []);
81.918 +
81.919 +
81.920 +(*. check a predicate labelled with indication of incomplete substitution;
81.921 +rls -> (*for eval_true*)
81.922 +bool * (*have _all_ variables(Free) from the model-pattern
81.923 + been substituted by a value from the pattern's environment ?*)
81.924 +Term.term (*the precondition*)
81.925 +->
81.926 +bool * (*has the precondition evaluated to true*)
81.927 +Term.term (*the precondition (for map)*)
81.928 +.*)
81.929 +fun evalprecond prls (false, pre) =
81.930 + (*NOT ALL Free's have been substituted, eg. because of incomplete model*)
81.931 + (false, pre)
81.932 + | evalprecond prls (true, pre) =
81.933 +(* val (prls, pre) = (prls, hd pres');
81.934 + val (prls, pre) = (prls, hd (tl pres'));
81.935 + *)
81.936 + if eval_true (assoc_thy "Isac.thy") (*for Pattern.match *)
81.937 + [pre] prls (*pre parsed, prls.thy*)
81.938 + then (true , pre)
81.939 + else (false , pre);
81.940 +
81.941 +fun pre2str (b, t) = pair2str(bool2str b, term2str t);
81.942 +fun pres2str pres = strs2str' (map (linefeed o pre2str) pres);
81.943 +
81.944 +(*. check preconditions, return true if all true .*)
81.945 +fun check_preconds' _ [] _ _ = [] (*empty preconditions are true*)
81.946 + | check_preconds' prls pres pbl _(*FIXME.WN0308 mvat re-introduce*) =
81.947 +(* val (prls, pres, pbl, _) = (prls, where_, probl, 0);
81.948 + val (prls, pres, pbl, _) = (prls, pre, itms, mvat);
81.949 + *)
81.950 + let val env = mk_env pbl;
81.951 + val pres' = map (subst_atomic_all env) pres;
81.952 + in map (evalprecond prls) pres' end;
81.953 +
81.954 +fun check_preconds thy prls pres pbl =
81.955 + check_preconds' prls pres pbl (max_vt pbl);
81.956 +
81.957 +
81.958 +
81.959 +
81.960 +(*----------------------------24.3.02: done too much-----
81.961 +(**. copy the already input items from probl to meth (in PblObj):
81.962 + for each item in met search the related one in pbl,
81.963 + items not found in probl are (1) inserted as 'untouched' (0,...),
81.964 + and (2) completed from oris (via max_vt)
81.965 + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ "uberkomplett 21.2.02 ------------ .**)
81.966 +(* val (pbl, met) = (itms, ppc);
81.967 + *)
81.968 +fun copy_pbl thy oris pbl met =
81.969 + let val vt = max_vt pbl;
81.970 + fun vt_and_dsc d' ((i,v,f,d,ts):ori) =
81.971 + vt mem v andalso d'= d
81.972 + fun cpy its [] (f, (d, id)) =
81.973 + if length its = 0 (*no dsc found in pbl*)
81.974 + then case find_first (vt_and_dsc d) oris
81.975 + of Some (i,v,_,_,ts) =>
81.976 + [(i,v,true,f, Cor ((d,ts), (id,pbl_ids' thy d ts)))]
81.977 + | None => [(0,[],false,f,Mis (d, id))]
81.978 + else its
81.979 + | cpy its ((it as (i, vs, b, f, itm_))::itms) (pb as (x, (d, id))) =
81.980 + if d = d_in itm_ andalso i<>0 (*already touched by user*)
81.981 + then cpy (its @ [it]) itms pb else cpy its itms pb;
81.982 + in ((flat o (map (cpy [] pbl))) met):itm list end;
81.983 +
81.984 +
81.985 +(**. copy the already input items from probl to meth (in PblObj):
81.986 + for each item in met search the related one in pbl,
81.987 + items not found in probl are inserted as 'untouched' (0,...)
81.988 + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ "uberkomplett 21.2.02 ------------ .**)
81.989 +(* val (pbl, met) = (itms, ppc);
81.990 + *)
81.991 +fun copy_pbl (pbl:itm list) met =
81.992 + let fun cpy its [] (f, (d, id)) =
81.993 + if length its = 0 (*no dsc found in pbl*)
81.994 + then [(0,[],false,f,Mis (d, id))]
81.995 + else its
81.996 + | cpy its ((it as (i, vs, b, f, itm_))::itms) (pb as (x, (d, id))) =
81.997 + if d = d_in itm_ andalso i<>0 (*already touched by user*)
81.998 + then cpy (its @ [it]) itms pb else cpy its itms pb;
81.999 + in ((flat o (map (cpy [] pbl))) met):itm list end;
81.1000 +
81.1001 +
81.1002 +(**. copy the already input items from probl to meth (in PblObj):
81.1003 + for each item in met search the related one in pbl
81.1004 + (missing items are requested by nxt_spec) .**)
81.1005 +(* val (pbl, met) = (itms, ppc);
81.1006 + *)
81.1007 +fun copy_pbl (pbl:itm list) met =
81.1008 + let fun cpy its [] (f, (d, id)) = its
81.1009 + | cpy its ((it as (i, vs, b, f, itm_))::itms) (pb as (x, (d, id))) =
81.1010 + if d = d_in itm_ andalso i<>0 (*already touched by user*)
81.1011 + then cpy (its @ [it]) itms pb
81.1012 + else cpy its itms pb;
81.1013 + in ((flat o (map (cpy [] pbl))) met):itm list end;
81.1014 +
81.1015 +(*. copy pbt to met (in Specify_Method)
81.1016 + ALL pbt. (1) dsc(pbt) notmem dsc(pbls) =>
81.1017 + (2) filter (dsc(pbt) = dsc(oris)) oris; -> newitms;
81.1018 + (3) pbt @ newitms .*)
81.1019 +(* val (pbl, met) = (itms, pbt);
81.1020 + *)
81.1021 +fun copy_pbl (pbl:itm list) met oris =
81.1022 + let fun eqdsc_pbt_itm ((_,(d,_))) ((_,_,_,_,itm_):itm) = d = d_in itm_;
81.1023 + fun notmem pbl pbt1 = case find_first (eqdsc_pbt_itm pbt1) pbl of
81.1024 + Some _ => false | None => true;
81.1025 + (*1*)val mis = ((map (cons2 (fst, fst o snd))) o (filter (notmem pbl))) met;
81.1026 +
81.1027 + fun eqdsc_ori d ((_,_,_,d',_):ori) = d = d';
81.1028 + fun ori2itmMis f ((i,v,_,d,ts):ori) = (i,v,false,f,Mis (d,ts)):itm;
81.1029 + fun oris2itms oris mis1 = ((map (ori2itmMis (fst mis1)))
81.1030 + o (filter ((eqdsc_ori o snd) mis1))) oris;
81.1031 + val news = (flat o (map (oris2itms oris))) mis;
81.1032 + in pbl @ news end;
81.1033 + ----------------------------24.3.02: done too much-----*)
81.1034 +
81.1035 +
81.1036 +
81.1037 +
81.1038 +
81.1039 +
81.1040 +(* ---------------------------------------------NOT UPTODATE !!! 4.9.01
81.1041 + eval test-maximum.sml until Specify_Method ...
81.1042 + val PblObj{probl=(_,pbl),origin=(_,(_,_,mI),_),...} = get_obj I pt [];
81.1043 + val met = (#ppc o get_met) mI;
81.1044 + val (m::_) = met;
81.1045 + cpy [] pbl m;
81.1046 +[((1,[1,2,3],true,"#Given",Cor ((Const #,[#]),[])),
81.1047 + [([1,2,3],Const ("Descript.fixedValues","bool List.list => Tools.nam"),
81.1048 + Free ("fix_","bool List.list"),Const # $ Free # $ Const (#,#))])]
81.1049 +: (itm * (vats * term * term * term) list) list
81.1050 +
81.1051 + upds_envv thy [] (flat eargs);
81.1052 +[(1,
81.1053 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
81.1054 + (Free ("m_","bool"),[Free (#,#)]),
81.1055 + (Free ("vs_","bool List.list"),[# $ # $ (# $ #)]),
81.1056 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
81.1057 + (2,
81.1058 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
81.1059 + (Free ("m_","bool"),[Free (#,#)]),
81.1060 + (Free ("vs_","bool List.list"),[# $ # $ (# $ #)]),
81.1061 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
81.1062 + (3,
81.1063 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
81.1064 + (Free ("m_","bool"),[Free (#,#)]),
81.1065 + (Free ("vs_","bool List.list"),[# $ # $ (# $ #)])])] : envv
81.1066 + *)
81.1067 +
81.1068 +(*----------------------------------------------------------*)
81.1069 +end
81.1070 +open SpecifyTools;
81.1071 +(*----------------------------------------------------------*)
82.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
82.2 +++ b/src/Pure/isac/ME/ptyps.sml Wed Jul 21 13:53:39 2010 +0200
82.3 @@ -0,0 +1,1276 @@
82.4 +(* the problems and methods as stored in hierarchies
82.5 + author Walther Neuper 1998
82.6 + (c) due to copyright terms
82.7 +
82.8 +use"ME/ptyps.sml";
82.9 +use"ptyps.sml";
82.10 +*)
82.11 +
82.12 +(*-----------------------------------------vvv-(1) aus modspec.sml 23.3.02*)
82.13 +val dsc_unknown = (term_of o the o (parseold Script.thy))
82.14 + "unknown::'a => unknow";
82.15 +(*-----------------------------------------^^^-(1) aus modspec.sml 23.3.02*)
82.16 +
82.17 +
82.18 +(*-----------------------------------------vvv-(2) aus modspec.sml 23.3.02*)
82.19 +
82.20 +
82.21 +
82.22 +
82.23 +fun itm_2item thy (Cor ((d,ts),_))= Correct(string_of_cterm (comp_dts thy(d,ts)))
82.24 + | itm_2item thy (Syn c) = SyntaxE c
82.25 + | itm_2item thy (Typ c) = TypeE c
82.26 + | itm_2item thy (Inc ((d,ts),_))= Incompl(string_of_cterm (comp_dts thy(d,ts)))
82.27 + | itm_2item thy (Sup (d,ts)) = Superfl(string_of_cterm (comp_dts thy(d,ts)))
82.28 + | itm_2item thy (Mis (d,pid)) =
82.29 + Missing (Sign.string_of_term (sign_of thy) d ^" "^
82.30 + Sign.string_of_term (sign_of thy) pid);
82.31 +
82.32 +
82.33 +
82.34 +
82.35 +
82.36 +(* --- 8.3.00
82.37 +fun get_dsc_in dscppc sel = ((the (assoc (dscppc, sel))):term list)
82.38 + handle _ => error ("get_dsc_in not for "^sel);
82.39 +
82.40 +fun dscs_in dscppc =
82.41 + ((get_dsc_in dscppc "#Given") @
82.42 + (get_dsc_in dscppc "#Find") @
82.43 + (get_dsc_in dscppc "#Relate")):term list;
82.44 +
82.45 + --- 26.1.88
82.46 +fun get_dsc_of pblID sel = (the (assoc((snd o get_pbt) pblID, sel)));
82.47 +fun get_dsc pblID =
82.48 + (get_dsc_of pblID "#Given") @
82.49 + (get_dsc_of pblID "#Find") @
82.50 + (get_dsc_of pblID "#Relate");
82.51 + --- *)
82.52 +
82.53 +fun mappc f ({Given=gi,Where=wh,Find=fi,With=wi,Relate=re}:'a ppc) =
82.54 + {Given=map f gi, Where=map f wh,
82.55 + Find=map f fi, With=map f wi, Relate=map f re}:'b ppc;
82.56 +fun appc f ({Given=gi,Where=wh,Find=fi,With=wi,Relate=re}:'a ppc) =
82.57 + {Given=f gi, Where=f wh,
82.58 + Find=f fi, With=f wi, Relate=f re}:'b ppc;
82.59 +
82.60 +(*for ppc of changing type*)
82.61 +fun sel_ppc sel ppc =
82.62 + case sel of
82.63 + "#Given" => #Given (ppc:'a ppc)
82.64 + | "#Where" => #Where (ppc:'a ppc)
82.65 + | "#Find" => #Find (ppc:'a ppc)
82.66 + | "#With" => #With (ppc:'a ppc)
82.67 + | "#Relate" => #Relate (ppc:'a ppc)
82.68 + | _ => raise error ("sel_ppc tried to select by '"^sel^"'");
82.69 +
82.70 +fun repl_sel_ppc sel
82.71 + ({Given=gi,Where=wh,Find=fi,With=wi,Relate=re}:'a ppc) x =
82.72 + case sel of
82.73 + "#Given" => ({Given= x,Where=wh,Find=fi,With=wi,Relate=re}:'a ppc)
82.74 + | "#Where" => {Given=gi,Where= x,Find=fi,With=wi,Relate=re}
82.75 + | "#Find" => {Given=gi,Where=wh,Find= x,With=wi,Relate=re}
82.76 + | "#With" => {Given=gi,Where=wh,Find=fi,With= x,Relate=re}
82.77 + | "#Relate" => {Given=gi,Where=wh,Find=fi,With=wi,Relate= x}
82.78 + | _ => raise error ("repl_sel_ppc tried to select by '"^sel^"'");
82.79 +
82.80 +fun add_sel_ppc thy sel
82.81 + ({Given=gi,Where=wh,Find=fi,With=wi,Relate=re}:'a ppc) x =
82.82 + case sel of
82.83 + "#Given" => ({Given=gi@[x],Where=wh,Find=fi,With=wi,Relate=re}:'a ppc)
82.84 + | "#Where" => {Given=gi,Where=wh@[x],Find=fi,With=wi,Relate=re}
82.85 + | "#Find" => {Given=gi,Where=wh,Find=fi@[x],With=wi,Relate=re}
82.86 + | "#Relate"=> {Given=gi,Where=wh,Find=fi,With=wi,Relate=re@[x]}
82.87 + | "#undef" => {Given=gi@[x],Where=wh,Find=fi,With=wi,Relate=re}(*ori2itmSup*)
82.88 + | _ => raise error ("add_sel_ppc tried to select by '"^sel^"'");
82.89 +fun add_where ({Given=gi,Find=fi,With=wi,Relate=re,...}:'a ppc) wh =
82.90 + ({Given=gi,Where=wh,Find=fi,With=wi,Relate=re}:'a ppc);
82.91 +
82.92 +(*-----------------------------------------^^^-(2) aus modspec.sml 23.3.02*)
82.93 +
82.94 +
82.95 +(*-----------------------------------------vvv-(3) aus modspec.sml 23.3.02*)
82.96 +
82.97 +
82.98 +
82.99 +(*decompose a problem-type into description and identifier
82.100 + FIXME split_dsc: no term list !!! (just for quick redoing prep_ori) *)
82.101 +fun split_dsc thy t =
82.102 + (let val (hd,args) = strip_comb t
82.103 + in if is_dsc hd
82.104 + then (hd, args)
82.105 + else (e_term, [t]) (*??? 9.01 just copied*)
82.106 + end)
82.107 + handle _ => raise error ("split_dsc: called with "^
82.108 + (Sign.string_of_term (sign_of thy) t));
82.109 +(*
82.110 +> val t1 = (term_of o the o (parse thy)) "errorBound err_";
82.111 +> split_dsc t1;
82.112 +(Const ("Descript.errorBound","bool => Tools.nam"),Free ("err_","bool"))
82.113 + : term * term
82.114 +> val t3 = (term_of o the o (parse thy)) "valuesFor vs_";
82.115 +> split_dsc t3;
82.116 +(Const ("Descript.valuesFor","bool List.list => Tools.toreall"),
82.117 + Free ("vs_","bool List.list")) : term * term*)
82.118 +
82.119 +
82.120 +
82.121 +(*. take the first two return-values; for prep_ori .*)
82.122 +(*WN.13.5.03fun split_dts' thy t =
82.123 + let val (d, ts, _) = split_dts thy t
82.124 + in (d, ts) end;*)
82.125 +(*WN.8.12.03 quick for prep_ori'*)
82.126 +fun split_dsc' t =
82.127 + (let val dsc $ var = t
82.128 + in var end)
82.129 + handle _ => raise error ("split_dsc': called with "^term2str t);
82.130 +
82.131 +(*9.3.00*)
82.132 +(* split a term into description and (id | structured variable)
82.133 + for pbt, met.ppc *)
82.134 +fun split_did t =
82.135 + (let val (hd,[arg]) = strip_comb t
82.136 + in (hd,arg) end)
82.137 + handle _ => raise error ("split_did: doesn't match (hd,[arg]) for t = "
82.138 + ^(Sign.string_of_term (sign_of Script.thy) t));
82.139 +
82.140 +
82.141 +
82.142 +(*create output-string for itm_*)
82.143 +fun itm_out thy (Cor ((d,ts),_)) = (string_of_cterm (comp_dts thy(d,ts)))
82.144 + | itm_out thy (Syn c) = c
82.145 + | itm_out thy (Typ c) = c
82.146 + | itm_out thy (Inc ((d,ts),_)) = (string_of_cterm (comp_dts thy(d,ts)))
82.147 + | itm_out thy (Sup (d,ts)) = (string_of_cterm (comp_dts thy(d,ts)))
82.148 + | itm_out thy (Mis (d,pid)) =
82.149 + Sign.string_of_term (sign_of thy) d ^" "^
82.150 + Sign.string_of_term (sign_of thy) pid;
82.151 +
82.152 +(*22.11.00 unused
82.153 +fun itm_ppc2str thy ipc = (ppc2str o (mappc (itm__2str thy))) ipc;*)
82.154 +
82.155 +
82.156 +(*--3.3.
82.157 +fun itms2dts itms =
82.158 + let
82.159 + fun coll itms' [] = itms'
82.160 + | coll itms' (i::itms) =
82.161 + case i of
82.162 + (Cor (d,ts)) => coll (itms' @ [(d,ts)]) itms
82.163 + | (Syn c) => coll (itms' ) itms
82.164 + | (Typ c) => coll (itms' ) itms
82.165 + | (Fal (d,ts)) => coll (itms' @ [(d,ts)]) itms
82.166 + | (Inc (d,ts)) => coll (itms' @ [(d,ts)]) itms
82.167 + | (Sup (d,ts)) => coll (itms' @ [(d,ts)]) itms
82.168 + in coll [] itms end;
82.169 +*)
82.170 +(*--3.3.00
82.171 +fun itm2item ((_,_,_,_,Cor (d,ts)):itm) =
82.172 + Correct (string_of_cterm (comp_dts thy(d,ts)))
82.173 + | itm2item (_,_,_,_,Syn (c)) = SyntaxE c
82.174 + | itm2item (_,_,_,_,Typ (c)) = TypeE c
82.175 + | itm2item (_,_,_,_,Fal (d,ts)) =
82.176 + False (string_of_cterm (comp_dts thy(d,ts)))
82.177 + | itm2item (_,_,_,_,Inc (d,ts)) =
82.178 + Incompl (string_of_cterm (comp_dts thy(d,ts)))
82.179 + | itm2item (_,_,_,_,Sup (d,ts)) =
82.180 + Superfl (string_of_cterm (comp_dts thy(d,ts)));
82.181 +*)
82.182 +
82.183 +fun boolterm2item (true, term) = Correct (term2str term)
82.184 + | boolterm2item (false, term) = False (term2str term);
82.185 +
82.186 +(* use"ME/modspec.sml";
82.187 + *)
82.188 +fun itms2itemppc thy (itms:itm list) (pre:(bool * term) list) =
82.189 + let
82.190 + fun coll ppc [] = ppc
82.191 + | coll ppc ((_,_,_,field,itm_)::itms) =
82.192 + coll (add_sel_ppc thy field ppc (itm_2item thy itm_)) itms;
82.193 + val gfr = coll empty_ppc itms;
82.194 + in add_where gfr (map boolterm2item pre) end;
82.195 +(*-----------------------------------------^^^-(3) aus modspec.sml 23.3.02*)
82.196 +
82.197 +(*-----------------------------------------vvv-(4) aus modspec.sml 23.3.02*)
82.198 +
82.199 +(* --- 9.3.fun add_field dscs (d,ts) =
82.200 + if d mem (get_dsc_in dscs "#Given")
82.201 + then ("#Given",d,ts:term list)
82.202 + else if d mem (get_dsc_in dscs "#Find")
82.203 + then ("#Find",d,ts)
82.204 + else if d mem (get_dsc_in dscs "#Relate")
82.205 + then ("#Relate",d,ts)
82.206 + else ("#undef",d,ts);
82.207 +(* 28.1.00 raise error ("add_field: '"^
82.208 + (Sign.string_of_term (sign_of thy) d)^
82.209 + "' not in ppc-description "); *)
82.210 + ------9.3. *)
82.211 +
82.212 +(* 9.3.00
82.213 + compare d and dsc in pbt and transfer field to pre-ori *)
82.214 +fun add_field thy pbt (d,ts) =
82.215 + let fun eq d pt = (d = (fst o snd) pt);
82.216 + in case filter (eq d) pbt of
82.217 + [(fi,(dsc,_))] => (fi,d,ts)
82.218 + | [] => ("#undef",d,ts) (*may come with met.ppc*)
82.219 + | _ => raise error ("add_field: "^
82.220 + (Sign.string_of_term (sign_of thy) d)^
82.221 + " more than once in pbt")
82.222 + end;
82.223 +
82.224 +(*. take over field from met.ppc at 'Specify_Method' into ori,
82.225 + i.e. also removes "#undef" fields .*)
82.226 +(* val (mpc, ori) = ((#ppc o get_met) mID, oris);
82.227 + *)
82.228 +fun add_field' thy mpc (ori:ori list) =
82.229 + let fun eq d pt = (d = (fst o snd) pt);
82.230 + fun repl mpc (i,v,_,d,ts) =
82.231 + case filter (eq d) mpc of
82.232 + [(fi,(dsc,_))] => [(i,v,fi,d,ts)]
82.233 + | [] => [] (*25.2.02: dsc in ori, but not in met -> superfluous*)
82.234 + (*raise error ("add_field': "^
82.235 + (Sign.string_of_term (sign_of thy) d)^
82.236 + " not in met"*)
82.237 + | _ => raise error ("add_field': "^
82.238 + (Sign.string_of_term (sign_of thy) d)^
82.239 + " more than once in met");
82.240 + in (flat ((map (repl mpc)) ori)):ori list end;
82.241 +
82.242 +
82.243 +(*.mark an element with the position within a plateau;
82.244 + a plateau with length 1 is marked with 0 .*)
82.245 +fun mark eq [] = raise error "mark []"
82.246 + | mark eq xs =
82.247 + let
82.248 + fun mar xx eq [x] n = xx @ [(if n=1 then 0 else n,x)]
82.249 + | mar xx eq (x::x'::xs) n =
82.250 + if eq(x,x') then mar (xx @ [(n,x)]) eq (x'::xs) (n+1)
82.251 + else mar (xx @ [(if n=1 then 0 else n,x)]) eq (x'::xs) 1;
82.252 + in mar [] eq xs 1 end;
82.253 +(*
82.254 +> val xs = [1,1,1,2,4,4,5];
82.255 +> mark (op=) xs;
82.256 +val it = [(1,1),(2,1),(3,1),(0,2),(1,4),(2,4),(0,5)]
82.257 +*)
82.258 +
82.259 +(*.assumes equal descriptions to be in adjacent 'plateaus',
82.260 + items at a certain position within the plateaus form a variant;
82.261 + length = 1 ... marked with 0: covers all variants .*)
82.262 +fun add_variants fdts =
82.263 + let
82.264 + fun eq (a,b) = curry op= (snd3 a) (snd3 b);
82.265 + in mark eq fdts end;
82.266 +
82.267 +(* collect equal elements: the model for coll_variants *)
82.268 +fun coll eq xs =
82.269 + let
82.270 + fun col xs eq x [] = xs @ [x]
82.271 + | col xs eq x (y::ys) =
82.272 + if eq(x,y) then col xs eq x ys
82.273 + else col (xs @ [x]) eq y ys;
82.274 + in col [] eq (hd xs) xs end;
82.275 +(*
82.276 +> val xs = [1,1,1,2,4,4,4];
82.277 +> coll (op=) xs;
82.278 +val it = [1,2,4] : int list
82.279 +*)
82.280 +
82.281 +fun max [] = raise error "max of []"
82.282 + | max (y::ys) =
82.283 + let fun mx x [] = x
82.284 + | mx x (y::ys) = if x < y then mx y ys else mx x ys;
82.285 +in mx y ys end;
82.286 +fun gen_max _ [] = raise error "gen_max of []"
82.287 + | gen_max ord (y::ys) =
82.288 + let fun mx x [] = x
82.289 + | mx x (y::ys) = if ord (x, y) then mx y ys else mx x ys;
82.290 +in mx y ys end;
82.291 +
82.292 +
82.293 +
82.294 +(* assumes *)
82.295 +fun coll_variants (((v,x)::vxs)) =
82.296 + let
82.297 + fun col xs (vs,x) [] = xs @ [(vs,x)]
82.298 + | col xs (vs,x) ((v',x')::vxs') =
82.299 + if x=x' then col xs (vs @ [v'], x') vxs'
82.300 + else col (xs @ [(vs,x)]) ([v'], x') vxs';
82.301 + in col [] ([v],x) vxs end;
82.302 +(* val xs = [(1,1),(2,1),(3,1),(0,2),(1,4),(2,4),(0,5)];
82.303 +> col [] ([(fst o hd) xs],(snd o hd) xs) (tl xs);
82.304 +val it = [([1,2,3],1),([0],2),([1,2],4),([0],5)] *)
82.305 +
82.306 +
82.307 +fun replace_0 vm [0] = intsto vm
82.308 + | replace_0 vm vs = vs;
82.309 +
82.310 +fun add_id [] = raise error "add_id []"
82.311 + | add_id xs =
82.312 + let fun add n [] = []
82.313 + | add n (x::xs) = (n,x) :: add (n+1) xs;
82.314 +in add 1 xs end;
82.315 +(*
82.316 +> val xs = [([1,2,3],1),([0],2),([1,2],4),([0],5)];
82.317 +> add_id xs;
82.318 +val it = [(1,([#,#,#],1)),(2,([#],2)),(3,([#,#],4)),(4,([#],5))]
82.319 + *)
82.320 +
82.321 +fun flattup (a,(b,(c,d,e))) = (a,b,c,d,e);
82.322 +fun flattup' (a,(b,((c,d),e))) = (a,b,c,d,e);
82.323 +fun flat3 (a,(b,c)) = (a,b,c);
82.324 +(*
82.325 + val pI = pI';
82.326 + !pbts;
82.327 +*)
82.328 +(* in root (only!) fmz may be empty: fill with ..,dsc,[]
82.329 +fun init_ori fmz thy pI =
82.330 + if fmz <> [] then prep_ori fmz thy pI (*fmz assumed complete*)
82.331 + else
82.332 + let
82.333 + val fds = map (cons2 (fst, fst o snd)) (get_pbt pI);
82.334 + val vfds = map ((pair [1]) o (rpair [])) fds;
82.335 + val ivfds = add_id vfds
82.336 + in (map flattup' ivfds):ori list end; 10.3.00---*)
82.337 +(* val fmz = ctl; val pI=["sqroot-test","univariate","equation"];
82.338 + val (thy,pbt) = (assoc_thy dI',(#ppc o get_pbt) pI');
82.339 + val (fmz, thy, pbt) = (fmz, thy, ((#ppc o get_pbt) pI));
82.340 + *)
82.341 +fun prep_ori [] _ _ = []
82.342 + | prep_ori fmz thy pbt =
82.343 + let
82.344 + val ctopts = map (parse thy) fmz
82.345 + val _= (*FIXME.WN060916 improve error report*)
82.346 + if null (filter is_none ctopts) then ()
82.347 + else raise error ("prep_ori: SYNTAX ERROR in " ^ strs2str' fmz)
82.348 + val dts = map ((split_dts thy) o term_of o the) ctopts
82.349 + val ori = map (add_field thy pbt) dts;
82.350 +(* val ori = map (flat3 o (pair "#undef")) dts; *)
82.351 + val ori' = add_variants ori;
82.352 + val maxv = max (map fst ori');
82.353 + val maxv = if maxv = 0 then 1(*only 1 variant*) else maxv;
82.354 + val ori'' = coll_variants ori';
82.355 + val ori''' = map (apfst (replace_0 maxv)) ori'';
82.356 + val ori'''' = add_id ori'''
82.357 + in (map flattup ori''''):ori list end;
82.358 +
82.359 +
82.360 +(*-----------------------------------------^^^-(4) aus modspec.sml 23.3.02*)
82.361 +
82.362 +(*.the pattern for an item of a problems model or a methods guard.*)
82.363 +type pat = (string * (*field*)
82.364 + (term * (*description*)
82.365 + term)) (*id | struct-var*);
82.366 +fun pat2str ((field, (dsc, id)):pat) =
82.367 + pair2str (field, pair2str (term2str dsc, term2str id));
82.368 +fun pats2str pats = (strs2str o (map pat2str)) pats;
82.369 +
82.370 +(* data for methods stored in 'methods'-database *)
82.371 +type met =
82.372 + {guh : guh, (*unique within this isac-knowledge *)
82.373 + mathauthors: string list,(*copyright *)
82.374 + init : pblID, (*WN060721 introduced mistakenly--TODO.REMOVE!*)
82.375 + rew_ord' : rew_ord', (*for rules in Detail
82.376 + TODO.WN0509 store fun itself, see 'type pbt'*)
82.377 + erls : rls, (*the eval_rls for cond. in rules FIXME "rls'
82.378 + instead erls in "fun prep_met" *)
82.379 + srls : rls, (*for evaluating list expressions in scr *)
82.380 + prls : rls, (*for evaluating predicates in modelpattern *)
82.381 + crls : rls, (*for check_elementwise, ie. formulae in calc.*)
82.382 + nrls : rls, (*canonical simplifier specific for this met *)
82.383 + calc : calc list, (*040207: <--- calclist' in fun prep_met *)
82.384 + (*branch : TransitiveB set in append_problem at generation ob pblobj
82.385 + FIXXXME.8.03: set branch from met in Apply_Method *)
82.386 +
82.387 + (* compare type pbt:*)
82.388 + ppc: pat list,
82.389 + (*.items in given, find, relate;
82.390 + items (in "#Find") which need not occur in the arg-list of a SubProblem
82.391 + are 'copy-named' with an identifier "*_!_".
82.392 + copy-named items are 'generating' if they are NOT "*___"
82.393 + see ME/calchead.sml 'fun is_copy_named'.*)
82.394 + pre: term list, (*preconditions in where*)
82.395 + (*script*)
82.396 + scr: scr (*prep_met requires either script or string "empty_script"*)
82.397 + };
82.398 +(* ------- template ------------------------------------------------------
82.399 +store_met
82.400 + (prep_met *.thy
82.401 + ([(*"EqSystem","normalize"*)],
82.402 + [("#Given" ,[ (*"equalities es_", "solveForVars vs_"*)]),
82.403 + ("#Find" ,[ (*dont forget typing non-reals *)]),
82.404 + ("#Relate",[])(*may be omitted *) ],
82.405 + {calc = [], (*filled autom. in prep_met *)
82.406 + crls = Erls, (*for check_elementwise *)
82.407 + prls = Erls, (*for evaluating preds in guard *)
82.408 + nrls = Erls, (*can.simplifier for all formulae*)
82.409 + rew_ord'="tless_true", (*for rules in Detail *)
82.410 + rls' = Erls, (*erls, the eval_rls for cond. in rules*)
82.411 + srls = Erls}, (*for evaluating list expr in scr*)
82.412 + "empty_script"
82.413 + ));
82.414 +---------- template ----------------------------------------------------*)
82.415 +val e_met = {guh="met_empty",mathauthors=[],init=e_metID,
82.416 + rew_ord' = "e_rew_ord'": rew_ord',
82.417 + erls = e_rls, srls = e_rls, prls = e_rls,
82.418 + calc = [], crls = e_rls, nrls = e_rls,
82.419 + (*asm_thm = []: thm' list,
82.420 + asm_rls = []: rls' list,*)
82.421 + ppc = []: (string * (term * term)) list,
82.422 + pre = []: term list,
82.423 + scr = EmptyScr: scr}:met;
82.424 +
82.425 +
82.426 +(** problem-types stored in format for usage in specify **)
82.427 +(*25.8.01 ----
82.428 +val pbltypes = ref ([(e_pblID,[])]:(pblID * ((string * (* field "#Given",..*)
82.429 + (term * (* description *)
82.430 + term)) (* id | struct-var *)
82.431 + list)
82.432 + ) list);*)
82.433 +
82.434 +(*deprecated due to 'type pat'*)
82.435 +type pbt_ = (string * (* field "#Given",..*)
82.436 + (term * (* description *)
82.437 + term)); (* id | struct-var *)
82.438 +val e_pbt_ = ("#Undef", (e_term, e_term)):pbt_;
82.439 +type pbt =
82.440 + {guh : guh, (*unique within this isac-knowledge*)
82.441 + mathauthors: string list, (*copyright*)
82.442 + init : pblID, (*to start refinement with*)
82.443 + thy : theory, (* which allows to compile that pbt
82.444 + TODO: search generalized for subthy (ref.p.69*)
82.445 + (*^^^ WN050912 NOT used during application of the problem,
82.446 + because applied terms may be from 'subthy' as well as from super;
82.447 + thus we take 'maxthy'; see match_ags !*)
82.448 + cas : term option,(*'CAS-command'*)
82.449 + prls : rls, (* for preds in where_*)
82.450 + where_: term list, (* where - predicates*)
82.451 + ppc : pat list,
82.452 + (*this is the model-pattern;
82.453 + it contains "#Given","#Where","#Find","#Relate"-patterns*)
82.454 + met : metID list}; (* methods solving the pbt*)
82.455 +val e_pbt = {guh="pbl_empty",mathauthors=[],init=e_pblID,thy=ProtoPure.thy,
82.456 + cas=None,prls=Erls,where_=[],ppc=[],met=[]}:pbt;
82.457 +fun pbt2 (str, (t1, t2)) =
82.458 + pair2str (str, pair2str (term2str t1, term2str t2));
82.459 +fun pbt2str pbt = (strs2str o (map (linefeed o pbt2))) pbt;
82.460 +
82.461 +
82.462 +val e_Ptyp = Ptyp ("e_pblID",[e_pbt],[]);
82.463 +val e_Mets = Ptyp ("e_metID",[e_met],[]);
82.464 +
82.465 +type ptyps = (pbt ptyp) list;
82.466 +val ptyps = ref ([e_Ptyp]:ptyps);
82.467 +
82.468 +type mets = (met ptyp) list;
82.469 +val mets = ref ([e_Mets]:mets);
82.470 +
82.471 +
82.472 +(**+ breadth-first search on hierarchy of problem-types +**)
82.473 +
82.474 +type pblRD = pblID;(*pblID are Reverted _on calling_ the retrieve-funs*)
82.475 + (* eg. ["equations","univariate","normalize"] while
82.476 + ["normalize","univariate","equations"] is the related pblID
82.477 + WN.24.4.03: also used for metID*)
82.478 +
82.479 +fun get_py thy d _ [] =
82.480 + error ("get_pbt not found: "^(strs2str d))
82.481 + | get_py thy d [k] ((Ptyp (k',[py],_))::pys) =
82.482 + if k=k' then py
82.483 + else get_py thy d ([k]:pblRD) pys
82.484 + | get_py thy d (k::ks) ((Ptyp (k',_,pys))::pys') =
82.485 + if k=k' then get_py thy d ks pys
82.486 + else get_py thy d (k::ks) pys';
82.487 +(*> ptyps:=
82.488 +[Ptyp ("1",[("ptyp 1",([],[]))],
82.489 + [Ptyp ("11",[("ptyp 11",([],[]))],
82.490 + [])
82.491 + ]),
82.492 + Ptyp ("2",[("ptyp 2",([],[]))],
82.493 + [Ptyp ("21",[("ptyp 21",([],[]))],
82.494 + [])
82.495 + ])
82.496 + ];
82.497 +> get_py SqRoot.thy ["1"] ["1"] (!ptyps);
82.498 +> get_py SqRoot.thy ["2","21"] ["2","21"] (!ptyps);
82.499 + _REVERSE_ .......... !!!!!!!!!!*)
82.500 +
82.501 +(*TODO: search generalized for subthy*)
82.502 +fun get_pbt (pblID:pblID) =
82.503 + let val pblRD = rev pblID;
82.504 + in get_py ProtoPure.thy pblID pblRD (!ptyps) end;
82.505 +(* get_pbt thy ["1"];
82.506 + get_pbt thy ["21","2"];
82.507 + *)
82.508 +
82.509 +(*TODO: throws exn 'get_pbt not found: ' ... confusing !!
82.510 + take 'ketype' as an argument !!!!!*)
82.511 +fun get_met (metID:metID) = get_py ProtoPure.thy metID metID (!mets);
82.512 +fun get_the (theID:theID) = get_py ProtoPure.thy theID theID (!thehier);
82.513 +
82.514 +
82.515 +
82.516 +fun del_eq k ptyps =
82.517 +let fun del k ptyps [] = ptyps
82.518 + | del k ptyps ((Ptyp (k', [p], ps))::pys) =
82.519 + if k=k' then del k ptyps pys
82.520 + else del k (ptyps @ [Ptyp (k', [p], ps)]) pys;
82.521 +in del k [] ptyps end;
82.522 +
82.523 +fun insrt d pbt [k] [] = [Ptyp (k, [pbt],[])]
82.524 +
82.525 + | insrt d pbt [k] ((Ptyp (k', [p], ps))::pys) =
82.526 +((*writeln("### insert 1: ks = "^(strs2str [k])^" k'= "^k');*)
82.527 + if k=k'
82.528 + then ((Ptyp (k', [pbt], ps))::pys)
82.529 + else (*ev.newly added pbt is free _only_ with 'last_elem pblID'*)
82.530 + ((Ptyp (k', [p], ps))::(insrt d pbt [k] pys))
82.531 +)
82.532 + | insrt d pbt (k::ks) ((Ptyp (k', [p], ps))::pys) =
82.533 +((*writeln("### insert 2: ks = "^(strs2str (k::ks))^" k'= "^k');*)
82.534 + if k=k'
82.535 + then ((Ptyp (k', [p], insrt d pbt ks ps))::pys)
82.536 + else
82.537 + if length pys = 0
82.538 + then error ("insert: not found "^(strs2str (d:pblID)))
82.539 + else ((Ptyp (k', [p], ps))::(insrt d pbt (k::ks) pys))
82.540 +);
82.541 +
82.542 +
82.543 +fun coll_pblguhs pbls =
82.544 + let fun node coll (Ptyp (_,[n],ns)) =
82.545 + [(#guh : pbt -> guh) n] @ (nodes coll ns)
82.546 + and nodes coll [] = coll
82.547 + | nodes coll (n::ns) = (node coll n) @ (nodes coll ns);
82.548 + in nodes [] pbls end;
82.549 +fun coll_metguhs mets =
82.550 + let fun node coll (Ptyp (_,[n],ns)) =
82.551 + [(#guh : met -> guh) n]
82.552 + and nodes coll [] = coll
82.553 + | nodes coll (n::ns) = (node coll n) @ (nodes coll ns);
82.554 + in nodes [] mets end;
82.555 +
82.556 +(*.lookup a guh in hierarchy or methods depending on fst chars in guh.*)
82.557 +fun guh2kestoreID (guh:guh) =
82.558 + case (implode o (take_fromto 1 4) o explode) guh of
82.559 + "pbl_" =>
82.560 + let fun node ids gu (Ptyp (id,[n as {guh,...} : pbt], ns)) =
82.561 + if gu = guh
82.562 + then Some ((ids@[id]) : kestoreID)
82.563 + else nodes (ids@[id]) gu ns
82.564 + and nodes _ _ [] = None
82.565 + | nodes ids gu (n::ns) =
82.566 + case node ids gu n of Some id => Some id
82.567 + | None => nodes ids gu ns
82.568 + in case nodes [] guh (!ptyps) of
82.569 + Some id => rev id
82.570 + | None => error ("guh2kestoreID: '" ^ guh ^ "' " ^
82.571 + "not found in (!ptyps)")
82.572 + end
82.573 + | "met_" =>
82.574 + let fun node ids gu (Ptyp (id,[n as {guh,...} : met], ns)) =
82.575 + if gu = guh
82.576 + then Some ((ids@[id]) : kestoreID)
82.577 + else nodes (ids@[id]) gu ns
82.578 + and nodes _ _ [] = None
82.579 + | nodes ids gu (n::ns) =
82.580 + case node ids gu n of Some id => Some id
82.581 + | None => nodes ids gu ns
82.582 + in case nodes [] guh (!mets) of
82.583 + Some id => id
82.584 + | None => error ("guh2kestoreID: '" ^ guh ^ "' " ^
82.585 + "not found in (!mets)") end
82.586 + | _ => error ("guh2kestoreID called with '" ^ guh ^ "'");
82.587 +(*> guh2kestoreID "pbl_equ_univ_lin";
82.588 +val it = ["linear", "univariate", "equation"] : string list*)
82.589 +
82.590 +
82.591 +fun check_pblguh_unique (guh:guh) (pbls: (pbt ptyp) list) =
82.592 + if guh mem (coll_pblguhs pbls)
82.593 + then error ("check_guh_unique failed with '"^guh^"';\n"^
82.594 + "use 'sort_pblguhs()' for a list of guhs;\n"^
82.595 + "consider setting 'check_guhs_unique := false'")
82.596 + else ();
82.597 +(* val (guh, mets) = ("met_test", !mets);
82.598 + *)
82.599 +fun check_metguh_unique (guh:guh) (mets: (met ptyp) list) =
82.600 + if guh mem (coll_metguhs mets)
82.601 + then error ("check_guh_unique failed with '"^guh^"';\n"^
82.602 + "use 'sort_metguhs()' for a list of guhs;\n"^
82.603 + "consider setting 'check_guhs_unique := false'")
82.604 + else ();
82.605 +
82.606 +
82.607 +
82.608 +(*.the pblID has the leaf-element as first; better readability achieved;.*)
82.609 +fun store_pbt (pbt as {guh,...}, pblID) =
82.610 + (if (!check_guhs_unique) then check_pblguh_unique guh (!ptyps) else ();
82.611 + ptyps:= insrt pblID pbt (rev pblID) (!ptyps));
82.612 +
82.613 +(*.the metID has the root-element as first; compare 'fun store_pbt'.*)
82.614 +(* val (met as {guh,...}, metID) =
82.615 + ((prep_met EqSystem.thy "met_eqsys" [] e_metID
82.616 + (["EqSystem"],
82.617 + [],
82.618 + {rew_ord'="tless_true", rls' = Erls, calc = [],
82.619 + srls = Erls, prls = Erls, crls = Erls, nrls = Erls},
82.620 + "empty_script"
82.621 + )));
82.622 + *)
82.623 +fun store_met (met as {guh,...}, metID) =
82.624 + (if (!check_guhs_unique) then check_metguh_unique guh (!mets) else ();
82.625 + mets:= insrt metID met metID (!mets));
82.626 +
82.627 +
82.628 +(*. prepare problem-types before storing in pbltypes;
82.629 + dont forget to 'check_guh_unique' before ins.*)
82.630 +fun prep_pbt thy guh maa init
82.631 + (pblID, dsc_dats: (string * (string list)) list,
82.632 + ev:rls, ca: string option, metIDs:metID list) =
82.633 +(* val (thy, (pblID, dsc_dats: (string * (string list)) list,
82.634 + ev:rls, ca: string option, metIDs:metID list)) =
82.635 + ((EqSystem.thy, (["system"],
82.636 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
82.637 + ("#Find" ,["solution ss___"](*___ is copy-named*))
82.638 + ],
82.639 + append_rls "e_rls" e_rls [(*for preds in where_*)],
82.640 + Some "solveSystem es_ vs_",
82.641 + [])));
82.642 + *)
82.643 + let fun eq f (f', _) = f = f';
82.644 + val gi = filter (eq "#Given") dsc_dats;
82.645 +(*val gi = [("#Given",["equality e_","solveFor v_"])]
82.646 + : (string * string list) list*)
82.647 + val gi = (case gi of
82.648 + [] => []
82.649 + | ((_,gi')::[]) =>
82.650 + ((map (split_did o term_of o the o (parse thy)) gi')
82.651 + handle _ => error
82.652 + ("prep_pbt: syntax error in '#Given' of "^
82.653 + (strs2str pblID)))
82.654 + | _ =>
82.655 + (error ("prep_pbt: more than one '#Given' in "^
82.656 + (strs2str pblID))));
82.657 +(*val gi =
82.658 + [(Const ("Descript.equality","bool => Tools.una"),Free ("e_","bool")),
82.659 + (Const ("Descript.solveFor","RealDef.real => Tools.una"),
82.660 + Free ("v_","RealDef.real"))] : (term * term) list *)
82.661 + val gi = map (pair "#Given") gi;
82.662 +(*val gi =
82.663 + [("#Given",
82.664 + (Const ("Descript.equality","bool => Tools.una"),Free ("e_","bool"))),
82.665 + ("#Given",
82.666 + (Const ("Descript.solveFor","RealDef.real => Tools.una"),
82.667 + Free ("v_","RealDef.real")))] : (string * (term * term)) list*)
82.668 +
82.669 + val fi = filter (eq "#Find") dsc_dats;
82.670 + val fi = (case fi of
82.671 + [] => [](*28.8.01: ["tool"] ...// raise error
82.672 + ("prep_pbt: no '#Find' in "^(strs2str pblID))*)
82.673 +(* val ((_,fi')::[]) = fi;
82.674 + *)
82.675 + | ((_,fi')::[]) =>
82.676 + ((map (split_did o term_of o the o (parse thy)) fi')
82.677 + handle _ => raise error
82.678 + ("prep_pbt: syntax error in '#Find' of "^
82.679 + (strs2str pblID)))
82.680 + | _ =>
82.681 + (raise error ("prep_pbt: more than one '#Find' in "^
82.682 + (strs2str pblID))));
82.683 + val fi = map (pair "#Find") fi;
82.684 +
82.685 + val re = filter (eq "#Relate") dsc_dats;
82.686 + val re = (case re of
82.687 + [] => []
82.688 + | ((_,re')::[]) =>
82.689 + ((map (split_did o term_of o the o (parse thy)) re')
82.690 + handle _ => raise error
82.691 + ("prep_pbt: syntax error in '#Relate' of "^
82.692 + (strs2str pblID)))
82.693 + | _ =>
82.694 + (raise error ("prep_pbt: more than one '#Relate' in "^
82.695 + (strs2str pblID))));
82.696 + val re = map (pair "#Relate") re;
82.697 +
82.698 + val wh = filter (eq "#Where") dsc_dats;
82.699 + val wh = (case wh of
82.700 + [] => []
82.701 + | ((_,wh')::[]) =>
82.702 + ((map (term_of o the o (parse thy)) wh')
82.703 + handle _ => raise error
82.704 + ("prep_pbt: syntax error in '#Where' of "^
82.705 + (strs2str pblID)))
82.706 + | _ =>
82.707 + (raise error ("prep_pbt: more than one '#Where' in "^
82.708 + (strs2str pblID))));
82.709 + in ({guh=guh,mathauthors=maa,init=init,
82.710 + thy=thy,cas= case ca of None => None
82.711 + | Some s =>
82.712 + Some ((term_of o the o (parse thy)) s),
82.713 + prls=ev,where_=wh,ppc= gi @ fi @ re,
82.714 + met=metIDs}, pblID):pbt * pblID end;
82.715 +(* prep_pbt thy (pblID, dsc_dats, metIDs);
82.716 + val it =
82.717 + ({met=[],
82.718 + ppc=[("#Given",(Const (#,#),Free (#,#))),
82.719 + ("#Given",(Const (#,#),Free (#,#))),
82.720 + ("#Find",(Const (#,#),Free (#,#)))],
82.721 + thy={ProtoPure, ..., Atools, RatArith},
82.722 + where_=[Const ("Descript.solutions","bool List.list => Tools.toreall") $
82.723 + Free ("v_i_","bool List.list")]},["equation"]) : pbt * pblID *)
82.724 +
82.725 +
82.726 +
82.727 +
82.728 +(*. prepare met for storage analogous to pbt .*)
82.729 +fun prep_met thy guh maa init
82.730 + (metID, ppc: (string * string list) list (*'#Where' -> #pre*),
82.731 + {rew_ord'=ro, rls'=rls, srls=srls, prls=prls,
82.732 + calc = scr_isa_fns(*FIXME.040207: del - auto-done*),
82.733 + crls=cr, nrls=nr}, scr) =
82.734 + let fun eq f (f', _) = f = f';
82.735 + (*val thy = (assoc_thy o fst) metID*)
82.736 + val gi = filter (eq "#Given") ppc;
82.737 + val gi = (case gi of
82.738 + [] => []
82.739 + | ((_,gi')::[]) =>
82.740 + ((map (split_did o term_of o the o (parse thy)) gi')
82.741 + handle _ => raise error
82.742 + ("prep_pbt: syntax error in '#Given' of "^
82.743 + (strs2str metID)))
82.744 + | _ =>
82.745 + (raise error ("prep_pbt: more than one '#Given' in "^
82.746 + (strs2str metID))));
82.747 + val gi = map (pair "#Given") gi;
82.748 +
82.749 + val fi = filter (eq "#Find") ppc;
82.750 + val fi = (case fi of
82.751 + [] => [](*28.8.01: ["tool"] ...// raise error
82.752 + ("prep_pbt: no '#Find' in "^(strs2str metID))*)
82.753 + | ((_,fi')::[]) =>
82.754 + ((map (split_did o term_of o the o (parse thy)) fi')
82.755 + handle _ => raise error
82.756 + ("prep_pbt: syntax error in '#Find' of "^
82.757 + (strs2str metID)))
82.758 + | _ =>
82.759 + (raise error ("prep_pbt: more than one '#Find' in "^
82.760 + (strs2str metID))));
82.761 + val fi = map (pair "#Find") fi;
82.762 +
82.763 + val re = filter (eq "#Relate") ppc;
82.764 + val re = (case re of
82.765 + [] => []
82.766 + | ((_,re')::[]) =>
82.767 + ((map (split_did o term_of o the o (parse thy)) re')
82.768 + handle _ => raise error
82.769 + ("prep_pbt: syntax error in '#Relate' of "^
82.770 + (strs2str metID)))
82.771 + | _ =>
82.772 + (raise error ("prep_pbt: more than one '#Relate' in "^
82.773 + (strs2str metID))));
82.774 + val re = map (pair "#Relate") re;
82.775 +
82.776 + val wh = filter (eq "#Where") ppc;
82.777 + val wh = (case wh of
82.778 + [] => []
82.779 + | ((_,wh')::[]) =>
82.780 + ((map (term_of o the o (parse thy)) wh')
82.781 + handle _ => raise error
82.782 + ("prep_pbt: syntax error in '#Where' of "^
82.783 + (strs2str metID)))
82.784 + | _ =>
82.785 + (raise error ("prep_pbt: more than one '#Where' in "^
82.786 + (strs2str metID))));
82.787 + val sc = (((inst_abs thy) o term_of o the o (parse thy)) scr)
82.788 + in ({guh=guh,mathauthors=maa,init=init,
82.789 + ppc=gi@fi@re, pre=wh, rew_ord'=ro, erls=rls, srls=srls, prls=prls,
82.790 + calc = if scr = "empty_script" then []
82.791 + else ((map (curry assoc1 (!calclist'))) o (map op_of_calc) o
82.792 + (filter is_calc) o stacpbls) sc,
82.793 + crls=cr, nrls=nr, scr=Script sc}:met,
82.794 + metID:metID)
82.795 + end;
82.796 +
82.797 +
82.798 +(**. get pblIDs of all entries in mat3D .**)
82.799 +
82.800 +
82.801 +fun format_pblID strl = enclose " [" "]" (commas_quote strl);
82.802 +fun format_pblIDl strll = enclose "[\n" "\n]\n"
82.803 + (space_implode ",\n" (map format_pblID strll));
82.804 +
82.805 +fun scan _ [] = [] (* no base case, for empty doms only *)
82.806 + | scan id ((Ptyp ((i,_,[])))::[]) = [id@[i]]
82.807 + | scan id ((Ptyp ((i,_,pl)))::[]) = scan (id@[i]) pl
82.808 + | scan id ((Ptyp ((i,_,[])))::ps) = [id@[i]] @(scan id ps)
82.809 + | scan id ((Ptyp ((i,_,pl)))::ps) =(scan (id@[i]) pl)@(scan id ps);
82.810 +
82.811 +fun show_ptyps () = (writeln o format_pblIDl o (scan [])) (!ptyps);
82.812 +(* ptyps:=[];
82.813 + show_ptyps();
82.814 + *)
82.815 +fun show_mets () = (writeln o format_pblIDl o (scan [])) (!mets);
82.816 +
82.817 +
82.818 +
82.819 +(*vvvvv---------- preparational work 8.01. UNUSED *)
82.820 +(**+ instantiate a problem-type +**)
82.821 +
82.822 +(*+ transform oris +*)
82.823 +
82.824 +fun coll_vats (vats, ((_,vs,_,_,_):ori)) = vats union vs;
82.825 +(*> coll_vats [11,22] (hd oris);
82.826 +val it = [22,11,1,2,3] : int list
82.827 +
82.828 +> foldl coll_vats ([],oris);
82.829 +val it = [1,2,3] : int list
82.830 +
82.831 +> val i=1;
82.832 +> filter ((curry (op mem) i) o #2) oris;
82.833 +val it =
82.834 + [(1,[1,2,3],"#Given",Const (#,#),[# $ #]),
82.835 + (2,[1,2,3],"#Find",Const (#,#),[Free #]),
82.836 + (3,[1,2,3],"#Find",Const (#,#),[# $ #,# $ #]),
82.837 + (4,[1,2],"#Relate",Const (#,#),[# $ #,# $ #]),
82.838 + (6,[1],"#undef",Const (#,#),[Free #]),
82.839 + (9,[1,2],"#undef",Const (#,#),[# $ #]),
82.840 + (11,[1,2,3],"#undef",Const (#,#),[# $ #])] : ori list *)
82.841 +
82.842 +fun filter_vat oris i = filter ((curry (op mem) i)o(#2:ori -> int list))oris;
82.843 +(*> map (filter_vat oris) [1,2,3];
82.844 +val it =
82.845 + [[(1,[1,2,3],"#Given",Const (#,#),[# $ #]),
82.846 + (2,[1,2,3],"#Find",Const (#,#),[Free #]),
82.847 + (3,[1,2,3],"#Find",Const (#,#),[# $ #,# $ #]),
82.848 + (4,[1,2],"#Relate",Const (#,#),[# $ #,# $ #]),
82.849 + (6,[1],"#undef",Const (#,#),[Free #]),
82.850 + (9,[1,2],"#undef",Const (#,#),[# $ #]),
82.851 + (11,[1,2,3],"#undef",Const (#,#),[# $ #])],
82.852 + [(1,[1,2,3],"#Given",Const (#,#),[# $ #]),
82.853 + (2,[1,2,3],"#Find",Const (#,#),[Free #]),
82.854 + (3,[1,2,3],"#Find",Const (#,#),[# $ #,# $ #]),
82.855 + (4,[1,2],"#Relate",Const (#,#),[# $ #,# $ #]),
82.856 + (7,[2],"#undef",Const (#,#),[Free #]),
82.857 + (9,[1,2],"#undef",Const (#,#),[# $ #]),
82.858 + (11,[1,2,3],"#undef",Const (#,#),[# $ #])],
82.859 + [(1,[1,2,3],"#Given",Const (#,#),[# $ #]),
82.860 + (2,[1,2,3],"#Find",Const (#,#),[Free #]),
82.861 + (3,[1,2,3],"#Find",Const (#,#),[# $ #,# $ #]),
82.862 + (5,[3],"#Relate",Const (#,#),[# $ #,# $ #,# $ #]),
82.863 + (8,[3],"#undef",Const (#,#),[Free #]),
82.864 + (10,[3],"#undef",Const (#,#),[# $ #]),
82.865 + (11,[1,2,3],"#undef",Const (#,#),[# $ #])]] : ori list list*)
82.866 +
82.867 +
82.868 +fun separate_vats oris =
82.869 + let val vats = foldl coll_vats ([],oris);
82.870 + in map (filter_vat oris) vats end;
82.871 +(*^^^ end preparational work 8.01.*)
82.872 +
82.873 +
82.874 +
82.875 +(**. check a problem (ie. itm list) for matching a problemtype .**)
82.876 +
82.877 +fun eq1 d (_,(d',_)) = (d = d');
82.878 +fun itm_id ((i,_,_,_,_):itm) = i;
82.879 +fun ori_id ((i,_,_,_,_):ori) = i;
82.880 +fun ori2itmSup ((i,v,_,d,ts):ori) = ((i,v,true,"#Given",Sup(d,ts)):itm);
82.881 +(*see + add_sel_ppc ~~~~~~~*)
82.882 +fun field_eq f ((_,_,f',_,_):ori) = f = f';
82.883 +
82.884 +(*. check an item (with arbitrary itm_ from previous matchings)
82.885 + for matching a problemtype; returns true only for itms found in pbt .*)
82.886 +fun chk_ thy pbt ((i,vats,b,f,Cor ((d,vs),_)):itm) =
82.887 + (case find_first (eq1 d) pbt of
82.888 + Some (_,(_,id)) => ((i,vats,b,f,Cor ((d,vs),
82.889 + (id, pbl_ids' thy d vs))):itm)
82.890 + | None => (i,vats,false,f,Sup (d,vs)))
82.891 + | chk_ thy pbt ((i,vats,b,f,Inc ((d,vs),_)):itm) =
82.892 + (case find_first (eq1 d) pbt of
82.893 + Some (_,(_,id)) => ((i,vats,b,f,Cor ((d,vs),
82.894 + (id, pbl_ids' thy d vs))):itm)
82.895 + | None => (i,vats,false,f,Sup (d,vs)))
82.896 +
82.897 + | chk_ thy pbt (itm as (i,vats,b,f,Syn ct):itm) = itm
82.898 + | chk_ thy pbt (itm as (i,vats,b,f,Typ ct):itm) = itm
82.899 +
82.900 + | chk_ thy pbt ((i,vats,b,f,Sup (d,vs)):itm) =
82.901 + (case find_first (eq1 d) pbt of
82.902 + Some (_,(_,id)) => ((i,vats,b,f,Cor ((d,vs),
82.903 + (id, pbl_ids' thy d vs))):itm)
82.904 + | None => (i,vats,false,f,Sup (d,vs)))
82.905 +(* val (i,vats,b,f,Mis (d,vs)) = i4;
82.906 + *)
82.907 + | chk_ thy pbt ((i,vats,b,f,Mis (d,vs)):itm) =
82.908 + (case find_first (eq1 d) pbt of
82.909 +(* val Some (_,(_,id)) = find_first (eq1 d) pbt;
82.910 + *)
82.911 + Some (_,(_,id)) => raise error "chk_: ((i,vats,b,f,Cor ((d,vs),\
82.912 + \(id, pbl_ids' d vs))):itm)"
82.913 + | None => (i,vats,false,f,Sup (d,[vs])));
82.914 +
82.915 +(* chk_ thy pbt i
82.916 + *)
82.917 +
82.918 +fun eq2 (_,(d,_)) ((_,_,_,_,itm_):itm) = d = d_in itm_;
82.919 +fun eq2' (_,(d,_)) ((_,_,_,d',_):ori) = d = d';
82.920 +fun eq0 ((0,_,_,_,_):itm) = true
82.921 + | eq0 _ = false;
82.922 +fun max_i i [] = i
82.923 + | max_i i ((id,_,_,_,_)::is) =
82.924 + if i > id then max_i i is else max_i id is;
82.925 +fun max_id [] = 0
82.926 + | max_id ((id,_,_,_,_)::is) = max_i id is;
82.927 +fun add_idvat itms _ _ [] = itms
82.928 + | add_idvat itms i mvat (((_,_,b,f,itm_):itm)::its) =
82.929 + add_idvat (itms @ [(i,[(*mvat ...meaningless with pbl-identifier *)
82.930 + ],b,f,itm_):itm]) (i+1) mvat its;
82.931 +
82.932 +
82.933 +(*. find elements of pbt not contained in itms;
82.934 + if such one is untouched, return this one, otherwise create new itm .*)
82.935 +fun chk_m (itms:itm list) untouched (p as (f,(d,id))) =
82.936 + case find_first (eq2 p) itms of
82.937 + Some _ => []
82.938 + | None => (case find_first (eq2 p) untouched of
82.939 + Some itm => [itm]
82.940 + | None => [(0,[],false,f,Mis (d,id)):itm]);
82.941 +(* val itms = itms'';
82.942 + *)
82.943 +fun chk_mis mvat itms untouched pbt =
82.944 + let val mis = (flat o (map (chk_m itms untouched))) pbt;
82.945 + val mid = max_id itms;
82.946 + in add_idvat [] (mid + 1) mvat mis end;
82.947 +
82.948 +(*. check a problem (ie. itm list) for matching a problemtype,
82.949 + takes the max_vt for concluding completeness (could be another!) .*)
82.950 +(* val itms = itms'; val (pbt,pre) = (ppc, pre);
82.951 + val itms = itms; val (pbt,pre) = (ppc, pre);
82.952 + *)
82.953 +fun match_itms thy itms (pbt,pre,prls) =
82.954 + (let fun okv mvat (_,vats,b,_,_) = mvat mem vats andalso b;
82.955 + val itms' = map (chk_ thy pbt) itms; (*all found are #3 true*)
82.956 + val mvat = max_vt itms';
82.957 + val itms'' = filter (okv mvat) itms';
82.958 + val untouched = filter eq0 itms;(*i.e. dsc only (from init)*)
82.959 + val mis = chk_mis mvat itms'' untouched pbt;
82.960 + val pre' = check_preconds' prls pre itms'' mvat
82.961 + val pb = foldl and_ (true, map fst pre')
82.962 + in (length mis = 0 andalso pb, (itms'@ mis, pre')) end);
82.963 +
82.964 +(*. check a problem pbl (ie. itm list) for matching a problemtype pbt,
82.965 + for missing items get data from formalization (ie. ori list);
82.966 + takes the max_vt for concluding completeness (could be another!) .*)
82.967 +(* (0) determine the most frequent variant mv in pbl
82.968 + ALL pbt. (1) dsc(pbt) notmem dsc(pbls) =>
82.969 + (2) filter (dsc(pbt) = dsc(oris)) oris; -> news;
82.970 + (3) newitms = filter (mv mem vat(news)) news
82.971 + (4) pbt @ newitms *)
82.972 +(* val (pbl, pbt, pre) = (met, mtt, pre);
82.973 + val (pbl, pbt, pre) = (itms, #ppc pbt, #where_ pbt);
82.974 + val (pbl, pbt, pre) = (itms, ppc, where_);
82.975 + *)
82.976 +fun match_itms_oris thy (pbl:itm list) (pbt, pre, prls) oris =
82.977 + let
82.978 + (*0*)val mv = max_vt pbl;
82.979 +
82.980 + fun eqdsc_pbt_itm ((_,(d,_))) ((_,_,_,_,itm_):itm) = d = d_in itm_;
82.981 + fun notmem pbl pbt1 = case find_first (eqdsc_pbt_itm pbt1) pbl of
82.982 + Some _ => false | None => true;
82.983 + (*1*)val mis = (*(map (cons2 (fst, fst o snd)))o*) (filter (notmem pbl)) pbt;
82.984 +
82.985 + fun eqdsc_ori (_,(d,_)) ((_,_,_,d',_):ori) = d = d';
82.986 + fun ori2itmMis (f,(d,pid)) ((i,v,_,_,ts):ori) =
82.987 + (i,v,false,f,Mis (d,pid)):itm;
82.988 + (*2*)fun oris2itms oris mis1 =
82.989 + ((map (ori2itmMis mis1)) o (filter (eqdsc_ori mis1))) oris;
82.990 + val news = (flat o (map (oris2itms oris))) mis;
82.991 + (*3*)fun mem_vat (_,vats,b,_,_) = mv mem vats;
82.992 + val newitms = filter mem_vat news;
82.993 + (*4*)val itms' = pbl @ newitms;
82.994 + val pre' = check_preconds' prls pre itms' mv
82.995 + val pb = foldl and_ (true, map fst pre')
82.996 + in (length mis = 0 andalso pb, (itms', pre')) end;
82.997 + (*handle _ => (false,([],[]))*);
82.998 +
82.999 +
82.1000 +(*vvv--- doubled 20.9.01: ... 7.3.02 itms --> oris, because oris
82.1001 + allow for faster access to descriptions and terms *)
82.1002 +(**. check a problem (ie. itm list) for matching a problemtype .**)
82.1003 +
82.1004 +(*. check an ori for matching a problemtype by description;
82.1005 + returns true only for itms found in pbt .*)
82.1006 +fun chk1_ thy pbt ((i,vats,f,d,vs):ori) =
82.1007 + case find_first (eq1 d) pbt of
82.1008 + Some (_,(_,id)) => [(i,vats,true,f,
82.1009 + Cor ((d,vs), (id, pbl_ids' thy d vs))):itm]
82.1010 + | None => [];
82.1011 +
82.1012 +(* elem 'p' of pbt contained in itms ? *)
82.1013 +fun chk1_m (itms:itm list) p =
82.1014 + case find_first (eq2 p) itms of
82.1015 + Some _ => true | None => false;
82.1016 +fun chk1_m' (oris: ori list) (p as (f,(d,t))) =
82.1017 + case find_first (eq2' p) oris of
82.1018 + Some _ => []
82.1019 + | None => [(f, Mis (d, t))];
82.1020 +fun pair0vatsfalse (f,itm_) = (0,[],false,f,itm_):itm;
82.1021 +
82.1022 +fun chk1_mis mvat itms ppc = foldl and_ (true, map (chk1_m itms) ppc);
82.1023 +fun chk1_mis' oris ppc =
82.1024 + map pair0vatsfalse ((flat o (map (chk1_m' oris))) ppc);
82.1025 +
82.1026 +
82.1027 +(*. check a problem (ie. ori list) for matching a problemtype,
82.1028 + takes the max_vt for concluding completeness (FIXME could be another!) .*)
82.1029 +(* val (prls,oris,pbt,pre)=(#prls py, ori, #ppc py, #where_ py);
82.1030 + *)
82.1031 +fun match_oris thy prls oris (pbt,pre) =
82.1032 + let val itms = (flat o (map (chk1_ thy pbt))) oris;
82.1033 + val mvat = max_vt itms;
82.1034 + val complete = chk1_mis mvat itms pbt;
82.1035 + val pre' = check_preconds' prls pre itms mvat
82.1036 + val pb = foldl and_ (true, map fst pre')
82.1037 + in if complete andalso pb then true else false end;
82.1038 +(*run subp-rooteq.sml 'root-eq + subpbl: solve_linear'
82.1039 + until 'val nxt = ("Model_Problem",Model_Problem ["linear","univariate"...
82.1040 +> val Nd(PblObj _,[_,_,_,_,_,_,_,_,_,_,_,
82.1041 + Nd(PblObj{origin=(oris,_,_),...},[])]) = pt;
82.1042 +> val (pbt,pre) = ((#ppc o get_pbt) ["linear","univariate","equation"],
82.1043 + (#where_ o get_pbt) ["linear","univariate","equation"]);
82.1044 +> match_oris oris (pbt,pre);
82.1045 +val it = true : bool
82.1046 +
82.1047 +
82.1048 +> val (pbt,pre) =((#ppc o get_pbt) ["plain_square","univariate","equation"],
82.1049 + (#where_ o get_pbt)["plain_square","univariate","equation"]);
82.1050 +> match_oris oris (pbt,pre);
82.1051 +val it = false : bool
82.1052 +
82.1053 +
82.1054 + ---------------------------------------------------
82.1055 + run subp-rooteq.sml 'root-eq + subpbl: solve_plain_square'
82.1056 + until 'val nxt = ("Model_Problem",Model_Problem ["plain_square","univ...
82.1057 +> val Nd (PblObj _, [_,_,_,_,_,_,_,Nd (PrfObj _,[]),
82.1058 + Nd (PblObj {origin=(oris,_,_),...},[])]) = pt;
82.1059 +> val (pbt,pre) = ((#ppc o get_pbt) ["linear","univariate","equation"],
82.1060 + (#where_ o get_pbt) ["linear","univariate","equation"]);
82.1061 +> match_oris oris (pbt,pre);
82.1062 +val it = false : bool
82.1063 +
82.1064 +
82.1065 +> val (pbt,pre)=((#ppc o get_pbt) ["plain_square","univariate","equation"],
82.1066 + (#where_ o get_pbt) ["plain_square","univariate","equation"]);
82.1067 +> match_oris oris (pbt,pre);
82.1068 +val it = true : bool
82.1069 +*)
82.1070 +(*^^^--- doubled 20.9.01 *)
82.1071 +
82.1072 +
82.1073 +(*. check a problem (ie. ori list) for matching a problemtype,
82.1074 + returns items for output to math-experts .*)
82.1075 +(* val (ppc,pre) = (#ppc py, #where_ py);
82.1076 + *)
82.1077 +fun match_oris' thy oris (ppc,pre,prls) =
82.1078 +(* val (thy, oris, (ppc,pre,prls)) = (thy, oris, (ppc, where_, prls));
82.1079 + *)
82.1080 + let val itms = (flat o (map (chk1_ thy ppc))) oris;
82.1081 + val sups = ((map ori2itmSup) o (filter(field_eq "#undef")))oris;
82.1082 + val mvat = max_vt itms;
82.1083 + val miss = chk1_mis' oris ppc;
82.1084 + val pre' = check_preconds' prls pre itms mvat
82.1085 + val pb = foldl and_ (true, map fst pre')
82.1086 + in (miss = [] andalso pb, (itms @ miss @ sups, pre')) end;
82.1087 +
82.1088 +(*. for the user .*)
82.1089 +datatype match' =
82.1090 + Matches' of item ppc
82.1091 +| NoMatch' of item ppc;
82.1092 +
82.1093 +(*. match a formalization with a problem type .*)
82.1094 +fun match_pbl (fmz:fmz_) ({thy=thy,where_=pre,ppc,prls=er,...}:pbt) =
82.1095 + let val oris = prep_ori fmz thy ppc;
82.1096 + val (bool, (itms, pre')) = match_oris' thy oris (ppc,pre,er);
82.1097 + in if bool then Matches' (itms2itemppc thy itms pre')
82.1098 + else NoMatch' (itms2itemppc thy itms pre') end;
82.1099 +(*
82.1100 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
82.1101 + "solveFor x","errorBound (eps=0)","solutions L"];
82.1102 +val pbt as {thy = thy, where_ = pre, ppc = ppc,...} =
82.1103 + get_pbt ["univariate","equation"];
82.1104 +match_pbl fmz pbt;
82.1105 +*)
82.1106 +
82.1107 +
82.1108 +(*. refine a problem; construct pblRD while scanning .*)
82.1109 +(* val (pblRD,ori)=("xxx",oris);
82.1110 + val py = get_pbt ["equation"];
82.1111 + val py = get_pbt ["univariate","equation"];
82.1112 + val py = get_pbt ["linear","univariate","equation"];
82.1113 + val py = get_pbt ["root","univariate","equation"];
82.1114 + match_oris (#prls py) ori (#ppc py, #where_ py);
82.1115 +
82.1116 + *)
82.1117 +fun refin (pblRD:pblRD) ori
82.1118 +((Ptyp (pI,[py],[])):pbt ptyp) =
82.1119 + if match_oris (#thy py) (#prls py) ori (#ppc py, #where_ py)
82.1120 + then Some ((pblRD @ [pI]):pblRD)
82.1121 + else None
82.1122 + | refin pblRD ori (Ptyp (pI,[py],pys)) =
82.1123 + if match_oris (#thy py) (#prls py) ori (#ppc py, #where_ py)
82.1124 + then (case refins (pblRD @ [pI]) ori pys of
82.1125 + Some pblRD' => Some pblRD'
82.1126 + | None => Some (pblRD @ [pI]))
82.1127 + else None
82.1128 +and refins pblRD ori [] = None
82.1129 + | refins pblRD ori ((p as Ptyp (pI,_,_))::pts) =
82.1130 + (case refin pblRD ori p of
82.1131 + Some pblRD' => Some pblRD'
82.1132 + | None => refins pblRD ori pts);
82.1133 +
82.1134 +(*. refine a problem; version providing output for math-experts .*)
82.1135 +fun refin' (pblRD:pblRD) fmz pbls ((Ptyp (pI,[py],[])):pbt ptyp) =
82.1136 +(* val ((pblRD:pblRD), fmz, pbls, ((Ptyp (pI,[py],[])):pbt ptyp)) =
82.1137 + (rev ["linear","system"], fmz, [(*match list*)],
82.1138 + ((Ptyp ("2x2",[get_pbt ["2x2","linear","system"]],[])):pbt ptyp));
82.1139 + *)
82.1140 + let val _ = (writeln o ((curry op^)"*** pass ") o strs2str)(pblRD @ [pI])
82.1141 + val {thy,ppc,where_,prls,...} = py
82.1142 + val oris = prep_ori fmz thy ppc
82.1143 + (*8.3.02: itms!: oris ev. are _not_ complete here*)
82.1144 + val (b, (itms, pre')) = match_oris' thy oris (ppc, where_, prls)
82.1145 + in if b then pbls @ [Matches (rev (pblRD @ [pI]),
82.1146 + itms2itemppc thy itms pre')]
82.1147 + else pbls @ [NoMatch (rev (pblRD @ [pI]),
82.1148 + itms2itemppc thy itms pre')]
82.1149 + end
82.1150 +(* val pblRD = ["pbla"]; val fmz = fmz1; val pbls = [];
82.1151 + val Ptyp (pI,[py],pys) = hd (!ptyps);
82.1152 + refin' pblRD fmz pbls (Ptyp (pI,[py],pys));
82.1153 +*)
82.1154 + | refin' pblRD fmz pbls (Ptyp (pI,[py],pys)) =
82.1155 + let val _ = (writeln o ((curry op^)"*** pass ") o strs2str) (pblRD @ [pI])
82.1156 + val {thy,ppc,where_,prls,...} = py
82.1157 + val oris = prep_ori fmz thy ppc;
82.1158 + (*8.3.02: itms!: oris ev. are _not_ complete here*)
82.1159 + val(b, (itms, pre')) = match_oris' thy oris (ppc,where_,prls);
82.1160 + in if b
82.1161 + then let val pbl = Matches (rev (pblRD @ [pI]),
82.1162 + itms2itemppc thy itms pre')
82.1163 + in refins' (pblRD @ [pI]) fmz (pbls @ [pbl]) pys end
82.1164 + else (pbls @ [NoMatch (rev (pblRD @ [pI]), itms2itemppc thy itms pre')])
82.1165 + end
82.1166 +and refins' pblRD fmz pbls [] = pbls
82.1167 + | refins' pblRD fmz pbls ((p as Ptyp (pI,_,_))::pts) =
82.1168 + let val pbls' = refin' pblRD fmz pbls p
82.1169 + in case last_elem pbls' of
82.1170 + Matches _ => pbls'
82.1171 + | NoMatch _ => refins' pblRD fmz pbls' pts end;
82.1172 +
82.1173 +(*. refine a problem; version for tactic Refine_Problem .*)
82.1174 +fun refin'' thy (pblRD:pblRD) itms pbls ((Ptyp (pI,[py],[])):pbt ptyp) =
82.1175 + let (*val _ = writeln("### refin''1: pI="^pI);*)
82.1176 + val {thy,ppc,where_,prls,...} = py
82.1177 + val (b, (itms', pre')) = match_itms thy itms (ppc,where_,prls);
82.1178 + in if b then pbls @ [Match_ (rev (pblRD @ [pI]), (itms', pre'))]
82.1179 + else pbls @ [NoMatch_]
82.1180 + end
82.1181 +(* val pblRD = (rev o tl) pblID; val pbls = [];
82.1182 + val Ptyp (pI,[py],pys) = app_ptyp I pblID (rev pblID) (!ptyps);
82.1183 + *)
82.1184 + | refin'' thy pblRD itms pbls (Ptyp (pI,[py],pys)) =
82.1185 + let (*val _ = writeln("### refin''2: pI="^pI);*)
82.1186 + val {thy,ppc,where_,prls,...} = py
82.1187 + val(b, (itms', pre')) = match_itms thy itms (ppc,where_,prls);
82.1188 + in if b
82.1189 + then let val pbl = Match_ (rev (pblRD @ [pI]), (itms', pre'))
82.1190 + in refins'' thy (pblRD @ [pI]) itms (pbls @ [pbl]) pys end
82.1191 + else (pbls @ [NoMatch_])
82.1192 + end
82.1193 +and refins'' thy pblRD itms pbls [] = pbls
82.1194 + | refins'' thy pblRD itms pbls ((p as Ptyp (pI,_,_))::pts) =
82.1195 + let val pbls' = refin'' thy pblRD itms pbls p
82.1196 + in case last_elem pbls' of
82.1197 + Match_ _ => pbls'
82.1198 + | NoMatch_ => refins'' thy pblRD itms pbls' pts end;
82.1199 +
82.1200 +
82.1201 +(*. apply a fun to a ptyps node; copied from get_py .*)
82.1202 +fun app_ptyp f (d:pblID) _ [] =
82.1203 + raise error ("app_ptyp not found: "^(strs2str d))
82.1204 + | app_ptyp f d (k::[]) ((p as Ptyp (k',[py],_))::pys) =
82.1205 + if k=k' then f p
82.1206 + else app_ptyp f d ([k]:pblRD) pys
82.1207 + | app_ptyp f d (k::ks) ((Ptyp (k',_,pys))::pys') =
82.1208 + if k=k' then app_ptyp f d ks pys
82.1209 + else app_ptyp f d (k::ks) pys';
82.1210 +
82.1211 +(*. for tactic Refine_Tacitly .*)
82.1212 +(*!!! oris are already created wrt. some pbt; pbt contains thy for parsing*)
82.1213 +(* val (thy,pblID) = (assoc_thy dI',pI);
82.1214 + *)
82.1215 +fun refine_ori oris (pblID:pblID) =
82.1216 + let val opt = app_ptyp (refin ((rev o tl) pblID) oris)
82.1217 + pblID (rev pblID) (!ptyps);
82.1218 + in case opt of
82.1219 + Some pblRD => let val (pblID':pblID) =(rev pblRD)
82.1220 + in if pblID' = pblID then None
82.1221 + else Some pblID' end
82.1222 + | None => None end;
82.1223 +fun refine_ori' oris pI = (the (refine_ori oris pI)) handle _ => pI;
82.1224 +
82.1225 +(*. for tactic Refine_Problem .*);
82.1226 +(* 10.03: returnvalue -> (pIrefined, itm list) would be sufficient *)
82.1227 +(* val pblID = pI; app_ptyp I pblID (rev pblID) (!ptyps);
82.1228 + *)
82.1229 +fun refine_pbl thy (pblID:pblID) itms =
82.1230 + case refined_ (app_ptyp (refin'' thy ((rev o tl) pblID) itms [])
82.1231 + pblID (rev pblID) (!ptyps)) of
82.1232 + None => None
82.1233 + | Some (Match_ (rfd as (pI',_))) =>
82.1234 + if pblID = pI' then None else Some rfd;
82.1235 +
82.1236 +
82.1237 +(*. for math-experts .*)
82.1238 +(*19.10.02FIXME: needs thy for parsing fmz*)
82.1239 +(* val fmz = fmz1; val pblID = ["pbla"]; val pblRD = (rev o tl) pblID;
82.1240 + val pbls = []; val ptys = !ptyps;
82.1241 + *)
82.1242 +fun refine (fmz:fmz_) (pblID:pblID) =
82.1243 + app_ptyp (refin' ((rev o tl) pblID) fmz []) pblID (rev pblID) (!ptyps);
82.1244 +
82.1245 +
82.1246 +(*.make a guh from a reference to an element in the kestore;
82.1247 + EXCEPT theory hierarchy ... compare 'fun keref2xml'.*)
82.1248 +fun pblID2guh (pblID:pblID) =
82.1249 + (((#guh o get_pbt) pblID)
82.1250 + handle _ => raise error ("pblID2guh: not for '"^strs2str' pblID ^ "'"));
82.1251 +fun metID2guh (metID:metID) =
82.1252 + (((#guh o get_met) metID)
82.1253 + handle _ => raise error ("metID2guh: no 'Met_' for '"^
82.1254 + strs2str' metID ^ "'"));
82.1255 +fun kestoreID2guh Pbl_ (kestoreID:kestoreID) = pblID2guh kestoreID
82.1256 + | kestoreID2guh Met_ (kestoreID:kestoreID) = metID2guh kestoreID
82.1257 + | kestoreID2guh ketype kestoreID =
82.1258 + raise error ("kestoreID2guh: '" ^ ketype2str ketype ^ "' not for '" ^
82.1259 + strs2str' kestoreID ^ "'");
82.1260 +
82.1261 +fun show_pblguhs () =
82.1262 + (print_depth 999;
82.1263 + (writeln o strs2str o (map linefeed)) (coll_pblguhs (!ptyps));
82.1264 + print_depth 3);
82.1265 +fun sort_pblguhs () =
82.1266 + (print_depth 999;
82.1267 + (writeln o strs2str o (map linefeed))
82.1268 + (((sort string_ord) o coll_pblguhs) (!ptyps));
82.1269 + print_depth 3);
82.1270 +
82.1271 +fun show_metguhs () =
82.1272 + (print_depth 999;
82.1273 + (writeln o strs2str o (map linefeed)) (coll_metguhs (!mets));
82.1274 + print_depth 3);
82.1275 +fun sort_metguhs () =
82.1276 + (print_depth 999;
82.1277 + (writeln o strs2str o (map linefeed))
82.1278 + (((sort string_ord) o coll_metguhs) (!mets));
82.1279 + print_depth 3);
83.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
83.2 +++ b/src/Pure/isac/ME/rewtools.sml Wed Jul 21 13:53:39 2010 +0200
83.3 @@ -0,0 +1,841 @@
83.4 +(* tools for rewriting, reverse rewriting, context to thy concerning rewriting
83.5 + authors: Walther Neuper 2002, 2006
83.6 + (c) due to copyright terms
83.7 +
83.8 +use"ME/rewtools.sml";
83.9 +use"rewtools.sml";
83.10 +*)
83.11 +
83.12 +
83.13 +
83.14 +(***.reverse rewriting.***)
83.15 +
83.16 +(*.derivation for insertin one level of nodes into the calctree.*)
83.17 +type deriv = (term * rule * (term *term list)) list;
83.18 +
83.19 +fun trta2str (t,r,(t',a)) = "\n("^(term2str t)^", "^(rule2str' r)^", ("^
83.20 + (term2str t')^", "^(terms2str a)^"))";
83.21 +fun trtas2str trtas = (strs2str o (map trta2str)) trtas;
83.22 +val deriv2str = trtas2str;
83.23 +fun rta2str (r,(t,a)) = "\n("^(rule2str' r)^", ("^
83.24 + (term2str t)^", "^(terms2str a)^"))";
83.25 +fun rtas2str rtas = (strs2str o (map rta2str)) rtas;
83.26 +val deri2str = rtas2str;
83.27 +
83.28 +
83.29 +(*.A1==>...==>An==>(Lhs = Rhs) goes to A1==>...==>An==>(Rhs = Lhs).*)
83.30 +fun sym_thm thm =
83.31 + let
83.32 + val {sign_ref = sign_ref, der = der, maxidx = maxidx,
83.33 + shyps = shyps, hyps = hyps, (*tpairs = tpairs,*) prop = prop} =
83.34 + rep_thm_G thm;
83.35 + val (lhs,rhs) = (dest_equals' o strip_trueprop
83.36 + o Logic.strip_imp_concl) prop;
83.37 + val prop' = case strip_imp_prems' prop of
83.38 + None => Trueprop $ (mk_equality (rhs, lhs))
83.39 + | Some cs =>
83.40 + ins_concl cs (Trueprop $ (mk_equality (rhs, lhs)));
83.41 + in assbl_thm sign_ref der maxidx shyps hyps (*tpairs*) prop' end;
83.42 +(*
83.43 + (sym RS real_mult_div_cancel1) handle e => print_exn e;
83.44 +Exception THM 1 raised:
83.45 +RSN: no unifiers
83.46 +"?s = ?t ==> ?t = ?s"
83.47 +"?k ~= 0 ==> ?k * ?m / (?k * ?n) = ?m / ?n"
83.48 +
83.49 + val thm = real_mult_div_cancel1;
83.50 + val prop = (#prop o rep_thm) thm;
83.51 + atomt prop;
83.52 + val ppp = Logic.strip_imp_concl prop;
83.53 + atomt ppp;
83.54 + ((#prop o rep_thm o sym_thm o sym_thm) thm) = (#prop o rep_thm) thm;
83.55 +val it = true : bool
83.56 + ((sym_thm o sym_thm) thm) = thm;
83.57 +val it = true : bool
83.58 +
83.59 + val thm = real_le_anti_sym;
83.60 + ((sym_thm o sym_thm) thm) = thm;
83.61 +val it = true : bool
83.62 +
83.63 + val thm = real_minus_zero;
83.64 + ((sym_thm o sym_thm) thm) = thm;
83.65 +val it = true : bool
83.66 +*)
83.67 +
83.68 +
83.69 +
83.70 +(*.derive normalform of a rls, or derive until Some goal,
83.71 + and record rules applied and rewrites.
83.72 +val it = fn
83.73 + : theory
83.74 + -> rls
83.75 + -> rule list
83.76 + -> rew_ord : the order of this rls, which 1 theorem of is used
83.77 + for rewriting 1 single step (?14.4.03)
83.78 + -> term option : 040214 ??? nonsense ???
83.79 + -> term
83.80 + -> (term * : to this term ...
83.81 + rule * : ... this rule is applied yielding ...
83.82 + (term * : ... this term ...
83.83 + term list)) : ... under these assumptions.
83.84 + list :
83.85 +returns empty list for a normal form
83.86 +FIXME.WN040214: treats rules as in Rls, _not_ as in Seq
83.87 +
83.88 +WN060825 too complicated for the intended use by cancel_, common_nominator_
83.89 +and unreflectedly adapted to extion of rules by Rls_: returns Rls_("sym_simpl..
83.90 + -- replaced below*)
83.91 +(* val (thy, erls, rs, ro, goal, tt) = (thy, erls, rs, ro, goal, t);
83.92 + val (thy, erls, rs, ro, goal, tt) = (thy, Atools_erls, rules, ro, None, tt);
83.93 + *)
83.94 +fun make_deriv thy erls (rs:rule list) ro(*rew_ord*) goal tt =
83.95 + let datatype switch = Appl | Noap
83.96 + fun rew_once lim rts t Noap [] =
83.97 + (case goal of
83.98 + None => rts
83.99 + | Some g =>
83.100 + raise error ("make_deriv: no derivation for "^(term2str t)))
83.101 + | rew_once lim rts t Appl [] =
83.102 + (*(case rs of Rls _ =>*) rew_once lim rts t Noap rs
83.103 + (*| Seq _ => rts) FIXXXXXME 14.3.03*)
83.104 + | rew_once lim rts t apno rs' =
83.105 + (case goal of
83.106 + None => rew_or_calc lim rts t apno rs'
83.107 + | Some g =>
83.108 + if g = t then rts
83.109 + else rew_or_calc lim rts t apno rs')
83.110 + and rew_or_calc lim rts t apno (rrs' as (r::rs')) =
83.111 + if lim < 0
83.112 + then (writeln ("make_deriv exceeds " ^ int2str (!lim_deriv) ^
83.113 + "with deriv =\n"); writeln (deriv2str rts); rts)
83.114 + else
83.115 + case r of
83.116 + Thm (thmid, tm) =>
83.117 + (if not (!trace_rewrite) then () else
83.118 + writeln ("### trying thm '" ^ thmid ^ "'");
83.119 + case rewrite_ thy ro erls true tm t of
83.120 + None => rew_once lim rts t apno rs'
83.121 + | Some (t',a') =>
83.122 + (if ! trace_rewrite
83.123 + then writeln ("### rewrites to: "^(term2str t')) else();
83.124 + rew_once (lim-1) (rts@[(t,r,(t',a'))]) t' Appl rrs'))
83.125 + | Calc (c as (op_,_)) =>
83.126 + let val _ = if not (!trace_rewrite) then () else
83.127 + writeln ("### trying calc. '" ^ op_ ^ "'")
83.128 + val t = uminus_to_string t
83.129 + in case get_calculation_ thy c t of
83.130 + None => rew_once lim rts t apno rs'
83.131 + | Some (thmid, tm) =>
83.132 + (let val Some (t',a') = rewrite_ thy ro erls true tm t
83.133 + val _ = if not (!trace_rewrite) then () else
83.134 + writeln("### calc. to: " ^ (term2str t'))
83.135 + val r' = Thm (thmid, tm)
83.136 + in rew_once (lim-1) (rts@[(t,r',(t',a'))]) t' Appl rrs'
83.137 + end)
83.138 + handle _ => raise error "derive_norm, Calc: no rewrite"
83.139 + end
83.140 +(* TODO.WN080222: see rewrite__set_
83.141 + @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
83.142 + | Cal1 (cc as (op_,_)) =>
83.143 + (let val _= if !trace_rewrite andalso i < ! depth then
83.144 + writeln((idt"#"(i+1))^" try cal1: "^op_^"'") else ();
83.145 + val ct = uminus_to_string ct
83.146 + in case get_calculation_ thy cc ct of
83.147 + None => (ct, asm)
83.148 + | Some (thmid, thm') =>
83.149 + let
83.150 + val pairopt =
83.151 + rewrite__ thy (i+1) bdv ((snd o #rew_ord o rep_rls) rls)
83.152 + ((#erls o rep_rls) rls) put_asm thm' ct;
83.153 + val _ = if pairopt <> None then ()
83.154 + else raise error("rewrite_set_, rewrite_ \""^
83.155 + (string_of_thmI thm')^"\" "^(term2str ct)^" = None")
83.156 + val _ = if ! trace_rewrite andalso i < ! depth
83.157 + then writeln((idt"="(i+1))^" cal1. to: "^
83.158 + (term2str ((fst o the) pairopt)))
83.159 + else()
83.160 + in the pairopt end
83.161 + end)
83.162 +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
83.163 + | Rls_ rls =>
83.164 + (case rewrite_set_ thy true rls t of
83.165 + None => rew_once lim rts t apno rs'
83.166 + | Some (t',a') =>
83.167 + rew_once (lim-1) (rts @ [(t,r,(t',a'))]) t' Appl rrs');
83.168 +(*WN060829 | Rls_ rls =>
83.169 + (case rewrite_set_ thy true rls t of
83.170 + None => rew_once lim rts t apno rs'
83.171 + | Some (t',a') =>
83.172 + if ro [] (t, t') then rew_once lim rts t apno rs'
83.173 + else rew_once (lim-1) (rts@[(t,r,(t',a'))]) t' Appl rrs');
83.174 +...lead to deriv = [] with make_polynomial.
83.175 +THERE IS SOMETHING DIFFERENT beetween rewriting with the code above
83.176 +and between rewriting with rewrite_set: with rules from make_polynomial and
83.177 +t = "(a^^^2 + -1*b^^^2) / (a^^^2 + -2*a*b + b^^^2)" the actual code
83.178 +leads to cycling Rls_ order_mult_rls_..Rls_ discard_parentheses_..Rls_ order..
83.179 +*)
83.180 + in rew_once (!lim_deriv) [] tt Noap rs end;
83.181 +
83.182 +
83.183 +(*.toggles the marker for 'fun sym_thm'.*)
83.184 +fun sym_thmID (thmID : thmID) =
83.185 + case explode thmID of
83.186 + "s"::"y"::"m"::"_"::id => implode id : thmID
83.187 + | id => "sym_"^thmID;
83.188 +(*
83.189 +> val thmID = "sym_real_mult_2";
83.190 +> sym_thmID thmID;
83.191 +val it = "real_mult_2" : string
83.192 +> val thmID = "real_num_collect";
83.193 +> sym_thmID thmID;
83.194 +val it = "sym_real_num_collect" : string*)
83.195 +fun sym_drop (thmID : thmID) =
83.196 + case explode thmID of
83.197 + "s"::"y"::"m"::"_"::id => implode id : thmID
83.198 + | id => thmID;
83.199 +fun is_sym (thmID : thmID) =
83.200 + case explode thmID of
83.201 + "s"::"y"::"m"::"_"::id => true
83.202 + | id => false;
83.203 +
83.204 +
83.205 +(*FIXXXXME.040219: detail has to handle Rls id="sym_..."
83.206 + by applying make_deriv, rev_deriv'; see concat_deriv*)
83.207 +fun sym_rls Erls = Erls
83.208 + | sym_rls (Rls {id, scr, calc, erls, srls, rules, rew_ord, preconds}) =
83.209 + Rls {id="sym_"^id, scr=scr, calc=calc, erls=erls, srls=srls,
83.210 + rules=rules, rew_ord=rew_ord, preconds=preconds}
83.211 + | sym_rls (Seq {id, scr, calc, erls, srls, rules, rew_ord, preconds}) =
83.212 + Seq {id="sym_"^id, scr=scr, calc=calc, erls=erls, srls=srls,
83.213 + rules=rules, rew_ord=rew_ord, preconds=preconds}
83.214 + | sym_rls (Rrls {id, scr, calc, erls, prepat, rew_ord}) =
83.215 + Rrls {id="sym_"^id, scr=scr, calc=calc, erls=erls, prepat=prepat,
83.216 + rew_ord=rew_ord};
83.217 +
83.218 +fun sym_Thm (Thm (thmID, thm)) = Thm (sym_thmID thmID, sym_thm thm)
83.219 + | sym_Thm (Rls_ rls) = Rls_ (*WN060825?!?*) (sym_rls rls)
83.220 + | sym_Thm r = raise error ("sym_Thm: not for "^(rule2str r));
83.221 +(*
83.222 + val th = Thm ("real_one_collect",num_str real_one_collect);
83.223 + sym_Thm th;
83.224 +val th =
83.225 + Thm ("real_one_collect","?m is_const ==> ?n + ?m * ?n = (1 + ?m) * ?n")
83.226 + : rule
83.227 +ML> val it =
83.228 + Thm ("sym_real_one_collect","?m is_const ==> (1 + ?m) * ?n = ?n + ?m * ?n")*)
83.229 +
83.230 +
83.231 +(*version for reverse rewrite used before 040214*)
83.232 +fun rev_deriv (t, r, (t', a)) = (sym_Thm r, (t, a));
83.233 +(* val (thy, erls, rs, ro, goal, t) = (thy, eval_rls, rules, ro, None, t');
83.234 + *)
83.235 +fun reverse_deriv thy erls (rs:rule list) ro(*rew_ord*) goal t =
83.236 + (rev o (map rev_deriv)) (make_deriv thy erls (rs:rule list) ro goal t);
83.237 +(*
83.238 + val rev_rew = reverse_deriv thy e_rls ;
83.239 + writeln(rtas2str rev_rew);
83.240 +*)
83.241 +
83.242 +fun eq_Thm (Thm (id1,_), Thm (id2,_)) = id1 = id2
83.243 + | eq_Thm (Thm (id1,_), _) = false
83.244 + | eq_Thm (Rls_ r1, Rls_ r2) = id_rls r1 = id_rls r2
83.245 + | eq_Thm (Rls_ r1, _) = false
83.246 + | eq_Thm (r1, r2) = raise error ("eq_Thm: called with '"^
83.247 + (rule2str r1)^"' '"^(rule2str r2)^"'");
83.248 +fun distinct_Thm r = gen_distinct eq_Thm r;
83.249 +
83.250 +fun eq_Thms thmIDs thm = ((id_of_thm thm) mem thmIDs)
83.251 + handle _ => false;
83.252 +
83.253 +
83.254 +
83.255 +
83.256 +(***. context to thy concerning rewriting .***)
83.257 +
83.258 +(*.create the unique handles and filenames for the theory-data.*)
83.259 +fun part2guh ([str]:theID) =
83.260 + (case str of
83.261 + "Isabelle" => "thy_isab_" ^ str ^ "-part" : guh
83.262 + | "IsacScripts" => "thy_scri_" ^ str ^ "-part"
83.263 + | "IsacKnowledge" => "thy_isac_" ^ str ^ "-part"
83.264 + | str => raise error ("thy2guh: called with '"^str^"'"))
83.265 + | part2guh theID = raise error ("part2guh called with theID = "
83.266 + ^ theID2str theID);
83.267 +fun part2filename str = part2guh str ^ ".xml" : filename;
83.268 +
83.269 +
83.270 +fun thy2guh ([part, thyID]:theID) =
83.271 + (case part of
83.272 + "Isabelle" => "thy_isab_" ^ thyID : guh
83.273 + | "IsacScripts" => "thy_scri_" ^ thyID
83.274 + | "IsacKnowledge" => "thy_isac_" ^ thyID
83.275 + | str => raise error ("thy2guh: called with '"^str^"'"))
83.276 + | thy2guh theID = raise error ("thy2guh called with '"^strs2str' theID^"'");
83.277 +fun thy2filename thy' = thy2guh thy' ^ ".xml" : filename;
83.278 +fun thypart2guh ([part, thyID, thypart]:theID) =
83.279 + case part of
83.280 + "Isabelle" => "thy_isab_" ^ thyID ^ "-" ^ thypart : guh
83.281 + | "IsacScripts" => "thy_scri_" ^ thyID ^ "-" ^ thypart
83.282 + | "IsacKnowledge" => "thy_isac_" ^ thyID ^ "-" ^ thypart
83.283 + | str => raise error ("thypart2guh: called with '"^str^"'");
83.284 +fun thypart2filename thy' = thypart2guh thy' ^ ".xml" : filename;
83.285 +
83.286 +(*.convert the data got via contextToThy to a globally unique handle
83.287 + there is another way to get the guh out of the 'theID' in the hierarchy.*)
83.288 +fun thm2guh (isa, thyID:thyID) (thmID:thmID) =
83.289 + case isa of
83.290 + "Isabelle" =>
83.291 + "thy_isab_" ^ theory'2thyID thyID ^ "-thm-" ^ strip_thy thmID : guh
83.292 + | "IsacKnowledge" =>
83.293 + "thy_isac_" ^ theory'2thyID thyID ^ "-thm-" ^ strip_thy thmID
83.294 + | "IsacScripts" =>
83.295 + "thy_scri_" ^ theory'2thyID thyID ^ "-thm-" ^ strip_thy thmID
83.296 + | str => raise error ("thm2guh called with isa = '"^isa^
83.297 + "' for thm = "^thmID^"'");
83.298 +fun thm2filename (isa_thyID: string * thyID) thmID =
83.299 + (thm2guh isa_thyID thmID) ^ ".xml" : filename;
83.300 +
83.301 +fun rls2guh (isa, thyID:thyID) (rls':rls') =
83.302 + case isa of
83.303 + "Isabelle" =>
83.304 + "thy_isab_" ^ theory'2thyID thyID ^ "-rls-" ^ rls' : guh
83.305 + | "IsacKnowledge" =>
83.306 + "thy_isac_" ^ theory'2thyID thyID ^ "-rls-" ^ rls'
83.307 + | "IsacScripts" =>
83.308 + "thy_scri_" ^ theory'2thyID thyID ^ "-rls-" ^ rls'
83.309 + | str => raise error ("rls2guh called with isa = '"^isa^
83.310 + "' for rls = '"^rls'^"'");
83.311 + fun rls2filename (isa, thyID) rls' =
83.312 + rls2guh (isa, thyID) rls' ^ ".xml" : filename;
83.313 +
83.314 +fun cal2guh (isa, thyID:thyID) calID =
83.315 + case isa of
83.316 + "Isabelle" =>
83.317 + "thy_isab_" ^ theory'2thyID thyID ^ "-cal-" ^ calID : guh
83.318 + | "IsacKnowledge" =>
83.319 + "thy_isac_" ^ theory'2thyID thyID ^ "-cal-" ^ calID
83.320 + | "IsacScripts" =>
83.321 + "thy_scri_" ^ theory'2thyID thyID ^ "-cal-" ^ calID
83.322 + | str => raise error ("cal2guh called with isa = '"^isa^
83.323 + "' for cal = '"^calID^"'");
83.324 +fun cal2filename (isa, thyID:thyID) calID =
83.325 + cal2guh (isa, thyID:thyID) calID ^ ".xml" : filename;
83.326 +
83.327 +fun ord2guh (isa, thyID:thyID) (rew_ord':rew_ord') =
83.328 + case isa of
83.329 + "Isabelle" =>
83.330 + "thy_isab_" ^ theory'2thyID thyID ^ "-ord-" ^ rew_ord' : guh
83.331 + | "IsacKnowledge" =>
83.332 + "thy_isac_" ^ theory'2thyID thyID ^ "-ord-" ^ rew_ord'
83.333 + | "IsacScripts" =>
83.334 + "thy_scri_" ^ theory'2thyID thyID ^ "-ord-" ^ rew_ord'
83.335 + | str => raise error ("ord2guh called with isa = '"^isa^
83.336 + "' for ord = '"^rew_ord'^"'");
83.337 +fun ord2filename (isa, thyID:thyID) (rew_ord':rew_ord') =
83.338 + ord2guh (isa, thyID:thyID) (rew_ord':rew_ord') ^ ".xml" : filename;
83.339 +
83.340 +
83.341 +(**.set up isab_thm_thy in Isac.ML.**)
83.342 +
83.343 +fun rearrange (thyID, (thmID, thm)) = (thmID, (thyID, thm));
83.344 +fun rearrange_inv (thmID, (thyID, thm)) = (thyID, (thmID, thm));
83.345 +
83.346 +(*.lookup the missing theorems in some thy (of Isabelle).*)
83.347 +fun make_isa missthms thy =
83.348 + map (pair (theory2thyID thy))
83.349 + (curry (gen_inter eq_thmI) missthms (thms_of thy))
83.350 + : (thyID * (thmID * Thm.thm)) list;
83.351 +
83.352 +(*.separate handling of sym_thms.*)
83.353 +fun make_isab rlsthmsNOTisac isab_thys =
83.354 + let fun les ((s1,_), (s2,_)) = (s1 : string) < s2
83.355 + val notsym = filter_out (is_sym o #1) rlsthmsNOTisac
83.356 + val notsym_isab = (flat o (map (make_isa notsym))) isab_thys
83.357 +
83.358 + val sym = filter (is_sym o #1) rlsthmsNOTisac
83.359 +
83.360 + val symsym = map ((apfst sym_drop) o (apsnd sym_thm)) sym
83.361 + val symsym_isab = (flat o (map (make_isa symsym))) isab_thys
83.362 +
83.363 + val sym_isab = map (((apsnd o apfst) sym_drop) o
83.364 + ((apsnd o apsnd) sym_thm)) symsym_isab
83.365 +
83.366 + val isab = notsym_isab @ symsym_isab @ sym_isab
83.367 + in ((map rearrange) o (gen_sort les)) isab
83.368 + : (thmID * (thyID * Thm.thm)) list
83.369 + end;
83.370 +
83.371 +(*.which theory below thy' contains a theorem; this can be in isabelle !
83.372 +get the occurence _after_ in the _list_ (is up to asking TUM) theory'.*)
83.373 +(* val (str, (_, thy)) = ("real_diff_minus", ("Root.thy", Root.thy));
83.374 + val (str, (_, thy)) = ("real_diff_minus", ("Poly.thy", Poly.thy));
83.375 + *)
83.376 +fun thy_contains_thm (str:xstring) (_, thy) =
83.377 + str mem (map (strip_thy o fst) (thms_of thy));
83.378 +(* val (thy', str) = ("Isac.thy", "real_mult_minus1");
83.379 + val (thy', str) = ("PolyMinus.thy", "klammer_minus_plus");
83.380 + *)
83.381 +fun thy_containing_thm (thy':theory') (str:xstring) =
83.382 + let val thy' = thyID2theory' thy'
83.383 + val str = sym_drop str
83.384 + val startsearch = dropuntil ((curry op= thy') o
83.385 + (#1:theory' * theory -> theory'))
83.386 + (rev (!theory'))
83.387 + in case find_first (thy_contains_thm str) startsearch of
83.388 + Some (thy',_) => ("IsacKnowledge", thy')
83.389 + | None => (case assoc (!isab_thm_thy (*see Isac.ML*), str) of
83.390 + Some (thyID,_) => ("Isabelle", thyID)
83.391 + | None =>
83.392 + raise error ("thy_containing_thm: theorem '"^str^
83.393 + "' not in !theory' above thy '"^thy'^"'"))
83.394 + end;
83.395 +
83.396 +
83.397 +(*.which theory below thy' contains a ruleset;
83.398 +get the occurence _after_ in the _list_ (is up to asking TUM) theory'.*)
83.399 +(* val (thy', rls') = ("PolyEq.thy", "separate_bdv");
83.400 + *)
83.401 +fun thy_containing_rls (thy':theory') (rls':rls') =
83.402 + let val rls' = strip_thy rls'
83.403 + val thy' = thyID2theory' thy'
83.404 + (*take thys between "Isac" and thy' not to search #1#*)
83.405 + val dropthys = takewhile [] (not o (curry op= thy') o
83.406 + (#1:theory' * theory -> theory'))
83.407 + (rev (!theory'))
83.408 + val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
83.409 + dropthys
83.410 + (*drop those rulesets which are generated in a theory found in #1#*)
83.411 + val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o
83.412 + ((#1 o #2) : rls' * (theory' * rls)
83.413 + -> theory'))
83.414 + (rev (!ruleset'))
83.415 + in case assoc (startsearch, rls') of
83.416 + Some (thy', _) => ("IsacKnowledge", thyID2theory' thy')
83.417 + | _ => raise error ("thy_containing_rls : rls '"^rls'^
83.418 + "' not in !rulset' above thy '"^thy'^"'")
83.419 + end;
83.420 +(* val (thy', termop) = (thyID, termop);
83.421 + *)
83.422 +fun thy_containing_cal (thy':theory') termop =
83.423 + let val thy' = thyID2theory' thy'
83.424 + val dropthys = takewhile [] (not o (curry op= thy') o
83.425 + (#1:theory' * theory -> theory'))
83.426 + (rev (!theory'))
83.427 + val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
83.428 + dropthys
83.429 + val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o
83.430 + (#1 : calc -> string)) (rev (!calclist'))
83.431 + in case assoc (startsearch, strip_thy termop) of
83.432 + Some (th_termop, _) => ("IsacKnowledge", strip_thy th_termop)
83.433 + | _ => raise error ("thy_containing_rls : rls '"^termop^
83.434 + "' not in !calclist' above thy '"^thy'^"'")
83.435 + end;
83.436 +
83.437 +(* print_depth 99; map #1 startsearch; print_depth 3;
83.438 + *)
83.439 +
83.440 +(*.packing return-values to matchTheory, contextToThy for xml-generation.*)
83.441 +datatype contthy = (*also an item from KEStore on Browser ......#*)
83.442 + EContThy (*not from KEStore ...........................*)
83.443 + | ContThm of (*a theorem in contex =============*)
83.444 + {thyID : thyID, (*for *2guh in sub-elems here .*)
83.445 + thm : guh, (*theorem in the context .*)
83.446 + applto : term, (*applied to formula ... .*)
83.447 + applat : term, (*... with lhs inserted .*)
83.448 + reword : rew_ord', (*order used for rewrite .*)
83.449 + asms : (term (*asumption instantiated .*)
83.450 + * term) list, (*asumption evaluated .*)
83.451 + lhs : term (*lhs of the theorem ... #*)
83.452 + * term, (*... instantiated .*)
83.453 + rhs : term (*rhs of the theorem ... #*)
83.454 + * term, (*... instantiated .*)
83.455 + result : term, (*resulting from the rewrite .*)
83.456 + resasms : term list, (*... with asms stored .*)
83.457 + asmrls : rls' (*ruleset for evaluating asms .*)
83.458 + }
83.459 + | ContThmInst of (*a theorem with bdvs in contex ======== *)
83.460 + {thyID : thyID, (*for *2guh in sub-elems here .*)
83.461 + thm : guh, (*theorem in the context .*)
83.462 + bdvs : subst, (*bound variables to modify....*)
83.463 + thminst : term, (*... theorem instantiated .*)
83.464 + applto : term, (*applied to formula ... .*)
83.465 + applat : term, (*... with lhs inserted .*)
83.466 + reword : rew_ord', (*order used for rewrite .*)
83.467 + asms : (term (*asumption instantiated .*)
83.468 + * term) list, (*asumption evaluated .*)
83.469 + lhs : term (*lhs of the theorem ... #*)
83.470 + * term, (*... instantiated .*)
83.471 + rhs : term (*rhs of the theorem ... #*)
83.472 + * term, (*... instantiated .*)
83.473 + result : term, (*resulting from the rewrite .*)
83.474 + resasms : term list, (*... with asms stored .*)
83.475 + asmrls : rls' (*ruleset for evaluating asms .*)
83.476 + }
83.477 + | ContRls of (*a rule set in contex ===================== *)
83.478 + {thyID : thyID, (*for *2guh in sub-elems here .*)
83.479 + rls : guh, (*rule set in the context .*)
83.480 + applto : term, (*rewrite this formula .*)
83.481 + result : term, (*resulting from the rewrite .*)
83.482 + asms : term list (*... with asms stored .*)
83.483 + }
83.484 + | ContRlsInst of (*a rule set with bdvs in contex ======= *)
83.485 + {thyID : thyID, (*for *2guh in sub-elems here .*)
83.486 + rls : guh, (*rule set in the context .*)
83.487 + bdvs : subst, (*for bound variables in thms .*)
83.488 + applto : term, (*rewrite this formula .*)
83.489 + result : term, (*resulting from the rewrite .*)
83.490 + asms : term list (*... with asms stored .*)
83.491 + }
83.492 + | ContNOrew of (*no rewrite for thm or rls ============== *)
83.493 + {thyID : thyID, (*for *2guh in sub-elems here .*)
83.494 + thm_rls : guh, (*thm or rls in the context .*)
83.495 + applto : term (*rewrite this formula .*)
83.496 + }
83.497 + | ContNOrewInst of (*no rewrite for some instantiation == *)
83.498 + {thyID : thyID, (*for *2guh in sub-elems here .*)
83.499 + thm_rls : guh, (*thm or rls in the context .*)
83.500 + bdvs : subst, (*for bound variables in thms .*)
83.501 + thminst : term, (*... theorem instantiated .*)
83.502 + applto : term (*rewrite this formula .*)
83.503 + };
83.504 +
83.505 +(*.check a rewrite-tac for bdv (RL always used *_Inst !) TODO.WN060718
83.506 + pass other tacs unchanged.*)
83.507 +fun get_tac_checked pt ((p,p_) : pos') = get_obj g_tac pt p;
83.508 +
83.509 +(*..*)
83.510 +
83.511 +
83.512 +
83.513 +(*.get the formula f at ptp rewritten by the Rewrite_* already applied to f.*)
83.514 +(* val (Rewrite' (thy', ord', erls, _, (thmID,_), f, (res,asm))) = tac';
83.515 + *)
83.516 +fun context_thy (pt, pos as (p,p_)) (tac as Rewrite (thmID,_)) =
83.517 + (case applicable_in pos pt tac of
83.518 + Appl (Rewrite' (thy', ord', erls, _, (thmID,_), f, (res,asm))) =>
83.519 + let val thy = assoc_thy thy'
83.520 + val thm = (norm o #prop o rep_thm o (get_thm thy)) thmID
83.521 + (*WN060616 the following must be done on subterm found _IN_ rew_sub
83.522 + val (lhs,rhs) = (dest_equals' o strip_trueprop
83.523 + o Logic.strip_imp_concl) thm
83.524 + val insts = Pattern.match (Sign.tsig_of (sign_of thy)) (lhs, f)
83.525 + val thm' = ren_inst (insts, thm, lhs, f)
83.526 + val (lhs',rhs') = (dest_equals' o strip_trueprop
83.527 + o Logic.strip_imp_concl) thm'
83.528 + val asms = map strip_trueprop (Logic.strip_imp_prems thm)
83.529 + val asms' = map strip_trueprop (Logic.strip_imp_prems thm')
83.530 + *)
83.531 + in ContThm {thyID = theory'2thyID thy',
83.532 + thm = thm2guh (thy_containing_thm thy' thmID) thmID,
83.533 + applto = f,
83.534 + applat = e_term,
83.535 + reword = ord',
83.536 + asms = [](*asms ~~ asms'*),
83.537 + lhs = (e_term, e_term)(*(lhs, lhs')*),
83.538 + rhs = (e_term, e_term)(*(rhs, rhs')*),
83.539 + result = res,
83.540 + resasms = asm,
83.541 + asmrls = id_rls erls}
83.542 + end
83.543 + | Notappl _ =>
83.544 + let val pp = par_pblobj pt p
83.545 + val thy' = get_obj g_domID pt pp
83.546 + val f = case p_ of
83.547 + Frm => get_obj g_form pt p
83.548 + | Res => (fst o (get_obj g_result pt)) p
83.549 + in ContNOrew {thyID = theory'2thyID thy',
83.550 + thm_rls = thm2guh (thy_containing_thm thy' thmID) thmID,
83.551 + applto = f}
83.552 + end)
83.553 +
83.554 +(* val ((pt,p), tac as Rewrite_Inst (subs, (thmID,_))) = ((pt,pos), tac);
83.555 + *)
83.556 + | context_thy (pt, pos as (p,p_))
83.557 + (tac as Rewrite_Inst (subs, (thmID,_))) =
83.558 + (case applicable_in pos pt tac of
83.559 +(* val Appl (Rewrite_Inst' (thy', ord', erls, _, subst, (thmID,_),
83.560 + f, (res,asm))) = applicable_in p pt tac;
83.561 + *)
83.562 + Appl (Rewrite_Inst' (thy', ord', erls, _, subst, (thmID,_),
83.563 + f, (res,(*path to subterm,*)asm))) =>
83.564 + let val thm = (norm o #prop o rep_thm o
83.565 + (get_thm (assoc_thy thy'))) thmID
83.566 + val thminst = inst_bdv subst thm
83.567 + (*WN060616 the following must be done on subterm found _IN_ rew_sub
83.568 + val (lhs,rhs) = (dest_equals' o strip_trueprop
83.569 + o Logic.strip_imp_concl) thminst
83.570 + val insts = Pattern.match (Sign.tsig_of (sign_of thy)) (lhs, f)
83.571 + val thm' = ren_inst (insts, thminst, lhs, f)
83.572 + val (lhs',rhs') = (dest_equals' o strip_trueprop
83.573 + o Logic.strip_imp_concl) thm'
83.574 + val asms = map strip_trueprop (Logic.strip_imp_prems thminst)
83.575 + val asms' = map strip_trueprop (Logic.strip_imp_prems thm')
83.576 + *)
83.577 + in ContThmInst {thyID = theory'2thyID thy',
83.578 + thm = thm2guh (thy_containing_thm
83.579 + thy' thmID) thmID,
83.580 + bdvs = subst,
83.581 + thminst = thminst,
83.582 + applto = f,
83.583 + applat = e_term,
83.584 + reword = ord',
83.585 + asms = [](*asms ~~ asms'*),
83.586 + lhs = (e_term, e_term)(*(lhs, lhs')*),
83.587 + rhs = (e_term, e_term)(*(rhs, rhs')*),
83.588 + result = res,
83.589 + resasms = asm,
83.590 + asmrls = id_rls erls}
83.591 + end
83.592 + | Notappl _ =>
83.593 + let val pp = par_pblobj pt p
83.594 + val thy' = get_obj g_domID pt pp
83.595 + val subst = subs2subst (assoc_thy thy') subs
83.596 + val thm = (norm o #prop o rep_thm o
83.597 + (get_thm (assoc_thy thy'))) thmID
83.598 + val thminst = inst_bdv subst thm
83.599 + val f = case p_ of
83.600 + Frm => get_obj g_form pt p
83.601 + | Res => (fst o (get_obj g_result pt)) p
83.602 + in ContNOrewInst {thyID = theory'2thyID thy',
83.603 + thm_rls = thm2guh (thy_containing_thm
83.604 + thy' thmID) thmID,
83.605 + bdvs = subst,
83.606 + thminst = thminst,
83.607 + applto = f}
83.608 + end)
83.609 + | context_thy (pt,p) (tac as Rewrite_Set rls') =
83.610 + (case applicable_in p pt tac of
83.611 + Appl (Rewrite_Set' (thy', _, rls, f, (res,asm))) =>
83.612 + ContRls {thyID = theory'2thyID thy',
83.613 + rls = rls2guh (thy_containing_rls thy' rls') rls',
83.614 + applto = f,
83.615 + result = res,
83.616 + asms = asm})
83.617 + | context_thy (pt,p) (tac as Rewrite_Set_Inst (subs, rls')) =
83.618 + (case applicable_in p pt tac of
83.619 + Appl (Rewrite_Set_Inst' (thy', _, subst, rls, f, (res,asm))) =>
83.620 + ContRlsInst {thyID = theory'2thyID thy',
83.621 + rls = rls2guh (thy_containing_rls thy' rls') rls',
83.622 + bdvs = subst,
83.623 + applto = f,
83.624 + result = res,
83.625 + asms = asm});
83.626 +
83.627 +(*.get all theorems in a rule set (recursivley containing rule sets).*)
83.628 +fun thm_of_rule Erule = []
83.629 + | thm_of_rule (thm as Thm _) = [thm]
83.630 + | thm_of_rule (Calc _) = []
83.631 + | thm_of_rule (Cal1 _) = []
83.632 + | thm_of_rule (Rls_ rls) = thms_of_rls rls
83.633 +and thms_of_rls Erls = []
83.634 + | thms_of_rls (Rls {rules,...}) = (flat o (map thm_of_rule)) rules
83.635 + | thms_of_rls (Seq {rules,...}) = (flat o (map thm_of_rule)) rules
83.636 + | thms_of_rls (Rrls _) = [];
83.637 +(* val Hrls {thy_rls = (_, rls),...} =
83.638 + get_the ["IsacKnowledge", "Test", "Rulesets", "expand_binomtest"];
83.639 +> thms_of_rls rls;
83.640 + *)
83.641 +
83.642 +(*. check if a rule is contained in a rule-set (recursivley down in Rls_);
83.643 + this rule can even be a rule-set itself.*)
83.644 +fun contains_rule r rls =
83.645 + let fun find (r, Rls_ rls) = finds (get_rules rls)
83.646 + | find r12 = eq_rule r12
83.647 + and finds [] = false
83.648 + | finds (r1 :: rs) = if eq_rule (r, r1) then true else finds rs;
83.649 + in
83.650 + (*writeln ("### contains_rule: r = "^rule2str r^", rls = "^rls2str rls);*)
83.651 + finds (get_rules rls)
83.652 + end;
83.653 +
83.654 +(*. try if a rewrite-rule is applicable to a given formula;
83.655 + in case of rule-sets (recursivley) collect all _atomic_ rewrites .*)
83.656 +fun try_rew thy ((_, ro):rew_ord) erls (subst:subst) f (thm' as Thm(id, thm)) =
83.657 + if contains_bdv thm
83.658 + then case rewrite_inst_ thy ro erls false subst thm f of
83.659 + Some (f',_) =>[rule2tac subst thm']
83.660 + | None => []
83.661 + else (case rewrite_ thy ro erls false thm f of
83.662 + Some (f',_) => [rule2tac [] thm']
83.663 + | None => [])
83.664 + | try_rew thy _ _ _ f (cal as Calc c) =
83.665 + (case get_calculation_ thy c f of
83.666 + Some (str, _) => [rule2tac [] cal]
83.667 + | None => [])
83.668 + | try_rew thy _ _ _ f (cal as Cal1 c) =
83.669 + (case get_calculation_ thy c f of
83.670 + Some (str, _) => [rule2tac [] cal]
83.671 + | None => [])
83.672 + | try_rew thy _ _ subst f (Rls_ rls) = filter_appl_rews thy subst f rls
83.673 +and filter_appl_rews thy subst f (Rls {rew_ord = ro, erls, rules,...}) =
83.674 + distinct (flat (map (try_rew thy ro erls subst f) rules))
83.675 + | filter_appl_rews thy subst f (Seq {rew_ord = ro, erls, rules,...}) =
83.676 + distinct (flat (map (try_rew thy ro erls subst f) rules))
83.677 + | filter_appl_rews thy subst f (Rrls _) = [];
83.678 +
83.679 +(*. decide if a tactic is applicable to a given formula;
83.680 + in case of Rewrite_Set* go down to _atomic_ rewrite-tactics .*)
83.681 +(* val
83.682 + *)
83.683 +fun atomic_appl_tacs thy _ _ f (Calculate scrID) =
83.684 + try_rew thy e_rew_ordX e_rls [] f (Calc (snd(assoc1 (!calclist', scrID))))
83.685 + | atomic_appl_tacs thy ro erls f (Rewrite (thm' as (thmID, _))) =
83.686 + try_rew thy (ro, assoc_rew_ord ro) erls [] f
83.687 + (Thm (thmID, assoc_thm' thy thm'))
83.688 + | atomic_appl_tacs thy ro erls f (Rewrite_Inst (subs, thm' as (thmID, _))) =
83.689 + try_rew thy (ro, assoc_rew_ord ro) erls (subs2subst thy subs) f
83.690 + (Thm (thmID, assoc_thm' thy thm'))
83.691 +
83.692 + | atomic_appl_tacs thy _ _ f (Rewrite_Set rls') =
83.693 + filter_appl_rews thy [] f (assoc_rls rls')
83.694 + | atomic_appl_tacs thy _ _ f (Rewrite_Set_Inst (subs, rls')) =
83.695 + filter_appl_rews thy (subs2subst thy subs) f (assoc_rls rls')
83.696 + | atomic_appl_tacs _ _ _ _ tac =
83.697 + (writeln ("### atomic_appl_tacs: not impl. for tac = '"^ tac2str tac ^"'");
83.698 + []);
83.699 +
83.700 +
83.701 +
83.702 +
83.703 +
83.704 +(*.not only for thydata, but also for thy's etc.*)
83.705 +fun theID2guh (theID:theID) =
83.706 + case length theID of
83.707 + 0 => raise error ("theID2guh: called with theID = "^strs2str' theID)
83.708 + | 1 => part2guh theID
83.709 + | 2 => thy2guh theID
83.710 + | 3 => thypart2guh theID
83.711 + | 4 => let val [isa, thyID, typ, elemID] = theID
83.712 + in case typ of
83.713 + "Theorems" => thm2guh (isa, thyID) elemID
83.714 + | "Rulesets" => rls2guh (isa, thyID) elemID
83.715 + | "Calculations" => cal2guh (isa, thyID) elemID
83.716 + | "Orders" => ord2guh (isa, thyID) elemID
83.717 + | "Theorems" => thy2guh [isa, thyID]
83.718 + | str => raise error ("theID2guh: called with theID = "^
83.719 + strs2str' theID)
83.720 + end
83.721 + | n => raise error ("theID2guh called with theID = "^strs2str' theID);
83.722 +(*.filenames not only for thydata, but also for thy's etc.*)
83.723 +fun theID2filename (theID:theID) = theID2guh theID ^ ".xml" : filename;
83.724 +
83.725 +fun guh2theID (guh:guh) =
83.726 + let val guh' = explode guh
83.727 + val part = implode (take_fromto 1 4 guh')
83.728 + val isa = implode (take_fromto 5 9 guh')
83.729 + in if not (part mem ["exp_", "thy_", "pbl_", "met_"])
83.730 + then raise error ("guh '"^guh^"' does not begin with \
83.731 + \exp_ | thy_ | pbl_ | met_")
83.732 + else let val chap = case isa of
83.733 + "isab_" => "Isabelle"
83.734 + | "scri_" => "IsacScripts"
83.735 + | "isac_" => "IsacKnowledge"
83.736 + | _ =>
83.737 + raise error ("guh2theID: '"^guh^
83.738 + "' does not have isab_ | scri_ | \
83.739 + \isac_ at position 5..9")
83.740 + val rest = takerest (9, guh')
83.741 + val thyID = takewhile [] (not o (curry op= "-")) rest
83.742 + val rest' = dropuntil (curry op= "-") rest
83.743 + in case implode rest' of
83.744 + "-part" => [chap] : theID
83.745 + | "" => [chap, implode thyID]
83.746 + | "-Theorems" => [chap, implode thyID, "Theorems"]
83.747 + | "-Rulesets" => [chap, implode thyID, "Rulesets"]
83.748 + | "-Operations" => [chap, implode thyID, "Operations"]
83.749 + | "-Orders" => [chap, implode thyID, "Orders"]
83.750 + | _ =>
83.751 + let val sect = implode (take_fromto 1 5 rest')
83.752 + val sect' =
83.753 + case sect of
83.754 + "-thm-" => "Theorems"
83.755 + | "-rls-" => "Rulesets"
83.756 + | "-cal-" => "Operations"
83.757 + | "-ord-" => "Orders"
83.758 + | str =>
83.759 + raise error ("guh2theID: '"^guh^"' has '"^sect^
83.760 + "' instead -thm- | -rls- | \
83.761 + \-cal- | -ord-")
83.762 + in [chap, implode thyID, sect', implode
83.763 + (takerest (5, rest'))]
83.764 + end
83.765 + end
83.766 + end;
83.767 +(*> guh2theID "thy_isac_Biegelinie-Theorems";
83.768 +val it = ["IsacKnowledge", "Biegelinie", "Theorems"] : theID
83.769 +> guh2theID "thy_scri_ListG-thm-zip_Nil";
83.770 +val it = ["IsacScripts", "ListG", "Theorems", "zip_Nil"] : theID*)
83.771 +
83.772 +fun guh2filename (guh : guh) = guh ^ ".xml" : filename;
83.773 +
83.774 +
83.775 +(*..*)
83.776 +fun guh2rewtac (guh:guh) ([] : subs) =
83.777 + let val [isa, thy, sect, xstr] = guh2theID guh
83.778 + in case sect of
83.779 + "Theorems" => Rewrite (xstr, "")
83.780 + | "Rulesets" => Rewrite_Set xstr
83.781 + | str => raise error ("guh2rewtac: not impl. for '"^xstr^"'")
83.782 + end
83.783 + | guh2rewtac (guh:guh) subs =
83.784 + let val [isa, thy, sect, xstr] = guh2theID guh
83.785 + in case sect of
83.786 + "Theorems" => Rewrite_Inst (subs, (xstr, ""))
83.787 + | "Rulesets" => Rewrite_Set_Inst (subs, xstr)
83.788 + | str => raise error ("guh2rewtac: not impl. for '"^xstr^"'")
83.789 + end;
83.790 +(*> guh2rewtac "thy_isac_Test-thm-constant_mult_square" [];
83.791 +val it = Rewrite ("constant_mult_square", "") : tac
83.792 +> guh2rewtac "thy_isac_Test-thm-risolate_bdv_add" ["(bdv, x)"];
83.793 +val it = Rewrite_Inst (["(bdv, x)"], ("risolate_bdv_add", "")) : tac
83.794 +> guh2rewtac "thy_isac_Test-rls-Test_simplify" [];
83.795 +val it = Rewrite_Set "Test_simplify" : tac
83.796 +> guh2rewtac "thy_isac_Test-rls-isolate_bdv" ["(bdv, x)"];
83.797 +val it = Rewrite_Set_Inst (["(bdv, x)"], "isolate_bdv") : tac*)
83.798 +
83.799 +
83.800 +(*.the front-end may request a context for any element of the hierarchy.*)
83.801 +(* val guh = "thy_isac_Test-rls-Test_simplify";
83.802 + *)
83.803 +fun no_thycontext (guh : guh) = (guh2theID guh; false)
83.804 + handle _ => true;
83.805 +
83.806 +(*> has_thycontext "thy_isac_Test";
83.807 +if has_thycontext "thy_isac_Test" then "OK" else "NOTOK";
83.808 + *)
83.809 +
83.810 +
83.811 +
83.812 +(*.get the substitution of bound variables for matchTheory:
83.813 + # lookup the thm|rls' in the script
83.814 + # take the [(bdv, v_),..] from the respective Rewrite_(Set_)Inst
83.815 + # instantiate this subs with the istates env to [(bdv, x),..]
83.816 + # otherwise [].*)
83.817 +(*WN060617 hack assuming that all scripts use only one bound variable
83.818 +and use 'v_' as the formal argument for this bound variable*)
83.819 +(* val (ScrState (env,_,_,_,_,_), _, guh) = (is, "dummy", guh);
83.820 + *)
83.821 +fun subs_from (ScrState (env,_,_,_,_,_)) _(*:Script sc*) (guh:guh) =
83.822 + let val theID as [isa, thyID, sect, xstr] = guh2theID guh
83.823 + in case sect of
83.824 + "Theorems" =>
83.825 + let val thm = get_thm (assoc_thy (thyID2theory' thyID)) xstr
83.826 + in if contains_bdv thm
83.827 + then let val formal_arg = str2term "v_"
83.828 + val value = subst_atomic env formal_arg
83.829 + in ["(bdv," ^ term2str value ^ ")"]:subs end
83.830 + else []
83.831 + end
83.832 + | "Rulesets" =>
83.833 + let val rules = (get_rules o assoc_rls) xstr
83.834 + in if contain_bdv rules
83.835 + then let val formal_arg = str2term"v_"
83.836 + val value = subst_atomic env formal_arg
83.837 + in ["(bdv,"^term2str value^")"]:subs end
83.838 + else []
83.839 + end
83.840 + end;
83.841 +
83.842 +(* use"ME/rewtools.sml";
83.843 + *)
83.844 +
84.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
84.2 +++ b/src/Pure/isac/ME/script.sml Wed Jul 21 13:53:39 2010 +0200
84.3 @@ -0,0 +1,2079 @@
84.4 +(* interpreter for scripts
84.5 + (c) Walther Neuper 2000
84.6 +
84.7 +use"ME/script.sml";
84.8 +use"script.sml";
84.9 +*)
84.10 +signature INTERPRETER =
84.11 +sig
84.12 + (*type ets (list of executed tactics) see sequent.sml*)
84.13 +
84.14 + datatype locate
84.15 + = NotLocatable
84.16 + | Steps of (tac_ * mout * ptree * pos' * cid * safe (* ets*)) list
84.17 +(* | ToDo of ets 28.4.02*)
84.18 +
84.19 + (*diss: next-tactic-function*)
84.20 + val next_tac : theory' -> ptree * pos' -> metID -> scr -> ets -> tac_
84.21 + (*diss: locate-function*)
84.22 + val locate_gen : theory'
84.23 + -> tac_
84.24 + -> ptree * pos' -> scr * rls -> ets -> loc_ -> locate
84.25 +
84.26 + val sel_rules : ptree -> pos' -> tac list
84.27 + val init_form : scr -> ets -> loc_ * term option (*FIXME not up to date*)
84.28 + val formal_args : term -> term list
84.29 +
84.30 + (*shift to library ...*)
84.31 + val inst_abs : theory' -> term -> term
84.32 + val itms2args : metID -> itm list -> term list
84.33 + val user_interrupt : loc_ * (tac_ * env * env * term * term * safe)
84.34 + (*val empty : term*)
84.35 +end
84.36 +
84.37 +
84.38 +
84.39 +
84.40 +(*
84.41 +structure Interpreter : INTERPRETER =
84.42 +struct
84.43 +*)
84.44 +
84.45 +(*.traces the leaves (ie. non-tactical nodes) of the script
84.46 + found by next_tac.
84.47 + a leaf is either a tactic or an 'exp' in 'let v = expr'
84.48 + where 'exp' does not contain a tactic.*)
84.49 +val trace_script = ref false;
84.50 +
84.51 +type step = (*data for creating a new node in the ptree;
84.52 + designed for use:
84.53 + fun ass* scrstate steps =
84.54 + ... case ass* scrstate steps of
84.55 + Assoc (scrstate, steps) => ... ass* scrstate steps*)
84.56 + tac_ (*transformed from associated tac*)
84.57 + * mout (*result with indentation etc.*)
84.58 + * ptree (*containing node created by tac_ + resp. scrstate*)
84.59 + * pos' (*position in ptree; ptree * pos' is the proofstate*)
84.60 + * pos' list; (*of ptree-nodes probably cut (by fst tac_)*)
84.61 +val e_step = (Empty_Tac_, EmptyMout, EmptyPtree, e_pos',[]:pos' list):step;
84.62 +
84.63 +fun rule2thm' (Thm (id, thm)) = (id, string_of_thmI thm):thm'
84.64 + | rule2thm' r = raise error ("rule2thm': not defined for "^(rule2str r));
84.65 +fun rule2rls' (Rls_ rls) = id_rls rls
84.66 + | rule2rls' r = raise error ("rule2rls': not defined for "^(rule2str r));
84.67 +
84.68 +(*.makes a (rule,term) list to a Step (m, mout, pt', p', cid) for solve;
84.69 + complicated with current t in rrlsstate.*)
84.70 +fun rts2steps steps ((pt,p),(f,f'',rss,rts),(thy',ro,er,pa)) [(r, (f', am))] =
84.71 + let val thy = assoc_thy thy'
84.72 + val m = Rewrite' (thy',ro,er,pa, rule2thm' r, f, (f', am))
84.73 + val is = RrlsState (f',f'',rss,rts)
84.74 + val p = case p of (p',Frm) => p | (p',Res) => (lev_on p',Res)
84.75 + val (p', cid, mout, pt') = generate1 thy m is p pt
84.76 + in (is, (m, mout, pt', p', cid)::steps) end
84.77 + | rts2steps steps ((pt,p),(f,f'',rss,rts),(thy',ro,er,pa))
84.78 + ((r, (f', am))::rts') =
84.79 + let val thy = assoc_thy thy'
84.80 + val m = Rewrite' (thy',ro,er,pa, rule2thm' r, f, (f', am))
84.81 + val is = RrlsState (f',f'',rss,rts)
84.82 + val p = case p of (p',Frm) => p | (p',Res) => (lev_on p',Res)
84.83 + val (p', cid, mout, pt') = generate1 thy m is p pt
84.84 + in rts2steps ((m, mout, pt', p', cid)::steps)
84.85 + ((pt',p'),(f',f'',rss,rts),(thy',ro,er,pa)) rts' end;
84.86 +
84.87 +
84.88 +(*. functions for the environment stack .*)
84.89 +fun accessenv id es = the (assoc((top es):env, id))
84.90 + handle _ => error ("accessenv: "^(free2str id)^" not in env");
84.91 +fun updateenv id vl (es:env stack) =
84.92 + (push (overwrite(top es, (id, vl))) (pop es)):env stack;
84.93 +fun pushenv id vl (es:env stack) =
84.94 + (push (overwrite(top es, (id, vl))) es):env stack;
84.95 +val popenv = pop:env stack -> env stack;
84.96 +
84.97 +
84.98 +
84.99 +fun de_esc_underscore str =
84.100 + let fun scan [] = []
84.101 + | scan (s::ss) = if s = "'" then (scan ss)
84.102 + else (s::(scan ss))
84.103 + in (implode o scan o explode) str end;
84.104 +(*
84.105 +> val str = "Rewrite_Set_Inst";
84.106 +> val esc = esc_underscore str;
84.107 +val it = "Rewrite'_Set'_Inst" : string
84.108 +> val des = de_esc_underscore esc;
84.109 + val des = de_esc_underscore esc;*)
84.110 +
84.111 +
84.112 +(*WN.12.5.03 not used any more,
84.113 + tacs are more stable than listepxr: subst_tacexpr
84.114 +fun is_listexpr t =
84.115 + (((ids_of o head_of) t) inter (!listexpr)) <> [];
84.116 +----*)
84.117 +
84.118 +(*go at a location in a script and fetch the contents*)
84.119 +fun go [] t = t
84.120 + | go (D::p) (Abs(s,ty,t0)) = go (p:loc_) t0
84.121 + | go (L::p) (t1 $ t2) = go p t1
84.122 + | go (R::p) (t1 $ t2) = go p t2
84.123 + | go l _ = raise error ("go: no "^(loc_2str l));
84.124 +(*
84.125 +> val t = (term_of o the o (parse thy)) "a+b";
84.126 +val it = Const (#,#) $ Free (#,#) $ Free ("b","RealDef.real") : term
84.127 +> val plus_a = go [L] t;
84.128 +> val b = go [R] t;
84.129 +> val plus = go [L,L] t;
84.130 +> val a = go [L,R] t;
84.131 +
84.132 +> val t = (term_of o the o (parse thy)) "a+b+c";
84.133 +val t = Const (#,#) $ (# $ # $ Free #) $ Free ("c","RealDef.real") : term
84.134 +> val pl_pl_a_b = go [L] t;
84.135 +> val c = go [R] t;
84.136 +> val a = go [L,R,L,R] t;
84.137 +> val b = go [L,R,R] t;
84.138 +*)
84.139 +
84.140 +
84.141 +(* get a subterm t with test t, and record location *)
84.142 +fun get l test (t as Const (s,T)) =
84.143 + if test t then Some (l,t) else None
84.144 + | get l test (t as Free (s,T)) =
84.145 + if test t then Some (l,t) else None
84.146 + | get l test (t as Bound n) =
84.147 + if test t then Some (l,t) else None
84.148 + | get l test (t as Var (s,T)) =
84.149 + if test t then Some (l,t) else None
84.150 + | get l test (t as Abs (s,T,body)) =
84.151 + if test t then Some (l:loc_,t) else get ((l@[D]):loc_) test body
84.152 + | get l test (t as t1 $ t2) =
84.153 + if test t then Some (l,t)
84.154 + else case get (l@[L]) test t1 of
84.155 + None => get (l@[R]) test t2
84.156 + | Some (l',t') => Some (l',t');
84.157 +(*18.6.00
84.158 +> val sss = ((term_of o the o (parse thy))
84.159 + "Script Solve_root_equation (eq_::bool) (v_::real) (err_::bool) =\
84.160 + \ (let e_ = Try (Rewrite square_equation_left True eq_) \
84.161 + \ in [e_])");
84.162 + ______ compares head_of !!
84.163 +> get [] (eq_str "Let") sss; [R]
84.164 +> get [] (eq_str "Script.Try") sss; [R,L,R]
84.165 +> get [] (eq_str "Script.Rewrite") sss; [R,L,R,R]
84.166 +> get [] (eq_str "True") sss; [R,L,R,R,L,R]
84.167 +> get [] (eq_str "e_") sss; [R,R]
84.168 +*)
84.169 +
84.170 +fun test_negotiable t = ((strip_thy o (term_str Script.thy) o head_of) t)
84.171 + mem (!negotiable);
84.172 +
84.173 +(*30.4.02: vvv--- doesnt work with curried functions ---> get_tac ------
84.174 +(*18.6.00: below _ALL_ negotiables must be in fun-patterns !
84.175 + then the last (non)pattern must be a subproblem*)
84.176 +fun init_frm thy (Const ("Script.Rewrite",_) $ _ $ _ $ eq) = Some eq
84.177 + | init_frm thy (Const ("Script.Rewrite'_Inst",_) $ _ $ _ $ _ $ eq) = Some eq
84.178 + | init_frm thy (Const ("Script.Rewrite'_Set",_) $ _ $ _ $ eq) = Some eq
84.179 + | init_frm thy (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ _ $ _ $ eq) =
84.180 + Some eq
84.181 + | init_frm thy (Const ("Script.Calculate",_) $ _ $ t) = Some t
84.182 + | init_frm thy t =
84.183 + (*if ((strip_thy o (term_str thy) o head_of) t) mem (!subpbls)
84.184 + then None
84.185 + else *)raise error ("init_frm: not impl. for "^
84.186 + (Sign.string_of_term (sign_of thy) t));
84.187 +
84.188 +> val t = (term_of o the o (parse thy))
84.189 + "Rewrite square_equation_left True (sqrt(#9+#4*x)=sqrt x + sqrt(#5+x))";
84.190 +> val Some ini = init_frm thy t;
84.191 +> Sign.string_of_term (sign_of thy) ini;
84.192 +val it = "sqrt (#9 + #4 * x) = sqrt x + sqrt (#5 + x)" : string
84.193 +
84.194 +> val t = (term_of o the o (parse thy))
84.195 + "solve_univar (Reals, [univar,equation], no_met) e1_ v1_";
84.196 +> val ini = init_frm thy t;
84.197 +> Sign.string_of_term (sign_of thy) ini;
84.198 +val it = "empty" : string
84.199 +
84.200 +> val t = (term_of o the o (parse thy))
84.201 + "Rewrite_Set norm_equation False x + #1 = #2";
84.202 +> val Some ini = init_frm thy t;
84.203 +> Sign.string_of_term (sign_of thy) ini;
84.204 +val it = "x + #1 = #2" : string
84.205 +
84.206 +> val t = (term_of o the o (parse thy))
84.207 + "Rewrite_Set_Inst [(bdv,x)] isolate_bdv False x + #1 = #2";
84.208 +> val Some ini = init_frm thy t;
84.209 +> Sign.string_of_term (sign_of thy) ini;
84.210 +val it = "x + #1 = #2" : string *)
84.211 +
84.212 +
84.213 +(*.get argument of first stactic in a script for init_form.*)
84.214 +fun get_stac thy (h $ body) =
84.215 +(*
84.216 + *)
84.217 + let
84.218 + fun get_t y (Const ("Script.Seq",_) $ e1 $ e2) a =
84.219 + (case get_t y e1 a of None => get_t y e2 a | la => la)
84.220 + | get_t y (Const ("Script.Seq",_) $ e1 $ e2 $ a) _ =
84.221 + (case get_t y e1 a of None => get_t y e2 a | la => la)
84.222 + | get_t y (Const ("Script.Try",_) $ e) a = get_t y e a
84.223 + | get_t y (Const ("Script.Try",_) $ e $ a) _ = get_t y e a
84.224 + | get_t y (Const ("Script.Repeat",_) $ e) a = get_t y e a
84.225 + | get_t y (Const ("Script.Repeat",_) $ e $ a) _ = get_t y e a
84.226 + | get_t y (Const ("Script.Or",_) $e1 $ e2) a =
84.227 + (case get_t y e1 a of None => get_t y e2 a | la => la)
84.228 + | get_t y (Const ("Script.Or",_) $e1 $ e2 $ a) _ =
84.229 + (case get_t y e1 a of None => get_t y e2 a | la => la)
84.230 + | get_t y (Const ("Script.While",_) $ c $ e) a = get_t y e a
84.231 + | get_t y (Const ("Script.While",_) $ c $ e $ a) _ = get_t y e a
84.232 + | get_t y (Const ("Script.Letpar",_) $ e1 $ Abs (_,_,e2)) a =
84.233 + (case get_t y e1 a of None => get_t y e2 a | la => la)
84.234 + (*| get_t y (Const ("Let",_) $ e1 $ Abs (_,_,e2)) a =
84.235 + (writeln("get_t: Let e1= "^(term2str e1)^", e2= "^(term2str e2));
84.236 + case get_t y e1 a of None => get_t y e2 a | la => la)
84.237 + | get_t y (Abs (_,_,e)) a = get_t y e a*)
84.238 + | get_t y (Const ("Let",_) $ e1 $ Abs (_,_,e2)) a =
84.239 + get_t y e1 a (*don't go deeper without evaluation !*)
84.240 + | get_t y (Const ("If",_) $ c $ e1 $ e2) a = None
84.241 + (*(case get_t y e1 a of None => get_t y e2 a | la => la)*)
84.242 +
84.243 + | get_t y (Const ("Script.Rewrite",_) $ _ $ _ $ a) _ = Some a
84.244 + | get_t y (Const ("Script.Rewrite",_) $ _ $ _ ) a = Some a
84.245 + | get_t y (Const ("Script.Rewrite'_Inst",_) $ _ $ _ $ _ $ a) _ = Some a
84.246 + | get_t y (Const ("Script.Rewrite'_Inst",_) $ _ $ _ $ _ ) a = Some a
84.247 + | get_t y (Const ("Script.Rewrite'_Set",_) $ _ $ _ $ a) _ = Some a
84.248 + | get_t y (Const ("Script.Rewrite'_Set",_) $ _ $ _ ) a = Some a
84.249 + | get_t y (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ _ $ _ $a)_ =Some a
84.250 + | get_t y (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ _ $ _ ) a =Some a
84.251 + | get_t y (Const ("Script.Calculate",_) $ _ $ a) _ = Some a
84.252 + | get_t y (Const ("Script.Calculate",_) $ _ ) a = Some a
84.253 +
84.254 + | get_t y (Const ("Script.Substitute",_) $ _ $ a) _ = Some a
84.255 + | get_t y (Const ("Script.Substitute",_) $ _ ) a = Some a
84.256 +
84.257 + | get_t y (Const ("Script.SubProblem",_) $ _ $ _) _ = None
84.258 +
84.259 + | get_t y x _ =
84.260 + ((*writeln ("### get_t yac: list-expr "^(term2str x));*)
84.261 + None)
84.262 +in get_t thy body e_term end;
84.263 +
84.264 +(*FIXME: get 1st stac by next_stac [] instead of ... ?? 29.7.02*)
84.265 +(* val Script sc = scr;
84.266 + *)
84.267 +fun init_form thy (Script sc) env =
84.268 + (case get_stac thy sc of
84.269 + None => None (*raise error ("init_form: no 1st stac in "^
84.270 + (Sign.string_of_term (sign_of thy) sc))*)
84.271 + | Some stac => Some (subst_atomic env stac))
84.272 + | init_form _ _ _ = raise error "init_form: no match";
84.273 +
84.274 +(* use"ME/script.sml";
84.275 + use"script.sml";
84.276 + *)
84.277 +
84.278 +
84.279 +
84.280 +(*the 'iteration-argument' of a stac (args not eval)*)
84.281 +fun itr_arg _ (Const ("Script.Rewrite'_Inst",_) $ _ $ _ $ _ $ v) = v
84.282 + | itr_arg _ (Const ("Script.Rewrite",_) $ _ $ _ $ v) = v
84.283 + | itr_arg _ (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ _ $ _ $ v) = v
84.284 + | itr_arg _ (Const ("Script.Rewrite'_Set",_) $ _ $ _ $ v) = v
84.285 + | itr_arg _ (Const ("Script.Calculate",_) $ _ $ v) = v
84.286 + | itr_arg _ (Const ("Script.Check'_elementwise",_) $ consts $ _) = consts
84.287 + | itr_arg _ (Const ("Script.Or'_to'_List",_) $ _) = e_term
84.288 + | itr_arg _ (Const ("Script.Tac",_) $ _) = e_term
84.289 + | itr_arg _ (Const ("Script.SubProblem",_) $ _ $ _) = e_term
84.290 + | itr_arg thy t = raise error
84.291 + ("itr_arg not impl. for "^
84.292 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));
84.293 +(* val t = (term_of o the o (parse thy))"Rewrite rroot_square_inv False e_";
84.294 +> itr_arg "Script.thy" t;
84.295 +val it = Free ("e_","RealDef.real") : term
84.296 +> val t = (term_of o the o (parse thy))"xxx";
84.297 +> itr_arg "Script.thy" t;
84.298 +*** itr_arg not impl. for xxx
84.299 +uncaught exception ERROR
84.300 + raised at: library.ML:1114.35-1114.40*)
84.301 +
84.302 +
84.303 +(*.get the arguments of the script out of the scripts parsetree.*)
84.304 +fun formal_args scr = (fst o split_last o snd o strip_comb) scr;
84.305 +(*
84.306 +> formal_args scr;
84.307 + [Free ("f_","RealDef.real"),Free ("v_","RealDef.real"),
84.308 + Free ("eqs_","bool List.list")] : term list
84.309 +*)
84.310 +
84.311 +(*.get the identifier of the script out of the scripts parsetree.*)
84.312 +fun id_of_scr sc = (id_of o fst o strip_comb) sc;
84.313 +
84.314 +
84.315 +(*WN020526: not clear, when a is available in ass_up for eva-_true*)
84.316 +(*WN060906: in "fun handle_leaf" eg. uses "Some M__"(from some PREVIOUS
84.317 + curried Rewrite) for CURRENT value (which may be different from PREVIOUS);
84.318 + thus "None" must be set at the end of currying (ill designed anyway)*)
84.319 +fun upd_env_opt env (Some a, v) = upd_env env (a,v)
84.320 + | upd_env_opt env (None, v) =
84.321 + (writeln("*** upd_env_opt: (None,"^(term2str v)^")");env);
84.322 +
84.323 +
84.324 +type dsc = typ; (*<-> nam..unknow in Descript.thy*)
84.325 +fun typ_str (Type (s,_)) = s
84.326 + | typ_str (TFree(s,_)) = s
84.327 + | typ_str (TVar ((s,i),_)) = s^(string_of_int i);
84.328 +
84.329 +(*get the _result_-type of a description*)
84.330 +fun dsc_valT (Const (_,(Type (_,[_,T])))) = (strip_thy o typ_str) T;
84.331 +(*> val t = (term_of o the o (parse thy)) "equality";
84.332 +> val T = type_of t;
84.333 +val T = "bool => Tools.una" : typ
84.334 +> val dsc = dsc_valT t;
84.335 +val dsc = "una" : string
84.336 +
84.337 +> val t = (term_of o the o (parse thy)) "fixedValues";
84.338 +> val T = type_of t;
84.339 +val T = "bool List.list => Tools.nam" : typ
84.340 +> val dsc = dsc_valT t;
84.341 +val dsc = "nam" : string*)
84.342 +
84.343 +(*.from penv in itm_ make args for script depending on type of description.*)
84.344 +(*6.5.03 TODO: push penv into script -- and drop mk_arg here || drop penv
84.345 + 9.5.03 penv postponed: penv = env for script at the moment, (*mk_arg*)*)
84.346 +fun mk_arg thy d [] = raise error ("mk_arg: no data for "^
84.347 + (Sign.string_of_term (sign_of thy) d))
84.348 + | mk_arg thy d [t] =
84.349 + (case dsc_valT d of
84.350 + "una" => [t]
84.351 + | "nam" =>
84.352 + [case t of
84.353 + r as (Const ("op =",_) $ _ $ _) => r
84.354 + | _ => raise error
84.355 + ("mk_arg: dsc-typ 'nam' applied to non-equality "^
84.356 + (Sign.string_of_term (sign_of thy) t))]
84.357 + | s => raise error ("mk_arg: not impl. for "^s))
84.358 +
84.359 + | mk_arg thy d (t::ts) = (mk_arg thy d [t]) @ (mk_arg thy d ts);
84.360 +(*
84.361 + val d = d_in itm_;
84.362 + val [t] = ts_in itm_;
84.363 +mk_arg thy
84.364 +*)
84.365 +
84.366 +
84.367 +
84.368 +
84.369 +(*.create the actual parameters (args) of script: their order
84.370 + is given by the order in met.pat .*)
84.371 +(*WN.5.5.03: ?: does this allow for different descriptions ???
84.372 + ?: why not taken from formal args of script ???
84.373 +!: FIXXXME penv: push it here in itms2args into script-evaluation*)
84.374 +(* val (thy, mI, itms) = (thy, metID, itms);
84.375 + *)
84.376 +fun itms2args thy mI (itms:itm list) =
84.377 + let val mvat = max_vt itms
84.378 + fun okv mvat (_,vats,b,_,_) = mvat mem vats andalso b
84.379 + val itms = filter (okv mvat) itms
84.380 + fun test_dsc d (_,_,_,_,itm_) = (d = d_in itm_)
84.381 + fun itm2arg itms (_,(d,_)) =
84.382 + case find_first (test_dsc d) itms of
84.383 + None =>
84.384 + raise error ("itms2args: '"^term2str d^"' not in itms")
84.385 + (*| Some (_,_,_,_,itm_) => mk_arg thy (d_in itm_) (ts_in itm_);
84.386 + penv postponed; presently penv holds already env for script*)
84.387 + | Some (_,_,_,_,itm_) => penvval_in itm_
84.388 + fun sel_given_find (s,_) = (s = "#Given") orelse (s = "#Find")
84.389 + val pats = (#ppc o get_met) mI
84.390 + in (flat o (map (itm2arg itms))) pats end;
84.391 +(*
84.392 +> val sc = ... Solve_root_equation ...
84.393 +> val mI = ("Script.thy","sqrt-equ-test");
84.394 +> val PblObj{meth={ppc=itms,...},...} = get_obj I pt [];
84.395 +> val ts = itms2args thy mI itms;
84.396 +> map (Sign.string_of_term (sign_of thy)) ts;
84.397 +["sqrt (#9 + #4 * x) = sqrt x + sqrt (#5 + x)","x","#0"] : string list
84.398 +*)
84.399 +
84.400 +
84.401 +(*["bool_ (1+x=2)","real_ x"] --match_ags--> oris
84.402 + --oris2fmz_vals--> ["equality (1+x=2)","boundVariable x","solutions L"]*)
84.403 +fun oris2fmz_vals oris =
84.404 + let fun ori2fmz_vals ((_,_,_,dsc,ts):ori) =
84.405 + ((term2str o comp_dts') (dsc, ts), last_elem ts)
84.406 + handle _ => raise error ("ori2fmz_env called with "^terms2str ts)
84.407 + in (split_list o (map ori2fmz_vals)) oris end;
84.408 +
84.409 +(*detour necessary, because generate1 delivers a string-result*)
84.410 +fun mout2term thy (Form' (FormKF (_,_,_,_,res))) =
84.411 + (term_of o the o (parse (assoc_thy thy))) res
84.412 + | mout2term thy (Form' (PpcKF _)) = e_term;(*3.8.01: res of subpbl
84.413 + at time of detection in script*)
84.414 +
84.415 +(*.convert a script-tac 'stac' to a tactic 'tac'; if stac is an initac,
84.416 + then convert to a 'tac_' (as required in appy).
84.417 + arg pt:ptree for pushing the thy specified in rootpbl into subpbls.*)
84.418 +fun stac2tac_ pt thy (Const ("Script.Rewrite",_) $ Free (thmID,_) $ _ $ f) =
84.419 +(* val (pt, thy, (Const ("Script.Rewrite",_) $ Free (thmID,_) $ _ $ f)) =
84.420 + (pt, (assoc_thy th), stac);
84.421 + *)
84.422 + let val tid = (de_esc_underscore o strip_thy) thmID
84.423 + in (Rewrite (tid, (string_of_thmI o
84.424 + (assoc_thm' thy)) (tid,"")), Empty_Tac_) end
84.425 +(* val (thy,
84.426 + mm as(Const ("Script.Rewrite'_Inst",_) $ sub $ Free(thmID,_) $ _ $ f))
84.427 + = (assoc_thy th,stac);
84.428 + stac2tac_ pt thy mm;
84.429 +
84.430 + assoc_thm' (assoc_thy "Isac.thy") (tid,"");
84.431 + assoc_thm' Isac.thy (tid,"");
84.432 + *)
84.433 + | stac2tac_ pt thy (Const ("Script.Rewrite'_Inst",_) $
84.434 + sub $ Free (thmID,_) $ _ $ f) =
84.435 + let val subML = ((map isapair2pair) o isalist2list) sub
84.436 + val subStr = subst2subs subML
84.437 + val tid = (de_esc_underscore o strip_thy) thmID (*4.10.02 unnoetig*)
84.438 + in (Rewrite_Inst
84.439 + (subStr, (tid, (string_of_thmI o
84.440 + (assoc_thm' thy)) (tid,""))), Empty_Tac_) end
84.441 +
84.442 + | stac2tac_ pt thy (Const ("Script.Rewrite'_Set",_) $ Free (rls,_) $ _ $ f)=
84.443 + (Rewrite_Set ((de_esc_underscore o strip_thy) rls), Empty_Tac_)
84.444 +
84.445 + | stac2tac_ pt thy (Const ("Script.Rewrite'_Set'_Inst",_) $
84.446 + sub $ Free (rls,_) $ _ $ f) =
84.447 + let val subML = ((map isapair2pair) o isalist2list) sub;
84.448 + val subStr = subst2subs subML;
84.449 + in (Rewrite_Set_Inst (subStr,rls), Empty_Tac_) end
84.450 +
84.451 + | stac2tac_ pt thy (Const ("Script.Calculate",_) $ Free (op_,_) $ f) =
84.452 + (Calculate op_, Empty_Tac_)
84.453 +
84.454 + | stac2tac_ pt thy (Const ("Script.Take",_) $ t) =
84.455 + (Take (term2str t), Empty_Tac_)
84.456 +
84.457 + | stac2tac_ pt thy (Const ("Script.Substitute",_) $ isasub $ arg) =
84.458 + (Substitute ((subte2sube o isalist2list) isasub), Empty_Tac_)
84.459 +(* val t = str2term"Substitute [x = L, M_b L = 0] (M_b x = q_0 * x + c)";
84.460 + val Const ("Script.Substitute", _) $ isasub $ arg = t;
84.461 + *)
84.462 +
84.463 +(*12.1.01.*)
84.464 + | stac2tac_ pt thy (Const("Script.Check'_elementwise",_) $ _ $
84.465 + (set as Const ("Collect",_) $ Abs (_,_,pred))) =
84.466 + (Check_elementwise (Sign.string_of_term (sign_of thy) pred),
84.467 + (*set*)Empty_Tac_)
84.468 +
84.469 + | stac2tac_ pt thy (Const("Script.Or'_to'_List",_) $ _ ) =
84.470 + (Or_to_List, Empty_Tac_)
84.471 +
84.472 +(*12.1.01.for subproblem_equation_dummy in root-equation *)
84.473 + | stac2tac_ pt thy (Const ("Script.Tac",_) $ Free (str,_)) =
84.474 + (Tac ((de_esc_underscore o strip_thy) str), Empty_Tac_)
84.475 + (*L_ will come from pt in appl_in*)
84.476 +
84.477 + (*3.12.03 copied from assod SubProblem*)
84.478 +(* val Const ("Script.SubProblem",_) $
84.479 + (Const ("Pair",_) $
84.480 + Free (dI',_) $
84.481 + (Const ("Pair",_) $ pI' $ mI')) $ ags' =
84.482 + str2term
84.483 + "SubProblem (EqSystem_, [linear, system], [no_met])\
84.484 + \ [bool_list_ [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2],\
84.485 + \ real_list_ [c, c_2]]";
84.486 +*)
84.487 + | stac2tac_ pt thy (stac as Const ("Script.SubProblem",_) $
84.488 + (Const ("Pair",_) $
84.489 + Free (dI',_) $
84.490 + (Const ("Pair",_) $ pI' $ mI')) $ ags') =
84.491 +(*compare "| assod _ (Subproblem'"*)
84.492 + let val dI = ((implode o drop_last(*.._*) o explode) dI')^".thy";
84.493 + val thy = maxthy (assoc_thy dI) (rootthy pt);
84.494 + val pI = ((map (de_esc_underscore o free2str)) o isalist2list) pI';
84.495 + val mI = ((map (de_esc_underscore o free2str)) o isalist2list) mI';
84.496 + val ags = isalist2list ags';
84.497 + val (pI, pors, mI) =
84.498 + if mI = ["no_met"]
84.499 + then let val pors = (match_ags thy ((#ppc o get_pbt) pI) ags)
84.500 + handle _ =>(match_ags_msg pI stac ags(*raise exn*);[])
84.501 + val pI' = refine_ori' pors pI;
84.502 + in (pI', pors (*refinement over models with diff.prec only*),
84.503 + (hd o #met o get_pbt) pI') end
84.504 + else (pI, (match_ags thy ((#ppc o get_pbt) pI) ags)
84.505 + handle _ => (match_ags_msg pI stac ags(*raise exn*); []),
84.506 + mI);
84.507 + val (fmz_, vals) = oris2fmz_vals pors;
84.508 + val {cas,ppc,thy,...} = get_pbt pI
84.509 + val dI = theory2theory' thy (*.take dI from _refined_ pbl.*)
84.510 + val dI = theory2theory' (maxthy (assoc_thy dI) (rootthy pt));
84.511 + val hdl = case cas of
84.512 + None => pblterm dI pI
84.513 + | Some t => subst_atomic ((vars_of_pbl_' ppc) ~~~ vals) t
84.514 + val f = subpbl (strip_thy dI) pI
84.515 + in (Subproblem (dI, pI),
84.516 + Subproblem' ((dI, pI, mI), pors, hdl, fmz_, f))
84.517 + end
84.518 +
84.519 + | stac2tac_ pt thy t = raise error
84.520 + ("stac2tac_ TODO: no match for "^
84.521 + (Sign.string_of_term (sign_of thy) t));
84.522 +(*
84.523 +> val t = (term_of o the o (parse thy))
84.524 + "Rewrite_Set_Inst [(bdv,v_::real)] isolate_bdv False (x=a+#1)";
84.525 +> stac2tac_ pt t;
84.526 +val it = Rewrite_Set_Inst ([(#,#)],"isolate_bdv") : tac
84.527 +
84.528 +> val t = (term_of o the o (parse SqRoot.thy))
84.529 +"(SubProblem (SqRoot_,[equation,univariate],(SqRoot_,solve_linear))\
84.530 + \ [bool_ e_, real_ v_])::bool list";
84.531 +> stac2tac_ pt SqRoot.thy t;
84.532 +val it = (Subproblem ("SqRoot.thy",[#,#]),Const (#,#) $ (# $ # $ (# $ #)))
84.533 +*)
84.534 +
84.535 +fun stac2tac pt thy t = (fst o stac2tac_ pt thy) t;
84.536 +
84.537 +
84.538 +
84.539 +
84.540 +(*test a term for being a _list_ (set ?) of constants; could be more rigorous*)
84.541 +fun list_of_consts (Const ("List.list.Cons",_) $ _ $ _) = true
84.542 + | list_of_consts (Const ("List.list.Nil",_)) = true
84.543 + | list_of_consts _ = false;
84.544 +(*val ttt = (term_of o the o (parse thy)) "[x=#1,x=#2,x=#3]";
84.545 +> list_of_consts ttt;
84.546 +val it = true : bool
84.547 +> val ttt = (term_of o the o (parse thy)) "[]";
84.548 +> list_of_consts ttt;
84.549 +val it = true : bool*)
84.550 +
84.551 +
84.552 +
84.553 +
84.554 +
84.555 +(* 15.1.01: evaluation of preds only works occasionally,
84.556 + but luckily for the 2 examples of root-equ:
84.557 +> val s = ((term_of o the o (parse thy)) "x",
84.558 + (term_of o the o (parse thy)) "-#5//#12");
84.559 +> val asm = (term_of o the o (parse thy))
84.560 + "#0 <= #9 + #4 * x & #0 <= sqrt x + sqrt (#-3 + x)";
84.561 +> val pred = subst_atomic [s] asm;
84.562 +> rewrite_set_ thy false (cterm_of (sign_of thy) pred);
84.563 +val it = None : (cterm * cterm list) option !!!!!!!!!!!!!!!!!!!!!!!!!!!!
84.564 +> eval_true' (string_of_thy thy) "eval_rls" (subst_atomic [s] pred);
84.565 +val it = false : bool
84.566 +
84.567 +> val s = ((term_of o the o (parse thy)) "x",
84.568 + (term_of o the o (parse thy)) "#4");
84.569 +> val asm = (term_of o the o (parse thy))
84.570 + "#0 <= #9 + #4 * x & #0 <= sqrt x + sqrt (#5 + x)";
84.571 +> val pred = subst_atomic [s] asm;
84.572 +> rewrite_set_ thy false (cterm_of (sign_of thy) pred);
84.573 +val it = Some ("True & True",[]) : (cterm * cterm list) option
84.574 +> eval_true' (string_of_thy thy) "eval_rls" (subst_atomic [s] pred);
84.575 +val it = true : bool`*)
84.576 +
84.577 +(*for check_elementwise: take apart the set, ev. instantiate assumptions
84.578 +fun rep_set thy pt p (set as Const ("Collect",_) $ Abs _) =
84.579 + let val (_ $ Abs (bdv,T,pred)) = inst_abs thy set;
84.580 + val bdv = Free (bdv,T);
84.581 + val pred = if pred <> Const ("Script.Assumptions",bool)
84.582 + then pred
84.583 + else (mk_and o (map fst)) (get_assumptions_ pt (p,Res))
84.584 + in (bdv, pred) end
84.585 + | rep_set thy _ _ set =
84.586 + raise error ("check_elementwise: no set "^ (*from script*)
84.587 + (Sign.string_of_term (sign_of thy) set));
84.588 +(*> val set = (term_of o the o (parse thy)) "{(x::real). Assumptions}";
84.589 +> val p = [];
84.590 +> val pt = union_asm pt p [("#0 <= sqrt x + sqrt (#5 + x)",[11]),
84.591 + ("#0 <= #9 + #4 * x",[22]),
84.592 + ("#0 <= x ^^^ #2 + #5 * x",[33]),
84.593 + ("#0 <= #2 + x",[44])];
84.594 +> val (bdv,pred) = rep_set thy pt p set;
84.595 +val bdv = Free ("x","RealDef.real") : term
84.596 +> writeln (Sign.string_of_term (sign_of thy) pred);
84.597 +((#0 <= sqrt x + sqrt (#5 + x) & #0 <= #9 + #4 * x) &
84.598 + #0 <= x ^^^ #2 + #5 * x) &
84.599 +#0 <= #2 + x
84.600 +*)
84.601 +--------------------------------------------11.6.03--was unused*)
84.602 +
84.603 +
84.604 +
84.605 +
84.606 +datatype ass =
84.607 + Ass of tac_ * (*SubProblem gets args instantiated in assod*)
84.608 + term (*for itr_arg,result in ets*)
84.609 +| AssWeak of tac_ *
84.610 + term (*for itr_arg,result in ets*)
84.611 +| NotAss;
84.612 +
84.613 +(*.assod: tac_ associated with stac w.r.t. d
84.614 +args
84.615 + pt:ptree for pushing the thy specified in rootpbl into subpbls
84.616 +returns
84.617 + Ass : associated: e.g. thmID in stac = thmID in m
84.618 + +++ arg in stac = arg in m
84.619 + AssWeak: weakly ass.:e.g. thmID in stac = thmID in m, //arg//
84.620 + NotAss : e.g. thmID in stac/=/thmID in m (not =)
84.621 +8.01:
84.622 + tac_ SubProblem with args completed from script
84.623 +.*)
84.624 +fun assod pt d (m as Rewrite_Inst' (thy',rod,rls,put,subs,(thmID,thm),f,(f',asm))) stac =
84.625 + (case stac of
84.626 + (Const ("Script.Rewrite'_Inst",_) $ subs_ $ Free (thmID_,idT) $b$f_)=>
84.627 + if thmID = thmID_ then
84.628 + if f = f_ then ((*writeln"3### assod ..Ass";*)Ass (m,f'))
84.629 + else ((*writeln"3### assod ..AssWeak";*)AssWeak(m, f'))
84.630 + else ((*writeln"3### assod ..NotAss";*)NotAss)
84.631 + | (Const ("Script.Rewrite'_Set'_Inst",_) $ sub_ $ Free (rls_,_) $_$f_)=>
84.632 + if contains_rule (Thm (thmID, refl(*dummy*))) (assoc_rls rls_) then
84.633 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.634 + else NotAss
84.635 + | _ => NotAss)
84.636 +
84.637 + | assod pt d (m as Rewrite' (thy,rod,rls,put,(thmID,thm),f,(f',asm))) stac =
84.638 + (case stac of
84.639 + (t as Const ("Script.Rewrite",_) $ Free (thmID_,idT) $ b $ f_) =>
84.640 + ((*writeln("3### assod: stac = "^
84.641 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));
84.642 + writeln("3### assod: f(m)= "^
84.643 + (Sign.string_of_term (sign_of (assoc_thy thy)) f));*)
84.644 + if thmID = thmID_ then
84.645 + if f = f_ then ((*writeln"3### assod ..Ass";*)Ass (m,f'))
84.646 + else ((*writeln"### assod ..AssWeak";
84.647 + writeln("### assod: f(m) = "^
84.648 + (Sign.string_of_term (sign_of(assoc_thy thy)) f));
84.649 + writeln("### assod: f(stac)= "^
84.650 + (Sign.string_of_term(sign_of(assoc_thy thy))f_))*)
84.651 + AssWeak (m,f'))
84.652 + else ((*writeln"3### assod ..NotAss";*)NotAss))
84.653 + | (Const ("Script.Rewrite'_Set",_) $ Free (rls_,_) $ _ $ f_) =>
84.654 + if contains_rule (Thm (thmID, refl(*dummy*))) (assoc_rls rls_) then
84.655 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.656 + else NotAss
84.657 + | _ => NotAss)
84.658 +
84.659 +(*val f = (term_of o the o (parse thy))"#0+(sqrt(sqrt(sqrt a))^^^#2)^^^#2=#0";
84.660 +> val f'= (term_of o the o (parse thy))"#0+(sqrt(sqrt a))^^^#2=#0";
84.661 +> val m = Rewrite'("Script.thy","tless_true","eval_rls",false,
84.662 + ("rroot_square_inv",""),f,(f',[]));
84.663 +> val stac = (term_of o the o (parse thy))
84.664 + "Rewrite rroot_square_inv False (#0+(sqrt(sqrt(sqrt a))^^^#2)^^^#2=#0)";
84.665 +> assod e_rls m stac;
84.666 +val it =
84.667 + (Some (Rewrite' (#,#,#,#,#,#,#)),Const ("empty","RealDef.real"),
84.668 + Const ("empty","RealDef.real")) : tac_ option * term * term*)
84.669 +
84.670 + | assod pt d (m as Rewrite_Set_Inst' (thy',put,sub,rls,f,(f',asm)))
84.671 + (Const ("Script.Rewrite'_Set'_Inst",_) $ sub_ $ Free (rls_,_) $ _ $ f_)=
84.672 + if id_rls rls = rls_ then
84.673 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.674 + else NotAss
84.675 +
84.676 + | assod pt d (m as Detail_Set_Inst' (thy',put,sub,rls,f,(f',asm)))
84.677 + (Const ("Script.Rewrite'_Set'_Inst",_) $ sub_ $ Free (rls_,_) $ _ $ f_)=
84.678 + if id_rls rls = rls_ then
84.679 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.680 + else NotAss
84.681 +
84.682 + | assod pt d (m as Rewrite_Set' (thy,put,rls,f,(f',asm)))
84.683 + (Const ("Script.Rewrite'_Set",_) $ Free (rls_,_) $ _ $ f_) =
84.684 + if id_rls rls = rls_ then
84.685 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.686 + else NotAss
84.687 +
84.688 + | assod pt d (m as Detail_Set' (thy,put,rls,f,(f',asm)))
84.689 + (Const ("Script.Rewrite'_Set",_) $ Free (rls_,_) $ _ $ f_) =
84.690 + if id_rls rls = rls_ then
84.691 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.692 + else NotAss
84.693 +
84.694 + | assod pt d (m as Calculate' (thy',op_,f,(f',thm'))) stac =
84.695 + (case stac of
84.696 + (Const ("Script.Calculate",_) $ Free (op__,_) $ f_) =>
84.697 + if op_ = op__ then
84.698 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.699 + else NotAss
84.700 + | (Const ("Script.Rewrite'_Set'_Inst",_) $ sub_ $ Free(rls_,_) $_$f_)=>
84.701 + if contains_rule (Calc (snd (assoc1 (!calclist', op_))))
84.702 + (assoc_rls rls_) then
84.703 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.704 + else NotAss
84.705 + | (Const ("Script.Rewrite'_Set",_) $ Free (rls_, _) $ _ $ f_) =>
84.706 + if contains_rule (Calc (snd (assoc1 (!calclist', op_))))
84.707 + (assoc_rls rls_) then
84.708 + if f = f_ then Ass (m,f') else AssWeak (m,f')
84.709 + else NotAss
84.710 + | _ => NotAss)
84.711 +
84.712 + | assod pt _ (m as Check_elementwise' (consts,_,(consts_chkd,_)))
84.713 + (Const ("Script.Check'_elementwise",_) $ consts' $ _) =
84.714 + ((*writeln("### assod Check'_elementwise: consts= "^(term2str consts)^
84.715 + ", consts'= "^(term2str consts'));
84.716 + atomty consts; atomty consts';*)
84.717 + if consts = consts' then ((*writeln"### assod Check'_elementwise: Ass";*)
84.718 + Ass (m, consts_chkd))
84.719 + else ((*writeln"### assod Check'_elementwise: NotAss";*) NotAss))
84.720 +
84.721 + | assod pt _ (m as Or_to_List' (ors, list))
84.722 + (Const ("Script.Or'_to'_List",_) $ _) =
84.723 + Ass (m, list)
84.724 +
84.725 + | assod pt _ (m as Take' term)
84.726 + (Const ("Script.Take",_) $ _) =
84.727 + Ass (m, term)
84.728 +
84.729 + | assod pt _ (m as Substitute' (_, _, res))
84.730 + (Const ("Script.Substitute",_) $ _ $ _) =
84.731 + Ass (m, res)
84.732 +(* val t = str2term "Substitute [(x, 3)] (x^^^2 + x + 1)";
84.733 + val (Const ("Script.Substitute",_) $ _ $ _) = t;
84.734 + *)
84.735 +
84.736 + | assod pt _ (m as Tac_ (thy,f,id,f'))
84.737 + (Const ("Script.Tac",_) $ Free (id',_)) =
84.738 + if id = id' then Ass (m, ((term_of o the o (parse thy)) f'))
84.739 + else NotAss
84.740 +
84.741 +
84.742 +(* val t = str2term
84.743 + "SubProblem (DiffApp_,[make,function],[no_met]) \
84.744 + \[real_ m_, real_ v_, bool_list_ rs_]";
84.745 +
84.746 + val (Subproblem' ((domID,pblID,metID),_,_,_,f)) = m;
84.747 + val (Const ("Script.SubProblem",_) $
84.748 + (Const ("Pair",_) $
84.749 + Free (dI',_) $
84.750 + (Const ("Pair",_) $ pI' $ mI')) $ ags') = stac;
84.751 + *)
84.752 + | assod pt _ (Subproblem' ((domID,pblID,metID),_,_,_,f))
84.753 + (stac as Const ("Script.SubProblem",_) $
84.754 + (Const ("Pair",_) $
84.755 + Free (dI',_) $
84.756 + (Const ("Pair",_) $ pI' $ mI')) $ ags') =
84.757 +(*compare "| stac2tac_ thy (Const ("Script.SubProblem",_)"*)
84.758 + let val dI = ((implode o drop_last o explode) dI')^".thy";
84.759 + val thy = maxthy (assoc_thy dI) (rootthy pt);
84.760 + val pI = ((map (de_esc_underscore o free2str)) o isalist2list) pI';
84.761 + val mI = ((map (de_esc_underscore o free2str)) o isalist2list) mI';
84.762 + val ags = isalist2list ags';
84.763 + val (pI, pors, mI) =
84.764 + if mI = ["no_met"]
84.765 + then let val pors = (match_ags thy ((#ppc o get_pbt) pI) ags)
84.766 + handle _=>(match_ags_msg pI stac ags(*raise exn*);[]);
84.767 + val pI' = refine_ori' pors pI;
84.768 + in (pI', pors (*refinement over models with diff.prec only*),
84.769 + (hd o #met o get_pbt) pI') end
84.770 + else (pI, (match_ags thy ((#ppc o get_pbt) pI) ags)
84.771 + handle _ => (match_ags_msg pI stac ags(*raise exn*);[]),
84.772 + mI);
84.773 + val (fmz_, vals) = oris2fmz_vals pors;
84.774 + val {cas, ppc,...} = get_pbt pI
84.775 + val {cas, ppc, thy,...} = get_pbt pI
84.776 + val dI = theory2theory' thy (*take dI from _refined_ pbl*)
84.777 + val dI = theory2theory' (maxthy (assoc_thy dI) (rootthy pt))
84.778 + val hdl = case cas of
84.779 + None => pblterm dI pI
84.780 + | Some t => subst_atomic ((vars_of_pbl_' ppc) ~~~ vals) t
84.781 + val f = subpbl (strip_thy dI) pI
84.782 + in if domID = dI andalso pblID = pI
84.783 + then Ass (Subproblem' ((dI, pI, mI), pors, hdl, fmz_, f), f)
84.784 + else NotAss
84.785 + end
84.786 +
84.787 + | assod pt d m t =
84.788 + (if (!trace_script)
84.789 + then writeln("@@@ the 'tac_' proposed to apply does NOT match the leaf found in the script:\n"^
84.790 + "@@@ tac_ = "^(tac_2str m))
84.791 + else ();
84.792 + NotAss);
84.793 +
84.794 +
84.795 +
84.796 +fun tac_2tac (Refine_Tacitly' (pI,_,_,_,_)) = Refine_Tacitly pI
84.797 + | tac_2tac (Model_Problem' (pI,_,_)) = Model_Problem
84.798 + | tac_2tac (Add_Given' (t,_)) = Add_Given t
84.799 + | tac_2tac (Add_Find' (t,_)) = Add_Find t
84.800 + | tac_2tac (Add_Relation' (t,_)) = Add_Relation t
84.801 +
84.802 + | tac_2tac (Specify_Theory' dI) = Specify_Theory dI
84.803 + | tac_2tac (Specify_Problem' (dI,_)) = Specify_Problem dI
84.804 + | tac_2tac (Specify_Method' (dI,_,_)) = Specify_Method dI
84.805 +
84.806 + | tac_2tac (Rewrite' (thy,rod,erls,put,(thmID,thm),f,(f',asm))) =
84.807 + Rewrite (thmID,thm)
84.808 +
84.809 + | tac_2tac (Rewrite_Inst' (thy,rod,erls,put,sub,(thmID,thm),f,(f',asm)))=
84.810 + Rewrite_Inst (subst2subs sub,(thmID,thm))
84.811 +
84.812 + | tac_2tac (Rewrite_Set' (thy,put,rls,f,(f',asm))) =
84.813 + Rewrite_Set (id_rls rls)
84.814 +
84.815 + | tac_2tac (Detail_Set' (thy,put,rls,f,(f',asm))) =
84.816 + Detail_Set (id_rls rls)
84.817 +
84.818 + | tac_2tac (Rewrite_Set_Inst' (thy,put,sub,rls,f,(f',asm))) =
84.819 + Rewrite_Set_Inst (subst2subs sub,id_rls rls)
84.820 +
84.821 + | tac_2tac (Detail_Set_Inst' (thy,put,sub,rls,f,(f',asm))) =
84.822 + Detail_Set_Inst (subst2subs sub,id_rls rls)
84.823 +
84.824 + | tac_2tac (Calculate' (thy,op_,t,(t',thm'))) = Calculate (op_)
84.825 +
84.826 + | tac_2tac (Check_elementwise' (consts,pred,consts')) =
84.827 + Check_elementwise pred
84.828 +
84.829 + | tac_2tac (Or_to_List' _) = Or_to_List
84.830 + | tac_2tac (Take' term) = Take (term2str term)
84.831 + | tac_2tac (Substitute' (subte, t, res)) = Substitute (subte2sube subte)
84.832 +
84.833 + | tac_2tac (Tac_ (_,f,id,f')) = Tac id
84.834 +
84.835 + | tac_2tac (Subproblem' ((domID, pblID, _), _, _,_,_)) =
84.836 + Subproblem (domID, pblID)
84.837 + | tac_2tac (Check_Postcond' (pblID, _)) =
84.838 + Check_Postcond pblID
84.839 + | tac_2tac Empty_Tac_ = Empty_Tac
84.840 +
84.841 + | tac_2tac m =
84.842 + raise error ("tac_2tac: not impl. for "^(tac_2str m));
84.843 +
84.844 +
84.845 +
84.846 +
84.847 +(** decompose tac_ to a rule and to (lhs,rhs)
84.848 + unly needed ~~~ **)
84.849 +
84.850 +val idT = Type ("Script.ID",[]);
84.851 +(*val tt = (term_of o the o (parse thy)) "square_equation_left::ID";
84.852 +type_of tt = idT;
84.853 +val it = true : bool
84.854 +*)
84.855 +(* 13.3.01
84.856 +v
84.857 +*)
84.858 +fun make_rule thy t =
84.859 + let val ct = cterm_of (sign_of thy) (Trueprop $ t)
84.860 + in Thm (string_of_cterm ct, make_thm ct) end;
84.861 +
84.862 +(* val (Rewrite_Inst'(thy',rod,rls,put,subs,(thmID,thm),f,(f',asm)))=m;
84.863 + *)
84.864 +(*decompose tac_ to a rule and to (lhs,rhs) for ets FIXME.12.03: obsolete!
84.865 + NOTE.12.03: also used for msg 'not locatable' ?!: 'Subproblem' missing !!!
84.866 +WN0508 only use in tac_2res, which uses only last return-value*)
84.867 +fun rep_tac_ (Rewrite_Inst'
84.868 + (thy',rod,rls,put,subs,(thmID,thm),f,(f',asm))) =
84.869 + let val fT = type_of f;
84.870 + val b = if put then HOLogic.true_const else HOLogic.false_const;
84.871 + val sT = (type_of o fst o hd) subs;
84.872 + val subs' = list2isalist (HOLogic.mk_prodT (sT, sT))
84.873 + (map HOLogic.mk_prod subs);
84.874 + val sT' = type_of subs';
84.875 + val lhs = Const ("Script.Rewrite'_Inst",[sT',idT,(*fT*)bool,fT] ---> fT)
84.876 + $ subs' $ Free (thmID,idT) $ b $ f;
84.877 + in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
84.878 +(*Fehlersuche 25.4.01
84.879 +(a)----- als String zusammensetzen:
84.880 +ML> Sign.string_of_term (sign_of thy)f;
84.881 +val it = "d_d x #4 + d_d x (x ^^^ #2 + #3 * x)" : string
84.882 +ML> Sign.string_of_term (sign_of thy)f';
84.883 +val it = "#0 + d_d x (x ^^^ #2 + #3 * x)" : string
84.884 +ML> subs;
84.885 +val it = [(Free ("bdv","RealDef.real"),Free ("x","RealDef.real"))] : subst
84.886 +> val tt = (term_of o the o (parse thy))
84.887 + "(Rewrite_Inst[(bdv,x)]diff_const False(d_d x #4 + d_d x (x ^^^ #2 + #3 * x)))=(#0 + d_d x (x ^^^ #2 + #3 * x))";
84.888 +> atomty tt;
84.889 +ML> writeln(Sign.string_of_term (sign_of thy)tt);
84.890 +(Rewrite_Inst [(bdv,x)] diff_const False d_d x #4 + d_d x (x ^^^ #2 + #3 * x)) =
84.891 + #0 + d_d x (x ^^^ #2 + #3 * x)
84.892 +
84.893 +(b)----- laut rep_tac_:
84.894 +> val ttt=HOLogic.mk_eq (lhs,f');
84.895 +> atomty ttt;
84.896 +
84.897 +
84.898 +(*Fehlersuche 1-2Monate vor 4.01:*)
84.899 +> val tt = (term_of o the o (parse thy))
84.900 + "Rewrite_Inst[(bdv,x)]square_equation_left True(x=#1+#2)";
84.901 +> atomty tt;
84.902 +
84.903 +> val f = (term_of o the o (parse thy)) "x=#1+#2";
84.904 +> val f' = (term_of o the o (parse thy)) "x=#3";
84.905 +> val subs = [((term_of o the o (parse thy)) "bdv",
84.906 + (term_of o the o (parse thy)) "x")];
84.907 +> val sT = (type_of o fst o hd) subs;
84.908 +> val subs' = list2isalist (HOLogic.mk_prodT (sT, sT))
84.909 + (map HOLogic.mk_prod subs);
84.910 +> val sT' = type_of subs';
84.911 +> val lhs = Const ("Script.Rewrite'_Inst",[sT',idT,fT,fT] ---> fT)
84.912 + $ subs' $ Free (thmID,idT) $ HOLogic.true_const $ f;
84.913 +> lhs = tt;
84.914 +val it = true : bool
84.915 +> rep_tac_ (Rewrite_Inst'
84.916 + ("Script.thy","tless_true","eval_rls",false,subs,
84.917 + ("square_equation_left",""),f,(f',[])));
84.918 +*)
84.919 + | rep_tac_ (Rewrite' (thy',rod,rls,put,(thmID,thm),f,(f',asm)))=
84.920 + let
84.921 + val fT = type_of f;
84.922 + val b = if put then HOLogic.true_const else HOLogic.false_const;
84.923 + val lhs = Const ("Script.Rewrite",[idT,HOLogic.boolT,fT] ---> fT)
84.924 + $ Free (thmID,idT) $ b $ f;
84.925 + in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
84.926 +(*
84.927 +> val tt = (term_of o the o (parse thy)) (*____ ____..test*)
84.928 + "Rewrite square_equation_left True (x=#1+#2) = (x=#3)";
84.929 +
84.930 +> val f = (term_of o the o (parse thy)) "x=#1+#2";
84.931 +> val f' = (term_of o the o (parse thy)) "x=#3";
84.932 +> val Thm (id,thm) =
84.933 + rep_tac_ (Rewrite'
84.934 + ("Script.thy","tless_true","eval_rls",false,
84.935 + ("square_equation_left",""),f,(f',[])));
84.936 +> val Some ct = parse thy
84.937 + "Rewrite square_equation_left True (x=#1+#2)";
84.938 +> rewrite_ Script.thy tless_true eval_rls true thm ct;
84.939 +val it = Some ("x = #3",[]) : (cterm * cterm list) option
84.940 +*)
84.941 + | rep_tac_ (Rewrite_Set_Inst'
84.942 + (thy',put,subs,rls,f,(f',asm))) =
84.943 + (e_rule, (e_term, f'))
84.944 +(*WN050824: type error ...
84.945 + let val fT = type_of f;
84.946 + val sT = (type_of o fst o hd) subs;
84.947 + val subs' = list2isalist (HOLogic.mk_prodT (sT, sT))
84.948 + (map HOLogic.mk_prod subs);
84.949 + val sT' = type_of subs';
84.950 + val b = if put then HOLogic.true_const else HOLogic.false_const
84.951 + val lhs = Const ("Script.Rewrite'_Set'_Inst",
84.952 + [sT',idT,fT,fT] ---> fT)
84.953 + $ subs' $ Free (id_rls rls,idT) $ b $ f;
84.954 + in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end*)
84.955 +(* ... vals from Rewrite_Inst' ...
84.956 +> rep_tac_ (Rewrite_Set_Inst'
84.957 + ("Script.thy",false,subs,
84.958 + "isolate_bdv",f,(f',[])));
84.959 +*)
84.960 +(* val (Rewrite_Set' (thy',put,rls,f,(f',asm)))=m;
84.961 +*)
84.962 + | rep_tac_ (Rewrite_Set' (thy',put,rls,f,(f',asm)))=
84.963 + let val fT = type_of f;
84.964 + val b = if put then HOLogic.true_const else HOLogic.false_const;
84.965 + val lhs = Const ("Script.Rewrite'_Set",[idT,bool,fT] ---> fT)
84.966 + $ Free (id_rls rls,idT) $ b $ f;
84.967 + in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
84.968 +(* 13.3.01:
84.969 +val thy = assoc_thy thy';
84.970 +val t = HOLogic.mk_eq (lhs,f');
84.971 +make_rule thy t;
84.972 +--------------------------------------------------
84.973 +val lll = (term_of o the o (parse thy))
84.974 + "Rewrite_Set SqRoot_simplify False (d_d x (x ^^^ #2 + #3 * x) + d_d x #4)";
84.975 +
84.976 +--------------------------------------------------
84.977 +> val f = (term_of o the o (parse thy)) "x=#1+#2";
84.978 +> val f' = (term_of o the o (parse thy)) "x=#3";
84.979 +> val Thm (id,thm) =
84.980 + rep_tac_ (Rewrite_Set'
84.981 + ("Script.thy",false,"SqRoot_simplify",f,(f',[])));
84.982 +val id = "(Rewrite_Set SqRoot_simplify True x = #1 + #2) = (x = #3)" : string
84.983 +val thm = "(Rewrite_Set SqRoot_simplify True x = #1 + #2) = (x = #3)" : thm
84.984 +*)
84.985 + | rep_tac_ (Calculate' (thy',op_,f,(f',thm')))=
84.986 + let val fT = type_of f;
84.987 + val lhs = Const ("Script.Calculate",[idT,fT] ---> fT)
84.988 + $ Free (op_,idT) $ f
84.989 + in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
84.990 +(*
84.991 +> val lhs'=(term_of o the o (parse thy))"Calculate plus (#1+#2)";
84.992 + ... test-root-equ.sml: calculate ...
84.993 +> val Appl m'=applicable_in p pt (Calculate "plus");
84.994 +> val (lhs,_)=tac_2etac m';
84.995 +> lhs'=lhs;
84.996 +val it = true : bool*)
84.997 + | rep_tac_ (Check_elementwise' (t,str,(t',asm))) = (Erule, (e_term, t'))
84.998 + | rep_tac_ (Subproblem' (_,_,_,_,t')) = (Erule, (e_term, t'))
84.999 + | rep_tac_ (Take' (t')) = (Erule, (e_term, t'))
84.1000 + | rep_tac_ (Substitute' (subst,t,t')) = (Erule, (t, t'))
84.1001 + | rep_tac_ (Or_to_List' (t, t')) = (Erule, (t, t'))
84.1002 + | rep_tac_ m = raise error ("rep_tac_: not impl.for "^
84.1003 + (tac_2str m));
84.1004 +
84.1005 +(*"N.3.6.03------
84.1006 +fun tac_2rule m = (fst o rep_tac_) m;
84.1007 +fun tac_2etac m = (snd o rep_tac_) m;
84.1008 +fun tac_2tac m = (fst o snd o rep_tac_) m;*)
84.1009 +fun tac_2res m = (snd o snd o rep_tac_) m;(*ONLYuse of rep_tac_
84.1010 + FIXXXXME: simplify rep_tac_*)
84.1011 +
84.1012 +
84.1013 +(*.handle a leaf;
84.1014 + a leaf is either a tactic or an 'exp' in 'let v = expr'
84.1015 + where 'exp' does not contain a tactic.
84.1016 + handling a leaf comprises
84.1017 + (1) 'subst_stacexpr' substitute env and complete curried tactic
84.1018 + (2) rewrite the leaf by 'srls'
84.1019 +WN060906 quick and dirty fix: return a' too (for updating E later)
84.1020 +.*)
84.1021 +fun handle_leaf call thy srls E a v t =
84.1022 + (*WN050916 'upd_env_opt' is a blind copy from previous version*)
84.1023 + case subst_stacexpr E a v t of
84.1024 + (a', STac stac) => (*script-tactic*)
84.1025 + let val stac' = eval_listexpr_ (assoc_thy thy) srls
84.1026 + (subst_atomic (upd_env_opt E (a,v)) stac)
84.1027 + in (if (!trace_script)
84.1028 + then writeln ("@@@ "^call^" leaf '"^term2str t^"' ---> STac '"^
84.1029 + term2str stac'^"'")
84.1030 + else ();
84.1031 + (a', STac stac'))
84.1032 + end
84.1033 + | (a', Expr lexpr) => (*leaf-expression*)
84.1034 + let val lexpr' = eval_listexpr_ (assoc_thy thy) srls
84.1035 + (subst_atomic (upd_env_opt E (a,v)) lexpr)
84.1036 + in (if (!trace_script)
84.1037 + then writeln("@@@ "^call^" leaf '"^term2str t^"' ---> Expr '"^
84.1038 + term2str lexpr'^"'")
84.1039 + else ();
84.1040 + (a', Expr lexpr'))
84.1041 + end;
84.1042 +
84.1043 +
84.1044 +
84.1045 +(** locate an applicable stactic in a script **)
84.1046 +
84.1047 +datatype assoc = (*ExprVal in the sense of denotational semantics*)
84.1048 + Assoc of (*the stac is associated, strongly or weakly*)
84.1049 + scrstate * (*the current; returned for next_tac etc. outside ass* *)
84.1050 + (step list) (*list of steps done until associated stac found;
84.1051 + initiated with the data for doing the 1st step,
84.1052 + thus the head holds these data further on,
84.1053 + while the tail holds steps finished (incl.scrstate in ptree)*)
84.1054 +| NasApp of (*stac not associated, but applicable, ptree-node generated*)
84.1055 + scrstate * (step list)
84.1056 +| NasNap of (*stac not associated, not applicable, nothing generated;
84.1057 + for distinction in Or, for leaving iterations, leaving Seq,
84.1058 + evaluate scriptexpressions*)
84.1059 + term * env;
84.1060 +fun assoc2str (Assoc _) = "Assoc"
84.1061 + | assoc2str (NasNap _) = "NasNap"
84.1062 + | assoc2str (NasApp _) = "NasApp";
84.1063 +
84.1064 +
84.1065 +datatype asap = (*arg. of assy _only_ for distinction w.r.t. Or*)
84.1066 + Aundef (*undefined: set only by (topmost) Or*)
84.1067 +| AssOnly (*do not execute appl stacs - there could be an associated
84.1068 + in parallel Or-branch*)
84.1069 +| AssGen; (*no Ass(Weak) found within Or, thus
84.1070 + search for _applicable_ stacs, execute and generate pt*)
84.1071 +(*this constructions doesnt allow arbitrary nesting of Or !!!*)
84.1072 +
84.1073 +
84.1074 +(*assy, ass_up, astep_up scanning for locate_gen at stactic in a script.
84.1075 + search is clearly separated into (1)-(2):
84.1076 + (1) assy is recursive descent;
84.1077 + (2) ass_up resumes interpretation at a location somewhere in the script;
84.1078 + astep_up does only get to the parentnode of the scriptexpr.
84.1079 + consequence:
84.1080 + * call of (2) means _always_ that in this branch below
84.1081 + there was an appl.stac (Repeat, Or e1, ...)
84.1082 +*)
84.1083 +fun assy ya (is as (E,l,a,v,S,b),ss)
84.1084 + (Const ("Let",_) $ e $ (Abs (id,T,body))) =
84.1085 +(* val (ya, (is as (E,l,a,v,S,b),ss),Const ("Let",_) $ e $ (Abs (id,T,body))) =
84.1086 + (*1*)(((ts,d),Aundef), ((E,[R],a,v,S,b),[(m,EmptyMout,pt,p,[])]), body);
84.1087 + *)
84.1088 + ((*writeln("### assy Let$e$Abs: is=");
84.1089 + writeln(istate2str (ScrState is));*)
84.1090 + case assy ya ((E , l@[L,R], a,v,S,b),ss) e of
84.1091 + NasApp ((E',l,a,v,S,bb),ss) =>
84.1092 + let val id' = mk_Free (id, T);
84.1093 + val E' = upd_env E' (id', v);
84.1094 + (*val _=writeln("### assy Let -> NasApp");*)
84.1095 + in assy ya ((E', l@[R,D], a,v,S,b),ss) body end
84.1096 + | NasNap (v,E) =>
84.1097 + let val id' = mk_Free (id, T);
84.1098 + val E' = upd_env E (id', v);
84.1099 + (*val _=writeln("### assy Let -> NasNap");*)
84.1100 + in assy ya ((E', l@[R,D], a,v,S,b),ss) body end
84.1101 + | ay => ay)
84.1102 +
84.1103 + | assy (ya as (((thy,srls),_),_)) ((E,l,_,v,S,b),ss)
84.1104 + (Const ("Script.While",_) $ c $ e $ a) =
84.1105 + ((*writeln("### assy While $ c $ e $ a, upd_env= "^
84.1106 + (subst2str (upd_env E (a,v))));*)
84.1107 + if eval_true_ thy srls (subst_atomic (upd_env E (a,v)) c)
84.1108 + then assy ya ((E, l@[L,R], Some a,v,S,b),ss) e
84.1109 + else NasNap (v, E))
84.1110 +
84.1111 + | assy (ya as (((thy,srls),_),_)) ((E,l,a,v,S,b),ss)
84.1112 + (Const ("Script.While",_) $ c $ e) =
84.1113 + ((*writeln("### assy While, l= "^(loc_2str l));*)
84.1114 + if eval_true_ thy srls (subst_atomic (upd_env_opt E (a,v)) c)
84.1115 + then assy ya ((E, l@[R], a,v,S,b),ss) e
84.1116 + else NasNap (v, E))
84.1117 +
84.1118 + | assy (ya as (((thy,srls),_),_)) ((E,l,a,v,S,b),ss)
84.1119 + (Const ("If",_) $ c $ e1 $ e2) =
84.1120 + (if eval_true_ thy srls (subst_atomic (upd_env_opt E (a,v)) c)
84.1121 + then assy ya ((E, l@[L,R], a,v,S,b),ss) e1
84.1122 + else assy ya ((E, l@[ R], a,v,S,b),ss) e2)
84.1123 +
84.1124 + | assy ya ((E,l,_,v,S,b),ss) (Const ("Script.Try",_) $ e $ a) =
84.1125 + ((*writeln("### assy Try $ e $ a, l= "^(loc_2str l));*)
84.1126 + case assy ya ((E, l@[L,R], Some a,v,S,b),ss) e of
84.1127 + ay => ay)
84.1128 +
84.1129 + | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Try",_) $ e) =
84.1130 + ((*writeln("### assy Try $ e, l= "^(loc_2str l));*)
84.1131 + case assy ya ((E, l@[R], a,v,S,b),ss) e of
84.1132 + ay => ay)
84.1133 +(* val (ya, ((E,l,_,v,S,b),ss), (Const ("Script.Seq",_) $e1 $ e2 $ a)) =
84.1134 + (*2*)(ya, ((E , l@[L,R], a,v,S,b),ss), e);
84.1135 + *)
84.1136 + | assy ya ((E,l,_,v,S,b),ss) (Const ("Script.Seq",_) $e1 $ e2 $ a) =
84.1137 + ((*writeln("### assy Seq $e1 $ e2 $ a, E= "^(subst2str E));*)
84.1138 + case assy ya ((E, l@[L,L,R], Some a,v,S,b),ss) e1 of
84.1139 + NasNap (v, E) => assy ya ((E, l@[L,R], Some a,v,S,b),ss) e2
84.1140 + | NasApp ((E,_,_,v,_,_),ss) =>
84.1141 + assy ya ((E, l@[L,R], Some a,v,S,b),ss) e2
84.1142 + | ay => ay)
84.1143 +
84.1144 + | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Seq",_) $e1 $ e2) =
84.1145 + (case assy ya ((E, l@[L,R], a,v,S,b),ss) e1 of
84.1146 + NasNap (v, E) => assy ya ((E, l@[R], a,v,S,b),ss) e2
84.1147 + | NasApp ((E,_,_,v,_,_),ss) =>
84.1148 + assy ya ((E, l@[R], a,v,S,b),ss) e2
84.1149 + | ay => ay)
84.1150 +
84.1151 + | assy ya ((E,l,_,v,S,b),ss) (Const ("Script.Repeat",_) $ e $ a) =
84.1152 + assy ya ((E,(l@[L,R]),Some a,v,S,b),ss) e
84.1153 +
84.1154 + | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Repeat",_) $ e) =
84.1155 + assy ya ((E,(l@[R]),a,v,S,b),ss) e
84.1156 +
84.1157 +(*15.6.02: ass,app Or nochmals "uberlegen FIXXXME*)
84.1158 + | assy (y, Aundef) ((E,l,_,v,S,b),ss) (Const ("Script.Or",_) $e1 $ e2 $ a) =
84.1159 + (case assy (y, AssOnly) ((E,(l@[L,L,R]),Some a,v,S,b),ss) e1 of
84.1160 + NasNap (v, E) =>
84.1161 + (case assy (y, AssOnly) ((E,(l@[L,R]),Some a,v,S,b),ss) e2 of
84.1162 + NasNap (v, E) =>
84.1163 + (case assy (y, AssGen) ((E,(l@[L,L,R]),Some a,v,S,b),ss) e1 of
84.1164 + NasNap (v, E) =>
84.1165 + assy (y, AssGen) ((E, (l@[L,R]), Some a,v,S,b),ss) e2
84.1166 + | ay => ay)
84.1167 + | ay =>(ay))
84.1168 + | NasApp _ => raise error ("assy: FIXXXME ///must not return NasApp///")
84.1169 + | ay => (ay))
84.1170 +
84.1171 + | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Or",_) $e1 $ e2) =
84.1172 + (case assy ya ((E,(l@[L,R]),a,v,S,b),ss) e1 of
84.1173 + NasNap (v, E) =>
84.1174 + assy ya ((E,(l@[R]),a,v,S,b),ss) e2
84.1175 + | ay => (ay))
84.1176 +(* val ((m,_,pt,(p,p_),c)::ss) = [(m,EmptyMout,pt,p,[])];
84.1177 + val t = (term_of o the o (parse Isac.thy)) "Rewrite rmult_1 False";
84.1178 +
84.1179 + val (ap,(p,p_),c,ss) = (Aundef,p,[],[]);
84.1180 + assy (((thy',srls),d),ap) ((E,l,a,v,S,b), (m,EmptyMout,pt,(p,p_),c)::ss) t;
84.1181 +val ((((thy',sr),d),ap), (is as (E,l,a,v,S,b), (m,_,pt,(p,p_),c)::ss), t) =
84.1182 + ();
84.1183 + *)
84.1184 +
84.1185 + | assy (((thy',sr),d),ap) (is as (E,l,a,v,S,b), (m,_,pt,(p,p_),c)::ss) t =
84.1186 + ((*writeln("### assy, m = "^tac_2str m);
84.1187 + writeln("### assy, (p,p_) = "^pos'2str (p,p_));
84.1188 + writeln("### assy, is= ");
84.1189 + writeln(istate2str (ScrState is));*)
84.1190 + case handle_leaf "locate" thy' sr E a v t of
84.1191 + (a', Expr s) =>
84.1192 + ((*writeln("### assy: listexpr t= "^(term2str t));
84.1193 + writeln("### assy, E= "^(env2str E));
84.1194 + writeln("### assy, eval(..)= "^(term2str
84.1195 + (eval_listexpr_ (assoc_thy thy') sr
84.1196 + (subst_atomic (upd_env_opt E (a',v)) t))));*)
84.1197 + NasNap (eval_listexpr_ (assoc_thy thy') sr
84.1198 + (subst_atomic (upd_env_opt E (a',v)) t), E))
84.1199 + (* val (_,STac stac) = subst_stacexpr E a v t;
84.1200 + *)
84.1201 + | (a', STac stac) =>
84.1202 + let (*val _=writeln("### assy, stac = "^term2str stac);*)
84.1203 + val p' = case p_ of Frm => p | Res => lev_on p
84.1204 + | _ => raise error ("assy: call by "^
84.1205 + (pos'2str (p,p_)));
84.1206 + in case assod pt d m stac of
84.1207 + Ass (m,v') =>
84.1208 + let (*val _=writeln("### assy: Ass ("^tac_2str m^", "^
84.1209 + term2str v'^")");*)
84.1210 + val (p'',c',f',pt') = generate1 (assoc_thy thy') m
84.1211 + (ScrState (E,l,a',v',S,true)) (p',p_) pt;
84.1212 + in Assoc ((E,l,a',v',S,true), (m,f',pt',p'',c @ c')::ss) end
84.1213 + | AssWeak (m,v') =>
84.1214 + let (*val _=writeln("### assy: Ass Weak("^tac_2str m^", "^
84.1215 + term2str v'^")");*)
84.1216 + val (p'',c',f',pt') = generate1 (assoc_thy thy') m
84.1217 + (ScrState (E,l,a',v',S,false)) (p',p_) pt;
84.1218 + in Assoc ((E,l,a',v',S,false), (m,f',pt',p'',c @ c')::ss) end
84.1219 + | NotAss =>
84.1220 + ((*writeln("### assy, NotAss");*)
84.1221 + case ap of (*switch for Or: 1st AssOnly, 2nd AssGen*)
84.1222 + AssOnly => (NasNap (v, E))
84.1223 + | gen => (case applicable_in (p,p_) pt
84.1224 + (stac2tac pt (assoc_thy thy') stac) of
84.1225 + Appl m' =>
84.1226 + let val is = (E,l,a',tac_2res m',S,false(*FIXXXME*))
84.1227 + val (p'',c',f',pt') =
84.1228 + generate1 (assoc_thy thy') m' (ScrState is) (p',p_) pt;
84.1229 + in NasApp (is,(m,f',pt',p'',c @ c')::ss) end
84.1230 + | Notappl _ =>
84.1231 + (NasNap (v, E))
84.1232 + )
84.1233 + )
84.1234 + end);
84.1235 +(* (astep_up ((thy',scr,d),NasApp_) ((E,l,a,v,S,b),[(m,EmptyMout,pt,p,[])])) handle e => print_exn_G e;
84.1236 + *)
84.1237 +
84.1238 +
84.1239 +(* val (ys as (y,s,Script sc,d),(is as (E,l,a,v,S,b),ss),Const ("Let",_) $ _) =
84.1240 + (ys, ((E,up,a,v,S,b),ss), go up sc);
84.1241 + *)
84.1242 +fun ass_up (ys as (y,s,Script sc,d)) (is as (E,l,a,v,S,b),ss)
84.1243 + (Const ("Let",_) $ _) =
84.1244 + let (*val _= writeln("### ass_up1 Let$e: is=")
84.1245 + val _= writeln(istate2str (ScrState is))*)
84.1246 + val l = drop_last l; (*comes from e, goes to Abs*)
84.1247 + val (Const ("Let",_) $ e $ (Abs (i,T,body))) = go l sc;
84.1248 + val i = mk_Free (i, T);
84.1249 + val E = upd_env E (i, v);
84.1250 + (*val _=writeln("### ass_up2 Let$e: E="^(subst2str E));*)
84.1251 + in case assy (((y,s),d),Aundef) ((E, l@[R,D], a,v,S,b),ss) body of
84.1252 + Assoc iss => Assoc iss
84.1253 + | NasApp iss => astep_up ys iss
84.1254 + | NasNap (v, E) => astep_up ys ((E,l,a,v,S,b),ss) end
84.1255 +
84.1256 + | ass_up ys (iss as (is,_)) (Abs (_,_,_)) =
84.1257 + ((*writeln("### ass_up Abs: is=");
84.1258 + writeln(istate2str (ScrState is));*)
84.1259 + astep_up ys iss) (*TODO 5.9.00: env ?*)
84.1260 +
84.1261 + | ass_up ys (iss as (is,_)) (Const ("Let",_) $ e $ (Abs (i,T,b)))=
84.1262 + ((*writeln("### ass_up Let $ e $ Abs: is=");
84.1263 + writeln(istate2str (ScrState is));*)
84.1264 + astep_up ys iss) (*TODO 5.9.00: env ?*)
84.1265 +
84.1266 + (* val (ysa, iss, (Const ("Script.Seq",_) $ _ $ _ $ _)) =
84.1267 + (ys, ((E,up,a,v,S,b),ss), (go up sc));
84.1268 + *)
84.1269 + | ass_up ysa iss (Const ("Script.Seq",_) $ _ $ _ $ _) =
84.1270 + astep_up ysa iss (*all has been done in (*2*) below*)
84.1271 +
84.1272 + | ass_up ysa iss (Const ("Script.Seq",_) $ _ $ _) =
84.1273 + (* val (ysa, iss, (Const ("Script.Seq",_) $ _ $ _)) =
84.1274 + (ys, ((E,up,a,v,S,b),ss), (go up sc));
84.1275 + *)
84.1276 + astep_up ysa iss (*2*: comes from e2*)
84.1277 +
84.1278 + | ass_up (ysa as (y,s,Script sc,d)) (is as (E,l,a,v,S,b),ss)
84.1279 + (Const ("Script.Seq",_) $ _ ) = (*2*: comes from e1, goes to e2*)
84.1280 + (* val ((ysa as (y,s,Script sc,d)), (is as (E,l,a,v,S,b),ss),
84.1281 + (Const ("Script.Seq",_) $ _ )) =
84.1282 + (ys, ((E,up,a,v,S,b),ss), (go up sc));
84.1283 + *)
84.1284 + let val up = drop_last l;
84.1285 + val Const ("Script.Seq",_) $ _ $ e2 = go up sc
84.1286 + (*val _= writeln("### ass_up Seq$e: is=")
84.1287 + val _= writeln(istate2str (ScrState is))*)
84.1288 + in case assy (((y,s),d),Aundef) ((E, up@[R], a,v,S,b),ss) e2 of
84.1289 + NasNap (v,E) => astep_up ysa ((E,up,a,v,S,b),ss)
84.1290 + | NasApp iss => astep_up ysa iss
84.1291 + | ay => ay end
84.1292 +
84.1293 + (* val (ysa, iss, (Const ("Script.Try",_) $ e $ _)) =
84.1294 + (ys, ((E,up,a,v,S,b),ss), (go up sc));
84.1295 + *)
84.1296 + | ass_up ysa iss (Const ("Script.Try",_) $ e $ _) =
84.1297 + astep_up ysa iss
84.1298 +
84.1299 + (* val (ysa, iss, (Const ("Script.Try",_) $ e)) =
84.1300 + (ys, ((E,up,a,v,S,b),ss), (go up sc));
84.1301 + *)
84.1302 + | ass_up ysa iss (Const ("Script.Try",_) $ e) =
84.1303 + ((*writeln("### ass_up Try $ e");*)
84.1304 + astep_up ysa iss)
84.1305 +
84.1306 + | ass_up (ys as (y,s,_,d)) ((E,l,_,v,S,b),ss)
84.1307 + (*(Const ("Script.While",_) $ c $ e $ a) = WN050930 blind fix*)
84.1308 + (t as Const ("Script.While",_) $ c $ e $ a) =
84.1309 + ((*writeln("### ass_up: While c= "^
84.1310 + (term2str (subst_atomic (upd_env E (a,v)) c)));*)
84.1311 + if eval_true_ y s (subst_atomic (upd_env E (a,v)) c)
84.1312 + then (case assy (((y,s),d),Aundef) ((E, l@[L,R], Some a,v,S,b),ss) e of
84.1313 + NasNap (v,E') => astep_up ys ((E',l, Some a,v,S,b),ss)
84.1314 + | NasApp ((E',l,a,v,S,b),ss) =>
84.1315 + ass_up ys ((E',l,a,v,S,b),ss) t (*WN050930 't' was not assigned*)
84.1316 + | ay => ay)
84.1317 + else astep_up ys ((E,l, Some a,v,S,b),ss)
84.1318 + )
84.1319 +
84.1320 + | ass_up (ys as (y,s,_,d)) ((E,l,a,v,S,b),ss)
84.1321 + (*(Const ("Script.While",_) $ c $ e) = WN050930 blind fix*)
84.1322 + (t as Const ("Script.While",_) $ c $ e) =
84.1323 + if eval_true_ y s (subst_atomic (upd_env_opt E (a,v)) c)
84.1324 + then (case assy (((y,s),d),Aundef) ((E, l@[R], a,v,S,b),ss) e of
84.1325 + NasNap (v,E') => astep_up ys ((E',l, a,v,S,b),ss)
84.1326 + | NasApp ((E',l,a,v,S,b),ss) =>
84.1327 + ass_up ys ((E',l,a,v,S,b),ss) t (*WN050930 't' was not assigned*)
84.1328 + | ay => ay)
84.1329 + else astep_up ys ((E,l, a,v,S,b),ss)
84.1330 +
84.1331 + | ass_up y iss (Const ("If",_) $ _ $ _ $ _) = astep_up y iss
84.1332 +
84.1333 + | ass_up (ys as (y,s,_,d)) ((E,l,_,v,S,b),ss)
84.1334 + (t as Const ("Script.Repeat",_) $ e $ a) =
84.1335 + (case assy (((y,s),d), Aundef) ((E, (l@[L,R]), Some a,v,S,b),ss) e of
84.1336 + NasNap (v,E') => astep_up ys ((E',l, Some a,v,S,b),ss)
84.1337 + | NasApp ((E',l,a,v,S,b),ss) =>
84.1338 + ass_up ys ((E',l,a,v,S,b),ss) t
84.1339 + | ay => ay)
84.1340 +
84.1341 + | ass_up (ys as (y,s,_,d)) (is as ((E,l,a,v,S,b),ss))
84.1342 + (t as Const ("Script.Repeat",_) $ e) =
84.1343 + (case assy (((y,s),d), Aundef) ((E, (l@[R]), a,v,S,b),ss) e of
84.1344 + NasNap (v', E') => astep_up ys ((E',l,a,v',S,b),ss)
84.1345 + | NasApp ((E',l,a,v',S,bb),ss) =>
84.1346 + ass_up ys ((E',l,a,v',S,b),ss) t
84.1347 + | ay => ay)
84.1348 +
84.1349 + | ass_up y iss (Const ("Script.Or",_) $ _ $ _ $ _) = astep_up y iss
84.1350 +
84.1351 + | ass_up y iss (Const ("Script.Or",_) $ _ $ _) = astep_up y iss
84.1352 +
84.1353 + | ass_up y ((E,l,a,v,S,b),ss) (Const ("Script.Or",_) $ _ ) =
84.1354 + astep_up y ((E, (drop_last l), a,v,S,b),ss)
84.1355 +
84.1356 + | ass_up y iss t =
84.1357 + raise error ("ass_up not impl for t= "^(term2str t))
84.1358 +(* 9.6.03
84.1359 + val (ys as (_,_,Script sc,_), ss) =
84.1360 + ((thy',srls,scr,d), [(m,EmptyMout,pt,p,[])]:step list);
84.1361 + astep_up ys ((E,l,a,v,S,b),ss);
84.1362 + val ((ys as (_,_,Script sc,_)), ((E,l,a,v,S,b),ss)) =
84.1363 + (ysa, iss);
84.1364 + val ((ys as (_,_,Script sc,_)), ((E,l,a,v,S,b),ss)) =
84.1365 + ((thy',srls,scr,d), ((E,l,a,v,S,b), [(m,EmptyMout,pt,p,[])]));
84.1366 + *)
84.1367 +and astep_up (ys as (_,_,Script sc,_)) ((E,l,a,v,S,b),ss) =
84.1368 + if 1 < length l
84.1369 + then
84.1370 + let val up = drop_last l;
84.1371 + (*val _= writeln("### astep_up: E= "^env2str E);*)
84.1372 + in ass_up ys ((E,up,a,v,S,b),ss) (go up sc) end
84.1373 + else (NasNap (v, E))
84.1374 +;
84.1375 +
84.1376 +
84.1377 +
84.1378 +
84.1379 +
84.1380 +(* use"ME/script.sml";
84.1381 + use"script.sml";
84.1382 + term2str (go up sc);
84.1383 +
84.1384 + *)
84.1385 +
84.1386 +(*check if there are tacs for rewriting only*)
84.1387 +fun rew_only ([]:step list) = true
84.1388 + | rew_only (((Rewrite' _ ,_,_,_,_))::ss) = rew_only ss
84.1389 + | rew_only (((Rewrite_Inst' _ ,_,_,_,_))::ss) = rew_only ss
84.1390 + | rew_only (((Rewrite_Set' _ ,_,_,_,_))::ss) = rew_only ss
84.1391 + | rew_only (((Rewrite_Set_Inst' _ ,_,_,_,_))::ss) = rew_only ss
84.1392 + | rew_only (((Calculate' _ ,_,_,_,_))::ss) = rew_only ss
84.1393 + | rew_only (((Begin_Trans' _ ,_,_,_,_))::ss) = rew_only ss
84.1394 + | rew_only (((End_Trans' _ ,_,_,_,_))::ss) = rew_only ss
84.1395 + | rew_only _ = false;
84.1396 +
84.1397 +
84.1398 +datatype locate =
84.1399 + Steps of istate (*producing hd of step list (which was latest)
84.1400 + for next_tac, for reporting Safe|Unsafe to DG*)
84.1401 + * step (*(scrstate producing this step is in ptree !)*)
84.1402 + list (*locate_gen may produce intermediate steps*)
84.1403 +| NotLocatable; (*no (m Ass m') or (m AssWeak m') found*)
84.1404 +
84.1405 +
84.1406 +
84.1407 +(* locate_gen tries to locate an input tac m in the script.
84.1408 + pursuing this goal the script is executed until an (m' equiv m) is found,
84.1409 + or the end of the script
84.1410 +args
84.1411 + m : input by the user, already checked by applicable_in,
84.1412 + (to be searched within Or; and _not_ an m doing the step on ptree !)
84.1413 + p,pt: (incl ets) at the time of input
84.1414 + scr : the script
84.1415 + d : canonical simplifier for locating Take, Substitute, Subproblems etc.
84.1416 + ets : ets at the time of input
84.1417 + l : the location (in scr) of the stac which generated the current formula
84.1418 +returns
84.1419 + Steps: pt,p (incl. ets) with m done
84.1420 + pos' list of proofobjs cut (from generate)
84.1421 + safe: implied from last proofobj
84.1422 + ets:
84.1423 + ///ToDo : ets contains a list of tacs to be done before m can be done
84.1424 + NOT IMPL. -- "error: do other step before"
84.1425 + NotLocatable: thus generate_hard
84.1426 +*)
84.1427 +(* val (Rewrite'(_,ro,er,pa,(id,str),f,_), p, Rfuns {locate_rule=lo,...},
84.1428 + RrlsState (_,f'',rss,rts)) = (m, (p,p_), sc, is);
84.1429 + *)
84.1430 +fun locate_gen (thy',_) (Rewrite'(_,ro,er,pa,(id,str),f,_)) (pt,p)
84.1431 + (Rfuns {locate_rule=lo,...}, d) (RrlsState (_,f'',rss,rts)) =
84.1432 + (case lo rss f (Thm (id, mk_thm (assoc_thy thy') str)) of
84.1433 + [] => NotLocatable
84.1434 + | rts' =>
84.1435 + Steps (rts2steps [] ((pt,p),(f,f'',rss,rts),(thy',ro,er,pa)) rts'))
84.1436 +(* val p as(p',p_)=(p,p_);val scr as Script(h $ body)=sc;val (E,l,a,v,S,bb)=is;
84.1437 + locate_gen (thy':theory') (m:tac_) ((pt,p):ptree * pos')
84.1438 + (scr,d) (E,l,a,v,S,bb);
84.1439 + 9.6.03
84.1440 + val ts = (thy',srls);
84.1441 + val p = (p,p_);
84.1442 + val (scr as Script (h $ body)) = (sc);
84.1443 + val ScrState (E,l,a,v,S,b) = (is);
84.1444 +
84.1445 + val (ts as (thy',srls), m, (pt,p),
84.1446 + (scr as Script (h $ body),d), (ScrState (E,l,a,v,S,b))) =
84.1447 + ((thy',srls), m, (pt,(p,p_)), (sc,d), is);
84.1448 + locate_gen (thy',srls) m (pt,p) (Script(h $ body),d)(ScrState(E,l,a,v,S,b));
84.1449 +
84.1450 + val (ts as (thy',srls), m, (pt,p),
84.1451 + (scr as Script (h $ body),d), (ScrState (E,l,a,v,S,b))) =
84.1452 + ((thy',srls), m', (pt,(lev_on p,Frm)), (sc,d), is');
84.1453 +
84.1454 + val (ts as (thy',srls), m, (pt,p),
84.1455 + (scr as Script (h $ body),d), (ScrState (E,l,a,v,S,b))) =
84.1456 + ((thy',srls), m', (pt,(p, Res)), (sc,d), is');
84.1457 +
84.1458 + val (ts as (thy',srls), m, (pt,p),
84.1459 + (scr as Script (h $ body),d), (ScrState (E,l,a,v,S,b))) =
84.1460 + ((thy',srls), m, (pt,(p,p_)), (sc,d), is);
84.1461 + *)
84.1462 + | locate_gen (ts as (thy',srls)) (m:tac_) ((pt,p):ptree * pos')
84.1463 + (scr as Script (h $ body),d) (ScrState (E,l,a,v,S,b)) =
84.1464 + let (*val _= writeln("### locate_gen-----------------: is=");
84.1465 + val _= writeln( istate2str (ScrState (E,l,a,v,S,b)));
84.1466 + val _= writeln("### locate_gen: l= "^loc_2str l^", p= "^pos'2str p)*)
84.1467 + val thy = assoc_thy thy';
84.1468 + in case if l=[] orelse ((*init.in solve..Apply_Method...*)
84.1469 + (last_elem o fst) p = 0 andalso snd p = Res)
84.1470 + then (assy ((ts,d),Aundef) ((E,[R],a,v,S,b),
84.1471 + [(m,EmptyMout,pt,p,[])]) body)
84.1472 +(* val Assoc (iss as (is as (_,_,_,_,_,bb), ss as ((m',f',pt',p',c')::_))) =
84.1473 + (astep_up (thy',srls,scr,d) ((E,l,a,v,S,b),[(m,EmptyMout,pt,p,[])]));
84.1474 + (assy ((ts,d),Aundef) ((E,[R],a,v,S,b),[(m,EmptyMout,pt,p,[])]) body);
84.1475 + *)
84.1476 + else (astep_up (thy',srls,scr,d) ((E,l,a,v,S,b),
84.1477 + [(m,EmptyMout,pt,p,[])]) ) of
84.1478 + Assoc (iss as (is as (_,_,_,_,_,bb), ss as ((m',f',pt',p',c')::_))) =>
84.1479 +(* val Assoc (iss as (is as (_,_,_,_,_,bb), ss as ((m',f',pt',p',c')::_))) =
84.1480 + (astep_up (thy',srls,scr,d) ((E,l,a,v,S,b),
84.1481 + [(m,EmptyMout,pt,p,[])]) );
84.1482 + *)
84.1483 + ((*writeln("### locate_gen Assoc: p'="^(pos'2str p'));*)
84.1484 + if bb then Steps (ScrState is, ss)
84.1485 + else if rew_only ss (*andalso 'not bb'= associated weakly*)
84.1486 + then let val (po,p_) = p
84.1487 + val po' = case p_ of Frm => po | Res => lev_on po
84.1488 + (*WN.12.03: noticed, that pos is also updated in assy !?!
84.1489 + instead take p' from Assoc ?????????????????????????????*)
84.1490 + val (p'',c'',f'',pt'') =
84.1491 + generate1 thy m (ScrState is) (po',p_) pt;
84.1492 + (*val _=writeln("### locate_gen, aft g1: p''="^(pos'2str p''));*)
84.1493 + (*drop the intermediate steps !*)
84.1494 + in Steps (ScrState is, [(m, f'',pt'',p'',c'')]) end
84.1495 + else Steps (ScrState is, ss))
84.1496 +
84.1497 + | NasApp _ (*[((E,l,a,v,S,bb),(m',f',pt',p',c'))] =>
84.1498 + raise error ("locate_gen: should not have got NasApp, ets =")*)
84.1499 + => NotLocatable
84.1500 + | NasNap (_,_) =>
84.1501 + if l=[] then NotLocatable
84.1502 + else (*scan from begin of script for rew_only*)
84.1503 + (case assy ((ts,d),Aundef) ((E,[R],a,v,Unsafe,b),
84.1504 + [(m,EmptyMout,pt,p,[])]) body of
84.1505 + Assoc (iss as (is as (_,_,_,_,_,bb),
84.1506 + ss as ((m',f',pt',p',c')::_))) =>
84.1507 + ((*writeln"4### locate_gen Assoc after Fini";*)
84.1508 + if rew_only ss
84.1509 + then let val(p'',c'',f'',pt'') =
84.1510 + generate1 thy m (ScrState is) p' pt;
84.1511 + (*drop the intermediate steps !*)
84.1512 + in Steps (ScrState is, [(m, f'',pt'',p'',c'')]) end
84.1513 + else NotLocatable)
84.1514 + | _ => ((*writeln ("#### locate_gen: after Fini");*)
84.1515 + NotLocatable))
84.1516 + end
84.1517 + | locate_gen _ m _ (sc,_) is =
84.1518 + raise error ("locate_gen: wrong arguments,\n tac= "^(tac_2str m)^
84.1519 + ",\n scr= "^(scr2str sc)^",\n istate= "^(istate2str is));
84.1520 +
84.1521 +
84.1522 +
84.1523 +(** find the next stactic in a script **)
84.1524 +
84.1525 +datatype appy = (*ExprVal in the sense of denotational semantics*)
84.1526 + Appy of (*applicable stac found, search stalled*)
84.1527 + tac_ * (*tac_ associated (fun assod) with stac*)
84.1528 + scrstate (*after determination of stac WN.18.8.03*)
84.1529 + | Napp of (*stac found was not applicable;
84.1530 + this mode may become Skip in Repeat, Try and Or*)
84.1531 + env (*stack*) (*popped while nxt_up*)
84.1532 + | Skip of (*for restart after Appy, for leaving iterations,
84.1533 + for passing the value of scriptexpressions,
84.1534 + and for finishing the script successfully*)
84.1535 + term * env (*stack*);
84.1536 +
84.1537 +(*appy, nxt_up, nstep_up scanning for next_tac.
84.1538 + search is clearly separated into (1)-(2):
84.1539 + (1) appy is recursive descent;
84.1540 + (2) nxt_up resumes interpretation at a location somewhere in the script;
84.1541 + nstep_up does only get to the parentnode of the scriptexpr.
84.1542 + consequence:
84.1543 + * call of (2) means _always_ that in this branch below
84.1544 + there was an applicable stac (Repeat, Or e1, ...)
84.1545 +*)
84.1546 +
84.1547 +
84.1548 +datatype appy_ = (*as argument in nxt_up, nstep_up, from appy*)
84.1549 + (* Appy is only (final) returnvalue, not argument during search
84.1550 + |*) Napp_ (*ev. detects 'script is not appropriate for this example'*)
84.1551 + | Skip_; (*detects 'script successfully finished'
84.1552 + also used as init-value for resuming; this works,
84.1553 + because 'nxt_up Or e1' treats as Appy*)
84.1554 +
84.1555 +fun appy thy ptp E l
84.1556 + (t as Const ("Let",_) $ e $ (Abs (i,T,b))) a v =
84.1557 +(* val (thy, ptp, E, l, t as Const ("Let",_) $ e $ (Abs (i,T,b)),a, v)=
84.1558 + (thy, ptp, E, up@[R,D], body, a, v);
84.1559 + appy thy ptp E l t a v;
84.1560 + *)
84.1561 + ((*writeln("### appy Let$e$Abs: is=");
84.1562 + writeln(istate2str (ScrState (E,l,a,v,Sundef,false)));*)
84.1563 + case appy thy ptp E (l@[L,R]) e a v of
84.1564 + Skip (res, E) =>
84.1565 + let (*val _= writeln("### appy Let "^(term2str t));
84.1566 + val _= writeln("### appy Let: Skip res ="^(term2str res));*)
84.1567 + (*val (i',b') = variant_abs (i,T,b); WN.15.5.03
84.1568 + val i = mk_Free(i',T); WN.15.5.03 *)
84.1569 + val E' = upd_env E (Free (i,T), res);
84.1570 + in appy thy ptp E' (l@[R,D]) b a v end
84.1571 + | ay => ay)
84.1572 +
84.1573 + | appy (thy as (th,sr)) ptp E l
84.1574 + (t as Const ("Script.While"(*1*),_) $ c $ e $ a) _ v = (*ohne n. 28.9.00*)
84.1575 + ((*writeln("### appy While $ c $ e $ a, upd_env= "^
84.1576 + (subst2str (upd_env E (a,v))));*)
84.1577 + if eval_true_ th sr (subst_atomic (upd_env E (a,v)) c)
84.1578 + then appy thy ptp E (l@[L,R]) e (Some a) v
84.1579 + else Skip (v, E))
84.1580 +
84.1581 + | appy (thy as (th,sr)) ptp E l
84.1582 + (t as Const ("Script.While"(*2*),_) $ c $ e) a v =(*ohne nachdenken 28.9.00*)
84.1583 + ((*writeln("### appy While $ c $ e, upd_env= "^
84.1584 + (subst2str (upd_env_opt E (a,v))));*)
84.1585 + if eval_true_ th sr (subst_atomic (upd_env_opt E (a,v)) c)
84.1586 + then appy thy ptp E (l@[R]) e a v
84.1587 + else Skip (v, E))
84.1588 +
84.1589 + | appy (thy as (th,sr)) ptp E l (t as Const ("If",_) $ c $ e1 $ e2) a v =
84.1590 + ((*writeln("### appy If: t= "^(term2str t));
84.1591 + writeln("### appy If: c= "^(term2str(subst_atomic(upd_env_opt E(a,v))c)));
84.1592 + writeln("### appy If: thy= "^(fst thy));*)
84.1593 + if eval_true_ th sr (subst_atomic (upd_env_opt E (a,v)) c)
84.1594 + then ((*writeln("### appy If: true");*)appy thy ptp E (l@[L,R]) e1 a v)
84.1595 + else ((*writeln("### appy If: false");*)appy thy ptp E (l@[ R]) e2 a v))
84.1596 +(* val (thy, ptp, E, l, (Const ("Script.Repeat",_) $ e $ a), _, v) =
84.1597 + (thy, ptp, E, (l@[R]), e, a, v);
84.1598 + *)
84.1599 + | appy thy ptp E (*env*) l
84.1600 + (Const ("Script.Repeat"(*1*),_) $ e $ a) _ v =
84.1601 + ((*writeln("### appy Repeat a: ");*)
84.1602 + appy thy ptp E (*env*) (l@[L,R]) e (Some a) v)
84.1603 +(* val (thy, ptp, E, l, (Const ("Script.Repeat",_) $ e), _, v) =
84.1604 + (thy, ptp, E, (l@[R]), e, a, v);
84.1605 + *)
84.1606 + | appy thy ptp E (*env*) l
84.1607 + (Const ("Script.Repeat"(*2*),_) $ e) a v =
84.1608 + ((*writeln("3### appy Repeat: a= "^
84.1609 + (Sign.string_of_term (sign_of (assoc_thy thy)) a));*)
84.1610 + appy thy ptp E (*env*) (l@[R]) e a v)
84.1611 +(* val (thy, ptp, E, l, (t as Const ("Script.Try",_) $ e $ a), _, v)=
84.1612 + (thy, ptp, E, (l@[R]), e2, a, v);
84.1613 + *)
84.1614 + | appy thy ptp E l
84.1615 + (t as Const ("Script.Try",_) $ e $ a) _ v =
84.1616 + (case appy thy ptp E (l@[L,R]) e (Some a) v of
84.1617 + Napp E => ((*writeln("### appy Try "^
84.1618 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));*)
84.1619 + Skip (v, E))
84.1620 + | ay => ay)
84.1621 +(* val (thy, ptp, E, l, (t as Const ("Script.Try",_) $ e), _, v)=
84.1622 + (thy, ptp, E, (l@[R]), e2, a, v);
84.1623 + val (thy, ptp, E, l, (t as Const ("Script.Try",_) $ e), _, v)=
84.1624 + (thy, ptp, E, (l@[L,R]), e1, a, v);
84.1625 + *)
84.1626 + | appy thy ptp E l
84.1627 + (t as Const ("Script.Try",_) $ e) a v =
84.1628 + (case appy thy ptp E (l@[R]) e a v of
84.1629 + Napp E => ((*writeln("### appy Try "^
84.1630 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));*)
84.1631 + Skip (v, E))
84.1632 + | ay => ay)
84.1633 +
84.1634 +
84.1635 + | appy thy ptp E l
84.1636 + (Const ("Script.Or"(*1*),_) $e1 $ e2 $ a) _ v =
84.1637 + (case appy thy ptp E (l@[L,L,R]) e1 (Some a) v of
84.1638 + Appy lme => Appy lme
84.1639 + | _ => appy thy ptp E (*env*) (l@[L,R]) e2 (Some a) v)
84.1640 +
84.1641 + | appy thy ptp E l
84.1642 + (Const ("Script.Or"(*2*),_) $e1 $ e2) a v =
84.1643 + (case appy thy ptp E (l@[L,R]) e1 a v of
84.1644 + Appy lme => Appy lme
84.1645 + | _ => appy thy ptp E (l@[R]) e2 a v)
84.1646 +
84.1647 +(* val (thy, ptp, E, l, (Const ("Script.Seq",_) $ e1 $ e2 $ a), _, v)=
84.1648 + (thy, ptp, E,(up@[R]),e2, a, v);
84.1649 + val (thy, ptp, E, l, (Const ("Script.Seq",_) $ e1 $ e2 $ a), _, v)=
84.1650 + (thy, ptp, E,(up@[R,D]),body, a, v);
84.1651 + *)
84.1652 + | appy thy ptp E l
84.1653 + (Const ("Script.Seq"(*1*),_) $ e1 $ e2 $ a) _ v =
84.1654 + ((*writeln("### appy Seq $ e1 $ e2 $ a, upd_env= "^
84.1655 + (subst2str (upd_env E (a,v))));*)
84.1656 + case appy thy ptp E (l@[L,L,R]) e1 (Some a) v of
84.1657 + Skip (v,E) => appy thy ptp E (l@[L,R]) e2 (Some a) v
84.1658 + | ay => ay)
84.1659 +
84.1660 +(* val (thy, ptp, E, l, (Const ("Script.Seq",_) $ e1 $ e2), _, v)=
84.1661 + (thy, ptp, E,(up@[R]),e2, a, v);
84.1662 + val (thy, ptp, E, l, (Const ("Script.Seq",_) $ e1 $ e2), _, v)=
84.1663 + (thy, ptp, E,(l@[R]), e2, a, v);
84.1664 + val (thy, ptp, E, l, (Const ("Script.Seq",_) $ e1 $ e2), _, v)=
84.1665 + (thy, ptp, E,(up@[R,D]),body, a, v);
84.1666 + *)
84.1667 + | appy thy ptp E l
84.1668 + (Const ("Script.Seq",_) $ e1 $ e2) a v =
84.1669 + (case appy thy ptp E (l@[L,R]) e1 a v of
84.1670 + Skip (v,E) => appy thy ptp E (l@[R]) e2 a v
84.1671 + | ay => ay)
84.1672 +
84.1673 + (*.a leaf has been found*)
84.1674 + | appy (thy as (th,sr)) (pt, p) E l t a v =
84.1675 +(* val (thy as (th,sr),(pt, p),E, l, t, a, v) =
84.1676 + (thy, ptp, E, up@[R,D], body, a, v);
84.1677 + val (thy as (th,sr),(pt, p),E, l, t, a, v) =
84.1678 + (thy, ptp, E, l@[L,R], e, a, v);
84.1679 + val (thy as (th,sr),(pt, p),E, l, t, a, v) =
84.1680 + (thy, ptp, E,(l@[R]), e, a, v);
84.1681 + *)
84.1682 + (case handle_leaf "next " th sr E a v t of
84.1683 +(* val (a', Expr s) = handle_leaf "next " th sr E a v t;
84.1684 + *)
84.1685 + (a', Expr s) => Skip (s, E)
84.1686 +(* val (a', STac stac) = handle_leaf "next " th sr E a v t;
84.1687 + *)
84.1688 + | (a', STac stac) =>
84.1689 + let
84.1690 + (*val _= writeln("### appy t, vor stac2tac_ is=");
84.1691 + val _= writeln(istate2str (ScrState (E,l,a',v,Sundef,false)));*)
84.1692 + val (m,m') = stac2tac_ pt (assoc_thy th) stac
84.1693 + in case m of
84.1694 + Subproblem _ => Appy (m', (E,l,a',tac_2res m',Sundef,false))
84.1695 + | _ => (case applicable_in p pt m of
84.1696 +(* val Appl m' = applicable_in p pt m;
84.1697 + *)
84.1698 + Appl m' =>
84.1699 + ((*writeln("### appy: Appy");*)
84.1700 + Appy (m', (E,l,a',tac_2res m',Sundef,false)))
84.1701 + | _ => ((*writeln("### appy: Napp");*)Napp E))
84.1702 + end);
84.1703 +
84.1704 +
84.1705 +(* val (scr as Script sc, l, t as Const ("Let",_) $ _) =
84.1706 + (Script sc, up, go up sc);
84.1707 + nxt_up thy ptp (Script sc) E l ay t a v;
84.1708 +
84.1709 + val (thy,ptp,scr as (Script sc),E,l, ay, t as Const ("Let",_) $ _, a, v)=
84.1710 + (thy,ptp,Script sc, E,up,ay, go up sc, a, v);
84.1711 + nxt_up thy ptp scr E l ay t a v;
84.1712 + *)
84.1713 +fun nxt_up thy ptp (scr as (Script sc)) E l ay
84.1714 + (t as Const ("Let",_) $ _) a v = (*comes from let=...*)
84.1715 + ((*writeln("### nxt_up1 Let$e: is=");
84.1716 + writeln(istate2str (ScrState (E,l,a,v,Sundef,false)));*)
84.1717 + if ay = Napp_
84.1718 + then nstep_up thy ptp scr E (drop_last l) Napp_ a v
84.1719 + else (*Skip_*)
84.1720 + let val up = drop_last l;
84.1721 + val (Const ("Let",_) $ e $ (Abs (i,T,body))) = go up sc;
84.1722 + val i = mk_Free (i, T);
84.1723 + val E = upd_env E (i, v);
84.1724 + (*val _= writeln("### nxt_up2 Let$e: is=");
84.1725 + val _= writeln(istate2str (ScrState (E,l,a,v,Sundef,false)));*)
84.1726 + in case appy thy ptp (E) (up@[R,D]) body a v of
84.1727 + Appy lre => Appy lre
84.1728 + | Napp E => nstep_up thy ptp scr E up Napp_ a v
84.1729 + | Skip (v,E) => nstep_up thy ptp scr E up Skip_ a v end)
84.1730 +
84.1731 + | nxt_up thy ptp scr E l ay
84.1732 + (t as Abs (_,_,_)) a v =
84.1733 + ((*writeln("### nxt_up Abs: "^
84.1734 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));*)
84.1735 + nstep_up thy ptp scr E (*enr*) l ay a v)
84.1736 +
84.1737 + | nxt_up thy ptp scr E l ay
84.1738 + (t as Const ("Let",_) $ e $ (Abs (i,T,b))) a v =
84.1739 + ((*writeln("### nxt_up Let$e$Abs: is=");
84.1740 + writeln(istate2str (ScrState (E,l,a,v,Sundef,false)));*)
84.1741 + (*writeln("### nxt_up Let e Abs: "^
84.1742 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));*)
84.1743 + nstep_up thy ptp scr (*upd_env*) E (*a,v)*)
84.1744 + (*eno,upd_env env (iar,res),iar,res,saf*) l ay a v)
84.1745 +
84.1746 + (*no appy_: never causes Napp -> Helpless*)
84.1747 + | nxt_up (thy as (th,sr)) ptp scr E l _
84.1748 + (Const ("Script.While"(*1*),_) $ c $ e $ _) a v =
84.1749 + if eval_true_ th sr (subst_atomic (upd_env_opt E (a,v)) c)
84.1750 + then case appy thy ptp E (l@[L,R]) e a v of
84.1751 + Appy lr => Appy lr
84.1752 + | Napp E => nstep_up thy ptp scr E l Skip_ a v
84.1753 + | Skip (v,E) => nstep_up thy ptp scr E l Skip_ a v
84.1754 + else nstep_up thy ptp scr E l Skip_ a v
84.1755 +
84.1756 + (*no appy_: never causes Napp - Helpless*)
84.1757 + | nxt_up (thy as (th,sr)) ptp scr E l _
84.1758 + (Const ("Script.While"(*2*),_) $ c $ e) a v =
84.1759 + if eval_true_ th sr (subst_atomic (upd_env_opt E (a,v)) c)
84.1760 + then case appy thy ptp E (l@[R]) e a v of
84.1761 + Appy lr => Appy lr
84.1762 + | Napp E => nstep_up thy ptp scr E l Skip_ a v
84.1763 + | Skip (v,E) => nstep_up thy ptp scr E l Skip_ a v
84.1764 + else nstep_up thy ptp scr E l Skip_ a v
84.1765 +
84.1766 +(* val (scr, l) = (Script sc, up);
84.1767 + *)
84.1768 + | nxt_up thy ptp scr E l ay (Const ("If",_) $ _ $ _ $ _) a v =
84.1769 + nstep_up thy ptp scr E l ay a v
84.1770 +
84.1771 + | nxt_up thy ptp scr E l _ (*no appy_: there was already a stac below*)
84.1772 + (Const ("Script.Repeat"(*1*),T) $ e $ _) a v =
84.1773 + (case appy thy ptp (*upd_env*) E (*a,v)*) ((l@[L,R]):loc_) e a v of
84.1774 + Appy lr => Appy lr
84.1775 + | Napp E => ((*writeln("### nxt_up Repeat a: ");*)
84.1776 + nstep_up thy ptp scr E l Skip_ a v)
84.1777 + | Skip (v,E) => ((*writeln("### nxt_up Repeat: Skip res ="^
84.1778 + (Sign.string_of_term(sign_of (assoc_thy thy)) res'));*)
84.1779 + nstep_up thy ptp scr E l Skip_ a v))
84.1780 +
84.1781 + | nxt_up thy ptp scr E l _ (*no appy_: there was already a stac below*)
84.1782 + (Const ("Script.Repeat"(*2*),T) $ e) a v =
84.1783 + (case appy thy ptp (*upd_env*) E (*a,v)*) ((l@[R]):loc_) e a v of
84.1784 + Appy lr => Appy lr
84.1785 + | Napp E => ((*writeln("### nxt_up Repeat a: ");*)
84.1786 + nstep_up thy ptp scr E l Skip_ a v)
84.1787 + | Skip (v,E) => ((*writeln("### nxt_up Repeat: Skip res ="^
84.1788 + (Sign.string_of_term(sign_of (assoc_thy thy)) res'));*)
84.1789 + nstep_up thy ptp scr E l Skip_ a v))
84.1790 +(* val (thy, ptp, scr, E, l, _,(t as Const ("Script.Try",_) $ e $ _), a, v) =
84.1791 + (thy, ptp, (Script sc),
84.1792 + E, up, ay,(go up sc), a, v);
84.1793 + *)
84.1794 + | nxt_up thy ptp scr E l _ (*makes Napp to Skip*)
84.1795 + (t as Const ("Script.Try",_) $ e $ _) a v =
84.1796 + ((*writeln("### nxt_up Try "^
84.1797 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));*)
84.1798 + nstep_up thy ptp scr E l Skip_ a v )
84.1799 +(* val (thy, ptp, scr, E, l, _,(t as Const ("Script.Try",_) $ e), a, v) =
84.1800 + (thy, ptp, (Script sc),
84.1801 + E, up, ay,(go up sc), a, v);
84.1802 + *)
84.1803 + | nxt_up thy ptp scr E l _ (*makes Napp to Skip*)
84.1804 + (t as Const ("Script.Try"(*2*),_) $ e) a v =
84.1805 + ((*writeln("### nxt_up Try "^
84.1806 + (Sign.string_of_term (sign_of (assoc_thy thy)) t));*)
84.1807 + nstep_up thy ptp scr E l Skip_ a v)
84.1808 +
84.1809 +
84.1810 + | nxt_up thy ptp scr E l ay
84.1811 + (Const ("Script.Or",_) $ _ $ _ $ _) a v = nstep_up thy ptp scr E l ay a v
84.1812 +
84.1813 + | nxt_up thy ptp scr E l ay
84.1814 + (Const ("Script.Or",_) $ _ $ _) a v = nstep_up thy ptp scr E l ay a v
84.1815 +
84.1816 + | nxt_up thy ptp scr E l ay
84.1817 + (Const ("Script.Or",_) $ _ ) a v =
84.1818 + nstep_up thy ptp scr E (drop_last l) ay a v
84.1819 +(* val (thy, ptp, scr, E, l, ay, (Const ("Script.Seq",_) $ _ $ _ $ _), a, v) =
84.1820 + (thy, ptp, (Script sc),
84.1821 + E, up, ay,(go up sc), a, v);
84.1822 + *)
84.1823 + | nxt_up thy ptp scr E l ay (*all has been done in (*2*) below*)
84.1824 + (Const ("Script.Seq"(*1*),_) $ _ $ _ $ _) a v =
84.1825 + nstep_up thy ptp scr E l ay a v
84.1826 +(* val (thy, ptp, scr, E, l, ay, (Const ("Script.Seq",_) $ _ $ e2), a, v) =
84.1827 + (thy, ptp, (Script sc),
84.1828 + E, up, ay,(go up sc), a, v);
84.1829 + *)
84.1830 + | nxt_up thy ptp scr E l ay (*comes from e2*)
84.1831 + (Const ("Script.Seq"(*2*),_) $ _ $ e2) a v =
84.1832 + nstep_up thy ptp scr E l ay a v
84.1833 +(* val (thy, ptp, scr, E, l, ay, (Const ("Script.Seq",_) $ _), a, v) =
84.1834 + (thy, ptp, (Script sc),
84.1835 + E, up, ay,(go up sc), a, v);
84.1836 + *)
84.1837 + | nxt_up thy ptp (scr as Script sc) E l ay (*comes from e1*)
84.1838 + (Const ("Script.Seq",_) $ _) a v =
84.1839 + if ay = Napp_
84.1840 + then nstep_up thy ptp scr E (drop_last l) Napp_ a v
84.1841 + else (*Skip_*)
84.1842 + let val up = drop_last l;
84.1843 + val Const ("Script.Seq"(*2*),_) $ _ $ e2 = go up sc;
84.1844 + in case appy thy ptp E (up@[R]) e2 a v of
84.1845 + Appy lr => Appy lr
84.1846 + | Napp E => nstep_up thy ptp scr E up Napp_ a v
84.1847 + | Skip (v,E) => nstep_up thy ptp scr E up Skip_ a v end
84.1848 +
84.1849 + | nxt_up (thy,_) ptp scr E l ay t a v =
84.1850 + raise error ("nxt_up not impl for "^
84.1851 + (Sign.string_of_term (sign_of (assoc_thy thy)) t))
84.1852 +
84.1853 +(* val (thy, ptp, (Script sc), E, l, ay, a, v)=
84.1854 + (thy, ptp, scr, E, l, Skip_, a, v);
84.1855 + val (thy, ptp, (Script sc), E, l, ay, a, v)=
84.1856 + (thy, ptp, sc, E, l, Skip_, a, v);
84.1857 + *)
84.1858 +and nstep_up thy ptp (Script sc) E l ay a v =
84.1859 + ((*writeln("### nstep_up from: "^(loc_2str l));
84.1860 + writeln("### nstep_up from: "^
84.1861 + (Sign.string_of_term (sign_of (assoc_thy thy)) (go l sc)));*)
84.1862 + if 1 < length l
84.1863 + then
84.1864 + let
84.1865 + val up = drop_last l;
84.1866 + in ((*writeln("### nstep_up to: "^
84.1867 + (Sign.string_of_term (sign_of (assoc_thy thy)) (go up sc)));*)
84.1868 + nxt_up thy ptp (Script sc) E up ay (go up sc) a v ) end
84.1869 + else (*interpreted to end*)
84.1870 + if ay = Skip_ then Skip (v, E) else Napp E
84.1871 +);
84.1872 +
84.1873 +(* decide for the next applicable stac in the script;
84.1874 + returns (stactic, value) - the value in case the script is finished
84.1875 + 12.8.02: ~~~~~ and no assumptions ??? FIXME ???
84.1876 + 20.8.02: must return p in case of finished, because the next script
84.1877 + consulted need not be the calling script:
84.1878 + in case of detail ie. _inserted_ PrfObjs, the next stac
84.1879 + has to searched in a script with PblObj.status<>Complete !
84.1880 + (.. not true for other details ..PrfObj ??????????????????
84.1881 + 20.8.02: do NOT return safe (is only changed in locate !!!)
84.1882 +*)
84.1883 +(* val (thy, (pt,p), Rfuns {next_rule=ne,...}, RrlsState (f,f',rss,_)) =
84.1884 + (thy', (pt,p), sc, RrlsState (ii t));
84.1885 + val (thy, (pt,p), Rfuns {next_rule=ne,...}, RrlsState (f,f',rss,_)) =
84.1886 + (thy', (pt',p'), sc, is');
84.1887 + *)
84.1888 +fun next_tac (thy,_) (pt,p) (Rfuns {next_rule,...}) (RrlsState(f,f',rss,_))=
84.1889 + if f = f' then (End_Detail' (f',[])(*8.6.03*), Uistate,
84.1890 + (f', Sundef(*FIXME is no value of next_tac! vor 8.6.03*)))
84.1891 + (*finished*)
84.1892 + else (case next_rule rss f of
84.1893 + None => (Empty_Tac_, Uistate, (e_term, Sundef)) (*helpless*)
84.1894 +(* val Some (Thm (id,thm)) = next_rule rss f;
84.1895 + *)
84.1896 + | Some (Thm (id,thm))(*8.6.03: muss auch f' liefern ?!!*) =>
84.1897 + (Rewrite' (thy, "e_rew_ord", e_rls,(*!?!8.6.03*) false,
84.1898 + (id, string_of_thmI thm), f,(e_term,[(*!?!8.6.03*)])),
84.1899 + Uistate, (e_term, Sundef))) (*next stac*)
84.1900 +
84.1901 +(* val(thy, ptp as (pt,(p,_)), sc as Script (h $ body),ScrState (E,l,a,v,s,b))=
84.1902 + ((thy',srls), (pt,pos), sc, is);
84.1903 + *)
84.1904 + | next_tac thy (ptp as (pt,(p,_)):ptree * pos') (sc as Script (h $ body))
84.1905 + (ScrState (E,l,a,v,s,b)) =
84.1906 + ((*writeln("### next_tac-----------------: E= ");
84.1907 + writeln( istate2str (ScrState (E,l,a,v,s,b)));*)
84.1908 + case if l=[] then appy thy ptp E [R] body None v
84.1909 + else nstep_up thy ptp sc E l Skip_ a v of
84.1910 + Skip (v,_) => (*finished*)
84.1911 + (case par_pbl_det pt p of
84.1912 + (true, p', _) =>
84.1913 + let val (_,pblID,_) = get_obj g_spec pt p';
84.1914 + in (Check_Postcond' (pblID, (v, [(*8.6.03 NO asms???*)])),
84.1915 + e_istate, (v,s)) end
84.1916 + | (_,p',rls') => (End_Detail' (e_term,[])(*8.6.03*), e_istate, (v,s)))
84.1917 + | Napp _ => (Empty_Tac_, e_istate, (e_term, Sundef)) (*helpless*)
84.1918 + | Appy (m', scrst as (_,_,_,v,_,_)) => (m', ScrState scrst,
84.1919 + (v, Sundef))) (*next stac*)
84.1920 +
84.1921 + | next_tac _ _ _ is = raise error ("next_tac: not impl for "^
84.1922 + (istate2str is));
84.1923 +
84.1924 +
84.1925 +
84.1926 +
84.1927 +(*.create the initial interpreter state from the items of the guard.*)
84.1928 +(* val (thy, itms, metID) = (thy, itms, mI);
84.1929 + *)
84.1930 +fun init_scrstate thy itms metID =
84.1931 + let val actuals = itms2args thy metID itms;
84.1932 + val scr as Script sc = (#scr o get_met) metID;
84.1933 + val formals = formal_args sc
84.1934 + (*expects same sequence of (actual) args in itms
84.1935 + and (formal) args in met*)
84.1936 + fun relate_args env [] [] = env
84.1937 + | relate_args env _ [] =
84.1938 + raise error ("ERROR in creating the environment for '"
84.1939 + ^id_of_scr sc^"' from \nthe items of the guard of "
84.1940 + ^metID2str metID^",\n\
84.1941 + \formal arg(s), from the script,\
84.1942 + \ miss actual arg(s), from the guards env:\n"
84.1943 + ^(string_of_int o length) formals
84.1944 + ^" formals: "^terms2str formals^"\n"
84.1945 + ^(string_of_int o length) actuals
84.1946 + ^" actuals: "^terms2str actuals)
84.1947 + | relate_args env [] actual_finds = env (*may drop Find!*)
84.1948 + | relate_args env (a::aa) (f::ff) =
84.1949 + if type_of a = type_of f
84.1950 + then relate_args (env @ [(a, f)]) aa ff else
84.1951 + raise error ("ERROR in creating the environment for '"
84.1952 + ^id_of_scr sc^"' from \nthe items of the guard of "
84.1953 + ^metID2str metID^",\n\
84.1954 + \different types of formal arg, from the script,\
84.1955 + \ and actual arg, from the guards env:'\n\
84.1956 + \formal: '"^term2str a^"::"^(type2str o type_of) a^"'\n\
84.1957 + \actual: '"^term2str f^"::"^(type2str o type_of) f^"'\n\
84.1958 + \in\n\
84.1959 + \formals: "^terms2str formals^"\n\
84.1960 + \actuals: "^terms2str actuals)
84.1961 + val env = relate_args [] formals actuals;
84.1962 + in (ScrState (env,[],None,e_term,Safe,true), scr):istate * scr end;
84.1963 +
84.1964 +(*.decide, where to get script/istate from:
84.1965 + (*1*) from PblObj.env: at begin of script if no init_form
84.1966 + (*2*) from PblObj/PrfObj: if stac is in the middle of the script
84.1967 + (*3*) from rls/PrfObj: in case of detail a ruleset.*)
84.1968 +(* val (thy', (p,p_), pt) = (thy', (p,p_), pt);
84.1969 + *)
84.1970 +fun from_pblobj_or_detail' thy' (p,p_) pt =
84.1971 + if p_ mem [Pbl,Met]
84.1972 + then case get_obj g_env pt p of
84.1973 + None => raise error "from_pblobj_or_detail': no istate"
84.1974 + | Some is =>
84.1975 + let val metID = get_obj g_metID pt p
84.1976 + val {srls,...} = get_met metID
84.1977 + in (srls, is, (#scr o get_met) metID) end
84.1978 + else
84.1979 + let val (pbl,p',rls') = par_pbl_det pt p
84.1980 + in if pbl
84.1981 + then (*2*)
84.1982 + let val thy = assoc_thy thy'
84.1983 + val PblObj{meth=itms,...} = get_obj I pt p'
84.1984 + val metID = get_obj g_metID pt p'
84.1985 + val {srls,...} = get_met metID
84.1986 + in (*if last_elem p = 0 (*nothing written to pt yet*)
84.1987 + then let val (is, sc) = init_scrstate thy itms metID
84.1988 + in (srls, is, sc) end
84.1989 + else*) (srls, get_istate pt (p,p_), (#scr o get_met) metID)
84.1990 + end
84.1991 + else (*3*)
84.1992 + (e_rls, (*FIXME: get from pbl or met !!!
84.1993 + unused for Rrls in locate_gen, next_tac*)
84.1994 + get_istate pt (p,p_),
84.1995 + case rls' of
84.1996 + Rls {scr=scr,...} => scr
84.1997 + | Seq {scr=scr,...} => scr
84.1998 + | Rrls {scr=rfuns,...} => rfuns)
84.1999 + end;
84.2000 +
84.2001 +(*.get script and istate from PblObj, see (*1*) above.*)
84.2002 +fun from_pblobj' thy' (p,p_) pt =
84.2003 + let val p' = par_pblobj pt p
84.2004 + val thy = assoc_thy thy'
84.2005 + val PblObj{meth=itms,...} = get_obj I pt p'
84.2006 + val metID = get_obj g_metID pt p'
84.2007 + val {srls,scr,...} = get_met metID
84.2008 + in if last_elem p = 0 (*nothing written to pt yet*)
84.2009 + then let val (is, scr) = init_scrstate thy itms metID
84.2010 + in (srls, is, scr) end
84.2011 + else (srls, get_istate pt (p,p_), scr)
84.2012 + end;
84.2013 +
84.2014 +(*.get the stactics and problems of a script as tacs
84.2015 + instantiated with the current environment;
84.2016 + l is the location which generated the given formula.*)
84.2017 +(*WN.12.5.03: quick-and-dirty repair for listexpressions*)
84.2018 +fun is_spec_pos Pbl = true
84.2019 + | is_spec_pos Met = true
84.2020 + | is_spec_pos _ = false;
84.2021 +
84.2022 +(*. fetch _all_ tactics from script .*)
84.2023 +fun sel_rules _ (([],Res):pos') =
84.2024 + raise PTREE "no tactics applicable at the end of a calculation"
84.2025 +| sel_rules pt (p,p_) =
84.2026 + if is_spec_pos p_
84.2027 + then [get_obj g_tac pt p]
84.2028 + else
84.2029 + let val pp = par_pblobj pt p;
84.2030 + val thy' = (get_obj g_domID pt pp):theory';
84.2031 + val thy = assoc_thy thy';
84.2032 + val metID = get_obj g_metID pt pp;
84.2033 + val metID' =if metID =e_metID then(thd3 o snd3)(get_obj g_origin pt pp)
84.2034 + else metID
84.2035 + val {scr=Script sc,srls,...} = get_met metID'
84.2036 + val ScrState (env,_,a,v,_,_) = get_istate pt (p,p_);
84.2037 + in map ((stac2tac pt thy) o rep_stacexpr o #2 o
84.2038 + (handle_leaf "selrul" thy' srls env a v)) (stacpbls sc) end;
84.2039 +(*
84.2040 +> val Script sc = (#scr o get_met) ("SqRoot.thy","sqrt-equ-test");
84.2041 +> val env = [((term_of o the o (parse Isac.thy)) "bdv",
84.2042 + (term_of o the o (parse Isac.thy)) "x")];
84.2043 +> map ((stac2tac pt thy) o #2 o(subst_stacexpr env None e_term)) (stacpbls sc);
84.2044 +*)
84.2045 +
84.2046 +
84.2047 +(*. fetch tactics from script and filter _applicable_ tactics;
84.2048 + in case of Rewrite_Set* go down to _atomic_ rewrite-tactics .*)
84.2049 +fun sel_appl_atomic_tacs _ (([],Res):pos') =
84.2050 + raise PTREE "no tactics applicable at the end of a calculation"
84.2051 + | sel_appl_atomic_tacs pt (p,p_) =
84.2052 + if is_spec_pos p_
84.2053 + then [get_obj g_tac pt p]
84.2054 + else
84.2055 + let val pp = par_pblobj pt p
84.2056 + val thy' = (get_obj g_domID pt pp):theory'
84.2057 + val thy = assoc_thy thy'
84.2058 + val metID = get_obj g_metID pt pp
84.2059 + val metID' =if metID = e_metID
84.2060 + then (thd3 o snd3) (get_obj g_origin pt pp)
84.2061 + else metID
84.2062 + val {scr=Script sc,srls,erls,rew_ord'=ro,...} = get_met metID'
84.2063 + val ScrState (env,_,a,v,_,_) = get_istate pt (p,p_)
84.2064 + val alltacs = (*we expect at least 1 stac in a script*)
84.2065 + map ((stac2tac pt thy) o rep_stacexpr o #2 o
84.2066 + (handle_leaf "selrul" thy' srls env a v)) (stacpbls sc)
84.2067 + val f = case p_ of
84.2068 + Frm => get_obj g_form pt p
84.2069 + | Res => (fst o (get_obj g_result pt)) p
84.2070 + (*WN071231 ? replace atomic_appl_tacs with applicable_in (ineff!) ?*)
84.2071 + in (distinct o flat o
84.2072 + (map (atomic_appl_tacs thy ro erls f))) alltacs end;
84.2073 +
84.2074 +
84.2075 +(*
84.2076 +end
84.2077 +open Interpreter;
84.2078 +*)
84.2079 +
84.2080 +(* use"ME/script.sml";
84.2081 + use"script.sml";
84.2082 + *)
85.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
85.2 +++ b/src/Pure/isac/ME/solve.sml Wed Jul 21 13:53:39 2010 +0200
85.3 @@ -0,0 +1,579 @@
85.4 +(* solve an example by interpreting a method's script
85.5 + (c) Walther Neuper 1999
85.6 +
85.7 +use"ME/solve.sml";
85.8 +use"solve.sml";
85.9 +*)
85.10 +
85.11 +fun safe (ScrState (_,_,_,_,s,_)) = s
85.12 + | safe (RrlsState _) = Safe;
85.13 +
85.14 +type mstID = string;
85.15 +type tac'_ = mstID * tac; (*DG <-> ME*)
85.16 +val e_tac'_ = ("Empty_Tac", Empty_Tac):tac'_;
85.17 +
85.18 +fun mk_tac'_ m = case m of
85.19 + Init_Proof (ppc, spec) => ("Init_Proof", Init_Proof (ppc, spec ))
85.20 +| Model_Problem => ("Model_Problem", Model_Problem)
85.21 +| Refine_Tacitly pblID => ("Refine_Tacitly", Refine_Tacitly pblID)
85.22 +| Refine_Problem pblID => ("Refine_Problem", Refine_Problem pblID)
85.23 +| Add_Given cterm' => ("Add_Given", Add_Given cterm')
85.24 +| Del_Given cterm' => ("Del_Given", Del_Given cterm')
85.25 +| Add_Find cterm' => ("Add_Find", Add_Find cterm')
85.26 +| Del_Find cterm' => ("Del_Find", Del_Find cterm')
85.27 +| Add_Relation cterm' => ("Add_Relation", Add_Relation cterm')
85.28 +| Del_Relation cterm' => ("Del_Relation", Del_Relation cterm')
85.29 +
85.30 +| Specify_Theory domID => ("Specify_Theory", Specify_Theory domID)
85.31 +| Specify_Problem pblID => ("Specify_Problem", Specify_Problem pblID)
85.32 +| Specify_Method metID => ("Specify_Method", Specify_Method metID)
85.33 +| Apply_Method metID => ("Apply_Method", Apply_Method metID)
85.34 +| Check_Postcond pblID => ("Check_Postcond", Check_Postcond pblID)
85.35 +| Free_Solve => ("Free_Solve",Free_Solve)
85.36 +
85.37 +| Rewrite_Inst (subs, thm') => ("Rewrite_Inst", Rewrite_Inst (subs, thm'))
85.38 +| Rewrite thm' => ("Rewrite", Rewrite thm')
85.39 +| Rewrite_Asm thm' => ("Rewrite_Asm", Rewrite_Asm thm')
85.40 +| Rewrite_Set_Inst (subs, rls')
85.41 + => ("Rewrite_Set_Inst", Rewrite_Set_Inst (subs, rls'))
85.42 +| Rewrite_Set rls' => ("Rewrite_Set", Rewrite_Set rls')
85.43 +| End_Ruleset => ("End_Ruleset", End_Ruleset)
85.44 +
85.45 +| End_Detail => ("End_Detail", End_Detail)
85.46 +| Detail_Set rls' => ("Detail_Set", Detail_Set rls')
85.47 +| Detail_Set_Inst (s, rls') => ("Detail_Set_Inst", Detail_Set_Inst (s, rls'))
85.48 +
85.49 +| Calculate op_ => ("Calculate", Calculate op_)
85.50 +| Substitute sube => ("Substitute", Substitute sube)
85.51 +| Apply_Assumption cts' => ("Apply_Assumption", Apply_Assumption cts')
85.52 +
85.53 +| Take cterm' => ("Take", Take cterm')
85.54 +| Take_Inst cterm' => ("Take_Inst", Take_Inst cterm')
85.55 +| Group (con, ints) => ("Group", Group (con, ints))
85.56 +| Subproblem (domID, pblID) => ("Subproblem", Subproblem (domID, pblID))
85.57 +(*
85.58 +| Subproblem_Full(spec,cts')=> ("Subproblem_Full", Subproblem_Full(spec,cts'))
85.59 +*)
85.60 +| End_Subproblem => ("End_Subproblem",End_Subproblem)
85.61 +| CAScmd cterm' => ("CAScmd", CAScmd cterm')
85.62 +
85.63 +| Split_And => ("Split_And", Split_And)
85.64 +| Conclude_And => ("Conclude_And", Conclude_And)
85.65 +| Split_Or => ("Split_Or", Split_Or)
85.66 +| Conclude_Or => ("Conclude_Or", Conclude_Or)
85.67 +| Begin_Trans => ("Begin_Trans", Begin_Trans)
85.68 +| End_Trans => ("End_Trans", End_Trans)
85.69 +| Begin_Sequ => ("Begin_Sequ", Begin_Sequ)
85.70 +| End_Sequ => ("End_Sequ", Begin_Sequ)
85.71 +| Split_Intersect => ("Split_Intersect", Split_Intersect)
85.72 +| End_Intersect => ("End_Intersect", End_Intersect)
85.73 +| Check_elementwise cterm' => ("Check_elementwise", Check_elementwise cterm')
85.74 +| Or_to_List => ("Or_to_List", Or_to_List)
85.75 +| Collect_Trues => ("Collect_Results", Collect_Trues)
85.76 +
85.77 +| Empty_Tac => ("Empty_Tac",Empty_Tac)
85.78 +| Tac string => ("Tac",Tac string)
85.79 +| User => ("User",User)
85.80 +| End_Proof' => ("End_Proof'",End_Proof');
85.81 +
85.82 +(*Detail*)
85.83 +val empty_tac'_ = (mk_tac'_ Empty_Tac):tac'_;
85.84 +
85.85 +fun mk_tac ((_,m):tac'_) = m;
85.86 +fun mk_mstID ((mI,_):tac'_) = mI;
85.87 +
85.88 +fun tac'_2str ((ID,ms):tac'_) = ID ^ (tac2str ms);
85.89 +(* TODO: tac2str, tac'_2str NOT tested *)
85.90 +
85.91 +
85.92 +
85.93 +type squ = ptree; (* TODO: safe etc. *)
85.94 +
85.95 +(*13.9.02--------------
85.96 +type ctr = (loc * pos) list;
85.97 +val ops = [("plus","op +"),("minus","op -"),("times","op *"),
85.98 + ("cancel","cancel"),("pow","pow"),("sqrt","sqrt")];
85.99 +fun op_intern op_ =
85.100 + case assoc (ops,op_) of
85.101 + Some op' => op' | None => raise error ("op_intern: no op= "^op_);
85.102 +-----------------------*)
85.103 +
85.104 +
85.105 +
85.106 +(* use"ME/solve.sml";
85.107 + use"solve.sml";
85.108 +
85.109 +val ttt = (term_of o the o (parse thy))"Substitute [(bdv,x)] g";
85.110 +val ttt = (term_of o the o (parse thy))"Rewrite thmid True g";
85.111 +
85.112 + Const ("Script.Rewrite'_Inst",_) $ sub $ Free (thm',_) $ Const (pa,_) $ f'
85.113 + *)
85.114 +
85.115 +
85.116 +
85.117 +val specsteps = ["Init_Proof","Refine_Tacitly","Refine_Problem",
85.118 + "Model_Problem",(*"Match_Problem",*)
85.119 + "Add_Given","Del_Given","Add_Find","Del_Find",
85.120 + "Add_Relation","Del_Relation",
85.121 + "Specify_Theory","Specify_Problem","Specify_Method"];
85.122 +
85.123 +"-----------------------------------------------------------------------";
85.124 +
85.125 +
85.126 +fun step2taci ((tac_, _, pt, p, _):step) = (*FIXXME.040312: redesign step*)
85.127 + (tac_2tac tac_, tac_, (p, get_istate pt p)):taci;
85.128 +
85.129 +
85.130 +(*FIXME.WN050821 compare solve ... nxt_solv*)
85.131 +(* val ("Apply_Method",Apply_Method' (mI,_))=(mI,m);
85.132 + val (("Apply_Method",Apply_Method' (mI,_,_)),pt, pos as (p,_))=(m,pt, pos);
85.133 + *)
85.134 +fun solve ("Apply_Method", m as Apply_Method' (mI, _, _))
85.135 + (pt:ptree, (pos as (p,_))) =
85.136 + let val {srls,...} = get_met mI;
85.137 + val PblObj{meth=itms,...} = get_obj I pt p;
85.138 + val thy' = get_obj g_domID pt p;
85.139 + val thy = assoc_thy thy';
85.140 + val (is as ScrState (env,_,_,_,_,_), sc) = init_scrstate thy itms mI;
85.141 + val ini = init_form thy sc env;
85.142 + val p = lev_dn p;
85.143 + in
85.144 + case ini of
85.145 + Some t => (* val Some t = ini;
85.146 + *)
85.147 + let val (pos,c,_,pt) =
85.148 + generate1 thy (Apply_Method' (mI, Some t, is))
85.149 + is (lev_on p, Frm)(*implicit Take*) pt;
85.150 + in ("ok",([(Apply_Method mI, Apply_Method' (mI, Some t, is),
85.151 + ((lev_on p, Frm), is))], c, (pt,pos)):calcstate')
85.152 + end
85.153 + | None => (*execute the first tac in the Script, compare solve m*)
85.154 + let val (m', is', _) = next_tac (thy', srls) (pt, (p, Res)) sc is;
85.155 + val d = e_rls (*FIXME: get simplifier from domID*);
85.156 + in
85.157 + case locate_gen (thy',srls) m' (pt,(p, Res))(sc,d) is' of
85.158 + Steps (is'', ss as (m'',f',pt',p',c')::_) =>
85.159 +(* val Steps (is'', ss as (m'',f',pt',p',c')::_) =
85.160 + locate_gen (thy',srls) m' (pt,(p,Res)) (sc,d) is';
85.161 + *)
85.162 + ("ok", (map step2taci ss, c', (pt',p')))
85.163 + | NotLocatable =>
85.164 + let val (p,ps,f,pt) =
85.165 + generate_hard (assoc_thy "Isac.thy") m (p,Frm) pt;
85.166 + in ("not-found-in-script",
85.167 + ([(tac_2tac m, m, (pos, is))], ps, (pt,p))) end
85.168 + (*just-before------------------------------------------------------
85.169 + ("ok",([(Apply_Method mI,Apply_Method'(mI,None,e_istate),
85.170 + (pos, is))],
85.171 + [], (update_env pt (fst pos) (Some is),pos)))
85.172 + -----------------------------------------------------------------*)
85.173 + end
85.174 + end
85.175 +
85.176 + | solve ("Free_Solve", Free_Solve') (pt,po as (p,_)) =
85.177 + let (*val _=writeln"###solve Free_Solve";*)
85.178 + val p' = lev_dn_ (p,Res);
85.179 + val pt = update_metID pt (par_pblobj pt p) e_metID;
85.180 + in ("ok", ((*(p',Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Unsafe,*)
85.181 + [(Empty_Tac, Empty_Tac_, (po, Uistate))], [], (pt,p'))) end
85.182 +
85.183 +(* val (("Check_Postcond",Check_Postcond' (pI,_)), (pt,(pos as (p,p_)))) =
85.184 + ( m, (pt, pos));
85.185 + *)
85.186 + | solve ("Check_Postcond",Check_Postcond' (pI,_)) (pt,(pos as (p,p_))) =
85.187 + let (*val _=writeln"###solve Check_Postcond";*)
85.188 + val pp = par_pblobj pt p
85.189 + val asm = (case get_obj g_tac pt p of
85.190 + Check_elementwise _ => (*collects and instantiates asms*)
85.191 + (snd o (get_obj g_result pt)) p
85.192 + | _ => ((map fst) o (get_assumptions_ pt)) (p,p_))
85.193 + handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*)
85.194 + val metID = get_obj g_metID pt pp;
85.195 + val {srls=srls,scr=sc,...} = get_met metID;
85.196 + val is as ScrState (E,l,a,_,_,b) = get_istate pt (p,p_);
85.197 + (*val _= writeln("### solve Check_postc, subpbl pos= "^(pos'2str (p,p_)));
85.198 + val _= writeln("### solve Check_postc, is= "^(istate2str is));*)
85.199 + val thy' = get_obj g_domID pt pp;
85.200 + val thy = assoc_thy thy';
85.201 + val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc is;
85.202 + (*val _= writeln("### solve Check_postc, scval= "^(term2str scval));*)
85.203 +
85.204 + in if pp = [] then
85.205 + let val is = ScrState (E,l,a,scval,scsaf,b)
85.206 + val tac_ = Check_Postcond'(pI,(scval, map term2str asm))
85.207 + val (pos,ps,f,pt) = generate1 thy tac_ is (pp,Res) pt;
85.208 + in ("ok", ((*(([],Res),is,End_Proof''), f, End_Proof', scsaf,*)
85.209 + [(Check_Postcond pI, tac_, ((pp,Res),is))], ps,(pt,pos))) end
85.210 + else
85.211 + let
85.212 + (*resume script of parpbl, transfer value of subpbl-script*)
85.213 + val ppp = par_pblobj pt (lev_up p);
85.214 + val thy' = get_obj g_domID pt ppp;
85.215 + val thy = assoc_thy thy';
85.216 + val metID = get_obj g_metID pt ppp;
85.217 + val sc = (#scr o get_met) metID;
85.218 + val is as ScrState (E,l,a,_,_,b) = get_istate pt (pp(*!/p/*),Frm);
85.219 + (*val _=writeln("### solve Check_postc, parpbl pos= "^(pos'2str(pp,Frm)));
85.220 + val _=writeln("### solve Check_postc, is(pt)= "^(istate2str is));
85.221 + val _=writeln("### solve Check_postc, is'= "^
85.222 + (istate2str (E,l,a,scval,scsaf,b)));*)
85.223 + val ((p,p_),ps,f,pt) =
85.224 + generate1 thy (Check_Postcond' (pI, (scval, map term2str asm)))
85.225 + (ScrState (E,l,a,scval,scsaf,b)) (pp,Res) pt;
85.226 + (*val _=writeln("### solve Check_postc, is(pt')= "^
85.227 + (istate2str (get_istate pt ([3],Res))));
85.228 + val (nx,is',_) = next_tac (thy',srls) (pt,(p,p_)) sc
85.229 + (ScrState (E,l,a,scval,scsaf,b));*)
85.230 + in ("ok",(*((pp,Res),is',nx), f, tac_2tac nx, scsaf,*)
85.231 + ([(Check_Postcond pI, Check_Postcond'(pI,(scval, map term2str asm)),
85.232 + ((pp,Res), ScrState (E,l,a,scval,scsaf,b)))],ps,(pt,(p,p_))))
85.233 + end
85.234 + end
85.235 +(* val (msg, cs') =
85.236 + ("ok",([(Check_Postcond pI,Check_Postcond'(pI, (scval, map term2str asm))),
85.237 + ((pp,Res),(ScrState (E,l,a,scval,scsaf,b)))], (pt,(p,p_))));
85.238 + val (_,(pt',p')) = cs';
85.239 + (writeln o istate2str) (get_istate pt' p');
85.240 + (term2str o fst) (get_obj g_result pt' (fst p'));
85.241 + *)
85.242 +
85.243 +(* writeln(istate2str(get_istate pt (p,p_)));
85.244 + *)
85.245 + | solve (_,End_Proof'') (pt, (p,p_)) =
85.246 + ("end-proof",
85.247 + ((*(([],Res),Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Safe,*)
85.248 + [(Empty_Tac,Empty_Tac_,(([],Res),Uistate))],[],(pt,(p,p_))))
85.249 +
85.250 +(*-----------vvvvvvvvvvv could be done by generate1 ?!?*)
85.251 + | solve (_,End_Detail' t) (pt,(p,p_)) =
85.252 + let val pr as (p',_) = (lev_up p, Res)
85.253 + val pp = par_pblobj pt p
85.254 + val r = (fst o (get_obj g_result pt)) p'
85.255 + (*Rewrite_Set* done at Detail_Set*: this result is already in ptree*)
85.256 + val thy' = get_obj g_domID pt pp
85.257 + val (srls, is, sc) = from_pblobj' thy' pr pt
85.258 + val (tac_,is',_) = next_tac (thy',srls) (pt,pr) sc is
85.259 + in ("ok", ((*((pp,Frm(*???*)),is,tac_),
85.260 + Form' (FormKF (~1, EdUndef, length p', Nundef, term2str r)),
85.261 + tac_2tac tac_, Sundef,*)
85.262 + [(End_Detail, End_Detail' t ,
85.263 + ((p,p_), get_istate pt (p,p_)))], [], (pt,pr))) end
85.264 +
85.265 + | solve (mI,m) (pt, po as (p,p_)) =
85.266 +(* val ((mI,m), (pt, po as (p,p_))) = (m, (pt, pos));
85.267 + *)
85.268 + if e_metID = get_obj g_metID pt (par_pblobj pt p)(*29.8.02:
85.269 + could be detail, too !!*)
85.270 + then let val ((p,p_),ps,f,pt) =
85.271 + generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p)))
85.272 + m e_istate (p,p_) pt;
85.273 + in ("no-method-specified", (*Free_Solve*)
85.274 + ((*((p,p_),Uistate,Empty_Tac_),f, Empty_Tac, Unsafe,*)
85.275 + [(Empty_Tac,Empty_Tac_, ((p,p_),Uistate))], ps, (pt,(p,p_)))) end
85.276 + else
85.277 + let
85.278 + val thy' = get_obj g_domID pt (par_pblobj pt p);
85.279 + val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt;
85.280 +(*val _= writeln("### solve, before locate_gen p="^(pos'2str(p,p_)));*)
85.281 + val d = e_rls; (*FIXME: canon.simplifier for domain is missing
85.282 + 8.01: generate from domID?*)
85.283 + in case locate_gen (thy',srls) m (pt,(p,p_)) (sc,d) is of
85.284 + Steps (is', ss as (m',f',pt',p',c')::_) =>
85.285 +(* val Steps (is', ss as (m',f',pt',p',c')::_) =
85.286 + locate_gen (thy',srls) m (pt,(p,p_)) (sc,d) is;
85.287 + *)
85.288 + let (*val _= writeln("### solve, after locate_gen: is= ")
85.289 + val _= writeln(istate2str is')*)
85.290 + (*val nxt_ =
85.291 + case p' of (*change from solve to model subpbl*)
85.292 + (_,Pbl) => nxt_model_pbl m' (pt',p')
85.293 + | _ => fst3 (next_tac (thy',srls) (pt',p') sc is');*)
85.294 + (*27.8.02:next_tac may change to other branches in pt FIXXXXME*)
85.295 + in ("ok", ((*(p',is',nxt_), f', tac_2tac nxt_, safe is',*)
85.296 + map step2taci ss, c', (pt',p'))) end
85.297 + | NotLocatable =>
85.298 + let val (p,ps,f,pt) =
85.299 + generate_hard (assoc_thy "Isac.thy") m (p,p_) pt;
85.300 + in ("not-found-in-script",
85.301 + ((*(p,Uistate,Empty_Tac_),f, Empty_Tac, Unsafe,*)
85.302 + [(tac_2tac m, m, (po,is))], ps, (pt,p))) end
85.303 + end;
85.304 +
85.305 +
85.306 +(*FIXME.WN050821 compare solve ... nxt_solv*)
85.307 +(* nxt_solv (Apply_Method' vvv FIXME: get args in applicable_in *)
85.308 +fun nxt_solv (Apply_Method' (mI,_,_)) _ (pt:ptree, pos as (p,_)) =
85.309 +(* val ((Apply_Method' (mI,_,_)), _, (pt:ptree, pos as (p,_))) =
85.310 + ((Apply_Method' (mI, None, e_istate)), e_istate, ptp);
85.311 + *)
85.312 + let val {srls,ppc,...} = get_met mI;
85.313 + val PblObj{meth=itms,origin=(oris,_,_),probl,...} = get_obj I pt p;
85.314 + val itms = if itms <> [] then itms
85.315 + else complete_metitms oris probl [] ppc
85.316 + val thy' = get_obj g_domID pt p;
85.317 + val thy = assoc_thy thy';
85.318 + val (is as ScrState (env,_,_,_,_,_), scr) = init_scrstate thy itms mI;
85.319 + val ini = init_form thy scr env;
85.320 + in
85.321 + case ini of
85.322 + Some t => (* val Some t = ini;
85.323 + *)
85.324 + let val pos = ((lev_on o lev_dn) p, Frm)
85.325 + val tac_ = Apply_Method' (mI, Some t, is);
85.326 + val (pos,c,_,pt) = (*implicit Take*)
85.327 + generate1 thy tac_ is pos pt
85.328 + (*val _= ("### nxt_solv Apply_Method, pos= "^pos'2str (lev_on p,Frm));*)
85.329 + in ([(Apply_Method mI, tac_, (pos, is))], c, (pt, pos)):calcstate' end
85.330 + | None =>
85.331 + let val pt = update_env pt (fst pos) (Some is)
85.332 + val (tacis, c, ptp) = nxt_solve_ (pt, pos)
85.333 + in (tacis @
85.334 + [(Apply_Method mI, Apply_Method' (mI, None, e_istate), (pos, is))],
85.335 + c, ptp) end
85.336 + end
85.337 +(* val ("Check_Postcond",Check_Postcond' (pI,_)) = (mI,m);
85.338 + val (Check_Postcond' (pI,_), _, (pt, pos as (p,p_))) =
85.339 + (tac_, is, ptp);
85.340 + *)
85.341 + (*TODO.WN050913 remove unnecessary code below*)
85.342 + | nxt_solv (Check_Postcond' (pI,_)) _ (pt, pos as (p,p_)) =
85.343 + let (*val _=writeln"###solve Check_Postcond";*)
85.344 + val pp = par_pblobj pt p
85.345 + val asm = (case get_obj g_tac pt p of
85.346 + Check_elementwise _ => (*collects and instantiates asms*)
85.347 + (snd o (get_obj g_result pt)) p
85.348 + | _ => ((map fst) o (get_assumptions_ pt)) (p,p_))
85.349 + handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*)
85.350 + val metID = get_obj g_metID pt pp;
85.351 + val {srls=srls,scr=sc,...} = get_met metID;
85.352 + val is as ScrState (E,l,a,_,_,b) = get_istate pt (p,p_);
85.353 + (*val _= writeln("### solve Check_postc, subpbl pos= "^(pos'2str (p,p_)));
85.354 + val _= writeln("### solve Check_postc, is= "^(istate2str is));*)
85.355 + val thy' = get_obj g_domID pt pp;
85.356 + val thy = assoc_thy thy';
85.357 + val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc is;
85.358 + (*val _= writeln("### solve Check_postc, scval= "^(term2str scval));*)
85.359 + in if pp = [] then
85.360 + let val is = ScrState (E,l,a,scval,scsaf,b)
85.361 + val tac_ = Check_Postcond'(pI,(scval, map term2str asm))
85.362 + (*val _= writeln"### nxt_solv2 Apply_Method: stored is =";
85.363 + val _= writeln(istate2str is);*)
85.364 + val ((p,p_),ps,f,pt) =
85.365 + generate1 thy tac_ is (pp,Res) pt;
85.366 + in ([(Check_Postcond pI, tac_, ((pp,Res), is))],ps,(pt, (p,p_))) end
85.367 + else
85.368 + let
85.369 + (*resume script of parpbl, transfer value of subpbl-script*)
85.370 + val ppp = par_pblobj pt (lev_up p);
85.371 + val thy' = get_obj g_domID pt ppp;
85.372 + val thy = assoc_thy thy';
85.373 + val metID = get_obj g_metID pt ppp;
85.374 + val {scr,...} = get_met metID;
85.375 + val is as ScrState (E,l,a,_,_,b) = get_istate pt (pp(*!/p/*),Frm)
85.376 + val tac_ = Check_Postcond' (pI, (scval, map term2str asm))
85.377 + val is = ScrState (E,l,a,scval,scsaf,b)
85.378 + (*val _= writeln"### nxt_solv3 Apply_Method: stored is =";
85.379 + val _= writeln(istate2str is);*)
85.380 + val ((p,p_),ps,f,pt) = generate1 thy tac_ is (pp, Res) pt;
85.381 + (*val (nx,is',_) = next_tac (thy',srls) (pt,(p,p_)) scr is;WN050913*)
85.382 + in ([(Check_Postcond pI, tac_, ((pp, Res), is))], ps, (pt, (p,p_))) end
85.383 + end
85.384 +(* writeln(istate2str(get_istate pt (p,p_)));
85.385 + *)
85.386 +
85.387 +(*.start interpreter and do one rewrite.*)
85.388 +(* val (_,Detail_Set'(thy',rls,t)) = (mI,m); val p = (p,p_);
85.389 + solve ("",Detail_Set'(thy', rls, t)) p pt;
85.390 + | nxt_solv (Detail_Set'(thy', rls, t)) _ (pt, p) = **********
85.391 +---> FE-interface/sml.sml
85.392 +
85.393 + | nxt_solv (End_Detail' t) _ (pt, (p,p_)) = **********
85.394 + let val pr as (p',_) = (lev_up p, Res)
85.395 + val pp = par_pblobj pt p
85.396 + val r = (fst o (get_obj g_result pt)) p'
85.397 + (*Rewrite_Set* done at Detail_Set*: this result is already in ptree*)
85.398 + val thy' = get_obj g_domID pt pp
85.399 + val (srls, is, sc) = from_pblobj' thy' pr pt
85.400 + val (tac_,is',_) = next_tac (thy',srls) (pt,pr) sc is
85.401 + in (pr, ((pp,Frm(*???*)),is,tac_),
85.402 + Form' (FormKF (~1, EdUndef, length p', Nundef, term2str r)),
85.403 + tac_2tac tac_, Sundef, pt) end
85.404 +*)
85.405 + | nxt_solv (End_Proof'') _ ptp = ([], [], ptp)
85.406 +
85.407 + | nxt_solv tac_ is (pt, pos as (p,p_)) =
85.408 +(* val (pt, pos as (p,p_)) = ptp;
85.409 + *)
85.410 + let val pos = case pos of
85.411 + (p, Met) => ((lev_on o lev_dn) p, Frm)(*begin script*)
85.412 + | (p, Res) => (lev_on p,Res) (*somewhere in script*)
85.413 + | _ => pos (*somewhere in script*)
85.414 + (*val _= writeln"### nxt_solv4 Apply_Method: stored is =";
85.415 + val _= writeln(istate2str is);*)
85.416 + val (pos',c,_,pt) = generate1 (assoc_thy "Isac.thy") tac_ is pos pt;
85.417 + in ([(tac_2tac tac_, tac_, (pos,is))], c, (pt, pos')) end
85.418 +
85.419 +
85.420 + (*(p,p_), (([],Res),Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Safe, pt*)
85.421 +
85.422 +
85.423 +(*.find the next tac from the script, nxt_solv will update the ptree.*)
85.424 +(* val (ptp as (pt,pos as (p,p_))) = ptp';
85.425 + val (ptp as (pt, pos as (p,p_))) = ptp'';
85.426 + val (ptp as (pt, pos as (p,p_))) = ptp;
85.427 + val (ptp as (pt, pos as (p,p_))) = (pt,ip);
85.428 + val (ptp as (pt, pos as (p,p_))) = (pt, pos);
85.429 + *)
85.430 +and nxt_solve_ (ptp as (pt, pos as (p,p_))) =
85.431 + if e_metID = get_obj g_metID pt (par_pblobj pt p)
85.432 + then ([], [], (pt,(p,p_))):calcstate'
85.433 + else let val thy' = get_obj g_domID pt (par_pblobj pt p);
85.434 + val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt;
85.435 + val (tac_,is,(t,_)) = next_tac (thy',srls) (pt,pos) sc is;
85.436 + (*TODO here ^^^ return finished/helpless/ok !*)
85.437 + (* val (tac_',is',(t',_)) = next_tac (thy',srls) (pt,pos) sc is;
85.438 + *)
85.439 + in case tac_ of
85.440 + End_Detail' _ => ([(End_Detail,
85.441 + End_Detail' (t,[(*FIXME.040215*)]),
85.442 + (pos, is))], [], (pt, pos))
85.443 + | _ => nxt_solv tac_ is ptp end;
85.444 +
85.445 +(*.says how may steps of a calculation should be done by "fun autocalc".*)
85.446 +(*TODO.WN0512 redesign togehter with autocalc ?*)
85.447 +datatype auto =
85.448 + Step of int (*1 do #int steps; may stop in model/specify:
85.449 + IS VERY INEFFICIENT IN MODEL/SPECIY*)
85.450 +| CompleteModel (*2 complete modeling
85.451 + if model complete, finish specifying + start solving*)
85.452 +| CompleteCalcHead (*3 complete model/specify in one go + start solving*)
85.453 +| CompleteToSubpbl (*4 stop at the next begin of a subproblem,
85.454 + if none, complete the actual (sub)problem*)
85.455 +| CompleteSubpbl (*5 complete the actual (sub)problem (incl.ev.subproblems)*)
85.456 +| CompleteCalc; (*6 complete the calculation as a whole*)
85.457 +fun autoord (Step _ ) = 1
85.458 + | autoord CompleteModel = 2
85.459 + | autoord CompleteCalcHead = 3
85.460 + | autoord CompleteToSubpbl = 4
85.461 + | autoord CompleteSubpbl = 5
85.462 + | autoord CompleteCalc = 6;
85.463 +
85.464 +(* val (auto, c, (ptp as (_, p))) = (auto, (c@c'), ptp);
85.465 + *)
85.466 +fun complete_solve auto c (ptp as (_, p): ptree * pos') =
85.467 + if p = ([], Res) then ("end-of-calculation", [], ptp) else
85.468 + case nxt_solve_ ptp of
85.469 + ((Subproblem _, tac_, (_, is))::_, c', ptp') =>
85.470 +(* val ptp' = ptp''';
85.471 + *)
85.472 + if autoord auto < 5 then ("ok", c@c', ptp)
85.473 + else let val ptp = all_modspec ptp';
85.474 + val (_, c'', ptp) = all_solve auto (c@c') ptp;
85.475 + in complete_solve auto (c@c'@c'') ptp end
85.476 + | ((Check_Postcond _, tac_, (_, is))::_, c', ptp' as (_, p')) =>
85.477 + if autoord auto < 6 orelse p' = ([],Res) then ("ok", c@c', ptp')
85.478 + else complete_solve auto (c@c') ptp'
85.479 + | ((End_Detail, _, _)::_, c', ptp') =>
85.480 + if autoord auto < 6 then ("ok", c@c', ptp')
85.481 + else complete_solve auto (c@c') ptp'
85.482 + | (_, c', ptp') => complete_solve auto (c@c') ptp'
85.483 +(* val (tacis, c', ptp') = nxt_solve_ ptp;
85.484 + val (tacis, c', ptp'') = nxt_solve_ ptp';
85.485 + val (tacis, c', ptp''') = nxt_solve_ ptp'';
85.486 + val (tacis, c', ptp'''') = nxt_solve_ ptp''';
85.487 + val (tacis, c', ptp''''') = nxt_solve_ ptp'''';
85.488 + *)
85.489 +and all_solve auto c (ptp as (pt, (p,_)): ptree * pos') =
85.490 +(* val (ptp as (pt, (p,_))) = ptp;
85.491 + val (ptp as (pt, (p,_))) = ptp';
85.492 + val (ptp as (pt, (p,_))) = (pt, pos);
85.493 + *)
85.494 + let val (_,_,mI) = get_obj g_spec pt p;
85.495 + val (_, c', ptp) = nxt_solv (Apply_Method' (mI, None, e_istate))
85.496 + e_istate ptp;
85.497 + in complete_solve auto (c@c') ptp end;
85.498 +(*@@@ vvv @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
85.499 +fun complete_solve auto c (ptp as (_, p as (_,p_)): ptree * pos') =
85.500 + if p = ([], Res) then ("end-of-calculation", [], ptp) else
85.501 + if p_ mem [Pbl, Met]
85.502 + then let val ptp = all_modspec ptp
85.503 + val (_, c', ptp) = all_solve auto c ptp
85.504 + in complete_solve auto (c@c') ptp end
85.505 + else case nxt_solve_ ptp of
85.506 + ((Subproblem _, tac_, (_, is))::_, c', ptp') =>
85.507 + if autoord auto < 5 then ("ok", c@c', ptp)
85.508 + else let val ptp = all_modspec ptp'
85.509 + val (_, c'', ptp) = all_solve auto (c@c') ptp
85.510 + in complete_solve auto (c@c'@c'') ptp end
85.511 + | ((Check_Postcond _, tac_, (_, is))::_, c', ptp' as (_, p')) =>
85.512 + if autoord auto < 6 orelse p' = ([],Res) then ("ok", c@c', ptp')
85.513 + else complete_solve auto (c@c') ptp'
85.514 + | ((End_Detail, _, _)::_, c', ptp') =>
85.515 + if autoord auto < 6 then ("ok", c@c', ptp')
85.516 + else complete_solve auto (c@c') ptp'
85.517 + | (_, c', ptp') => complete_solve auto (c@c') ptp'
85.518 +and all_solve auto c (ptp as (pt, (p,_)): ptree * pos') =
85.519 + let val (_,_,mI) = get_obj g_spec pt p
85.520 + val (_, c', ptp) = nxt_solv (Apply_Method' (mI, None, e_istate))
85.521 + e_istate ptp
85.522 + in complete_solve auto (c@c') ptp end;
85.523 +
85.524 +(*.aux.fun for detailrls with Rrls, reverse rewriting.*)
85.525 +(* val (nds, t, ((rule, (t', asm)) :: rts)) = ([], t, rul_terms);
85.526 + *)
85.527 +fun rul_terms_2nds nds t [] = nds
85.528 + | rul_terms_2nds nds t ((rule, res as (t', _)) :: rts) =
85.529 + (append_atomic [] e_istate t (rule2tac [] rule) res Complete EmptyPtree) ::
85.530 + (rul_terms_2nds nds t' rts);
85.531 +
85.532 +
85.533 +(*. detail steps done internally by Rewrite_Set*
85.534 + into ctree by use of a script .*)
85.535 +(* val (pt, (p,p_)) = (pt, pos);
85.536 + *)
85.537 +fun detailrls pt ((p,p_):pos') =
85.538 + let val t = get_obj g_form pt p
85.539 + val tac = get_obj g_tac pt p
85.540 + val rls = (assoc_rls o rls_of) tac
85.541 + in case rls of
85.542 +(* val Rrls {scr = Rfuns {init_state,...},...} = rls;
85.543 + *)
85.544 + Rrls {scr = Rfuns {init_state,...},...} =>
85.545 + let val (_,_,_,rul_terms) = init_state t
85.546 + val newnds = rul_terms_2nds [] t rul_terms
85.547 + val pt''' = ins_chn newnds pt p
85.548 + in ("detailrls", pt''', (p @ [length newnds], Res):pos') end
85.549 + | _ =>
85.550 + let val is = init_istate tac t
85.551 + (*TODO.WN060602 ScrState (["(t_, Problem (Isac,[equation,univar]))"]
85.552 + is wrong for simpl, but working ?!? *)
85.553 + val tac_ = Apply_Method' (e_metID(*WN0402: see generate1 !?!*),
85.554 + Some t, is)
85.555 + val pos' = ((lev_on o lev_dn) p, Frm)
85.556 + val thy = assoc_thy "Isac.thy"
85.557 + val (_,_,_,pt') = (*implicit Take*)generate1 thy tac_ is pos' pt
85.558 + val (_,_,(pt'',_)) = complete_solve CompleteSubpbl [] (pt',pos')
85.559 + val newnds = children (get_nd pt'' p)
85.560 + val pt''' = ins_chn newnds pt p
85.561 + (*complete_solve cuts branches after*)
85.562 + in ("detailrls", pt'''(*, get_formress [] ((lev_on o lev_dn) p)cn*),
85.563 + (p @ [length newnds], Res):pos') end
85.564 + end;
85.565 +
85.566 +
85.567 +
85.568 +(* val(mI,m)=m;val ppp=p;(*!!!*)val(p,p_)=pos;val(_,pt,_)=ppp(*!!!*);
85.569 + get_form ((mI,m):tac'_) ((p,p_):pos') ppp;
85.570 + *)
85.571 +fun get_form ((mI,m):tac'_) ((p,p_):pos') pt =
85.572 + case applicable_in (p,p_) pt m of
85.573 + Notappl e => Error' (Error_ e)
85.574 + | Appl m =>
85.575 + (* val Appl m=applicable_in (p,p_) pt m;
85.576 + *)
85.577 + if mI mem specsteps
85.578 + then let val (_,_,f,_,_,_) = specify m (p,p_) [] pt
85.579 + in f end
85.580 + else let val (*_,_,f,_,_,_*)_ = solve (mI,m) (pt,(p,p_))
85.581 + in (*f*) EmptyMout end;
85.582 +
86.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
86.2 +++ b/src/Pure/isac/RCODE-root.sml Wed Jul 21 13:53:39 2010 +0200
86.3 @@ -0,0 +1,81 @@
86.4 +(*.evaluate isac (all the code of the kernel) and isactest
86.5 + (c) Walther Neuper 1997
86.6 +
86.7 + /usr/local/Isabelle2002/bin/isabelle HOL-Real-Isac
86.8 +
86.9 + /usr/local/Isabelle2002/bin/isabelle HOL-Real
86.10 + cd"~/proto2/isac/src/sml"; use"RCODE-root.sml";
86.11 +
86.12 + use"ROOT.ML";
86.13 + use"RTEST-root.sml";
86.14 +.*)
86.15 +
86.16 +(*.please change HERE and in ROOT.ML accordingly,
86.17 + if you store a new heap ...*)
86.18 +val version_isac = "WN0710-calcResponse";
86.19 +
86.20 +print_depth 1;(*reduces verbosity of stdout*)
86.21 +
86.22 +(*.this function from Isabelle2002/src/Pure/library.ML is overwritten
86.23 + by some Isabelle2002 theory file; thus reestablished for isac.*)
86.24 +fun find_first _ [] = None
86.25 + | find_first pred (x :: xs) =
86.26 + if pred x then Some x else find_first pred xs;
86.27 +fun swap (x, y) = (y, x);
86.28 +(*HACK.WN080107*) val sstr = str;
86.29 +
86.30 +"**** build the isac kernel = math-engine + IsacKnowledge ";
86.31 +"**** build the math-engine ******************************";
86.32 +use"library.sml";
86.33 +use"calcelems.sml";
86.34 +cd "Scripts";
86.35 + use"term_G.sml";
86.36 + use"calculate.sml";
86.37 + use"rewrite.sml";
86.38 + use_thy"Script";
86.39 +(* remove_thy"ListG";
86.40 + use_thy"~/proto2/isac/src/sml/Scripts/Script";
86.41 + *)
86.42 + use"scrtools.sml";
86.43 + cd "..";
86.44 +cd "ME";
86.45 + use"mstools.sml";
86.46 + use"ctree.sml";
86.47 + use"ptyps.sml";
86.48 + use"generate.sml";
86.49 + use"calchead.sml";
86.50 + use"appl.sml";
86.51 + use"rewtools.sml";
86.52 + use"script.sml";
86.53 + use"solve.sml";
86.54 + use"inform.sml";
86.55 + use"mathengine.sml";
86.56 + cd "..";
86.57 +cd "xmlsrc";
86.58 + use"mathml.sml";
86.59 + use"datatypes.sml";
86.60 + use"pbl-met-hierarchy.sml";
86.61 + use"thy-hierarchy.sml";
86.62 + use"interface-xml.sml";
86.63 + cd "..";
86.64 +cd"FE-interface";
86.65 + use"messages.sml";
86.66 + use"states.sml";
86.67 + use"interface.sml";
86.68 + cd "..";
86.69 +use"print_exn_G.sml";
86.70 +"**** build math-engine complete *************************";
86.71 +
86.72 +"**** build the IsacKnowledge ****************************";
86.73 + cd "IsacKnowledge";
86.74 + use_thy"Isac"; (*evaluates ALL thys depending on the root 'Isac'*)
86.75 +
86.76 + (* remove_thy"Typefix";
86.77 + use_thy"~/proto2/isac/src/sml/IsacKnowledge/Isac";
86.78 + *)
86.79 + cd "..";
86.80 +"**** build IsacKnowledge complete ***********************";
86.81 +"**** build isac kernel complete *************************";
86.82 +
86.83 +states:=[];
86.84 +print_depth 3;
87.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
87.2 +++ b/src/Pure/isac/README Wed Jul 21 13:53:39 2010 +0200
87.3 @@ -0,0 +1,125 @@
87.4 +src/Pure/isac/README
87.5 +WN100220
87.6 +
87.7 +1= hg download Isabelle: what is downloaded to where ?
87.8 +2= convert cvs: want .hg created at /usr/local/Isabelle2009-1/ FAILED
87.9 +3= setup mercurial with isac + minimal-Isabelle2009-1
87.10 +4= WN-comments from IsaWS09 (Isabelle2009) to Isabelle2009-1
87.11 +5= continue work from old notebook
87.12 +
87.13 +1=================================================================
87.14 +download Isabelle: what is downloaded to where ?
87.15 +# http://isabelle.in.tum.de/repos/isabelle/summary
87.16 + 2 months ago Isabelle2009-1 changeset | changelog | files
87.17 + ^^^^^^6a973bd43949
87.18 +~/tmp/isab$ hg clone http://isabelle.in.tum.de/repos/isabelle/file/6a973bd43949 isab/
87.19 +requesting all changes
87.20 +adding changesets
87.21 +adding manifests
87.22 +adding file changes
87.23 +added 35358 changesets with 90911 changes to 7004 files
87.24 +updating working directory
87.25 +2780 files updated, 0 files merged, 0 files removed, 0 files unresolved
87.26 +
87.27 +~/tmp/isab$ ls -la
87.28 +total 404
87.29 +drwxr-xr-x 10 neuper neuper 4096 2010-02-25 09:04 .
87.30 +drwxr-xr-x 4 neuper neuper 4096 2010-02-25 08:59 ..
87.31 +drwxr-xr-x 11 neuper neuper 4096 2010-02-25 09:04 Admin
87.32 +[...]
87.33 +drwxr-xr-x 3 neuper neuper 4096 2010-02-25 09:04 .hg
87.34 +-rw-r--r-- 1 neuper neuper 405 2010-02-25 09:04 .hgignore
87.35 +-rw-r--r-- 1 neuper neuper 1441 2010-02-25 09:04 .hgtags
87.36 +[...]
87.37 +the whole repository is downloaded inside the dir specified as last argument
87.38 +=================================================================
87.39 +WN100225
87.40 +2=================================================================
87.41 +convert cvs: want .hg created at /usr/local/Isabelle2009-1/
87.42 + and isac stored at /usr/local/Isabelle2009-1/src/Pure/isac
87.43 +we had: cvs -d :ext:wneuper@soy.ist.intra:/netshares/commons/isac/.cvs checkout isac
87.44 +test 1:
87.45 +/home/neuper/tmp$ hg convert wneuper@soy.ist.intra:/netshares/commons/isac/.cvs/isac/src/sml /home/neuper/tmp/isac/sml
87.46 +initializing destination /home/neuper/tmp/isac/sml repository
87.47 +wneuper@soy.ist.intra:/netshares/commons/isac/.cvs/isac/src/sml does not look like a CVS checkout
87.48 +[...]
87.49 +abort: wneuper@soy.ist.intra:/netshares/commons/isac/.cvs/isac/src/sml: missing or unsupported repository
87.50 +
87.51 +test 2:
87.52 +/home/neuper/tmp$ hg convert wneuper@soy.ist.intra:/netshares/commons/isac/.cvs /home/neuper/tmp/isac/sml
87.53 +initializing destination /home/neuper/tmp/isac/sml repository
87.54 +wneuper@soy.ist.intra:/netshares/commons/isac/.cvs does not look like a CVS checkout
87.55 +[...]
87.56 +abort: wneuper@soy.ist.intra:/netshares/commons/isac/.cvs: missing or unsupported repository
87.57 +
87.58 +test 3:
87.59 +/home/neuper/tmp$ cvs -d :ext:wneuper@pear.ist.intra:/netshares/commons/isac/.cvs checkout isac
87.60 +OK!
87.61 +/home/neuper/tmp$ cvs -d :ext:wneuper@pear.ist.intra:/netshares/commons/isac/.cvs/isac/src/sml checkout /home/neuper/tmp/isac/sml
87.62 +Cannot access /netshares/commons/isac/.cvs/isac/src/sml/CVSROOT
87.63 +
87.64 +STOPPED, AND COPIED CVS-CHECKOUT FILES WITHOUT CVS INTO proto3
87.65 +NOT: /usr/local/Isabelle2009-1/$ hg convert wneuper@soy.ist.intra:/netshares/commons/isac/.cvs/isac/src/sml ...
87.66 +=================================================================
87.67 +
87.68 +3=================================================================
87.69 +setup mercurial with isac + minimal-Isabelle2009-1
87.70 +/usr/local/Isabelle2009-1$ hg init
87.71 +/usr/local/Isabelle2009-1$ emacs .hgingonre &
87.72 +/usr/local/Isabelle2009-1$ hg status # shows right ignores
87.73 +/usr/local/Isabelle2009-1$ hg add -I */*/*/*.sml # etc did not work, thus ...
87.74 +/usr/local/Isabelle2009-1$ hg add # ... all files separately ?!?
87.75 +=================================================================
87.76 +
87.77 +4=================================================================
87.78 +copy WN-comments from IsaWS09 (Isabelle2009) to Isabelle2009-1
87.79 +/usr/local/Isabelle2009/src/Pure$ grep -r WN *
87.80 +IsaMakefile:# scaladoc -d classes $(SCALA_FILES) WN090814 IsaDevWorkshop
87.81 +Isar/isar.scala: /* basic editor commands WN090811 unused */
87.82 +Isar/isar.scala://WN suche parser dazu:
87.83 +Isar/isar.scala://WN for these 3 defs see bottom of Pure/System/isar.ML
87.84 +System/isabelle_process.scala://WN see ex-makarius... for calling this directly
87.85 +System/isabelle_process.scala: /*WN used by interrupt, kill, StdinThread!!, StdoutThread??, MessageThread*/
87.86 +System/isabelle_process.scala: /* stdin WN: of SML, where Scala writes to */
87.87 +System/isabelle_process.scala: /* stdout WN of SML, where Scala reads from*/
87.88 +System/isabelle_system.scala://WN after compile-ERROR: value getenv is not a member of package System...
87.89 +System/isabelle_system.scala: private val environment = System.getenv //WN java.lang.System
87.90 +System/isabelle_system.scala: //WN start own: return "poly"
87.91 +System/isar.ML:(* editor model WN: parsers: -- >> !
87.92 +System/isar.ML: WN go from untyped string to typed world.
87.93 +vvv------------------------------ cp to src/Pure/isac-del/ !search code in other files!
87.94 +classes/isabelle/isar.scala: /* basic editor commands WN090811 unused */
87.95 +classes/isabelle/isar.scala://WN suche parser dazu:
87.96 +classes/isabelle/isar.scala://WN for these 3 defs see bottom of Pure/System/isar.ML
87.97 +classes/isabelle/isabelle_process.scala://WN see ex-makarius... for calling this directly
87.98 +classes/isabelle/isabelle_process.scala: /*WN used by interrupt, kill, StdinThread!!, StdoutThread??, MessageThread*/
87.99 +classes/isabelle/isabelle_process.scala: /* stdin WN: of SML, where Scala writes to */
87.100 +classes/isabelle/isabelle_process.scala: /* stdout WN of SML, where Scala reads from*/
87.101 +classes/isabelle/isabelle_system.scala://WN after compile-ERROR: value getenv is not a member of package System...
87.102 +classes/isabelle/isabelle_system.scala: private val environment = System.getenv //WN java.lang.System
87.103 +classes/isabelle/isabelle_system.scala: //WN start own: return "poly"
87.104 +^^^------------------------------ cp to src/Pure/isac-del/
87.105 +context.ML:WN the essence of the context
87.106 +context.ML:WN only ensures monotonicity etc, not really production code
87.107 +context.ML:(*fake predeclarations WN forward decl.*)
87.108 +conv.ML:WN see Stefan Berhofers talk at IDWS Aug.09
87.109 +tctical.ML:DOES NOT HANDLE TYPE UNKNOWNS.
87.110 +# thm.ML: type deriv (*WN*)
87.111 +# thm.ML: val rep_thm_G:(*WN*) thm ->
87.112 +# thm.ML: val make_thm:(*WN*) cterm -> thm
87.113 +# thm.ML: val assbl_thm:(*WN*) deriv ->
87.114 +# thm.ML:(*structure Thm = WN for error detection*)
87.115 +# thm.ML:fun rep_thm_G (Thm (deriv , args)) = (deriv, args); (*WN*)
87.116 +# thm.ML:fun make_thm raw_ct = (*WN ---vvv *)
87.117 +# thm.ML: (*else if maxidx <> ~1 then (*WN true with matches (?b * v_ = 0)..*)
87.118 +# thm.ML: end; (*WN ---^^^ *)
87.119 +# thm.ML:fun assbl_thm deriv thy_ref tags maxidx shyps hyps tpairs prop = (*WN*)
87.120 +variable.ML:(** local context data WN annotation im context, see Isab/Isar Impl. Manual **)
87.121 +=================================================================
87.122 +
87.123 +5=================================================================
87.124 +continue work from old notebook
87.125 +# copy thm-WN.ML --> thm.ML
87.126 +# /usr/local/Isabelle2009-1$ sudo mv HOL HOL-orig
87.127 +# /usr/local/Isabelle2009-1$ sudo ./build HOL
87.128 +# copy other (*WN*) to original files
88.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
88.2 +++ b/src/Pure/isac/ROOT.ML Wed Jul 21 13:53:39 2010 +0200
88.3 @@ -0,0 +1,282 @@
88.4 +(*.evaluate isac (all the code of the kernel) and isactest
88.5 + (c) Walther Neuper 1997
88.6 +
88.7 +--------------------------------------------------------old heap on new nb
88.8 + polyisac /home/neuper/devel/isac-10/heap/HOL-Real-Isac
88.9 +--------------------------------------------------------old heap on new nb
88.10 +
88.11 + poly /usr/local/Isabelle2002/heaps/polyml-4.1.3_x86-linux/HOL-Real
88.12 + cd"/home/neuper/proto2/isac/src/sml"; use"ROOT.ML";
88.13 +
88.14 +############################# nb-setup 080917 broke the isabelle configuration; thus HOL-Real CANNOT BE RECOMPUTED todo !
88.15 +
88.16 + /usr/local/Isabelle2002/bin/isabelle HOL-Real
88.17 + cd"/home/neuper/proto2/isac/src/sml"; use"ROOT.ML";
88.18 +
88.19 +############################# Rational-SK070730.ML #############
88.20 +
88.21 + cd"/home/neuper/proto2/isac/src/sml"; use"RCODE-root.sml";
88.22 + cd"/home/neuper/proto2/isac/src/sml"; use"RTEST-root.sml";
88.23 +.*)
88.24 +
88.25 +(*.please change HERE and in RCODE-root accordingly,
88.26 + if you store a new heap ...*)
88.27 +val version_isac = "WN071206-applyTacticTW";
88.28 +
88.29 +print_depth 1;(*reduces verbosity of stdout*)
88.30 +
88.31 +(*.these functions from Isabelle2002/src/Pure/library.ML are overwritten
88.32 + by some Isabelle2002 theory file; thus reestablished for isac.*)
88.33 +fun find_first _ [] = None
88.34 + | find_first pred (x :: xs) =
88.35 + if pred x then Some x else find_first pred xs;
88.36 +fun swap (x, y) = (y, x);
88.37 +(*HACK.WN080107*) val sstr = str;
88.38 +
88.39 +"**** build the isac kernel = math-engine + IsacKnowledge ";
88.40 +"**** build the math-engine ******************************";
88.41 +use"library.sml";
88.42 +use"calcelems.sml";
88.43 +check_guhs_unique := true;
88.44 +cd "Scripts";
88.45 + use"term_G.sml";
88.46 + use"calculate.sml";
88.47 + use"rewrite.sml";
88.48 + use_thy"Script";
88.49 +(* remove_thy"ListG";
88.50 + use_thy"~/proto2/isac/src/sml/Scripts/Script";
88.51 + *)
88.52 + use"scrtools.sml";
88.53 + cd "..";
88.54 +cd "ME";
88.55 + use"mstools.sml";
88.56 + use"ctree.sml";
88.57 + use"ptyps.sml";
88.58 + use"generate.sml";
88.59 + use"calchead.sml";
88.60 + use"appl.sml";
88.61 + use"rewtools.sml";
88.62 + use"script.sml";
88.63 + use"solve.sml";
88.64 + use"inform.sml";
88.65 + use"mathengine.sml";
88.66 + cd "..";
88.67 +cd "xmlsrc";
88.68 + use"mathml.sml";
88.69 + use"datatypes.sml";
88.70 + use"pbl-met-hierarchy.sml";
88.71 + use"thy-hierarchy.sml";
88.72 + use"interface-xml.sml";
88.73 + cd "..";
88.74 +cd"FE-interface";
88.75 + use"messages.sml";
88.76 + use"states.sml";
88.77 + use"interface.sml";
88.78 + cd "..";
88.79 +use"print_exn_G.sml";
88.80 +"**** build math-engine complete *************************";
88.81 +
88.82 +"**** build the IsacKnowledge ****************************";
88.83 + cd "IsacKnowledge";
88.84 + use_thy"Isac"; (*evaluates ALL thys depending on the root 'Isac'*)
88.85 +
88.86 + (* remove_thy"Typefix";
88.87 + use_thy"~/proto2/isac/src/sml/IsacKnowledge/Isac";
88.88 + *)
88.89 + cd "..";
88.90 +"**** build IsacKnowledge complete ***********************";
88.91 +"**** build isac kernel complete *************************";
88.92 +check_guhs_unique := false;
88.93 +
88.94 +"**** run the tests **************************************";
88.95 +cd "systest";
88.96 +(*+ check kbtest/diffapp.sml for additional items in met-model*)
88.97 + use"root-equ.sml";
88.98 + use"script.sml";
88.99 + (* use"script_if.sml"; WN03 missing: is_rootequation_in*)
88.100 + use"scriptnew.sml";
88.101 + use"subp-rooteq.sml";
88.102 + use"tacis.sml";
88.103 + use"interface-xml.sml";
88.104 + (* use"testdaten.sml"; no update after dropping 'errorBound'*)
88.105 + cd "../..";
88.106 +"**** run systests complete ******************************";
88.107 +(*TODO copy the whole filestructure from sml to smltest*)
88.108 +
88.109 +cd"smltest/Scripts";
88.110 + use"calculate-float.sml";
88.111 + use"calculate.sml";
88.112 + use"listg.sml";
88.113 + use"rewrite.sml";
88.114 + use"scrtools.sml";
88.115 + use"term_G.sml";
88.116 + use"tools.sml";
88.117 + cd "../..";
88.118 +cd"smltest/ME";
88.119 + use"ctree.sml";
88.120 + use"calchead.sml";
88.121 + use"rewtools.sml";
88.122 + use"solve.sml"; (*detailrls can notyet ackn. 'Rewrite_Set "cancel"' *);
88.123 + use"inform.sml";
88.124 + use"me.sml";
88.125 + use"ptyps.sml";
88.126 + cd "../..";
88.127 +cd"smltest/xmlsrc";
88.128 + use"datatypes.sml";
88.129 + use"pbl-met-hierarchy.sml";
88.130 + use"thy-hierarchy.sml";
88.131 + cd "../..";
88.132 +cd"smltest/FE-interface";
88.133 + use"interface.sml";
88.134 + cd "../..";
88.135 +"**** run tests on math-engine complete ******************";
88.136 +cd"smltest/IsacKnowledge";
88.137 + use"atools.sml";
88.138 + use"complex.sml";
88.139 + use"diff.sml";
88.140 + use"diffapp.sml";
88.141 + use"integrate.sml";
88.142 + use"equation.sml";
88.143 + (*use"inssort.sml"; problems with recdef in Isabelle2002*)
88.144 + use"logexp.sml";
88.145 + use"poly.sml";
88.146 + use"polyminus.sml";
88.147 + use"polyeq.sml"; (*TODO 31.b, n1., 44.a, 1.a~, 1.b (all'expanded')WN
88.148 + ? also check others without check 'diff.behav.'*);
88.149 + use"rateq.sml";
88.150 + use"rational.sml" (*TODO add_fractions_p throws overflow-exn WN*);
88.151 + use"rlang.sml"; (*WN.12.6.03: for TODOs search 'writeln',
88.152 + for simplification search MG
88.153 + erls: 98a(1) 104a(1) 104a(2) 68a *);
88.154 + use"root.sml";
88.155 + use"rooteq.sml";
88.156 + use"rootrateq.sml";
88.157 + use"termorder.sml";
88.158 + use"trig.sml";
88.159 + use"vect.sml";
88.160 + use"wn.sml";
88.161 + use"eqsystem.sml";
88.162 + use"biegelinie.sml";
88.163 + use"algein.sml";
88.164 + cd "../..";
88.165 +"**** run tests on IsacKnowledge complete ****************";
88.166 +
88.167 +val path = "/home/neuper/proto2/testsml2xml/";
88.168 +pbl_hierarchy2file (path ^ "pbl/");
88.169 +pbls2file (path ^ "pbl/");
88.170 +met_hierarchy2file (path ^ "met/");
88.171 +mets2file (path ^ "met/");
88.172 +thy_hierarchy2file (path ^ "thy/");
88.173 +thes2file (path ^ "thy/");
88.174 +"**** tested creation of xmldata *************************";
88.175 +
88.176 +cd"sml";
88.177 +states:=[];
88.178 +print_depth 3;
88.179 +"=========================================================";
88.180 +
88.181 +"**** build math-engine complete *************************";
88.182 +"**** build IsacKnowledge complete ***********************";
88.183 +"**** run systests complete ***************** re-organize!";
88.184 +"**** run tests on math-engine complete ******************";
88.185 +"**** run tests on IsacKnowledge complete ****************";
88.186 +"**** tested creation of xmldata *************************";
88.187 +"**** build isac kernel + run tests complete *************";
88.188 +
88.189 +
88.190 +
88.191 +(****************************************************************************
88.192 +WN.notebook: SMLNJ
88.193 +-----------------------------------------------------------------------------
88.194 + cd ~/isabelle-smlnj/heaps/smlnj-110_x86-linux/
88.195 + sml @SMLload=02-HOL-Real-isac
88.196 + cd"~/develop/sml/";
88.197 + use"ROOT.ML";
88.198 +
88.199 +*****************************************************************************
88.200 +WN.notebook: create HTML representation for theory files für Isac
88.201 +-----------------------------------------------------------------------------
88.202 +su
88.203 +cd /home/neuper/proto2/isac/src/
88.204 +mv sml Isac
88.205 +mv Isac/ROOT.ML Isac/ROOT.ML-save
88.206 +cp Isac/RCODE-root.sml Isac/ROOT.ML
88.207 +(*!!!cd"sml";!!! in ROOT.ML-save causes SysErr ("chdir failed", SOME ENOENT)*)
88.208 +
88.209 +/usr/local/Isabelle2002/bin/isatool usedir -i true HOL-Real /home/neuper/proto2/isac/src/Isac/
88.210 +(*^^^ does not create a new heap and writes only NEW files ...
88.211 + ... to isab-installation vvv*)
88.212 +cd /usr/local/Isabelle2002/browser_info/HOL/HOL-Real/
88.213 +cp -r Isac/ /home/neuper/proto2/www/kbase/thy/browser_info/HOL/HOL-Real/
88.214 +
88.215 +cd /home/neuper/proto2/isac/src/
88.216 +mv Isac sml
88.217 +mv sml/ROOT.ML-save sml/ROOT.ML
88.218 +exit
88.219 +
88.220 +*****************************************************************************
88.221 +save and restore contents in *.xml-files; @ stands for thy | pbl | met
88.222 +-----------------------------------------------------------------------------
88.223 +@> grep EXPLANATIONS *.xml > saveecex/EXPLANATIONS.tex
88.224 +@> emacs saveexec/EXPLANATIONS.tex &
88.225 +## there search with "<EXPLANATIONS> </EXPLANATIONS>" for missing lines ...
88.226 +@> cd saveexec
88.227 +## ... and check with ls -l file.xml
88.228 +@> cd ..
88.229 +@> rm *.xml
88.230 +-----------------------------------------------------------------------------
88.231 +export of problems and methods from sml to xml ... see below ***
88.232 +restore contents in *.xml-files:
88.233 +-----------------------------------------------------------------------------
88.234 +
88.235 +
88.236 +
88.237 +*****************************************************************************
88.238 +export of problems and methods from sml to xml
88.239 +-----------------------------------------------------------------------------
88.240 +> val path = "/home/neuper/proto2/isac/xmldata/";
88.241 +
88.242 +> pbl_hierarchy2file (path ^ "pbl/");
88.243 +> pbls2file (path ^ "pbl/");
88.244 +
88.245 +> met_hierarchy2file (path ^ "met/");
88.246 +> mets2file (path ^ "met/");
88.247 +
88.248 +> thy_hierarchy2file (path ^ "thy/");
88.249 +> thes2file (path ^ "thy/");
88.250 +
88.251 +*****************************************************************************
88.252 +WN.notebook: create a new heap (which is used by java in eclipse)
88.253 +(PolyML overwrites HOL-Real-Isac !)
88.254 +-----------------------------------------------------------------------------
88.255 + su
88.256 + cd /usr/local/Isabelle2002/heaps/polyml-4.1.3_x86-linux
88.257 + rm HOL-Real-Isac
88.258 + cp HOL-Real HOL-Real-Isac
88.259 + poly /usr/local/Isabelle2002/heaps/polyml-4.1.3_x86-linux/HOL-Real-Isac
88.260 + cd"/home/neuper/proto2/isac/src/sml"; use"RCODE-root.sml";
88.261 + <ctrl><d>
88.262 + exit
88.263 +
88.264 +*****************************************************************************;
88.265 +IST has another linux + polyml: create another new heap
88.266 +-----------------------------------------------------------------------------
88.267 +notebook:sml> scp -r ../sml wneuper@pear.ist.intra:del_graz/
88.268 +
88.269 + ssh ist
88.270 + cd /usr/local/Isabelle2002/heaps/polyml-4.1.3_x86-linux/
88.271 + rm HOL-Real-Isac
88.272 + TYPE 'yes' !!!
88.273 + cp HOL-Real HOL-Real-Isac
88.274 + chmod u+w HOL-Real-Isac
88.275 + cd ~/del_graz/sml
88.276 + /usr/local/Isabelle2002/bin/isabelle HOL-Real-Isac
88.277 + use"RCODE-root.sml";
88.278 + <ctrl><d>
88.279 + cd /usr/local/Isabelle2002/heaps/polyml-4.1.3_x86-linux/
88.280 + chmod u-w HOL-Real-Isac
88.281 +
88.282 + logout
88.283 +-----------------------------------------------------------------------------
88.284 +test ist> /usr/local/Isabelle2002/bin/isabelle HOL-Real-Isac
88.285 +*****************************************************************************);
89.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
89.2 +++ b/src/Pure/isac/RTEST-root.sml Wed Jul 21 13:53:39 2010 +0200
89.3 @@ -0,0 +1,103 @@
89.4 +(*.evaluate isac (all the code of the kernel) and isactest
89.5 + (c) Walther Neuper 1997
89.6 +
89.7 + /usr/local/Isabelle2002/bin/isabelle HOL-Real-Isac
89.8 +
89.9 + /usr/local/Isabelle2002/bin/isabelle HOL-Real
89.10 + cd"~/proto2/isac/src/sml";
89.11 + use"RTEST-root.sml";
89.12 +
89.13 + use"ROOT.ML";
89.14 + use"RCODE-root.sml";
89.15 +.*)
89.16 +
89.17 +"**** run the tests **************************************";
89.18 +cd "systest";
89.19 +(*+ check kbtest/diffapp.sml for additional items in met-model*)
89.20 + use"root-equ.sml";
89.21 + use"script.sml";
89.22 + (* use"script_if.sml"; WN03 missing: is_rootequation_in*)
89.23 + use"scriptnew.sml";
89.24 + use"subp-rooteq.sml";
89.25 + use"tacis.sml";
89.26 + use"interface-xml.sml";
89.27 + (* use"testdaten.sml"; no update after dropping 'errorBound'*)
89.28 + cd "../..";
89.29 +"**** run systests complete ******************************";
89.30 +
89.31 +cd"smltest/Scripts";
89.32 + use"calculate-float.sml";
89.33 + use"calculate.sml";
89.34 + use"listg.sml";
89.35 + use"rewrite.sml";
89.36 + use"scrtools.sml";
89.37 + use"term_G.sml";
89.38 + use"tools.sml";
89.39 + cd "../..";
89.40 +cd"smltest/ME";
89.41 + use"ctree.sml";
89.42 + use"calchead.sml";
89.43 + use"rewtools.sml";
89.44 + use"solve.sml"; (*detailrls can notyet ackn. 'Rewrite_Set "cancel"' *);
89.45 + use"inform.sml";
89.46 + use"me.sml";
89.47 + use"ptyps.sml";
89.48 + cd "../..";
89.49 +cd"smltest/xmlsrc";
89.50 + use"datatypes.sml";
89.51 + use"pbl-met-hierarchy.sml";
89.52 + use"thy-hierarchy.sml";
89.53 + cd "../..";
89.54 +cd"smltest/FE-interface";
89.55 + use"interface.sml";
89.56 + cd "../..";
89.57 +"**** run tests on math-engine complete ******************";
89.58 +cd"smltest/IsacKnowledge";
89.59 + use"atools.sml";
89.60 + use"complex.sml";
89.61 + use"diff.sml";
89.62 + use"diffapp.sml";
89.63 + use"integrate.sml";
89.64 + use"equation.sml";
89.65 + (*use"inssort.sml"; problems with recdef in Isabelle2002*)
89.66 + use"logexp.sml";
89.67 + use"poly.sml";
89.68 + use"polyminus.sml";
89.69 + use"polyeq.sml"; (*TODO 31.b, n1., 44.a, 1.a~, 1.b (all'expanded')WN
89.70 + ? also check others without check 'diff.behav.'*);
89.71 + use"rateq.sml";
89.72 + use"rational.sml" (*TODO add_fractions_p throws overflow-exn WN*);
89.73 + use"rlang.sml"; (*WN.12.6.03: for TODOs search 'writeln',
89.74 + for simplification search MG
89.75 + erls: 98a(1) 104a(1) 104a(2) 68a *);
89.76 + use"root.sml";
89.77 + use"rooteq.sml";
89.78 + use"rootrateq.sml";
89.79 + use"termorder.sml";
89.80 + use"trig.sml";
89.81 + use"vect.sml";
89.82 + use"wn.sml";
89.83 + use"eqsystem.sml";
89.84 + use"biegelinie.sml";
89.85 + use"algein.sml";
89.86 + cd "../..";
89.87 +"**** run tests on IsacKnowledge complete ****************";
89.88 +
89.89 +val path = "/home/neuper/proto2/testsml2xml/";
89.90 +pbl_hierarchy2file (path ^ "pbl/");
89.91 +pbls2file (path ^ "pbl/");
89.92 +met_hierarchy2file (path ^ "met/");
89.93 +mets2file (path ^ "met/");
89.94 +thy_hierarchy2file (path ^ "thy/");
89.95 +thes2file (path ^ "thy/");
89.96 +"**** tested creation of xmldata *************************";
89.97 +
89.98 +cd"sml";
89.99 +states:=[];
89.100 +"=========================================================";
89.101 +
89.102 +"**** run systests complete ***************** re-organize!";
89.103 +"**** run tests on math-engine complete ******************";
89.104 +"**** run tests on IsacKnowledge complete ****************";
89.105 +"**** build isac kernel + run tests complete *************";
89.106 +"**** tested creation of xmldata *************************";
90.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
90.2 +++ b/src/Pure/isac/Scripts/Isabelle-isac-conflicts Wed Jul 21 13:53:39 2010 +0200
90.3 @@ -0,0 +1,22 @@
90.4 +6.8.02:
90.5 +(1) special constants are already defined by Isabelle2002,
90.6 + and thus cannot be parsed from terms; eg.
90.7 +
90.8 + Reals thus formula 'subproblem (Reals,...)' not possible
90.9 + power thus 'Calculate power' not possible in Scripts
90.10 +
90.11 +(2) numerals in (terms and) thms are stored differently:
90.12 + string Isabelle term isac term
90.13 + 123 Bin.... Free("123",_)
90.14 + 0 Const("0",_) Free("0",_)
90.15 + 0 Const("1",_) Free("1",_)
90.16 +
90.17 +(3) overwritteln functions
90.18 + find_first see isac/ROOT.ML
90.19 +
90.20 +
90.21 +Questions for Isabelle team:
90.22 +
90.23 +28.02.03
90.24 +(4) what is going on in Isa02/Typefix.thy (Markus Wenzen) ?
90.25 +(5) how avoid "- x" ---parse---> Free ("-x", _) ?
90.26 \ No newline at end of file
91.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
91.2 +++ b/src/Pure/isac/Scripts/ListG.ML Wed Jul 21 13:53:39 2010 +0200
91.3 @@ -0,0 +1,77 @@
91.4 +(* use"Scripts/ListG.ML";
91.5 + W.N. 8.01
91.6 +*)
91.7 +
91.8 +"---------";
91.9 +refl;
91.10 +@{thm length_Nil_'};
91.11 +(*
91.12 +nth_Cons_';
91.13 +
91.14 +val list_rls =
91.15 + Rls{id="list_rls",preconds = [], rew_ord = ("dummy_ord",dummy_ord),
91.16 + erls = e_rls, srls = Erls, calc = [], (*asm_thm=[],*)
91.17 + rules = (*8.01: copied from*)
91.18 + [Thm ("refl", num_str refl), (*'a<>b -> FALSE' by fun eval_equal*)
91.19 + (*Thm ("o_apply", num_str Fun.o_apply)*)
91.20 + Thm ("nth_Cons_",num_str nth_Cons_),(*erls for cond. in Atools.ML*)
91.21 + Thm ("nth_Nil_",num_str nth_Nil_)
91.22 +
91.23 + ]};
91.24 +*)
91.25 +
91.26 +(** rule set for evaluating listexpr in scripts **)
91.27 +(*
91.28 +val list_rls =
91.29 + Rls{id="list_rls",preconds = [], rew_ord = ("dummy_ord",dummy_ord),
91.30 + erls = e_rls, srls = Erls, calc = [], (*asm_thm=[],*)
91.31 + rules = (*8.01: copied from*)
91.32 + [Thm ("refl", num_str refl), (*'a<>b -> FALSE' by fun eval_equal*)
91.33 + Thm ("o_apply", num_str o_apply),
91.34 +
91.35 + Thm ("nth_Cons_",num_str nth_Cons_),(*erls for cond. in Atools.ML*)
91.36 + Thm ("nth_Nil_",num_str nth_Nil_),
91.37 + Thm ("append_Cons",num_str append_Cons),
91.38 + Thm ("append_Nil",num_str append_Nil),
91.39 + Thm ("butlast_Cons",num_str butlast_Cons),
91.40 + Thm ("butlast_Nil",num_str butlast_Nil),
91.41 + Thm ("concat_Cons",num_str concat_Cons),
91.42 + Thm ("concat_Nil",num_str concat_Nil),
91.43 + Thm ("del_base",num_str del_base),
91.44 + Thm ("del_rec",num_str del_rec),
91.45 +
91.46 + Thm ("distinct_Cons",num_str distinct_Cons),
91.47 + Thm ("distinct_Nil",num_str distinct_Nil),
91.48 + Thm ("dropWhile_Cons",num_str dropWhile_Cons),
91.49 + Thm ("dropWhile_Nil",num_str dropWhile_Nil),
91.50 + Thm ("filter_Cons",num_str filter_Cons),
91.51 + Thm ("filter_Nil",num_str filter_Nil),
91.52 + Thm ("foldr_Cons",num_str foldr_Cons),
91.53 + Thm ("foldr_Nil",num_str foldr_Nil),
91.54 + Thm ("hd_thm",num_str hd_thm),
91.55 + Thm ("last_thm",num_str last_thm),
91.56 + Thm ("length_Cons_",num_str length_Cons_),
91.57 + Thm ("length_Nil_",num_str length_Nil_),
91.58 + Thm ("list_diff_def",num_str list_diff_def),
91.59 + Thm ("map_Cons",num_str map_Cons),
91.60 + Thm ("map_Nil",num_str map_Cons),
91.61 + Thm ("mem_Cons",num_str mem_Cons),
91.62 + Thm ("mem_Nil",num_str mem_Nil),
91.63 + Thm ("null_Cons",num_str null_Cons),
91.64 + Thm ("null_Nil",num_str null_Nil),
91.65 + Thm ("remdups_Cons",num_str remdups_Cons),
91.66 + Thm ("remdups_Nil",num_str remdups_Nil),
91.67 + Thm ("rev_Cons",num_str rev_Cons),
91.68 + Thm ("rev_Nil",num_str rev_Nil),
91.69 + Thm ("take_Nil",num_str take_Nil),
91.70 + Thm ("take_Cons",num_str take_Cons),
91.71 + Thm ("tl_Cons",num_str tl_Cons),
91.72 + Thm ("tl_Nil",num_str tl_Nil),
91.73 + Thm ("zip_Cons",num_str zip_Cons),
91.74 + Thm ("zip_Nil",num_str zip_Nil)
91.75 + ], scr = EmptyScr}:rls;
91.76 +
91.77 +ruleset' := overwritelthy thy (!ruleset',
91.78 + [("list_rls",list_rls)
91.79 + ]);
91.80 +*)
92.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
92.2 +++ b/src/Pure/isac/Scripts/ListG.thy Wed Jul 21 13:53:39 2010 +0200
92.3 @@ -0,0 +1,216 @@
92.4 +(* use_thy_only"../Scripts/ListG";
92.5 + use_thy_only"Scripts/ListG";
92.6 + use_thy"Scripts/ListG";
92.7 +
92.8 + use_thy_only"ListG";
92.9 + W.N. 8.01
92.10 + attaches identifiers to definition of listfuns,
92.11 + for storing them in list_rls
92.12 +
92.13 +WN.29.4.03:
92.14 +*)
92.15 +
92.16 +theory ListG
92.17 +imports Complex_Main
92.18 +uses ("library.sml")("calcelems.sml")
92.19 +("Scripts/term_G.sml")("Scripts/calculate.sml")
92.20 +("Scripts/rewrite.sml")
92.21 +begin
92.22 +use "library.sml"
92.23 +use "calcelems.sml"
92.24 +use "Scripts/term_G.sml"
92.25 +use "Scripts/calculate.sml"
92.26 +use "Scripts/rewrite.sml"
92.27 +
92.28 +text {* 'nat' in List.thy replaced by 'real' *}
92.29 +
92.30 +primrec length_' :: "'a list => real"
92.31 +where
92.32 + length_Nil_': "length_' [] = 0" (*length: 'a list => nat*)
92.33 +| length_Cons_': "length_' (x#xs) = 1 + length_' xs"
92.34 +
92.35 +primrec del :: "['a list, 'a] => 'a list"
92.36 +where
92.37 + del_base: "del [] x = []"
92.38 +| del_rec: "del (y#ys) x = (if x = y then ys else y#(del ys x))"
92.39 +
92.40 +definition
92.41 + list_diff :: "['a list, 'a list] => 'a list" (* as -- bs *)
92.42 + ("(_ --/ _)" [66, 66] 65)
92.43 + where "a -- b == foldl del a b"
92.44 +
92.45 +consts nth_' :: "[real, 'a list] => 'a"
92.46 +axioms
92.47 + (*** more than one non-variable in pattern in "nth_ 1 [x] = x"--*)
92.48 + nth_Nil_': "nth_' 1 (x#xs) = x"
92.49 +(* nth_Cons_': "nth_' n (x#xs) = nth_' (n+ -1) xs" *)
92.50 +
92.51 +(*rewriter does not reach base case ...... ;
92.52 + the condition involves another rule set (erls, eval_binop in Atools):*)
92.53 + nth_Cons_': "1 < n ==> nth_' n (x#xs) = nth_' (n+ - 1) xs"
92.54 +
92.55 +axioms
92.56 +(*primrec from Isabelle/src/HOL/List.thy -- def.twice not allowed*)
92.57 +(*primrec*)
92.58 + hd_thm: "hd(x#xs) = x"
92.59 +(*primrec*)
92.60 + tl_Nil: "tl([]) = []"
92.61 + tl_Cons: "tl(x#xs) = xs"
92.62 +(*primrec*)
92.63 + null_Nil: "null([]) = True"
92.64 + null_Cons: "null(x#xs) = False"
92.65 +(*primrec*)
92.66 + last_thm: "last(x#xs) = (if xs=[] then x else last xs)"
92.67 +(*primrec*)
92.68 + butlast_Nil: "butlast [] = []"
92.69 + butlast_Cons: "butlast(x#xs) = (if xs=[] then [] else x#butlast xs)"
92.70 +(*primrec*)
92.71 + mem_Nil: "x mem [] = False"
92.72 + mem_Cons: "x mem (y#ys) = (if y=x then True else x mem ys)"
92.73 +(*primrec-------already named---
92.74 + "set [] = {}"
92.75 + "set (x#xs) = insert x (set xs)"
92.76 + primrec
92.77 + list_all_Nil "list_all P [] = True"
92.78 + list_all_Cons "list_all P (x#xs) = (P(x) & list_all P xs)"
92.79 +----------------*)
92.80 +(*primrec*)
92.81 + map_Nil: "map f [] = []"
92.82 + map_Cons: "map f (x#xs) = f(x)#map f xs"
92.83 +(*primrec*)
92.84 + append_Nil: "[] @ys = ys"
92.85 + append_Cons: "(x#xs)@ys = x#(xs@ys)"
92.86 +(*primrec*)
92.87 + rev_Nil: "rev([]) = []"
92.88 + rev_Cons: "rev(x#xs) = rev(xs) @ [x]"
92.89 +(*primrec*)
92.90 + filter_Nil: "filter P [] = []"
92.91 + filter_Cons: "filter P (x#xs) =(if P x then x#filter P xs else filter P xs)"
92.92 +(*primrec-------already named---
92.93 + foldl_Nil "foldl f a [] = a"
92.94 + foldl_Cons "foldl f a (x#xs) = foldl f (f a x) xs"
92.95 +----------------*)
92.96 +(*primrec*)
92.97 + foldr_Nil: "foldr f [] a = a"
92.98 + foldr_Cons: "foldr f (x#xs) a = f x (foldr f xs a)"
92.99 +(*primrec*)
92.100 + concat_Nil: "concat([]) = []"
92.101 + concat_Cons: "concat(x#xs) = x @ concat(xs)"
92.102 +(*primrec-------already named---
92.103 + drop_Nil "drop n [] = []"
92.104 + drop_Cons "drop n (x#xs) = (case n of 0 => x#xs | Suc(m) => drop m xs)"
92.105 + (* Warning: simpset does not contain this definition but separate theorems
92.106 + for n=0 / n=Suc k*)
92.107 +(*primrec*)
92.108 + take_Nil "take n [] = []"
92.109 + take_Cons "take n (x#xs) = (case n of 0 => [] | Suc(m) => x # take m xs)"
92.110 + (* Warning: simpset does not contain this definition but separate theorems
92.111 + for n=0 / n=Suc k*)
92.112 +(*primrec*)
92.113 + nth_Cons "(x#xs)!n = (case n of 0 => x | (Suc k) => xs!k)"
92.114 + (* Warning: simpset does not contain this definition but separate theorems
92.115 + for n=0 / n=Suc k*)
92.116 +(*primrec*)
92.117 + " [][i:=v] = []"
92.118 + "(x#xs)[i:=v] = (case i of 0 => v # xs
92.119 + | Suc j => x # xs[j:=v])"
92.120 +----------------*)
92.121 +(*primrec*)
92.122 + takeWhile_Nil: "takeWhile P [] = []"
92.123 + takeWhile_Cons:
92.124 + "takeWhile P (x#xs) = (if P x then x#takeWhile P xs else [])"
92.125 +(*primrec*)
92.126 + dropWhile_Nil: "dropWhile P [] = []"
92.127 + dropWhile_Cons:
92.128 + "dropWhile P (x#xs) = (if P x then dropWhile P xs else x#xs)"
92.129 +(*primrec*)
92.130 + zip_Nil: "zip xs [] = []"
92.131 + zip_Cons: "zip xs (y#ys) =(case xs of [] => [] | z#zs =>(z,y)#zip zs ys)"
92.132 + (* Warning: simpset does not contain this definition but separate theorems
92.133 + for xs=[] / xs=z#zs *)
92.134 +(*primrec
92.135 + upt_0 "[i..0(] = []"
92.136 + upt_Suc "[i..(Suc j)(] = (if i <= j then [i..j(] @ [j] else [])"
92.137 +*)
92.138 +(*primrec*)
92.139 + distinct_Nil: "distinct [] = True"
92.140 + distinct_Cons: "distinct (x#xs) = (x ~: set xs & distinct xs)"
92.141 +(*primrec*)
92.142 + remdups_Nil: "remdups [] = []"
92.143 + remdups_Cons: "remdups (x#xs) =
92.144 + (if x : set xs then remdups xs else x # remdups xs)"
92.145 +(*primrec-------already named---
92.146 + replicate_0 "replicate 0 x = []"
92.147 + replicate_Suc "replicate (Suc n) x = x # replicate n x"
92.148 +----------------*)
92.149 +
92.150 +(** Lexicographic orderings on lists ...!!!**)
92.151 +
92.152 +
92.153 +ML{* @{thm o_apply} *}
92.154 +ML{* val list_rls =
92.155 + Rls{id="list_rls",preconds = [], rew_ord = ("dummy_ord",dummy_ord),
92.156 + erls = e_rls, srls = Erls, calc = [], (*asm_thm=[],*)
92.157 + rules = (*8.01: copied from*)
92.158 + [Thm ("refl", num_str refl), (*'a<>b -> FALSE' by fun eval_equal*)
92.159 + Thm ("append_Cons",num_str @{thm append_Cons})
92.160 + ], scr = EmptyScr}:rls;
92.161 + *}
92.162 +(*
92.163 +ML{*
92.164 +(** rule set for evaluating listexpr in scripts **)
92.165 +val list_rls =
92.166 + Rls{id="list_rls",preconds = [], rew_ord = ("dummy_ord",dummy_ord),
92.167 + erls = e_rls, srls = Erls, calc = [], (*asm_thm=[],*)
92.168 + rules = (*8.01: copied from*)
92.169 + [Thm ("refl", num_str refl), (*'a<>b -> FALSE' by fun eval_equal*)
92.170 + Thm ("o_apply", num_str @{thm o_apply}),
92.171 +
92.172 + Thm ("nth_Cons_",num_str @{thm nth_Cons_}),(*erls for cond. in Atools.ML*)
92.173 + Thm ("nth_Nil_",num_str @{thm nth_Nil_}),
92.174 + Thm ("append_Cons",num_str @{thm append_Cons}),
92.175 + Thm ("append_Nil",num_str @{thm append_Nil}),
92.176 + Thm ("butlast_Cons",num_str @{thm butlast_Cons}),
92.177 + Thm ("butlast_Nil",num_str @{thm butlast_Nil}),
92.178 + Thm ("concat_Cons",num_str @{thm concat_Cons}),
92.179 + Thm ("concat_Nil",num_str @{thm concat_Nil}),
92.180 + Thm ("del_base",num_str @{thm del_base}),
92.181 + Thm ("del_rec",num_str @{thm del_rec}),
92.182 +
92.183 + Thm ("distinct_Cons",num_str @{thm distinct_Cons}),
92.184 + Thm ("distinct_Nil",num_str @{thm distinct_Nil}),
92.185 + Thm ("dropWhile_Cons",num_str @{thm dropWhile_Cons}),
92.186 + Thm ("dropWhile_Nil",num_str @{thm dropWhile_Nil}),
92.187 + Thm ("filter_Cons",num_str @{thm filter_Cons}),
92.188 + Thm ("filter_Nil",num_str @{thm filter_Nil}),
92.189 + Thm ("foldr_Cons",num_str @{thm foldr_Cons}),
92.190 + Thm ("foldr_Nil",num_str @{thm foldr_Nil}),
92.191 + Thm ("hd_thm",num_str @{thm hd_thm}),
92.192 + Thm ("last_thm",num_str @{thm last_thm}),
92.193 + Thm ("length_Cons_",num_str @{thm length_Cons_}),
92.194 + Thm ("length_Nil_",num_str @{thm length_Nil_}),
92.195 + Thm ("list_diff_def",num_str @{thm list_diff_def}),
92.196 + Thm ("map_Cons",num_str @{thm map_Cons}),
92.197 + Thm ("map_Nil",num_str @{thm map_Cons}),
92.198 + Thm ("mem_Cons",num_str @{thm mem_Cons}),
92.199 + Thm ("mem_Nil",num_str @{thm mem_Nil}),
92.200 + Thm ("null_Cons",num_str @{thm null_Cons}),
92.201 + Thm ("null_Nil",num_str @{thm null_Nil}),
92.202 + Thm ("remdups_Cons",num_str @{thm remdups_Cons}),
92.203 + Thm ("remdups_Nil",num_str @{thm remdups_Nil}),
92.204 + Thm ("rev_Cons",num_str @{thm rev_Cons}),
92.205 + Thm ("rev_Nil",num_str @{thm rev_Nil}),
92.206 + Thm ("take_Nil",num_str @{thm take_Nil}),
92.207 + Thm ("take_Cons",num_str @{thm take_Cons}),
92.208 + Thm ("tl_Cons",num_str @{thm tl_Cons}),
92.209 + Thm ("tl_Nil",num_str @{thm tl_Nil}),
92.210 + Thm ("zip_Cons",num_str @{thm zip_Cons}),
92.211 + Thm ("zip_Nil",num_str @{thm zip_Nil})
92.212 + ], scr = EmptyScr}:rls;
92.213 +
92.214 +ruleset' := overwritelthy thy (!ruleset',
92.215 + [("list_rls",list_rls)
92.216 + ]);
92.217 +*}
92.218 +*)
92.219 +end
93.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
93.2 +++ b/src/Pure/isac/Scripts/Real2002-theorems.sml Wed Jul 21 13:53:39 2010 +0200
93.3 @@ -0,0 +1,1005 @@
93.4 +(*WN060306 from isabelle-users:
93.5 +put expressions involving plus and minus into a canonical form. Here is a possible set of
93.6 +rules:
93.7 +
93.8 + add_assoc add_commute
93.9 + diff_def minus_add_distrib
93.10 + minus_minus minus_zero
93.11 +===========================================================================*)
93.12 +
93.13 +(*
93.14 + cd ~/Isabelle2002/src/HOL/Real
93.15 + grep qed *.ML > ~/develop/isac/Isa02/Real2002-theorems.sml
93.16 + WN 9.8.02
93.17 +
93.18 +ML> thy;
93.19 +val it =
93.20 + {ProtoPure, CPure, HOL, Set, Typedef, Fun, Product_Type, Lfp, Gfp, Sum_Type,
93.21 + Relation, Record, Inductive, Transitive_Closure, Wellfounded_Recursion,
93.22 + NatDef, Nat, NatArith, Divides, Power, SetInterval, Finite_Set, Equiv,
93.23 + IntDef, Int, Datatype_Universe, Datatype, Numeral, Bin, IntArith,
93.24 + Wellfounded_Relations, Recdef, IntDiv, IntPower, NatBin, NatSimprocs,
93.25 + Relation_Power, PreList, List, Map, Hilbert_Choice, Main, Lubs, PNat, PRat,
93.26 + PReal, RealDef, RealOrd, RealInt, RealBin, RealArith0, RealArith,
93.27 + RComplete, RealAbs, RealPow, Ring_and_Field, Complex_Numbers, Real}
93.28 + : theory
93.29 +
93.30 +theories with their respective theorems found by
93.31 +grep qed *.ML > ~/develop/isac/Isa02/Real2002-theorems.sml;
93.32 +theories listed in the the order as found in Real.thy above
93.33 +
93.34 +comments
93.35 + (**)"...theorem..." : first choice for one of the rule-sets
93.36 + "...theorem..."(*??*): to be investigated
93.37 + "...theorem... : just for documenting the contents
93.38 +*)
93.39 +
93.40 +Lubs.ML:qed -----------------------------------------------------------------
93.41 + "setleI"; "ALL y::?'a:?S::?'a set. y <= (?x::?'a) ==> ?S *<= ?x"
93.42 + "setleD"; "[| (?S::?'a set) *<= (?x::?'a); (?y::?'a) : ?S |] ==> ?y <= ?x"
93.43 + "setgeI"; "Ball (?S::?'a set) (op <= (?x::?'a)) ==> ?x <=* ?S"
93.44 + "setgeD"; "[| (?x::?'a) <=* (?S::?'a set); (?y::?'a) : ?S |] ==> ?x <= ?y"
93.45 + "leastPD1";
93.46 + "leastPD2";
93.47 + "leastPD3";
93.48 + "isLubD1";
93.49 + "isLubD1a";
93.50 + "isLub_isUb";
93.51 + "isLubD2";
93.52 + "isLubD3";
93.53 + "isLubI1";
93.54 + "isLubI2";
93.55 + "isUbD";
93.56 + "[| isUb (?R::?'a set) (?S::?'a set) (?x::?'a); (?y::?'a) : ?S |]
93.57 + ==> ?y <= ?x" "isUbD2";
93.58 + "isUbD2a";
93.59 + "isUbI";
93.60 + "isLub_le_isUb";
93.61 + "isLub_ubs";
93.62 +PNat.ML:qed ------------------------------------------------------------------
93.63 + "pnat_fun_mono"; "mono (%X::nat set. {Suc (0::nat)} Un Suc ` X)"
93.64 + "one_RepI"; "Suc (0::nat) : pnat"
93.65 + "pnat_Suc_RepI";
93.66 + "two_RepI";
93.67 + "PNat_induct";
93.68 + "[| (?i::nat) : pnat; (?P::nat => bool) (Suc (0::nat));
93.69 + !!j::nat. [| j : pnat; ?P j |] ==> ?P (Suc j) |] ==> ?P ?i"
93.70 + "pnat_induct";
93.71 + "[| (?P::pnat => bool) (1::pnat); !!n::pnat. ?P n ==> ?P (pSuc n) |]
93.72 + ==> ?P (?n::pnat)"
93.73 + "pnat_diff_induct";
93.74 + "pnatE";
93.75 + "inj_on_Abs_pnat";
93.76 + "inj_Rep_pnat";
93.77 + "zero_not_mem_pnat";
93.78 + "mem_pnat_gt_zero";
93.79 + "gt_0_mem_pnat";
93.80 + "mem_pnat_gt_0_iff";
93.81 + "Rep_pnat_gt_zero";
93.82 + "pnat_add_commute"; "(?x::pnat) + (?y::pnat) = ?y + ?x"
93.83 + "Collect_pnat_gt_0";
93.84 + "pSuc_not_one";
93.85 + "inj_pSuc";
93.86 + "pSuc_pSuc_eq";
93.87 + "n_not_pSuc_n";
93.88 + "not1_implies_pSuc";
93.89 + "pSuc_is_plus_one";
93.90 + "sum_Rep_pnat";
93.91 + "sum_Rep_pnat_sum";
93.92 + "pnat_add_assoc";
93.93 + "pnat_add_left_commute";
93.94 + "pnat_add_left_cancel";
93.95 + "pnat_add_right_cancel";
93.96 + "pnat_no_add_ident";
93.97 + "pnat_less_not_refl";
93.98 + "pnat_less_not_refl2";
93.99 + "Rep_pnat_not_less0";
93.100 + "Rep_pnat_not_less_one";
93.101 + "Rep_pnat_gt_implies_not0";
93.102 + "pnat_less_linear";
93.103 + "Rep_pnat_le_one";
93.104 + "lemma_less_ex_sum_Rep_pnat";
93.105 + "pnat_le_iff_Rep_pnat_le";
93.106 + "pnat_add_left_cancel_le";
93.107 + "pnat_add_left_cancel_less";
93.108 + "pnat_add_lessD1";
93.109 + "pnat_not_add_less1";
93.110 + "pnat_not_add_less2";
93.111 +PNat.ML:qed_spec_mp
93.112 + "pnat_add_leD1";
93.113 + "pnat_add_leD2";
93.114 +PNat.ML:qed
93.115 + "pnat_less_add_eq_less";
93.116 + "pnat_less_iff";
93.117 + "pnat_linear_Ex_eq";
93.118 + "pnat_eq_lessI";
93.119 + "Rep_pnat_mult_1";
93.120 + "Rep_pnat_mult_1_right";
93.121 + "mult_Rep_pnat";
93.122 + "mult_Rep_pnat_mult";
93.123 + "pnat_mult_commute"; "(?m::pnat) * (?n::pnat) = ?n * ?m"
93.124 + "pnat_add_mult_distrib";
93.125 + "pnat_add_mult_distrib2";
93.126 + "pnat_mult_assoc";
93.127 + "pnat_mult_left_commute";
93.128 + "pnat_mult_1";
93.129 + "pnat_mult_1_left";
93.130 + "pnat_mult_less_mono2";
93.131 + "pnat_mult_less_mono1";
93.132 + "pnat_mult_less_cancel2";
93.133 + "pnat_mult_less_cancel1";
93.134 + "pnat_mult_cancel2";
93.135 + "pnat_mult_cancel1";
93.136 + "pnat_same_multI2";
93.137 + "eq_Abs_pnat";
93.138 + "pnat_one_iff";
93.139 + "pnat_two_eq";
93.140 + "inj_pnat_of_nat";
93.141 + "nat_add_one_less";
93.142 + "nat_add_one_less1";
93.143 + "pnat_of_nat_add";
93.144 + "pnat_of_nat_less_iff";
93.145 + "pnat_of_nat_mult";
93.146 +PRat.ML:qed ------------------------------------------------------------------
93.147 + "prat_trans_lemma";
93.148 + "[| (?x1.0::pnat) * (?y2.0::pnat) = (?x2.0::pnat) * (?y1.0::pnat);
93.149 + ?x2.0 * (?y3.0::pnat) = (?x3.0::pnat) * ?y2.0 |]
93.150 + ==> ?x1.0 * ?y3.0 = ?x3.0 * ?y1.0"
93.151 + "ratrel_iff";
93.152 + "ratrelI";
93.153 + "ratrelE_lemma";
93.154 + "ratrelE";
93.155 + "ratrel_refl";
93.156 + "equiv_ratrel";
93.157 + "ratrel_in_prat";
93.158 + "inj_on_Abs_prat";
93.159 + "inj_Rep_prat";
93.160 + "inj_prat_of_pnat";
93.161 + "eq_Abs_prat";
93.162 + "qinv_congruent";
93.163 + "qinv";
93.164 + "qinv_qinv";
93.165 + "inj_qinv";
93.166 + "qinv_1";
93.167 + "prat_add_congruent2_lemma";
93.168 + "prat_add_congruent2";
93.169 + "prat_add";
93.170 + "prat_add_commute";
93.171 + "prat_add_assoc";
93.172 + "prat_add_left_commute";
93.173 + "pnat_mult_congruent2";
93.174 + "prat_mult";
93.175 + "prat_mult_commute";
93.176 + "prat_mult_assoc";
93.177 + "prat_mult_left_commute";
93.178 + "prat_mult_1";
93.179 + "prat_mult_1_right";
93.180 + "prat_of_pnat_add";
93.181 + "prat_of_pnat_mult";
93.182 + "prat_mult_qinv";
93.183 + "prat_mult_qinv_right";
93.184 + "prat_qinv_ex";
93.185 + "prat_qinv_ex1";
93.186 + "prat_qinv_left_ex1";
93.187 + "prat_mult_inv_qinv";
93.188 + "prat_as_inverse_ex";
93.189 + "qinv_mult_eq";
93.190 + "prat_add_mult_distrib";
93.191 + "prat_add_mult_distrib2";
93.192 + "prat_less_iff";
93.193 + "prat_lessI";
93.194 + "prat_lessE_lemma";
93.195 + "prat_lessE";
93.196 + "prat_less_trans";
93.197 + "prat_less_not_refl";
93.198 + "prat_less_not_sym";
93.199 + "lemma_prat_dense";
93.200 + "prat_lemma_dense";
93.201 + "prat_dense";
93.202 + "prat_add_less2_mono1";
93.203 + "prat_add_less2_mono2";
93.204 + "prat_mult_less2_mono1";
93.205 + "prat_mult_left_less2_mono1";
93.206 + "lemma_prat_add_mult_mono";
93.207 + "qless_Ex";
93.208 + "lemma_prat_less_linear";
93.209 + "prat_linear";
93.210 + "prat_linear_less2";
93.211 + "lemma1_qinv_prat_less";
93.212 + "lemma2_qinv_prat_less";
93.213 + "qinv_prat_less";
93.214 + "prat_qinv_gt_1";
93.215 + "prat_qinv_is_gt_1";
93.216 + "prat_less_1_2";
93.217 + "prat_less_qinv_2_1";
93.218 + "prat_mult_qinv_less_1";
93.219 + "prat_self_less_add_self";
93.220 + "prat_self_less_add_right";
93.221 + "prat_self_less_add_left";
93.222 + "prat_self_less_mult_right";
93.223 + "prat_leI";
93.224 + "prat_leD";
93.225 + "prat_less_le_iff";
93.226 + "not_prat_leE";
93.227 + "prat_less_imp_le";
93.228 + "prat_le_imp_less_or_eq";
93.229 + "prat_less_or_eq_imp_le";
93.230 + "prat_le_eq_less_or_eq";
93.231 + "prat_le_refl";
93.232 + "prat_le_less_trans";
93.233 + "prat_le_trans";
93.234 + "not_less_not_eq_prat_less";
93.235 + "prat_add_less_mono";
93.236 + "prat_mult_less_mono";
93.237 + "prat_mult_left_le2_mono1";
93.238 + "prat_mult_le2_mono1";
93.239 + "qinv_prat_le";
93.240 + "prat_add_left_le2_mono1";
93.241 + "prat_add_le2_mono1";
93.242 + "prat_add_le_mono";
93.243 + "prat_add_right_less_cancel";
93.244 + "prat_add_left_less_cancel";
93.245 + "Abs_prat_mult_qinv";
93.246 + "lemma_Abs_prat_le1";
93.247 + "lemma_Abs_prat_le2";
93.248 + "lemma_Abs_prat_le3";
93.249 + "pre_lemma_gleason9_34";
93.250 + "pre_lemma_gleason9_34b";
93.251 + "prat_of_pnat_less_iff";
93.252 + "lemma_prat_less_1_memEx";
93.253 + "lemma_prat_less_1_set_non_empty";
93.254 + "empty_set_psubset_lemma_prat_less_1_set";
93.255 + "lemma_prat_less_1_not_memEx";
93.256 + "lemma_prat_less_1_set_not_rat_set";
93.257 + "lemma_prat_less_1_set_psubset_rat_set";
93.258 + "preal_1";
93.259 + "{x::prat. x < prat_of_pnat (Abs_pnat (Suc (0::nat)))}
93.260 + : {A::prat set.
93.261 + {} < A &
93.262 + A < UNIV &
93.263 + (ALL y::prat:A. (ALL z::prat. z < y --> z : A) & Bex A (op < y))}"
93.264 +PReal.ML:qed -----------------------------------------------------------------
93.265 + "inj_on_Abs_preal"; "inj_on Abs_preal preal"
93.266 + "inj_Rep_preal";
93.267 + "empty_not_mem_preal";
93.268 + "one_set_mem_preal";
93.269 + "preal_psubset_empty";
93.270 + "Rep_preal_psubset_empty";
93.271 + "mem_Rep_preal_Ex";
93.272 + "prealI1";
93.273 + "[| {} < (?A::prat set); ?A < UNIV;
93.274 + ALL y::prat:?A. (ALL z::prat. z < y --> z : ?A) & Bex ?A (op < y) |]
93.275 + ==> ?A : preal"
93.276 + "prealI2";
93.277 + "prealE_lemma";
93.278 + "prealE_lemma1";
93.279 + "prealE_lemma2";
93.280 + "prealE_lemma3";
93.281 + "prealE_lemma3a";
93.282 + "prealE_lemma3b";
93.283 + "prealE_lemma4";
93.284 + "prealE_lemma4a";
93.285 + "not_mem_Rep_preal_Ex";
93.286 + "lemma_prat_less_set_mem_preal";
93.287 + "lemma_prat_set_eq";
93.288 + "inj_preal_of_prat";
93.289 + "not_in_preal_ub";
93.290 + "preal_less_not_refl";
93.291 + "preal_not_refl2";
93.292 + "preal_less_trans";
93.293 + "preal_less_not_sym";
93.294 + "preal_linear";
93.295 + "(?r1.0::preal) < (?r2.0::preal) | ?r1.0 = ?r2.0 | ?r2.0 < ?r1.0"
93.296 + "preal_linear_less2";
93.297 + "preal_add_commute"; "(?x::preal) + (?y::preal) = ?y + ?x"
93.298 + "preal_add_set_not_empty";
93.299 + "preal_not_mem_add_set_Ex";
93.300 + "preal_add_set_not_prat_set";
93.301 + "preal_add_set_lemma3";
93.302 + "preal_add_set_lemma4";
93.303 + "preal_mem_add_set";
93.304 + "preal_add_assoc";
93.305 + "preal_add_left_commute";
93.306 + "preal_mult_commute"; "(?x::preal) * (?y::preal) = ?y * ?x"
93.307 + "preal_mult_set_not_empty";
93.308 + "preal_not_mem_mult_set_Ex";
93.309 + "preal_mult_set_not_prat_set";
93.310 + "preal_mult_set_lemma3";
93.311 + "preal_mult_set_lemma4";
93.312 + "preal_mem_mult_set";
93.313 + "preal_mult_assoc";
93.314 + "preal_mult_left_commute";
93.315 + "preal_mult_1";
93.316 + "preal_mult_1_right";
93.317 + "preal_add_assoc_cong";
93.318 + "preal_add_assoc_swap";
93.319 + "mem_Rep_preal_addD";
93.320 + "mem_Rep_preal_addI";
93.321 + "mem_Rep_preal_add_iff";
93.322 + "mem_Rep_preal_multD";
93.323 + "mem_Rep_preal_multI";
93.324 + "mem_Rep_preal_mult_iff";
93.325 + "lemma_add_mult_mem_Rep_preal";
93.326 + "lemma_add_mult_mem_Rep_preal1";
93.327 + "lemma_preal_add_mult_distrib";
93.328 + "lemma_preal_add_mult_distrib2";
93.329 + "preal_add_mult_distrib2";
93.330 + "preal_add_mult_distrib";
93.331 + "qinv_not_mem_Rep_preal_Ex";
93.332 + "lemma_preal_mem_inv_set_ex";
93.333 + "preal_inv_set_not_empty";
93.334 + "qinv_mem_Rep_preal_Ex";
93.335 + "preal_not_mem_inv_set_Ex";
93.336 + "preal_inv_set_not_prat_set";
93.337 + "preal_inv_set_lemma3";
93.338 + "preal_inv_set_lemma4";
93.339 + "preal_mem_inv_set";
93.340 + "preal_mem_mult_invD";
93.341 + "lemma1_gleason9_34";
93.342 + "lemma1b_gleason9_34";
93.343 + "lemma_gleason9_34a";
93.344 + "lemma_gleason9_34";
93.345 + "lemma1_gleason9_36";
93.346 + "lemma2_gleason9_36";
93.347 + "lemma_gleason9_36";
93.348 + "lemma_gleason9_36a";
93.349 + "preal_mem_mult_invI";
93.350 + "preal_mult_inv";
93.351 + "preal_mult_inv_right";
93.352 + "eq_Abs_preal";
93.353 + "Rep_preal_self_subset";
93.354 + "Rep_preal_sum_not_subset";
93.355 + "Rep_preal_sum_not_eq";
93.356 + "preal_self_less_add_left";
93.357 + "preal_self_less_add_right";
93.358 + "preal_leD";
93.359 + "not_preal_leE";
93.360 + "preal_leI";
93.361 + "preal_less_le_iff";
93.362 + "preal_less_imp_le";
93.363 + "preal_le_imp_less_or_eq";
93.364 + "preal_less_or_eq_imp_le";
93.365 + "preal_le_refl";
93.366 + "preal_le_trans";
93.367 + "preal_le_anti_sym";
93.368 + "preal_neq_iff";
93.369 + "preal_less_le";
93.370 + "lemma_psubset_mem";
93.371 + "lemma_psubset_not_refl";
93.372 + "psubset_trans";
93.373 + "subset_psubset_trans";
93.374 + "subset_psubset_trans2";
93.375 + "psubsetD";
93.376 + "lemma_ex_mem_less_left_add1";
93.377 + "preal_less_set_not_empty";
93.378 + "lemma_ex_not_mem_less_left_add1";
93.379 + "preal_less_set_not_prat_set";
93.380 + "preal_less_set_lemma3";
93.381 + "preal_less_set_lemma4";
93.382 + "preal_mem_less_set";
93.383 + "preal_less_add_left_subsetI";
93.384 + "lemma_sum_mem_Rep_preal_ex";
93.385 + "preal_less_add_left_subsetI2";
93.386 + "preal_less_add_left";
93.387 + "preal_less_add_left_Ex";
93.388 + "preal_add_less2_mono1";
93.389 + "preal_add_less2_mono2";
93.390 + "preal_mult_less_mono1";
93.391 + "preal_mult_left_less_mono1";
93.392 + "preal_mult_left_le_mono1";
93.393 + "preal_mult_le_mono1";
93.394 + "preal_add_left_le_mono1";
93.395 + "preal_add_le_mono1";
93.396 + "preal_add_right_less_cancel";
93.397 + "preal_add_left_less_cancel";
93.398 + "preal_add_less_iff1";
93.399 + "preal_add_less_iff2";
93.400 + "preal_add_less_mono";
93.401 + "preal_mult_less_mono";
93.402 + "preal_add_right_cancel";
93.403 + "preal_add_left_cancel";
93.404 + "preal_add_left_cancel_iff";
93.405 + "preal_add_right_cancel_iff";
93.406 + "preal_sup_mem_Ex";
93.407 + "preal_sup_set_not_empty";
93.408 + "preal_sup_not_mem_Ex";
93.409 + "preal_sup_not_mem_Ex1";
93.410 + "preal_sup_set_not_prat_set";
93.411 + "preal_sup_set_not_prat_set1";
93.412 + "preal_sup_set_lemma3";
93.413 + "preal_sup_set_lemma3_1";
93.414 + "preal_sup_set_lemma4";
93.415 + "preal_sup_set_lemma4_1";
93.416 + "preal_sup";
93.417 + "preal_sup1";
93.418 + "preal_psup_leI";
93.419 + "preal_psup_leI2";
93.420 + "preal_psup_leI2b";
93.421 + "preal_psup_leI2a";
93.422 + "psup_le_ub";
93.423 + "psup_le_ub1";
93.424 + "preal_complete";
93.425 + "lemma_preal_rat_less";
93.426 + "lemma_preal_rat_less2";
93.427 + "preal_of_prat_add";
93.428 + "lemma_preal_rat_less3";
93.429 + "lemma_preal_rat_less4";
93.430 + "preal_of_prat_mult";
93.431 + "preal_of_prat_less_iff"; "(preal_of_prat ?p < preal_of_prat ?q) = (?p < ?q)"
93.432 +RealDef.ML:qed ---------------------------------------------------------------
93.433 + "preal_trans_lemma";
93.434 + "realrel_iff";
93.435 + "realrelI";
93.436 + "?x1.0 + ?y2.0 = ?x2.0 + ?y1.0 ==> ((?x1.0, ?y1.0), ?x2.0, ?y2.0) : realrel"
93.437 + "realrelE_lemma";
93.438 + "realrelE";
93.439 + "realrel_refl";
93.440 + "equiv_realrel";
93.441 + "realrel_in_real";
93.442 + "inj_on_Abs_REAL";
93.443 + "inj_Rep_REAL";
93.444 + "inj_real_of_preal";
93.445 + "eq_Abs_REAL";
93.446 + "real_minus_congruent";
93.447 + "real_minus";
93.448 + "- Abs_REAL (realrel `` {(?x, ?y)}) = Abs_REAL (realrel `` {(?y, ?x)})"
93.449 + "real_minus_minus"; (**)"- (- (?z::real)) = ?z"
93.450 + "inj_real_minus"; "inj uminus"
93.451 + "real_minus_zero"; (**)"- 0 = 0"
93.452 + "real_minus_zero_iff"; (**)"(- ?x = 0) = (?x = 0)"
93.453 + "real_add_congruent2";
93.454 + "congruent2 realrel
93.455 + (%p1 p2. (%(x1, y1). (%(x2, y2). realrel `` {(x1 + x2, y1 + y2)}) p2) p1)"
93.456 + "real_add";
93.457 + "Abs_REAL (realrel `` {(?x1.0, ?y1.0)}) +
93.458 + Abs_REAL (realrel `` {(?x2.0, ?y2.0)}) =
93.459 + Abs_REAL (realrel `` {(?x1.0 + ?x2.0, ?y1.0 + ?y2.0)})"
93.460 + "real_add_commute"; (**)"(?z::real) + (?w::real) = ?w + ?z"
93.461 + "real_add_assoc"; (**)
93.462 + "real_add_left_commute"; (**)
93.463 + "real_add_zero_left"; (**)"0 + ?z = ?z"
93.464 + "real_add_zero_right"; (**)
93.465 + "real_add_minus"; (**)"?z + - ?z = 0"
93.466 + "real_add_minus_left"; (**)
93.467 + "real_add_minus_cancel"; (**)"?z + (- ?z + ?w) = ?w"
93.468 + "real_minus_add_cancel"; (**)"- ?z + (?z + ?w) = ?w"
93.469 + "real_minus_ex"; "EX y. ?x + y = 0"
93.470 + "real_minus_ex1";
93.471 + "real_minus_left_ex1"; "EX! y. y + ?x = 0"
93.472 + "real_add_minus_eq_minus";"?x + ?y = 0 ==> ?x = - ?y"
93.473 + "real_as_add_inverse_ex"; "EX y. ?x = - y"
93.474 + "real_minus_add_distrib"; (**)"- (?x + ?y) = - ?x + - ?y"
93.475 + "real_add_left_cancel"; "(?x + ?y = ?x + ?z) = (?y = ?z)"
93.476 + "real_add_right_cancel"; "(?y + ?x = ?z + ?x) = (?y = ?z)"
93.477 + "real_diff_0"; (**)"0 - ?x = - ?x"
93.478 + "real_diff_0_right"; (**)"?x - 0 = ?x"
93.479 + "real_diff_self"; (**)"?x - ?x = 0"
93.480 + "real_mult_congruent2_lemma";
93.481 + "real_mult_congruent2";
93.482 + "congruent2 realrel
93.483 + (%p1 p2.
93.484 + (%(x1, y1).
93.485 + (%(x2, y2). realrel `` {(x1 * x2 + y1 * y2, x1 * y2 + x2 * y1)})
93.486 + p2) p1)"
93.487 + "real_mult";
93.488 + "Abs_REAL (realrel `` {(?x1.0, ?y1.0)}) *
93.489 + Abs_REAL (realrel `` {(?x2.0, ?y2.0)}) =
93.490 + Abs_REAL
93.491 + (realrel ``
93.492 + {(?x1.0 * ?x2.0 + ?y1.0 * ?y2.0, ?x1.0 * ?y2.0 + ?x2.0 * ?y1.0)})"
93.493 + "real_mult_commute"; (**)"?z * ?w = ?w * ?z"
93.494 + "real_mult_assoc"; (**)
93.495 + "real_mult_left_commute";
93.496 + (**)"?z1.0 * (?z2.0 * ?z3.0) = ?z2.0 * (?z1.0 * ?z3.0)"
93.497 + "real_mult_1"; (**)"1 * ?z = ?z"
93.498 + "real_mult_1_right"; (**)"?z * 1 = ?z"
93.499 + "real_mult_0"; (**)
93.500 + "real_mult_0_right"; (**)"?z * 0 = 0"
93.501 + "real_mult_minus_eq1"; (**)"- ?x * ?y = - (?x * ?y)"
93.502 + "real_mult_minus_eq2"; (**)"?x * - ?y = - (?x * ?y)"
93.503 + "real_mult_minus_1"; (**)"- 1 * ?z = - ?z"
93.504 + "real_mult_minus_1_right";(**)"?z * - 1 = - ?z"
93.505 + "real_minus_mult_cancel"; (**)"- ?x * - ?y = ?x * ?y"
93.506 + "real_minus_mult_commute";(**)"- ?x * ?y = ?x * - ?y"
93.507 + "real_add_assoc_cong";
93.508 + "?z + ?v = ?z' + ?v' ==> ?z + (?v + ?w) = ?z' + (?v' + ?w)"
93.509 + "real_add_assoc_swap"; (**)"?z + (?v + ?w) = ?v + (?z + ?w)"
93.510 + "real_add_mult_distrib"; (**)"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"
93.511 + "real_add_mult_distrib2"; (**)"?w * (?z1.0 + ?z2.0) = ?w * ?z1.0 + ?w * ?z2.0"
93.512 + "real_diff_mult_distrib"; (**)"(?z1.0 - ?z2.0) * ?w = ?z1.0 * ?w - ?z2.0 * ?w"
93.513 + "real_diff_mult_distrib2";(**)"?w * (?z1.0 - ?z2.0) = ?w * ?z1.0 - ?w * ?z2.0"
93.514 + "real_zero_not_eq_one";
93.515 + "real_zero_iff"; "0 = Abs_REAL (realrel `` {(?x, ?x)})"
93.516 + "real_mult_inv_right_ex"; "?x ~= 0 ==> EX y. ?x * y = 1"
93.517 + "real_mult_inv_left_ex"; "?x ~= 0 ==> inverse ?x * ?x = 1"
93.518 + "real_mult_inv_left";
93.519 + "real_mult_inv_right"; "?x ~= 0 ==> ?x * inverse ?x = 1"
93.520 + "INVERSE_ZERO"; "inverse 0 = 0"
93.521 + "DIVISION_BY_ZERO"; (*NOT for adding to default simpset*)"?a / 0 = 0"
93.522 + "real_mult_left_cancel"; (**)"?c ~= 0 ==> (?c * ?a = ?c * ?b) = (?a = ?b)"
93.523 + "real_mult_right_cancel"; (**)"?c ~= 0 ==> (?a * ?c = ?b * ?c) = (?a = ?b)"
93.524 + "real_mult_left_cancel_ccontr"; "?c * ?a ~= ?c * ?b ==> ?a ~= ?b"
93.525 + "real_mult_right_cancel_ccontr"; "?a * ?c ~= ?b * ?c ==> ?a ~= ?b"
93.526 + "real_inverse_not_zero"; "?x ~= 0 ==> inverse ?x ~= 0"
93.527 + "real_mult_not_zero"; "[| ?x ~= 0; ?y ~= 0 |] ==> ?x * ?y ~= 0"
93.528 + "real_inverse_inverse"; "inverse (inverse ?x) = ?x"
93.529 + "real_inverse_1"; "inverse 1 = 1"
93.530 + "real_minus_inverse"; "inverse (- ?x) = - inverse ?x"
93.531 + "real_inverse_distrib"; "inverse (?x * ?y) = inverse ?x * inverse ?y"
93.532 + "real_times_divide1_eq"; (**)"?x * (?y / ?z) = ?x * ?y / ?z"
93.533 + "real_times_divide2_eq"; (**)"?y / ?z * ?x = ?y * ?x / ?z"
93.534 + "real_divide_divide1_eq"; (**)"?x / (?y / ?z) = ?x * ?z / ?y"
93.535 + "real_divide_divide2_eq"; (**)"?x / ?y / ?z = ?x / (?y * ?z)"
93.536 + "real_minus_divide_eq"; (**)"- ?x / ?y = - (?x / ?y)"
93.537 + "real_divide_minus_eq"; (**)"?x / - ?y = - (?x / ?y)"
93.538 + "real_add_divide_distrib"; (**)"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"
93.539 + "preal_lemma_eq_rev_sum";
93.540 + "[| ?x = ?y; ?x1.0 = ?y1.0 |] ==> ?x + ?y1.0 = ?x1.0 + ?y"
93.541 + "preal_add_left_commute_cancel";
93.542 + "?x + (?b + ?y) = ?x1.0 + (?b + ?y1.0) ==> ?x + ?y = ?x1.0 + ?y1.0"
93.543 + "preal_lemma_for_not_refl";
93.544 + "real_less_not_refl"; "~ ?R < ?R"
93.545 + "real_not_refl2";
93.546 + "preal_lemma_trans";
93.547 + "real_less_trans";
93.548 + "real_less_not_sym";
93.549 + "real_of_preal_add";
93.550 + "real_of_preal (?z1.0 + ?z2.0) = real_of_preal ?z1.0 + real_of_preal ?z2.0"
93.551 + "real_of_preal_mult";
93.552 + "real_of_preal_ExI";
93.553 + "real_of_preal_ExD";
93.554 + "real_of_preal_iff";
93.555 + "real_of_preal_trichotomy";
93.556 + "real_of_preal_trichotomyE";
93.557 + "real_of_preal_lessD";
93.558 + "real_of_preal_lessI";
93.559 + "?m1.0 < ?m2.0 ==> real_of_preal ?m1.0 < real_of_preal ?m2.0"
93.560 + "real_of_preal_less_iff1";
93.561 + "real_of_preal_minus_less_self";
93.562 + "real_of_preal_minus_less_zero";
93.563 + "real_of_preal_not_minus_gt_zero";
93.564 + "real_of_preal_zero_less";
93.565 + "real_of_preal_not_less_zero";
93.566 + "real_minus_minus_zero_less";
93.567 + "real_of_preal_sum_zero_less";
93.568 + "real_of_preal_minus_less_all";
93.569 + "real_of_preal_not_minus_gt_all";
93.570 + "real_of_preal_minus_less_rev1";
93.571 + "real_of_preal_minus_less_rev2";
93.572 + "real_of_preal_minus_less_rev_iff";
93.573 + "real_linear"; "?R1.0 < ?R2.0 | ?R1.0 = ?R2.0 | ?R2.0 < ?R1.0"
93.574 + "real_neq_iff";
93.575 + "real_linear_less2";
93.576 + "[| ?R1.0 < ?R2.0 ==> ?P; ?R1.0 = ?R2.0 ==> ?P; ?R2.0 < ?R1.0 ==> ?P |]
93.577 + ==> ?P"
93.578 + "real_leI";
93.579 + "real_leD"; "~ ?w < ?z ==> ?z <= ?w"
93.580 + "real_less_le_iff";
93.581 + "not_real_leE";
93.582 + "real_le_imp_less_or_eq";
93.583 + "real_less_or_eq_imp_le";
93.584 + "real_le_less";
93.585 + "real_le_refl"; "?w <= ?w"
93.586 + "real_le_linear";
93.587 + "real_le_trans"; "[| ?i <= ?j; ?j <= ?k |] ==> ?i <= ?k"
93.588 + "real_le_anti_sym"; "[| ?z <= ?w; ?w <= ?z |] ==> ?z = ?w"
93.589 + "not_less_not_eq_real_less";
93.590 + "real_less_le"; "(?w < ?z) = (?w <= ?z & ?w ~= ?z)"
93.591 + "real_minus_zero_less_iff";
93.592 + "real_minus_zero_less_iff2";
93.593 + "real_less_add_positive_left_Ex";
93.594 + "real_less_sum_gt_zero"; "?W < ?S ==> 0 < ?S + - ?W"
93.595 + "real_lemma_change_eq_subj";
93.596 + "real_sum_gt_zero_less"; "0 < ?S + - ?W ==> ?W < ?S"
93.597 + "real_less_sum_gt_0_iff"; "(0 < ?S + - ?W) = (?W < ?S)"
93.598 + "real_less_eq_diff"; "(?x < ?y) = (?x - ?y < 0)"
93.599 + "real_add_diff_eq"; (**)"?x + (?y - ?z) = ?x + ?y - ?z"
93.600 + "real_diff_add_eq"; (**)"?x - ?y + ?z = ?x + ?z - ?y"
93.601 + "real_diff_diff_eq"; (**)"?x - ?y - ?z = ?x - (?y + ?z)"
93.602 + "real_diff_diff_eq2"; (**)"?x - (?y - ?z) = ?x + ?z - ?y"
93.603 + "real_diff_less_eq"; "(?x - ?y < ?z) = (?x < ?z + ?y)"
93.604 + "real_less_diff_eq";
93.605 + "real_diff_le_eq"; "(?x - ?y <= ?z) = (?x <= ?z + ?y)"
93.606 + "real_le_diff_eq";
93.607 + "real_diff_eq_eq"; (**)"(?x - ?y = ?z) = (?x = ?z + ?y)"
93.608 + "real_eq_diff_eq"; (**)"(?x - ?y = ?z) = (?x = ?z + ?y)"
93.609 + "real_less_eqI";
93.610 + "real_le_eqI";
93.611 + "real_eq_eqI"; "?x - ?y = ?x' - ?y' ==> (?x = ?y) = (?x' = ?y')"
93.612 +RealOrd.ML:qed ---------------------------------------------------------------
93.613 + "real_add_cancel_21"; "(?x + (?y + ?z) = ?y + ?u) = (?x + ?z = ?u)"
93.614 + "real_add_cancel_end"; "(?x + (?y + ?z) = ?y) = (?x = - ?z)"
93.615 + "real_minus_diff_eq"; (*??*)"- (?x - ?y) = ?y - ?x"
93.616 + "real_gt_zero_preal_Ex";
93.617 + "real_gt_preal_preal_Ex";
93.618 + "real_ge_preal_preal_Ex";
93.619 + "real_less_all_preal"; "?y <= 0 ==> ALL x. ?y < real_of_preal x"
93.620 + "real_less_all_real2";
93.621 + "real_lemma_add_positive_imp_less";
93.622 + "real_ex_add_positive_left_less";"EX T. 0 < T & ?R + T = ?S ==> ?R < ?S"
93.623 + "real_less_iff_add";
93.624 + "real_of_preal_le_iff";
93.625 + "real_mult_order"; "[| 0 < ?x; 0 < ?y |] ==> 0 < ?x * ?y"
93.626 + "neg_real_mult_order";
93.627 + "real_mult_less_0"; "[| 0 < ?x; ?y < 0 |] ==> ?x * ?y < 0"
93.628 + "real_zero_less_one"; "0 < 1"
93.629 + "real_add_right_cancel_less"; "(?v + ?z < ?w + ?z) = (?v < ?w)"
93.630 + "real_add_left_cancel_less";
93.631 + "real_add_right_cancel_le";
93.632 + "real_add_left_cancel_le";
93.633 + "real_add_less_le_mono"; "[| ?w' < ?w; ?z' <= ?z |] ==> ?w' + ?z' < ?w + ?z"
93.634 + "real_add_le_less_mono"; "[| ?w' <= ?w; ?z' < ?z |] ==> ?w' + ?z' < ?w + ?z"
93.635 + "real_add_less_mono2";
93.636 + "real_less_add_right_cancel";
93.637 + "real_less_add_left_cancel"; "?C + ?A < ?C + ?B ==> ?A < ?B"
93.638 + "real_le_add_right_cancel";
93.639 + "real_le_add_left_cancel"; "?C + ?A <= ?C + ?B ==> ?A <= ?B"
93.640 + "real_add_order"; "[| 0 < ?x; 0 < ?y |] ==> 0 < ?x + ?y"
93.641 + "real_le_add_order";
93.642 + "real_add_less_mono";
93.643 + "real_add_left_le_mono1";
93.644 + "real_add_le_mono";
93.645 + "real_less_Ex";
93.646 + "real_add_minus_positive_less_self"; "0 < ?r ==> ?u + - ?r < ?u"
93.647 + "real_le_minus_iff"; "(- ?s <= - ?r) = (?r <= ?s)"
93.648 + "real_le_square";
93.649 + "real_of_posnat_one";
93.650 + "real_of_posnat_two";
93.651 + "real_of_posnat_add"; "real_of_posnat ?n1.0 + real_of_posnat ?n2.0 =
93.652 + real_of_posnat (?n1.0 + ?n2.0) + 1"
93.653 + "real_of_posnat_add_one";
93.654 + "real_of_posnat_Suc";
93.655 + "inj_real_of_posnat";
93.656 + "real_of_nat_zero";
93.657 + "real_of_nat_one"; "real (Suc 0) = 1"
93.658 + "real_of_nat_add";
93.659 + "real_of_nat_Suc";
93.660 + "real_of_nat_less_iff";
93.661 + "real_of_nat_le_iff";
93.662 + "inj_real_of_nat";
93.663 + "real_of_nat_ge_zero";
93.664 + "real_of_nat_mult";
93.665 + "real_of_nat_inject";
93.666 +RealOrd.ML:qed_spec_mp
93.667 + "real_of_nat_diff";
93.668 +RealOrd.ML:qed
93.669 + "real_of_nat_zero_iff";
93.670 + "real_of_nat_neg_int";
93.671 + "real_inverse_gt_0";
93.672 + "real_inverse_less_0";
93.673 + "real_mult_less_mono1";
93.674 + "real_mult_less_mono2";
93.675 + "real_mult_less_cancel1";
93.676 + "(?k * ?m < ?k * ?n) = (0 < ?k & ?m < ?n | ?k < 0 & ?n < ?m)"
93.677 + "real_mult_less_cancel2";
93.678 + "real_mult_less_iff1";
93.679 + "real_mult_less_iff2";
93.680 + "real_mult_le_cancel_iff1";
93.681 + "real_mult_le_cancel_iff2";
93.682 + "real_mult_le_less_mono1";
93.683 + "real_mult_less_mono";
93.684 + "real_mult_less_mono'";
93.685 + "real_gt_zero"; "1 <= ?x ==> 0 < ?x"
93.686 + "real_mult_self_le"; "[| 1 < ?r; 1 <= ?x |] ==> ?x <= ?r * ?x"
93.687 + "real_mult_self_le2";
93.688 + "real_inverse_less_swap";
93.689 + "real_mult_is_0";
93.690 + "real_inverse_add";
93.691 + "real_minus_zero_le_iff";
93.692 + "real_minus_zero_le_iff2";
93.693 + "real_sum_squares_cancel"; "?x * ?x + ?y * ?y = 0 ==> ?x = 0"
93.694 + "real_sum_squares_cancel2"; "?x * ?x + ?y * ?y = 0 ==> ?y = 0"
93.695 + "real_0_less_mult_iff";
93.696 + "real_0_le_mult_iff";
93.697 + "real_mult_less_0_iff"; "(?x * ?y < 0) = (0 < ?x & ?y < 0 | ?x < 0 & 0 < ?y)"
93.698 + "real_mult_le_0_iff";
93.699 +RealInt.ML:qed ---------------------------------------------------------------
93.700 + "real_of_int_congruent";
93.701 + "real_of_int"; "real (Abs_Integ (intrel `` {(?i, ?j)})) =
93.702 + Abs_REAL
93.703 + (realrel ``
93.704 + {(preal_of_prat (prat_of_pnat (pnat_of_nat ?i)),
93.705 + preal_of_prat (prat_of_pnat (pnat_of_nat ?j)))})"
93.706 + "inj_real_of_int";
93.707 + "real_of_int_zero";
93.708 + "real_of_one";
93.709 + "real_of_int_add"; "real ?x + real ?y = real (?x + ?y)"
93.710 + "real_of_int_minus";
93.711 + "real_of_int_diff";
93.712 + "real_of_int_mult"; "real ?x * real ?y = real (?x * ?y)"
93.713 + "real_of_int_Suc";
93.714 + "real_of_int_real_of_nat";
93.715 + "real_of_nat_real_of_int";
93.716 + "real_of_int_zero_cancel";
93.717 + "real_of_int_less_cancel";
93.718 + "real_of_int_inject";
93.719 + "real_of_int_less_mono";
93.720 + "real_of_int_less_iff";
93.721 + "real_of_int_le_iff";
93.722 +RealBin.ML:qed ---------------------------------------------------------------
93.723 + "real_number_of"; "real (number_of ?w) = number_of ?w"
93.724 + "real_numeral_0_eq_0";
93.725 + "real_numeral_1_eq_1";
93.726 + "add_real_number_of";
93.727 + "minus_real_number_of";
93.728 + "diff_real_number_of";
93.729 + "mult_real_number_of";
93.730 + "real_mult_2"; (**)"2 * ?z = ?z + ?z"
93.731 + "real_mult_2_right"; (**)"?z * 2 = ?z + ?z"
93.732 + "eq_real_number_of";
93.733 + "less_real_number_of";
93.734 + "le_real_number_of_eq_not_less";
93.735 + "real_minus_1_eq_m1"; "- 1 = -1"(*uminus.. = "-.."*)
93.736 + "real_mult_minus1"; (**)"-1 * ?z = - ?z"
93.737 + "real_mult_minus1_right"; (**)"?z * -1 = - ?z"
93.738 + "zero_less_real_of_nat_iff";"(0 < real ?n) = (0 < ?n)"
93.739 + "zero_le_real_of_nat_iff";
93.740 + "real_add_number_of_left";
93.741 + "real_mult_number_of_left";
93.742 + "number_of ?v * (number_of ?w * ?z) = number_of (bin_mult ?v ?w) * ?z"
93.743 + "real_add_number_of_diff1";
93.744 + "real_add_number_of_diff2";"number_of ?v + (?c - number_of ?w) =
93.745 + number_of (bin_add ?v (bin_minus ?w)) + ?c"
93.746 + "real_of_nat_number_of";
93.747 + "real (number_of ?v) = (if neg (number_of ?v) then 0 else number_of ?v)"
93.748 + "real_less_iff_diff_less_0"; "(?x < ?y) = (?x - ?y < 0)"
93.749 + "real_eq_iff_diff_eq_0";
93.750 + "real_le_iff_diff_le_0";
93.751 + "left_real_add_mult_distrib";
93.752 + (**)"?i * ?u + (?j * ?u + ?k) = (?i + ?j) * ?u + ?k"
93.753 + "real_eq_add_iff1";
93.754 + "(?i * ?u + ?m = ?j * ?u + ?n) = ((?i - ?j) * ?u + ?m = ?n)"
93.755 + "real_eq_add_iff2";
93.756 + "real_less_add_iff1";
93.757 + "real_less_add_iff2";
93.758 + "real_le_add_iff1";
93.759 + "real_le_add_iff2";
93.760 + "real_mult_le_mono1";
93.761 + "real_mult_le_mono2";
93.762 + "real_mult_le_mono";
93.763 + "[| ?i <= ?j; ?k <= ?l; 0 <= ?j; 0 <= ?k |] ==> ?i * ?k <= ?j * ?l"
93.764 +RealArith0.ML:qed ------------------------------------------------------------
93.765 + "real_diff_minus_eq"; (**)"?x - - ?y = ?x + ?y"
93.766 + "real_0_divide"; (**)"0 / ?x = 0"
93.767 + "real_0_less_inverse_iff"; "(0 < inverse ?x) = (0 < ?x)"
93.768 + "real_inverse_less_0_iff";
93.769 + "real_0_le_inverse_iff";
93.770 + "real_inverse_le_0_iff";
93.771 + "REAL_DIVIDE_ZERO"; "?x / 0 = 0"(*!!!*)
93.772 + "real_inverse_eq_divide";
93.773 + "real_0_less_divide_iff";"(0 < ?x / ?y) = (0 < ?x & 0 < ?y | ?x < 0 & ?y < 0)"
93.774 + "real_divide_less_0_iff";"(?x / ?y < 0) = (0 < ?x & ?y < 0 | ?x < 0 & 0 < ?y)"
93.775 + "real_0_le_divide_iff";
93.776 + "real_divide_le_0_iff";
93.777 + "(?x / ?y <= 0) = ((?x <= 0 | ?y <= 0) & (0 <= ?x | 0 <= ?y))"
93.778 + "real_inverse_zero_iff";
93.779 + "real_divide_eq_0_iff"; "(?x / ?y = 0) = (?x = 0 | ?y = 0)"(*!!!*)
93.780 + "real_divide_self_eq"; "?h ~= 0 ==> ?h / ?h = 1"(**)
93.781 + "real_minus_less_minus"; "(- ?y < - ?x) = (?x < ?y)"
93.782 + "real_mult_less_mono1_neg"; "[| ?i < ?j; ?k < 0 |] ==> ?j * ?k < ?i * ?k"
93.783 + "real_mult_less_mono2_neg";
93.784 + "real_mult_le_mono1_neg";
93.785 + "real_mult_le_mono2_neg";
93.786 + "real_mult_less_cancel2";
93.787 + "real_mult_le_cancel2";
93.788 + "real_mult_less_cancel1";
93.789 + "real_mult_le_cancel1";
93.790 + "real_mult_eq_cancel1"; "(?k * ?m = ?k * ?n) = (?k = 0 | ?m = ?n)"
93.791 + "real_mult_eq_cancel2"; "(?m * ?k = ?n * ?k) = (?k = 0 | ?m = ?n)"
93.792 + "real_mult_div_cancel1"; (**)"?k ~= 0 ==> ?k * ?m / (?k * ?n) = ?m / ?n"
93.793 + "real_mult_div_cancel_disj";
93.794 + "?k * ?m / (?k * ?n) = (if ?k = 0 then 0 else ?m / ?n)"
93.795 + "pos_real_le_divide_eq";
93.796 + "neg_real_le_divide_eq";
93.797 + "pos_real_divide_le_eq";
93.798 + "neg_real_divide_le_eq";
93.799 + "pos_real_less_divide_eq";
93.800 + "neg_real_less_divide_eq";
93.801 + "pos_real_divide_less_eq";
93.802 + "neg_real_divide_less_eq";
93.803 + "real_eq_divide_eq"; (**)"?z ~= 0 ==> (?x = ?y / ?z) = (?x * ?z = ?y)"
93.804 + "real_divide_eq_eq"; (**)"?z ~= 0 ==> (?y / ?z = ?x) = (?y = ?x * ?z)"
93.805 + "real_divide_eq_cancel2"; "(?m / ?k = ?n / ?k) = (?k = 0 | ?m = ?n)"
93.806 + "real_divide_eq_cancel1"; "(?k / ?m = ?k / ?n) = (?k = 0 | ?m = ?n)"
93.807 + "real_inverse_less_iff";
93.808 + "real_inverse_le_iff";
93.809 + "real_divide_1"; (**)"?x / 1 = ?x"
93.810 + "real_divide_minus1"; (**)"?x / -1 = - ?x"
93.811 + "real_minus1_divide"; (**)"-1 / ?x = - (1 / ?x)"
93.812 + "real_lbound_gt_zero";
93.813 + "[| 0 < ?d1.0; 0 < ?d2.0 |] ==> EX e. 0 < e & e < ?d1.0 & e < ?d2.0"
93.814 + "real_inverse_eq_iff"; "(inverse ?x = inverse ?y) = (?x = ?y)"
93.815 + "real_divide_eq_iff"; "(?z / ?x = ?z / ?y) = (?z = 0 | ?x = ?y)"
93.816 + "real_less_minus"; "(?x < - ?y) = (?y < - ?x)"
93.817 + "real_minus_less"; "(- ?x < ?y) = (- ?y < ?x)"
93.818 + "real_le_minus";
93.819 + "real_minus_le"; "(- ?x <= ?y) = (- ?y <= ?x)"
93.820 + "real_equation_minus"; (**)"(?x = - ?y) = (?y = - ?x)"
93.821 + "real_minus_equation"; (**)"(- ?x = ?y) = (- ?y = ?x)"
93.822 + "real_add_minus_iff"; (**)"(?x + - ?a = 0) = (?x = ?a)"
93.823 + "real_minus_eq_cancel"; (**)"(- ?b = - ?a) = (?b = ?a)"
93.824 + "real_add_eq_0_iff"; (**)"(?x + ?y = 0) = (?y = - ?x)"
93.825 + "real_add_less_0_iff"; "(?x + ?y < 0) = (?y < - ?x)"
93.826 + "real_0_less_add_iff";
93.827 + "real_add_le_0_iff";
93.828 + "real_0_le_add_iff";
93.829 + "real_0_less_diff_iff"; "(0 < ?x - ?y) = (?y < ?x)"
93.830 + "real_0_le_diff_iff";
93.831 + "real_minus_diff_eq"; (**)"- (?x - ?y) = ?y - ?x"
93.832 + "real_less_half_sum"; "?x < ?y ==> ?x < (?x + ?y) / 2"
93.833 + "real_gt_half_sum";
93.834 + "real_dense"; "?x < ?y ==> EX r. ?x < r & r < ?y"
93.835 +RealArith ///!!!///-----------------------------------------------------------
93.836 +RComplete.ML:qed -------------------------------------------------------------
93.837 + "real_sum_of_halves"; (**)"?x / 2 + ?x / 2 = ?x"
93.838 + "real_sup_lemma1";
93.839 + "real_sup_lemma2";
93.840 + "posreal_complete";
93.841 + "real_isLub_unique";
93.842 + "real_order_restrict";
93.843 + "posreals_complete";
93.844 + "real_sup_lemma3";
93.845 + "lemma_le_swap2";
93.846 + "lemma_real_complete2b";
93.847 + "reals_complete";
93.848 + "real_of_nat_Suc_gt_zero";
93.849 + "reals_Archimedean"; "0 < ?x ==> EX n. inverse (real (Suc n)) < ?x"
93.850 + "reals_Archimedean2";
93.851 +RealAbs.ML:qed
93.852 + "abs_nat_number_of";
93.853 + "abs (number_of ?v) =
93.854 + (if neg (number_of ?v) then number_of (bin_minus ?v) else number_of ?v)"
93.855 + "abs_split";
93.856 + "abs_iff";
93.857 + "abs_zero"; "abs 0 = 0"
93.858 + "abs_one";
93.859 + "abs_eqI1";
93.860 + "abs_eqI2";
93.861 + "abs_minus_eqI2";
93.862 + "abs_minus_eqI1";
93.863 + "abs_ge_zero"; "0 <= abs ?x"
93.864 + "abs_idempotent"; "abs (abs ?x) = abs ?x"
93.865 + "abs_zero_iff"; "(abs ?x = 0) = (?x = 0)"
93.866 + "abs_ge_self"; "?x <= abs ?x"
93.867 + "abs_ge_minus_self";
93.868 + "abs_mult"; "abs (?x * ?y) = abs ?x * abs ?y"
93.869 + "abs_inverse"; "abs (inverse ?x) = inverse (abs ?x)"
93.870 + "abs_mult_inverse";
93.871 + "abs_triangle_ineq"; "abs (?x + ?y) <= abs ?x + abs ?y"
93.872 + "abs_triangle_ineq_four";
93.873 + "abs_minus_cancel";
93.874 + "abs_minus_add_cancel";
93.875 + "abs_triangle_minus_ineq";
93.876 +RealAbs.ML:qed_spec_mp
93.877 + "abs_add_less"; "[| abs ?x < ?r; abs ?y < ?s |] ==> abs (?x + ?y) < ?r + ?s"
93.878 +RealAbs.ML:qed
93.879 + "abs_add_minus_less";
93.880 + "real_mult_0_less"; "(0 * ?x < ?r) = (0 < ?r)"
93.881 + "real_mult_less_trans";
93.882 + "real_mult_le_less_trans";
93.883 + "abs_mult_less";
93.884 + "abs_mult_less2";
93.885 + "abs_less_gt_zero";
93.886 + "abs_minus_one"; "abs -1 = 1"
93.887 + "abs_disj"; "abs ?x = ?x | abs ?x = - ?x"
93.888 + "abs_interval_iff";
93.889 + "abs_le_interval_iff";
93.890 + "abs_add_pos_gt_zero";
93.891 + "abs_add_one_gt_zero";
93.892 + "abs_not_less_zero";
93.893 + "abs_circle"; "abs ?h < abs ?y - abs ?x ==> abs (?x + ?h) < abs ?y"
93.894 + "abs_le_zero_iff";
93.895 + "real_0_less_abs_iff";
93.896 + "abs_real_of_nat_cancel";
93.897 + "abs_add_one_not_less_self";
93.898 + "abs_triangle_ineq_three"; "abs (?w + ?x + ?y) <= abs ?w + abs ?x + abs ?y"
93.899 + "abs_diff_less_imp_gt_zero";
93.900 + "abs_diff_less_imp_gt_zero2";
93.901 + "abs_diff_less_imp_gt_zero3";
93.902 + "abs_diff_less_imp_gt_zero4";
93.903 + "abs_triangle_ineq_minus_cancel";
93.904 + "abs_sum_triangle_ineq";
93.905 + "abs (?x + ?y + (- ?l + - ?m)) <= abs (?x + - ?l) + abs (?y + - ?m)"
93.906 +RealPow.ML:qed
93.907 + "realpow_zero"; "0 ^ Suc ?n = 0"
93.908 +RealPow.ML:qed_spec_mp
93.909 + "realpow_not_zero"; "?r ~= 0 ==> ?r ^ ?n ~= 0"
93.910 + "realpow_zero_zero"; "?r ^ ?n = 0 ==> ?r = 0"
93.911 + "realpow_inverse"; "inverse (?r ^ ?n) = inverse ?r ^ ?n"
93.912 + "realpow_abs"; "abs (?r ^ ?n) = abs ?r ^ ?n"
93.913 + "realpow_add"; (**)"?r ^ (?n + ?m) = ?r ^ ?n * ?r ^ ?m"
93.914 + "realpow_one"; (**)"?r ^ 1 = ?r"
93.915 + "realpow_two"; (**)"?r ^ Suc (Suc 0) = ?r * ?r"
93.916 +RealPow.ML:qed_spec_mp
93.917 + "realpow_gt_zero"; "0 < ?r ==> 0 < ?r ^ ?n"
93.918 + "realpow_ge_zero"; "0 <= ?r ==> 0 <= ?r ^ ?n"
93.919 + "realpow_le"; "0 <= ?x & ?x <= ?y ==> ?x ^ ?n <= ?y ^ ?n"
93.920 + "realpow_less";
93.921 +RealPow.ML:qed
93.922 + "realpow_eq_one"; (**)"1 ^ ?n = 1"
93.923 + "abs_realpow_minus_one"; "abs (-1 ^ ?n) = 1"
93.924 + "realpow_mult"; (**)"(?r * ?s) ^ ?n = ?r ^ ?n * ?s ^ ?n"
93.925 + "realpow_two_le"; "0 <= ?r ^ Suc (Suc 0)"
93.926 + "abs_realpow_two";
93.927 + "realpow_two_abs"; "abs ?x ^ Suc (Suc 0) = ?x ^ Suc (Suc 0)"
93.928 + "realpow_two_gt_one";
93.929 +RealPow.ML:qed_spec_mp
93.930 + "realpow_ge_one"; "1 < ?r ==> 1 <= ?r ^ ?n"
93.931 +RealPow.ML:qed
93.932 + "realpow_ge_one2";
93.933 + "two_realpow_ge_one";
93.934 + "two_realpow_gt";
93.935 + "realpow_minus_one"; (**)"-1 ^ (2 * ?n) = 1"
93.936 + "realpow_minus_one_odd"; "-1 ^ Suc (2 * ?n) = - 1"
93.937 + "realpow_minus_one_even";
93.938 +RealPow.ML:qed_spec_mp
93.939 + "realpow_Suc_less";
93.940 + "realpow_Suc_le"; "0 <= ?r & ?r < 1 ==> ?r ^ Suc ?n <= ?r ^ ?n"
93.941 +RealPow.ML:qed
93.942 + "realpow_zero_le"; "0 <= 0 ^ ?n"
93.943 +RealPow.ML:qed_spec_mp
93.944 + "realpow_Suc_le2";
93.945 +RealPow.ML:qed
93.946 + "realpow_Suc_le3";
93.947 +RealPow.ML:qed_spec_mp
93.948 + "realpow_less_le"; "0 <= ?r & ?r < 1 & ?n < ?N ==> ?r ^ ?N <= ?r ^ ?n"
93.949 +RealPow.ML:qed
93.950 + "realpow_le_le"; "[| 0 <= ?r; ?r < 1; ?n <= ?N |] ==> ?r ^ ?N <= ?r ^ ?n"
93.951 + "realpow_Suc_le_self";
93.952 + "realpow_Suc_less_one";
93.953 +RealPow.ML:qed_spec_mp
93.954 + "realpow_le_Suc";
93.955 + "realpow_less_Suc";
93.956 + "realpow_le_Suc2";
93.957 + "realpow_gt_ge";
93.958 + "realpow_gt_ge2";
93.959 +RealPow.ML:qed
93.960 + "realpow_ge_ge"; "[| 1 < ?r; ?n <= ?N |] ==> ?r ^ ?n <= ?r ^ ?N"
93.961 + "realpow_ge_ge2";
93.962 +RealPow.ML:qed_spec_mp
93.963 + "realpow_Suc_ge_self";
93.964 + "realpow_Suc_ge_self2";
93.965 +RealPow.ML:qed
93.966 + "realpow_ge_self";
93.967 + "realpow_ge_self2";
93.968 +RealPow.ML:qed_spec_mp
93.969 + "realpow_minus_mult"; "0 < ?n ==> ?x ^ (?n - 1) * ?x = ?x ^ ?n"
93.970 + "realpow_two_mult_inverse";
93.971 + "?r ~= 0 ==> ?r * inverse ?r ^ Suc (Suc 0) = inverse ?r"
93.972 + "realpow_two_minus"; "(- ?x) ^ Suc (Suc 0) = ?x ^ Suc (Suc 0)"
93.973 + "realpow_two_diff";
93.974 + "realpow_two_disj";
93.975 + "realpow_diff";
93.976 + "[| ?x ~= 0; ?m <= ?n |] ==> ?x ^ (?n - ?m) = ?x ^ ?n * inverse (?x ^ ?m)"
93.977 + "realpow_real_of_nat";
93.978 + "realpow_real_of_nat_two_pos"; "0 < real (Suc (Suc 0) ^ ?n)"
93.979 +RealPow.ML:qed_spec_mp
93.980 + "realpow_increasing";
93.981 + "realpow_Suc_cancel_eq";
93.982 + "[| 0 <= ?x; 0 <= ?y; ?x ^ Suc ?n = ?y ^ Suc ?n |] ==> ?x = ?y"
93.983 +RealPow.ML:qed
93.984 + "realpow_eq_0_iff"; "(?x ^ ?n = 0) = (?x = 0 & 0 < ?n)"
93.985 + "zero_less_realpow_abs_iff";
93.986 + "zero_le_realpow_abs";
93.987 + "real_of_int_power"; "real ?x ^ ?n = real (?x ^ ?n)"
93.988 + "power_real_number_of"; "number_of ?v ^ ?n = real (number_of ?v ^ ?n)"
93.989 +Ring_and_Field ---///!!!///---------------------------------------------------
93.990 +Complex_Numbers --///!!!///---------------------------------------------------
93.991 +Real -------------///!!!///---------------------------------------------------
93.992 +real_arith0.ML:qed "";
93.993 +real_arith0.ML:qed "";
93.994 +real_arith0.ML:qed "";
93.995 +real_arith0.ML:qed "";
93.996 +real_arith0.ML:qed "";
93.997 +real_arith0.ML:qed "";
93.998 +real_arith0.ML:qed "";
93.999 +real_arith0.ML:qed "";
93.1000 +real_arith0.ML:qed "";
93.1001 +
93.1002 +
93.1003 +
93.1004 +
93.1005 +
93.1006 +
93.1007 +
93.1008 +
94.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
94.2 +++ b/src/Pure/isac/Scripts/Script.ML Wed Jul 21 13:53:39 2010 +0200
94.3 @@ -0,0 +1,58 @@
94.4 +(* lists of tactics, script-expressions etc.
94.5 + WN.14.3.00
94.6 + *)
94.7 +
94.8 +theory' := overwritel (! theory',
94.9 + [(e_domID,Script.thy),
94.10 + ("Script.thy",Script.thy)
94.11 + ]);
94.12 +
94.13 +(*.record all theories defined for Scripts; in order to distinguish them
94.14 + from general IsacKnowledge defined later on.*)
94.15 +script_thys := !theory';
94.16 +
94.17 +
94.18 +(*--vvv----- SHIFT? or delete ?*)
94.19 +val IDTyp = Type("Script.ID",[]);
94.20 +
94.21 +
94.22 +val tacs = ref (distinct
94.23 + ["Calculate",
94.24 + "Rewrite","Rewrite'_Inst","Rewrite'_Set","Rewrite'_Set'_Inst",
94.25 + "Substitute","Tac","Check'_elementswise",
94.26 + "Take","Subproblem","Or'_to'_List"] \ "");
94.27 +
94.28 +val screxpr = ref (distinct
94.29 + ["Let","If","Repeat","While","Try","Or"] \ "");
94.30 +
94.31 +val listfuns = ref [(*_all_ functions in Isa99.List.thy *)
94.32 + "@","filter","concat","foldl","hd","last","set","list_all",
94.33 + "map","mem","nth","list_update","take","drop",
94.34 + "takeWhile","dropWhile","tl","butlast",
94.35 + "rev","zip","upt","remdups","nodups","replicate",
94.36 +
94.37 + "Cons","Nil"];
94.38 +
94.39 +val scrfuns = ref (distinct
94.40 + ["Testvar"] \ "");
94.41 +
94.42 +val listexpr = ref ((!listfuns) union (!scrfuns));
94.43 +
94.44 +val notsimp = ref
94.45 + (distinct (!tacs @ !screxpr @ (*!subpbls @*) !scrfuns @ !listfuns) \ "");
94.46 +
94.47 +val negotiable = ref ((!tacs (*@ !subpbls*)));
94.48 +
94.49 +val tacpbl = ref
94.50 + (distinct (!tacs (*@ !subpbls*)) \ "");
94.51 +(*--^^^----- SHIFT? or delete ?*)
94.52 +
94.53 +
94.54 +
94.55 +
94.56 +
94.57 +
94.58 +
94.59 +
94.60 +
94.61 +
95.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
95.2 +++ b/src/Pure/isac/Scripts/Script.thy Wed Jul 21 13:53:39 2010 +0200
95.3 @@ -0,0 +1,145 @@
95.4 +(* tactics, tacticals etc. for scripts
95.5 + W.N.24.2.00
95.6 + use_thy_only"Scripts/Script";
95.7 + use_thy"../Scripts/Script";
95.8 + use_thy"Script";
95.9 + *)
95.10 +
95.11 +theory Script
95.12 +imports Tools
95.13 +begin
95.14 +
95.15 +typedecl
95.16 + ID (* identifiers for thy, ruleset,... *)
95.17 +
95.18 +typedecl
95.19 + arg (* argument of subproblem *)
95.20 +
95.21 +consts
95.22 +
95.23 +(*types of subproblems' arguments*)
95.24 + real_' :: "real => arg"
95.25 + real_list_' :: "(real list) => arg"
95.26 + real_set_' :: "(real set) => arg"
95.27 + bool_' :: "bool => arg"
95.28 + bool_list_' :: "(bool list) => arg"
95.29 + real_real_' :: "(real => real) => arg"
95.30 +
95.31 +(*tactics*)
95.32 + Rewrite :: "[ID, bool, 'a] => 'a"
95.33 + Rewrite'_Inst:: "[(real * real) list, ID, bool, 'a] => 'a"
95.34 + ("(Rewrite'_Inst (_ _ _))" 11)
95.35 + (*without last argument ^^ for @@*)
95.36 + Rewrite'_Set :: "[ID, bool, 'a] => 'a" ("(Rewrite'_Set (_ _))" 11)
95.37 + Rewrite'_Set'_Inst
95.38 + :: "[(real * real) list, ID, bool, 'a] => 'a"
95.39 + ("(Rewrite'_Set'_Inst (_ _ _))" 11)
95.40 + (*without last argument ^^ for @@*)
95.41 + Calculate :: "[ID, 'a] => 'a"
95.42 + Calculate1 :: "[ID, 'a] => 'a" (*FIXXXME: unknown to script-interpreter*)
95.43 +
95.44 + (* WN0509 substitution now is rewriting by a list of terms (of type bool)
95.45 + Substitute :: "[(real * real) list, 'a] => 'a"*)
95.46 + Substitute :: "[bool list, 'a] => 'a"
95.47 +
95.48 + Map :: "['a => 'b, 'a list] => 'b list"
95.49 + Tac :: "ID => 'a" (*deprecated; only use in Test.ML*)
95.50 + Check'_elementwise ::
95.51 + "['a list, 'b set] => 'a list"
95.52 + ("Check'_elementwise (_ _)" 11)
95.53 + Take :: "'a => 'a" (*for non-var args as long as no 'o'*)
95.54 + SubProblem :: "[ID * ID list * ID list, arg list] => 'a"
95.55 +
95.56 + Or'_to'_List :: "bool => 'a list" ("Or'_to'_List (_)" 11)
95.57 + (*=========== record these ^^^ in 'tacs' in Script.ML =========*)
95.58 +
95.59 + Assumptions :: bool
95.60 + Problem :: "[ID * ID list] => 'a"
95.61 +
95.62 +(*special formulas for frontend 'CAS format'*)
95.63 + Subproblem :: "(ID * ID list) => 'a"
95.64 +
95.65 +(*script-expressions (tacticals)*)
95.66 + Seq :: "['a => 'a, 'a => 'a, 'a] => 'a" (infixr "@@" 10) (*@ used*)
95.67 + Try :: "['a => 'a, 'a] => 'a"
95.68 + Repeat :: "['a => 'a, 'a] => 'a"
95.69 + Or :: "['a => 'a, 'a => 'a, 'a] => 'a" (infixr "Or" 10)
95.70 + While :: "[bool, 'a => 'a, 'a] => 'a" ("((While (_) Do)//(_))" 9)
95.71 + (*'b => bool doesn't work with "contains_root _"*)
95.72 + Letpar :: "['a, 'a => 'b] => 'b"
95.73 + (*--- defined in Isabelle/scr/HOL/HOL.thy:
95.74 + Let :: "['a, 'a => 'b] => 'b"
95.75 + "_Let" :: "[letbinds, 'a] => 'a" ("(let (_)/ in (_))" 10)
95.76 + If :: "[bool, 'a, 'a] => 'a" ("(if (_)/ then (_)/ else (_))" 10)
95.77 + %x. P x .. lambda is defined in Isabelles meta logic
95.78 + --- *)
95.79 +
95.80 +
95.81 + failtac :: 'a
95.82 + idletac :: 'a
95.83 + (*... + RECORD IN 'screxpr' in Script.ML *)
95.84 +
95.85 +(*for scripts generated automatically from rls*)
95.86 + Stepwise :: "['z, 'z] => 'z" ("((Script Stepwise (_ =))// (_))" 9)
95.87 + Stepwise'_inst:: "['z,real,'z] => 'z"
95.88 + ("((Script Stepwise'_inst (_ _ =))// (_))" 9)
95.89 +
95.90 +
95.91 +(*SHIFT -> resp.thys ----vvv---------------------------------------------*)
95.92 +(*script-names: initial capital letter,
95.93 + type of last arg (=script-body) == result-type !
95.94 + Xxxx :: script ids, duplicate result-type 'r in last argument:
95.95 + "['a, ... , \
95.96 + \ 'r] => 'r
95.97 +*)
95.98 +
95.99 +(*make'_solution'_set :: "bool => bool list"
95.100 + ("(make'_solution'_set (_))" 11)
95.101 +
95.102 + max'_on'_interval
95.103 + :: "[ID * (ID list) * ID, bool,real,real set] => real"
95.104 + ("(max'_on'_interval (_)/ (_ _ _))" 9)
95.105 + find'_vals
95.106 + :: "[ID * (ID list) * ID,
95.107 + real,real,real,real,bool list] => bool list"
95.108 + ("(find'_vals (_)/ (_ _ _ _ _))" 9)
95.109 +
95.110 + make'_fun :: "[ID * (ID list) * ID, real,real,bool list] => bool"
95.111 + ("(make'_fun (_)/ (_ _ _))" 9)
95.112 +
95.113 + solve'_univar
95.114 + :: "[ID * (ID list) * ID, bool,real] => bool list"
95.115 + ("(solve'_univar (_)/ (_ _ ))" 9)
95.116 + solve'_univar'_err
95.117 + :: "[ID * (ID list) * ID, bool,real,bool] => bool list"
95.118 + ("(solve'_univar (_)/ (_ _ _))" 9)
95.119 +----------*)
95.120 +
95.121 + Testeq :: "[bool, bool] => bool"
95.122 + ("((Script Testeq (_ =))//
95.123 + (_))" 9)
95.124 +
95.125 + Testeq2 :: "[bool, bool list] => bool list"
95.126 + ("((Script Testeq2 (_ =))//
95.127 + (_))" 9)
95.128 +
95.129 + Testterm :: "[real, real] => real"
95.130 + ("((Script Testterm (_ =))//
95.131 + (_))" 9)
95.132 +
95.133 + Testchk :: "[bool, real, real list] => real list"
95.134 + ("((Script Testchk (_ _ =))//
95.135 + (_))" 9)
95.136 + (*... + RECORD IN 'subpbls' in Script.ML *)
95.137 +(*SHIFT -> resp.thys ----^^^----------------------------*)
95.138 +
95.139 +syntax
95.140 +
95.141 + "_Letpar" :: "[letbinds, 'a] => 'a" ("(letpar (_)/ in (_))" 10)
95.142 +
95.143 +translations
95.144 +
95.145 + "_Letpar (_binds b bs) e" == "_Letpar b (_Letpar bs e)"
95.146 + "letpar x = a in e" == "Letpar a (%x. e)"
95.147 +
95.148 +end
96.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
96.2 +++ b/src/Pure/isac/Scripts/Tools.ML Wed Jul 21 13:53:39 2010 +0200
96.3 @@ -0,0 +1,199 @@
96.4 +(* auxiliary functions for scripts
96.5 + WN.9.00
96.6 +*)
96.7 +(* use"~/proto2/isac/src/sml/Scripts/Tools.ML";
96.8 + *)
96.9 +
96.10 +
96.11 +(*11.02: for equation solving only*)
96.12 +val UniversalList = (term_of o the o (parse Tools.thy)) "UniversalList";
96.13 +val EmptyList = (term_of o the o (parse Tools.thy)) "[]::bool list";
96.14 +
96.15 +
96.16 +
96.17 +(*+ for Or_to_List +*)
96.18 +fun or2list (Const ("True",_)) = (writeln"### or2list True";UniversalList)
96.19 + | or2list (Const ("False",_)) = (writeln"### or2list False";EmptyList)
96.20 + | or2list (t as Const ("op =",_) $ _ $ _) =
96.21 + (writeln"### or2list _ = _";list2isalist bool [t])
96.22 + | or2list ors =
96.23 + (writeln"### or2list _ | _";
96.24 + let fun get ls (Const ("op |",_) $ o1 $ o2) =
96.25 + case o2 of
96.26 + Const ("op |",_) $ _ $ _ => get (ls @ [o1]) o2
96.27 + | _ => ls @ [o1, o2]
96.28 + in (((list2isalist bool) o (get [])) ors)
96.29 + handle _ => raise error ("or2list: no ORs= "^(term2str ors)) end
96.30 + );
96.31 +(*>val t = HOLogic.true_const;
96.32 +> val t' = or2list t;
96.33 +> term2str t';
96.34 +"Atools.UniversalList"
96.35 +> val t = HOLogic.false_const;
96.36 +> val t' = or2list t;
96.37 +> term2str t';
96.38 +"[]"
96.39 +> val t=(term_of o the o (parse thy)) "x=3";
96.40 +> val t' = or2list t;
96.41 +> term2str t';
96.42 +"[x = 3]"
96.43 +> val t=(term_of o the o (parse thy))"(x=3) | (x=-3) | (x=0)";
96.44 +> val t' = or2list t;
96.45 +> term2str t';
96.46 +"[x = #3, x = #-3, x = #0]" : string *)
96.47 +
96.48 +
96.49 +
96.50 +
96.51 +(** evaluation on the meta-level **)
96.52 +
96.53 +(*. evaluate the predicate matches (match on whole term only) .*)
96.54 +(*("matches",("Tools.matches",eval_matches "#matches_")):calc*)
96.55 +fun eval_matches (thmid:string) "Tools.matches"
96.56 + (t as Const ("Tools.matches",_) $ pat $ tst) thy =
96.57 + if matches thy tst pat
96.58 + then let val prop = Trueprop $ (mk_equality (t, true_as_term))
96.59 + in Some ((string_of_cterm o cterm_of (sign_of thy)) prop,
96.60 + prop) end
96.61 + else let val prop = Trueprop $ (mk_equality (t, false_as_term))
96.62 + in Some ((string_of_cterm o cterm_of (sign_of thy)) prop,
96.63 + prop) end
96.64 + | eval_matches _ _ _ _ = None;
96.65 +(*
96.66 +> val t = (term_of o the o (parse thy))
96.67 + "matches (?x = 0) (1 * x ^^^ 2 = 0)";
96.68 +> eval_matches "/thmid/" "/op_/" t thy;
96.69 +val it =
96.70 + Some
96.71 + ("matches (x = 0) (1 * x ^^^ 2 = 0) = False",
96.72 + Const (#,#) $ (# $ # $ Const #)) : (string * term) option
96.73 +
96.74 +> val t = (term_of o the o (parse thy))
96.75 + "matches (?a = #0) (#1 * x ^^^ #2 = #0)";
96.76 +> eval_matches "/thmid/" "/op_/" t thy;
96.77 +val it =
96.78 + Some
96.79 + ("matches (?a = #0) (#1 * x ^^^ #2 = #0) = True",
96.80 + Const (#,#) $ (# $ # $ Const #)) : (string * term) option
96.81 +
96.82 +> val t = (term_of o the o (parse thy))
96.83 + "matches (?a * x = #0) (#1 * x ^^^ #2 = #0)";
96.84 +> eval_matches "/thmid/" "/op_/" t thy;
96.85 +val it =
96.86 + Some
96.87 + ("matches (?a * x = #0) (#1 * x ^^^ #2 = #0) = False",
96.88 + Const (#,#) $ (# $ # $ Const #)) : (string * term) option
96.89 +
96.90 +> val t = (term_of o the o (parse thy))
96.91 + "matches (?a * x ^^^ #2 = #0) (#1 * x ^^^ #2 = #0)";
96.92 +> eval_matches "/thmid/" "/op_/" t thy;
96.93 +val it =
96.94 + Some
96.95 + ("matches (?a * x ^^^ #2 = #0) (#1 * x ^^^ #2 = #0) = True",
96.96 + Const (#,#) $ (# $ # $ Const #)) : (string * term) option
96.97 +----- before ?patterns ---:
96.98 +> val t = (term_of o the o (parse thy))
96.99 + "matches (a * b^^^#2 = c) (#3 * x^^^#2 = #1)";
96.100 +> eval_matches "/thmid/" "/op_/" t thy;
96.101 +Some
96.102 + ("matches (a * b ^^^ #2 = c) (#3 * x ^^^ #2 = #1) = True",
96.103 + Const ("Trueprop","bool => prop") $ (Const # $ (# $ #) $ Const (#,#)))
96.104 + : (string * term) option
96.105 +
96.106 +> val t = (term_of o the o (parse thy))
96.107 + "matches (a * b^^^#2 = c) (#3 * x^^^#2222 = #1)";
96.108 +> eval_matches "/thmid/" "/op_/" t thy;
96.109 +Some ("matches (a * b ^^^ #2 = c) (#3 * x ^^^ #2222 = #1) = False",
96.110 + Const ("Trueprop","bool => prop") $ (Const # $ (# $ #) $ Const (#,#)))
96.111 +
96.112 +> val t = (term_of o the o (parse thy))
96.113 + "matches (a = b) (x + #1 + #-1 * #2 = #0)";
96.114 +> eval_matches "/thmid/" "/op_/" t thy;
96.115 +Some ("matches (a = b) (x + #1 + #-1 * #2 = #0) = True",Const # $ (# $ #))
96.116 +*)
96.117 +
96.118 +(*.does a pattern match some subterm ?.*)
96.119 +fun matchsub thy t pat =
96.120 + let fun matchs (t as Const _) = matches thy t pat
96.121 + | matchs (t as Free _) = matches thy t pat
96.122 + | matchs (t as Var _) = matches thy t pat
96.123 + | matchs (Bound _) = false
96.124 + | matchs (t as Abs (_, _, body)) =
96.125 + if matches thy t pat then true else matches thy body pat
96.126 + | matchs (t as f1 $ f2) =
96.127 + if matches thy t pat then true
96.128 + else if matchs f1 then true else matchs f2
96.129 + in matchs t end;
96.130 +
96.131 +(*("matchsub",("Tools.matchsub",eval_matchsub "#matchsub_")):calc*)
96.132 +fun eval_matchsub (thmid:string) "Tools.matchsub"
96.133 + (t as Const ("Tools.matchsub",_) $ pat $ tst) thy =
96.134 + if matchsub thy tst pat
96.135 + then let val prop = Trueprop $ (mk_equality (t, true_as_term))
96.136 + in Some ((string_of_cterm o cterm_of (sign_of thy)) prop,
96.137 + prop) end
96.138 + else let val prop = Trueprop $ (mk_equality (t, false_as_term))
96.139 + in Some ((string_of_cterm o cterm_of (sign_of thy)) prop,
96.140 + prop) end
96.141 + | eval_matchsub _ _ _ _ = None;
96.142 +
96.143 +
96.144 +
96.145 +(*get the variables in an isabelle-term*)
96.146 +(*("Vars" ,("Tools.Vars" ,eval_var "#Vars_")):calc*)
96.147 +fun eval_var (thmid:string) "Tools.Vars"
96.148 + (t as (Const(op0,t0) $ arg)) thy =
96.149 + let
96.150 + val t' = ((list2isalist HOLogic.realT) o vars) t;
96.151 + val thmId = thmid^(Sign.string_of_term (sign_of thy) arg);
96.152 + in Some (thmId, Trueprop $ (mk_equality (t,t'))) end
96.153 + | eval_var _ _ _ _ = None;
96.154 +
96.155 +fun lhs (Const ("op =",_) $ l $ _) = l
96.156 + | lhs t = error("lhs called with (" ^ term2str t ^ ")");
96.157 +(*("lhs" ,("Tools.lhs" ,eval_lhs "")):calc*)
96.158 +fun eval_lhs _ "Tools.lhs"
96.159 + (t as (Const ("Tools.lhs",_) $ (Const ("op =",_) $ l $ _))) _ =
96.160 + Some ((term2str t) ^ " = " ^ (term2str l),
96.161 + Trueprop $ (mk_equality (t, l)))
96.162 + | eval_lhs _ _ _ _ = None;
96.163 +(*
96.164 +> val t = (term_of o the o (parse thy)) "lhs (1 * x ^^^ 2 = 0)";
96.165 +> val Some (id,t') = eval_lhs 0 0 t 0;
96.166 +val id = "Tools.lhs (1 * x ^^^ 2 = 0) = 1 * x ^^^ 2" : string
96.167 +> term2str t';
96.168 +val it = "Tools.lhs (1 * x ^^^ 2 = 0) = 1 * x ^^^ 2" : string
96.169 +*)
96.170 +
96.171 +fun rhs (Const ("op =",_) $ _ $ r) = r
96.172 + | rhs t = error("rhs called with (" ^ term2str t ^ ")");
96.173 +(*("rhs" ,("Tools.rhs" ,eval_rhs "")):calc*)
96.174 +fun eval_rhs _ "Tools.rhs"
96.175 + (t as (Const ("Tools.rhs",_) $ (Const ("op =",_) $ _ $ r))) _ =
96.176 + Some ((term2str t) ^ " = " ^ (term2str r),
96.177 + Trueprop $ (mk_equality (t, r)))
96.178 + | eval_rhs _ _ _ _ = None;
96.179 +
96.180 +
96.181 +
96.182 +
96.183 +
96.184 +
96.185 +
96.186 +
96.187 +
96.188 +
96.189 +
96.190 +
96.191 +val list_rls = append_rls "list_rls" list_rls
96.192 + [Calc ("Tools.rhs",eval_rhs "")];
96.193 +ruleset' := overwritelthy thy (!ruleset',
96.194 + [("list_rls",list_rls)
96.195 + ]);
96.196 +calclist':= overwritel (!calclist',
96.197 + [("matches",("Tools.matches",eval_matches "#matches_")),
96.198 + ("matchsub",("Tools.matchsub",eval_matchsub "#matchsub_")),
96.199 + ("Vars" ,("Tools.Vars" ,eval_var "#Vars_")),
96.200 + ("lhs" ,("Tools.lhs" ,eval_lhs "")),
96.201 + ("rhs" ,("Tools.rhs" ,eval_rhs ""))
96.202 + ]);
97.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
97.2 +++ b/src/Pure/isac/Scripts/Tools.sml Wed Jul 21 13:53:39 2010 +0200
97.3 @@ -0,0 +1,113 @@
97.4 +(* = Tools.ML
97.5 + +++ outcommented tests *)
97.6 +
97.7 +
97.8 +fun eval_var (thmid:string) (op_:string)
97.9 + (t as (Const(op0,t0) $ arg)) thy =
97.10 + let
97.11 + val t' = ((list2isalist HOLogic.realT) o vars) t;
97.12 + val thmId = thmid^(Sign.string_of_term (sign_of thy) arg);
97.13 + in Some (thmId, Trueprop $ (mk_equality (t,t'))) end
97.14 + | eval_var _ _ _ _ = raise GO_ON;
97.15 +(*
97.16 +> val t = (term_of o the o (parse thy)) "Var (A=a*(b::real))";
97.17 +> val op_ = "Var";
97.18 +> val eval_fn = the (assoc (!eval_list, op_));
97.19 +> get_pair op_ eval_fn t;
97.20 +> val (t as (Const(op0,t0) $ arg)) = t;
97.21 +> eval_fn op0 t;
97.22 +
97.23 +> val thmid = "#Var_";
97.24 +> val (Some(thmId,t')) = eval_var thmid op0 t;
97.25 +val it = Some ("#Var_(A::real) = (a::real) * (b::real)",Const # $ (# $ #))
97.26 + : (string * term) option
97.27 +> Sign.string_of_term (sign_of thy) t';
97.28 +val it = "Var ((A::real) = (a::real) * (b::real)) = [A, a, b]" : string
97.29 +*)
97.30 +fun eval_Length (thmid:string) (op_:string)
97.31 + (t as (Const(op0,t0) $ arg)) thy =
97.32 + let
97.33 + val t' = ((term_of_num HOLogic.realT) o length o isalist2list) arg;
97.34 + val thmId = thmid^(Sign.string_of_term (sign_of thy) arg);
97.35 + in Some (thmId, Trueprop $ (mk_equality (t,t'))) end
97.36 + | eval_Length _ _ _ _ = raise GO_ON;
97.37 +(*
97.38 +> val thmid = "#Length_"; val op_ = "Length";
97.39 +> val s = "Length [A = a * b, a // #2 = #2]";
97.40 +> val (t as (Const(op0,t0) $ arg)) = (term_of o the o (parse thy)) s;
97.41 +> val (Some (id,t')) = eval_Length thmid op_ t;
97.42 +val id = "#Length_[A = a * b, a // #2 = #2]" : string
97.43 +val t' = Const ("Trueprop","bool => prop") $ (Const # $ (# $ #) $ Free (#,#))
97.44 +val it = "Length [A = a * b, a // #2 = #2] = #2" : cterm
97.45 +---------------------------------------------
97.46 +> val thmid = "#Length_"; val op_ = "Length";
97.47 +> val s =
97.48 + "if #1 < Length [A = a * b, a // #2 = #2] \
97.49 + \then make_fun (R, [make, function], no_met) A a_ [A = a * b, a // #2 = #2]\
97.50 + \else hd [A = a * b, a // #2 = #2]";
97.51 +
97.52 +> cterm_of (sign_of thy) t';
97.53 +> val t = (term_of o the o (parse thy)) s;
97.54 +> val eval_fn = the (assoc (!eval_list, op_));
97.55 +> val (Some(_,t')) = get_pair op_ eval_fn t;
97.56 +val t' = Const ("Trueprop","bool => prop") $ (Const # $ (# $ #) $ Free (#,#))
97.57 +val it = "Length [A = a * b, a // #2 = #2] = #2" : cterm
97.58 +
97.59 +> val ct = (the o (parse thy)) s;
97.60 +> val (Some(_,thm)) = get_calculation thy (op_, eval_fn) ct;
97.61 +val thm = "Length [A = a * b, a // #2 = #2] = #2" [[ Free ( #2, real) !!!]]
97.62 +> rewrite_ thy tless_true e_rls false thm ct;
97.63 +("if #1 < #2
97.64 + then make_fun (R, [make, function], no_met)
97.65 + A a_ [A = a * b, a // #2 = #2] else hd [A = a * b, a // #2 = #2]",
97.66 + []) : (cterm * cterm list) option
97.67 +> val ct = (the o (parse thy)) s;
97.68 +> rewrite_set_ thy e_rls false eval_script ct;
97.69 +("if #1 < #2
97.70 + then make_fun (R, [make, function], no_met)
97.71 + A a_ [A = a * b, a // #2 = #2] else hd [A = a * b, a // #2 = #2]",
97.72 + []) : (cterm * cterm list) option
97.73 +*)
97.74 +
97.75 +fun eval_Nth (thmid:string) (op_:string) (t as
97.76 + (Const (op0,t0) $ t1 $ t2 )) thy =
97.77 +(writeln"@@@ eval_Nth";
97.78 + if is_num t1 andalso is_list t2
97.79 + then
97.80 + let
97.81 + val t' = (nth (num_of_term t1) (isalist2list t2))
97.82 + handle _ => raise GO_ON;
97.83 + val thmId = thmid^(Sign.string_of_term (sign_of thy) t1)^
97.84 + "_"^(Sign.string_of_term (sign_of thy) t2)^
97.85 + " = "^(Sign.string_of_term (sign_of thy) t');
97.86 + in Some (thmId, Trueprop $ (mk_equality (t,t'))) end
97.87 + else raise GO_ON
97.88 +)
97.89 + | eval_Nth _ _ _ _ = raise GO_ON;
97.90 +(*
97.91 +> val thmid = "#Nth_"; val op_ = "Nth";
97.92 +> val s = "Nth #2 [A = a * b, a // #2 = #2]";
97.93 +> val t = (term_of o the o (parse thy)) s;
97.94 +> eval_Nth thmid op_ t;
97.95 +
97.96 +> val eval_fn = the (assoc (!eval_list, op_));
97.97 +> val (Some(id,t')) = get_pair op_ eval_fn t;
97.98 +> cterm_of (sign_of thy) t';
97.99 +val it = "Nth #2 [A = a * b, a // #2 = #2] = (a // #2 = #2)"
97.100 +*)
97.101 +
97.102 +
97.103 +(*17.6.00: calc_list instead eval_list*)
97.104 +eval_list:= overwritel (! eval_list,
97.105 + [("Var",eval_var "#Var_"),
97.106 + ("Length",eval_Length "#Length_"),
97.107 + ("Nth",eval_Nth "#Nth_")
97.108 + ]);
97.109 +(*17.6.00: association list for calculate_, calculate*)
97.110 +calc_list:= overwritel (! calc_list,
97.111 + [
97.112 + ("Var" ,("Var",eval_var "#Var_")),
97.113 + ("Length",("Length",eval_Length "#Length_")),
97.114 + ("Nth" ,("Nth",eval_Nth "#Nth_"))
97.115 + ]);
97.116 +
98.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
98.2 +++ b/src/Pure/isac/Scripts/Tools.thy Wed Jul 21 13:53:39 2010 +0200
98.3 @@ -0,0 +1,54 @@
98.4 +(* auxiliary functions used in scripts
98.5 + author: Walther Neuper 000301
98.6 + WN0509 shift into Atools ?!? (because used also in where of models !)
98.7 +
98.8 + (c) copyright due to lincense terms.
98.9 +
98.10 +remove_thy"Tools";
98.11 +use_thy"Scripts/Tools";
98.12 +*)
98.13 +
98.14 +theory Tools
98.15 +imports ListG
98.16 +begin
98.17 +
98.18 +(*belongs to theory ListG*)
98.19 +ML {*
98.20 +val first_isac_thy = @{theory ListG}
98.21 +*}
98.22 +
98.23 +(*for Descript.thy*)
98.24 +
98.25 + (***********************************************************************)
98.26 + (* 'fun is_dsc' in Scripts/scrtools.smlMUST contain ALL these types !!!*)
98.27 + (***********************************************************************)
98.28 +typedecl nam (* named variables *)
98.29 +typedecl una (* unnamed variables *)
98.30 +typedecl unl (* unnamed variables of type list, elementwise input prohibited*)
98.31 +typedecl str (* structured variables *)
98.32 +typedecl toreal (* var with undef real value: forces typing *)
98.33 +typedecl toreall (* var with undef real list value: forces typing *)
98.34 +typedecl tobooll (* var with undef bool list value: forces typing *)
98.35 +typedecl unknow (* input without dsc in fmz=[] *)
98.36 +typedecl cpy (* UNUSED: copy-named variables
98.37 + identified by .._0, .._i .._' in pbt *)
98.38 + (***********************************************************************)
98.39 + (* 'fun is_dsc' in Scripts/scrtools.smlMUST contain ALL these types !!!*)
98.40 + (***********************************************************************)
98.41 +
98.42 +consts
98.43 +
98.44 + UniversalList :: "bool list"
98.45 +
98.46 + lhs :: "bool => real" (*of an equality*)
98.47 + rhs :: "bool => real" (*of an equality*)
98.48 + Vars :: "'a => real list" (*get the variables of a term *)
98.49 + matches :: "['a, 'a] => bool"
98.50 + matchsub :: "['a, 'a] => bool"
98.51 +
98.52 +constdefs
98.53 +
98.54 + Testvar :: "[real, 'a] => bool" (*is a variable in a term: unused 6.5.03*)
98.55 + "Testvar v t == v mem (Vars t)" (*by rewriting only,no Calcunused 6.5.03*)
98.56 +
98.57 +end
99.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
99.2 +++ b/src/Pure/isac/Scripts/calculate.sml Wed Jul 21 13:53:39 2010 +0200
99.3 @@ -0,0 +1,408 @@
99.4 +(* calculate values for function constants
99.5 + (c) Walther Neuper 000106
99.6 +
99.7 +use"Scripts/calculate.sml";
99.8 +*)
99.9 +
99.10 +
99.11 +(* dirty type-conversion 30.1.00 for "fixed_values [R=R]" *)
99.12 +
99.13 +val aT = Type ("'a", []);
99.14 +(* isas types for Free, parseold: (1) "R=R" or (2) "R=(R::real)":
99.15 +(1)
99.16 +> val (TFree(ss2,TT2)) = T2;
99.17 +val ss2 = "'a" : string
99.18 +val TT2 = ["term"] : sort
99.19 +(2)
99.20 +> val (Type(ss2',TT2')) = T2';
99.21 +val ss2' = "RealDef.real" : string
99.22 +val TT2' = [] : typ list
99.23 +(3)
99.24 +val realType = TFree ("RealDef.real", HOLogic.termS);
99.25 +is different internally, too;
99.26 +
99.27 +(1) .. (3) are displayed equally !!!
99.28 +*)
99.29 +
99.30 +
99.31 +
99.32 +(* 30.1.00: generating special terms for ME:
99.33 + (1) binary numerals reconverted to Free ("#num",...)
99.34 + by libarary_G.num_str: called from parse (below) and
99.35 + interface_ME_ISA for all thms used
99.36 + (compare HOLogic.dest_binum)
99.37 + (2) 'a types converted to RealDef.real by typ_a2real
99.38 + in parse below
99.39 + (3) binary operators fixed to type real in RatArith.thy
99.40 + (trick by Markus Wenzel)
99.41 +*)
99.42 +
99.43 +
99.44 +
99.45 +
99.46 +(** calculate numerals **)
99.47 +
99.48 +(*27.3.00: problems with patterns below:
99.49 +"Vars (a // #2 = r * xxxxx b)" doesn't work, but
99.50 +"Vars (a // #2 = r * sqrt b)" works
99.51 +*)
99.52 +
99.53 +fun popt2str (SOME (str, term)) = "SOME "^term2str term
99.54 + | popt2str NONE = "NONE";
99.55 +
99.56 +(* scan a term for applying eval_fn ef
99.57 +args
99.58 + thy:
99.59 + op_: operator (as string) selecting the root of the pair
99.60 + ef : fn : (string -> term -> theory -> (string * term) option)
99.61 + ^^^^^^... for creating the string for the resulting theorem
99.62 + t : term to be scanned
99.63 +result:
99.64 + (string * term) option: found by the eval_* -function of type
99.65 + fn : string -> string -> term -> theory -> (string * term) option
99.66 + ^^^^^^... the selecting operator op_ (variable for eval_binop)
99.67 +*)
99.68 +fun get_pair thy op_ (ef:string -> term -> theory -> (string * term) option)
99.69 + (t as (Const(op0,t0) $ arg)) = (* unary fns *)
99.70 +(* val (thy, op_, (ef), (t as (Const(op0,t0) $ arg))) =
99.71 + (thy, op_, eval_fn, ct);
99.72 + *)
99.73 + if op_ = op0 then
99.74 + let val popt = ef op_ t thy
99.75 + in case popt of
99.76 + SOME _ => popt
99.77 + | NONE => get_pair thy op_ ef arg end
99.78 + else get_pair thy op_ ef arg
99.79 +
99.80 + | get_pair thy "Atools.ident" ef (t as (Const("Atools.ident",t0) $ _ $ _ )) =
99.81 +(* val (thy, "Atools.ident", ef, t as (Const(op0,_) $ t1 $ t2)) =
99.82 + (thy, op_, eval_fn, ct);
99.83 + *)
99.84 + ef "Atools.ident" t thy (* not nested *)
99.85 +
99.86 + | get_pair thy op_ ef (t as (Const(op0,_) $ t1 $ t2)) = (* binary funs*)
99.87 +(* val (thy, op_, ef, (t as (Const(op0,_) $ t1 $ t2))) =
99.88 + (thy, op_, eval_fn, ct);
99.89 + *)
99.90 + ((*writeln("1.. get_pair: binop = "^op_);*)
99.91 + if op_ = op0 then
99.92 + let val popt = ef op_ t thy
99.93 + (*val _ = writeln("2.. get_pair: "^term2str t^" -> "^popt2str popt)*)
99.94 + in case popt of
99.95 + SOME (id,_) => popt
99.96 + | NONE =>
99.97 + let val popt = get_pair thy op_ ef t1
99.98 + (*val _ = writeln("3.. get_pair: "^term2str t1^
99.99 + " -> "^popt2str popt)*)
99.100 + in case popt of
99.101 + SOME (id,_) => popt
99.102 + | NONE => get_pair thy op_ ef t2
99.103 + end
99.104 + end
99.105 + else (*search subterms*)
99.106 + let val popt = get_pair thy op_ ef t1
99.107 + (*val _ = writeln("4.. get_pair: "^term2str t^" -> "^popt2str popt)*)
99.108 + in case popt of
99.109 + SOME (id,_) => popt
99.110 + | NONE => get_pair thy op_ ef t2
99.111 + end)
99.112 + | get_pair thy op_ ef (t as (Const(op0,_) $ t1 $ t2 $ t3)) =(* trinary funs*)
99.113 + ((*writeln("### get_pair 4a: t= "^term2str t);
99.114 + writeln("### get_pair 4a: op_= "^op_);
99.115 + writeln("### get_pair 4a: op0= "^op0);*)
99.116 + if op_ = op0 then
99.117 + case ef op_ t thy of
99.118 + SOME tt => SOME tt
99.119 + | NONE => (case get_pair thy op_ ef t2 of
99.120 + SOME tt => SOME tt
99.121 + | NONE => get_pair thy op_ ef t3)
99.122 + else (case get_pair thy op_ ef t1 of
99.123 + SOME tt => SOME tt
99.124 + | NONE => (case get_pair thy op_ ef t2 of
99.125 + SOME tt => SOME tt
99.126 + | NONE => get_pair thy op_ ef t3)))
99.127 + | get_pair thy op_ ef (Const _) = NONE
99.128 + | get_pair thy op_ ef (Free _) = NONE
99.129 + | get_pair thy op_ ef (Var _) = NONE
99.130 + | get_pair thy op_ ef (Bound _) = NONE
99.131 + | get_pair thy op_ ef (Abs(a,T,body)) = get_pair thy op_ ef body
99.132 + | get_pair thy op_ ef (t1$t2) =
99.133 + let(*val _= writeln("5.. get_pair t1 $ t2: "^term2str t1^"
99.134 + $ "^term2str t2)*)
99.135 + val popt = get_pair thy op_ ef t1
99.136 + in case popt of
99.137 + SOME _ => popt
99.138 + | NONE => ((*writeln"### get_pair: t1 $ t2 -> NONE";*)
99.139 + get_pair thy op_ ef t2)
99.140 + end;
99.141 + (*
99.142 +> val t = (term_of o the o (parse thy)) "#3 + #4";
99.143 +> val eval_fn = the (assoc (!eval_list, "op +"));
99.144 +> val (SOME (id,t')) = get_pair thy "op +" eval_fn t;
99.145 +> Sign.string_of_term (sign_of thy) t';
99.146 +> atomty t';
99.147 +>
99.148 +> val t = (term_of o the o (parse thy)) "(a + #3) + #4";
99.149 +> val (SOME (id,t')) = get_pair thy "op +" eval_fn t;
99.150 +> Sign.string_of_term (sign_of thy) t';
99.151 +>
99.152 +> val t = (term_of o the o (parse thy)) "#3 + (#4 + (a::real))";
99.153 +> val (SOME (id,t')) = get_pair thy "op +" eval_fn t;
99.154 +> Sign.string_of_term (sign_of thy) t';
99.155 +>
99.156 +> val t = (term_of o the o (parse thy)) "x = #5 * (#3 + (#4 + a))";
99.157 +> atomty t;
99.158 +> val (SOME (id,t')) = get_pair thy "op +" eval_fn t;
99.159 +> Sign.string_of_term (sign_of thy) t';
99.160 +> val it = "#3 + (#4 + a) = #7 + a" : string
99.161 +>
99.162 +>
99.163 +> val t = (term_of o the o (parse thy)) "#-4//#-2";
99.164 +> val eval_fn = the (assoc (!eval_list, "cancel"));
99.165 +> val (SOME (id,t')) = get_pair thy "cancel" eval_fn t;
99.166 +> Sign.string_of_term (sign_of thy) t';
99.167 +>
99.168 +> val t = (term_of o the o (parse thy)) "#2^^^#3";
99.169 +> eval_binop "xxx" "pow" t thy;
99.170 +> val eval_fn = (eval_binop "xxx")
99.171 +> : string -> term -> theory -> (string * term) option;
99.172 +> val SOME (id,t') = get_pair thy "pow" eval_fn t;
99.173 +> Sign.string_of_term (sign_of thy) t';
99.174 +> val eval_fn = the (assoc (!eval_list, "pow"));
99.175 +> val (SOME (id,t')) = get_pair thy "pow" eval_fn t;
99.176 +> Sign.string_of_term (sign_of thy) t';
99.177 +>
99.178 +> val t = (term_of o the o (parse thy)) "x = #0 + #-1 * #-4";
99.179 +> val eval_fn = the (assoc (!eval_list, "op *"));
99.180 +> val (SOME (id,t')) = get_pair thy "op *" eval_fn t;
99.181 +> Sign.string_of_term (sign_of thy) t';
99.182 +>
99.183 +> val t = (term_of o the o (parse thy)) "#0 < #4";
99.184 +> val eval_fn = the (assoc (!eval_list, "op <"));
99.185 +> val (SOME (id,t')) = get_pair thy "op <" eval_fn t;
99.186 +> Sign.string_of_term (sign_of thy) t';
99.187 +> val t = (term_of o the o (parse thy)) "#0 < #-4";
99.188 +> val (SOME (id,t')) = get_pair thy "op <" eval_fn t;
99.189 +> Sign.string_of_term (sign_of thy) t';
99.190 +>
99.191 +> val t = (term_of o the o (parse thy)) "#3 is_const";
99.192 +> val eval_fn = the (assoc (!eval_list, "is'_const"));
99.193 +> val (SOME (id,t')) = get_pair thy "is'_const" eval_fn t;
99.194 +> Sign.string_of_term (sign_of thy) t';
99.195 +> val t = (term_of o the o (parse thy)) "a is_const";
99.196 +> val (SOME (id,t')) = get_pair thy "is'_const" eval_fn t;
99.197 +> Sign.string_of_term (sign_of thy) t';
99.198 +>
99.199 +> val t = (term_of o the o (parse thy)) "#6//(#8::real)";
99.200 +> val eval_fn = the (assoc (!eval_list, "cancel"));
99.201 +> val (SOME (id,t')) = get_pair thy "cancel" eval_fn t;
99.202 +> Sign.string_of_term (sign_of thy) t';
99.203 +>
99.204 +> val t = (term_of o the o (parse thy)) "sqrt #12";
99.205 +> val eval_fn = the (assoc (!eval_list, "SqRoot.sqrt"));
99.206 +> val (SOME (id,t')) = get_pair thy "SqRoot.sqrt" eval_fn t;
99.207 +> Sign.string_of_term (sign_of thy) t';
99.208 +> val it = "sqrt #12 = #2 * sqrt #3 " : string
99.209 +>
99.210 +> val t = (term_of o the o (parse thy)) "sqrt #9";
99.211 +> val (SOME (id,t')) = get_pair thy "SqRoot.sqrt" eval_fn t;
99.212 +> Sign.string_of_term (sign_of thy) t';
99.213 +>
99.214 +> val t = (term_of o the o (parse thy)) "Nth #2 [#11,#22,#33]";
99.215 +> val eval_fn = the (assoc (!eval_list, "Tools.Nth"));
99.216 +> val (SOME (id,t')) = get_pair thy "Tools.Nth" eval_fn t;
99.217 +> Sign.string_of_term (sign_of thy) t';
99.218 +*)
99.219 +
99.220 +(* val ((op_, eval_fn),ct)=(cc,pre);
99.221 + (get_calculation_ Isac.thy (op_, eval_fn) ct) handle e => print_exn e;
99.222 + parse thy ""
99.223 + *)
99.224 +(*.get a thm from an op_ somewhere in the term;
99.225 + apply ONLY to (uminus_to_string term), uminus_to_string (- 4711) --> (-4711).*)
99.226 +fun get_calculation_ thy (op_, eval_fn) ct =
99.227 +(* val (thy, (op_, eval_fn), ct) =
99.228 + (thy, (the (assoc(!calclist',"order_system"))), t);
99.229 + *)
99.230 + case get_pair thy op_ eval_fn ct of
99.231 + NONE => ((*writeln("@@@ get_calculation: NONE, op_="^op_);
99.232 + writeln("@@@ get_calculation: ct= ");atomty ct;*)
99.233 + NONE)
99.234 + | SOME (thmid,t) =>
99.235 + ((*writeln("@@@ get_calculation: NONE, op_="^op_);
99.236 + writeln("@@@ get_calculation: ct= ");atomty ct;*)
99.237 + SOME (thmid, (make_thm o (cterm_of thy)) t));
99.238 +(*
99.239 +> val ct = (the o (parse thy)) "#9 is_const";
99.240 +> get_calculation_ thy ("is'_const",the (assoc(!eval_list,"is'_const"))) ct;
99.241 +val it = SOME ("is_const9_","(is_const 9 ) = True [(is_const 9 ) = True]")
99.242 +
99.243 +> val ct = (the o (parse thy)) "sqrt #9";
99.244 +> get_calculation_ thy ("sqrt",the (assoc(!eval_list,"sqrt"))) ct;
99.245 +val it = SOME ("sqrt_9_","sqrt 9 = 3 [sqrt 9 = 3]") : (string * thm) option
99.246 +
99.247 +> val ct = (the o (parse thy)) "#4<#4";
99.248 +> get_calculation_ thy ("op <",the (assoc(!eval_list,"op <"))) ct;fun is_no str = (hd o explode) str = "#";
99.249 +
99.250 +val it = SOME ("less_5_4","(5 < 4) = False [(5 < 4) = False]")
99.251 +
99.252 +> val ct = (the o (parse thy)) "a<#4";
99.253 +> get_calculation_ thy ("op <",the (assoc(!eval_list,"op <"))) ct;
99.254 +val it = NONE : (string * thm) option
99.255 +
99.256 +> val ct = (the o (parse thy)) "#5<=#4";
99.257 +> get_calculation_ thy ("op <=",the (assoc(!eval_list,"op <="))) ct;
99.258 +val it = SOME ("less_equal_5_4","(5 <= 4) = False [(5 <= 4) = False]")
99.259 +
99.260 +-------------------------------------------------------------------6.8.02:
99.261 + val thy = SqRoot.thy;
99.262 + val t = (term_of o the o (parse thy)) "1+2";
99.263 + get_calculation_ thy (the(assoc(!calc_list,"plus"))) t;
99.264 + val it = SOME ("add_3_4","3 + 4 = 7 [3 + 4 = 7]") : (string * thm) option
99.265 +-------------------------------------------------------------------6.8.02:
99.266 + val t = (term_of o the o (parse thy)) "-1";
99.267 + atomty t;
99.268 + val t = (term_of o the o (parse thy)) "0";
99.269 + atomty t;
99.270 + val t = (term_of o the o (parse thy)) "1";
99.271 + atomty t;
99.272 + val t = (term_of o the o (parse thy)) "2";
99.273 + atomty t;
99.274 + val t = (term_of o the o (parse thy)) "999999999";
99.275 + atomty t;
99.276 +-------------------------------------------------------------------6.8.02:
99.277 +
99.278 +> val ct = (the o (parse thy)) "a+#3+#4";
99.279 +> get_calculation_ thy ("op +",the (assoc(!eval_list,"op +"))) ct;
99.280 +val it = SOME ("add_3_4","a + 3 + 4 = a + 7 [a + 3 + 4 = a + 7]")
99.281 +
99.282 +> val ct = (the o (parse thy)) "#3+(#4+a)";
99.283 +> get_calculation_ thy ("op +",the (assoc(!eval_list,"op +"))) ct;
99.284 +val it = SOME ("add_3_4","3 + (4 + a) = 7 + a [3 + (4 + a) = 7 + a]")
99.285 +
99.286 +> val ct = (the o (parse thy)) "a+(#3+#4)+#5";
99.287 +> get_calculation_ thy ("op +",the (assoc(!eval_list,"op +"))) ct;
99.288 +val it = SOME ("add_3_4","3 + 4 = 7 [3 + 4 = 7]") : (string * thm) option
99.289 +
99.290 +> val ct = (the o (parse thy)) "#3*(#4*a)";
99.291 +> get_calculation_ thy ("op *",the (assoc(!eval_list,"op *"))) ct;
99.292 +val it = SOME ("mult_3_4","3 * (4 * a) = 12 * a [3 * (4 * a) = 12 * a]")
99.293 +
99.294 +> val ct = (the o (parse thy)) "#3 + #4^^^#2 + #5";
99.295 +> get_calculation_ thy ("pow",the (assoc(!eval_list,"pow"))) ct;
99.296 +val it = SOME ("4_(+2)","4 ^ 2 = 16 [4 ^ 2 = 16]") : (string * thm) option
99.297 +
99.298 +> val ct = (the o (parse thy)) "#-4//#-2";
99.299 +> get_calculation_ thy ("cancel",the (assoc(!eval_list,"cancel"))) ct;
99.300 +val it = SOME ("cancel_(-4)_(-2)","(-4) // (-2) = (+2) [(-4) // (-2) = (+2)]")
99.301 +
99.302 +> val ct = (the o (parse thy)) "#6//#-8";
99.303 +> get_calculation_ thy ("cancel",the (assoc(!eval_list,"cancel"))) ct;
99.304 +val it = SOME ("cancel_6_(-8)","6 // (-8) = (-3) // 4 [6 // (-8) = (-3) // 4]")
99.305 +
99.306 +*)
99.307 +
99.308 +
99.309 +(*
99.310 +> val ct = (the o (parse thy)) "a + 3*4";
99.311 +> applicable "calculate" (Calc("op *", "mult_")) ct;
99.312 +val it = SOME "3 * 4 = 12 [3 * 4 = 12]" : thm option
99.313 +
99.314 +--------------------------
99.315 +> val ct = (the o (parse thy)) "3 =!= 3";
99.316 +> val (thmid, thm) = the (get_calculation_ thy "Atools.ident" ct);
99.317 +val thm = "(3 =!= 3) = True [(3 =!= 3) = True]" : thm
99.318 +
99.319 +> val ct = (the o (parse thy)) "~ (3 =!= 3)";
99.320 +> val (thmid, thm) = the (get_calculation_ thy "Atools.ident" ct);
99.321 +val thm = "(3 =!= 3) = True [(3 =!= 3) = True]" : thm
99.322 +
99.323 +> val ct = (the o (parse thy)) "3 =!= 4";
99.324 +> val (thmid, thm) = the (get_calculation_ thy "Atools.ident" ct);
99.325 +val thm = "(3 =!= 4) = False [(3 =!= 4) = False]" : thm
99.326 +
99.327 +> val ct = (the o (parse thy)) "( 4 + (4 * x + x ^ 2) =!= (+0))";
99.328 +> val (thmid, thm) = the (get_calculation_ thy "Atools.ident" ct);
99.329 + "(4 + (4 * x + x ^ 2) =!= (+0)) = False"
99.330 +
99.331 +> val ct = (the o (parse thy)) "~ ( 4 + (4 * x + x ^ 2) =!= (+0))";
99.332 +> val (thmid, thm) = the (get_calculation_ thy "Atools.ident" ct);
99.333 + "(4 + (4 * x + x ^ 2) =!= (+0)) = False"
99.334 +
99.335 +> val ct = (the o (parse thy)) "~ ( 4 + (4 * x + x ^ 2) =!= (+0))";
99.336 +> val rls = eval_rls;
99.337 +> val (ct,_) = the (rewrite_set_ thy false rls ct);
99.338 +val ct = "True" : cterm
99.339 +--------------------------
99.340 +*)
99.341 +
99.342 +
99.343 +(*.get a thm applying an op_ to a term;
99.344 + apply ONLY to (numbers_to_string term), numbers_to_string (- 4711) --> (-4711).*)
99.345 +(* val (thy, (op_, eval_fn), ct) =
99.346 + (thy, ("Integrate.add'_new'_c", eval_add_new_c "add_new_c_"), term);
99.347 + *)
99.348 +fun get_calculation1_ thy ((op_, eval_fn):cal) ct =
99.349 + case eval_fn op_ ct thy of
99.350 + NONE => NONE
99.351 + | SOME (thmid,t) =>
99.352 + SOME (thmid, (make_thm o (cterm_of thy)) t);
99.353 +
99.354 +
99.355 +
99.356 +
99.357 +
99.358 +(*.substitute bdv in an rls and leave Calc as they are.(*28.10.02*)
99.359 +fun inst_thm' subs (Thm (id, thm)) =
99.360 + Thm (id, (*read_instantiate throws: *** No such variable in term: ?bdv*)
99.361 + (read_instantiate subs thm) handle _ => thm)
99.362 + | inst_thm' _ calc = calc;
99.363 +fun inst_thm' (subs as (bdv,_)::_) (Thm (id, thm)) =
99.364 + Thm (id, (writeln("@@@ inst_thm': thm= "^(string_of_thmI thm));
99.365 + if bdv mem (vars_str o #prop o rep_thm) thm
99.366 + then (writeln("@@@ inst_thm': read_instantiate, thm="^((string_of_thmI thm)));
99.367 + read_instantiate subs thm)
99.368 + else (writeln("@@@ inst_thm': not mem.. "^bdv);
99.369 + thm)))
99.370 + | inst_thm' _ calc = calc;
99.371 +
99.372 +fun instantiate_rls subs
99.373 + (Rls{preconds=preconds,rew_ord=rew_ord,erls=ev,srls=sr,calc=ca,
99.374 + asm_thm=at,rules=rules,scr=scr}:rls) =
99.375 + (Rls{preconds=preconds,rew_ord=rew_ord,erls=ev,srls=sr,calc=ca,
99.376 + asm_thm=at,scr=scr,
99.377 + rules = map (inst_thm' subs) rules}:rls);---------------------------*)
99.378 +
99.379 +
99.380 +
99.381 +(** rewriting: ordered, conditional **)
99.382 +
99.383 +fun mk_rule (prems,l,r) =
99.384 + Trueprop $ (list_implies (prems, mk_equality (l,r)));
99.385 +
99.386 +(* 'norms' a rule, e.g.
99.387 +(*1*) a = 1 ==> a*(b+c) = b+c
99.388 + => a = 1 ==> a*(b+c) = b+c no change
99.389 +(*2*) t = t => (t=t) = True !!
99.390 +(*3*) [| k < l; m + l = k + n |] ==> m < n
99.391 + => [| k<l; m+l=k+n |] ==> m < n = True !! *)
99.392 +(* val it = fn : term -> term *)
99.393 +fun norm rule =
99.394 + let
99.395 + val (prems,concl)=(map strip_trueprop(Logic.strip_imp_prems rule),
99.396 + (strip_trueprop o Logic.strip_imp_concl)rule)
99.397 + in if is_equality concl then
99.398 + let val (l,r) = dest_equals' concl
99.399 + in if l = r then
99.400 + (*2*) mk_rule(prems,concl,true_as_term)
99.401 + else (*1*) rule end
99.402 + else (*3*) mk_rule(prems,concl,true_as_term)
99.403 + end;
99.404 +
99.405 +
99.406 +
99.407 +
99.408 +
99.409 +
99.410 +
99.411 +
100.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
100.2 +++ b/src/Pure/isac/Scripts/rewrite.sml Wed Jul 21 13:53:39 2010 +0200
100.3 @@ -0,0 +1,736 @@
100.4 +(* isac's rewriter
100.5 + (c) Walther Neuper 2000
100.6 +
100.7 +use"Scripts/rewrite.sml";
100.8 +use"rewrite.sml";
100.9 +*)
100.10 +
100.11 +
100.12 +exception NO_REWRITE;
100.13 +exception STOP_REW_SUB; (*WN050820 quick and dirty*)
100.14 +
100.15 +(*17.6.00: rewrite by going down the term with rew_sub*)
100.16 +(* val (thy, i, bdv, tless, rls, put_asm, thm, ct) =
100.17 + (thy, 1, []:(Term.term * Term.term) list, rew_ord, erls, bool,thm,term);
100.18 + *)
100.19 +fun rewrite__ thy i bdv tless rls put_asm thm ct =
100.20 + ((*writeln ("@@@ r..te__ begin: t = "^(term2str ct));*)
100.21 + let
100.22 + val (t',asms,lrd,rew) =
100.23 + rew_sub thy i bdv tless rls put_asm [(*root of the term*)]
100.24 + (((inst_bdv bdv) o norm o #prop o rep_thm) thm) ct;
100.25 + in if rew then SOME (t', distinct asms)
100.26 + else NONE end)
100.27 +(* val(r,t)=(((inst_bdv bdv) o norm o #prop o rep_thm) thm,ct);
100.28 + val t1 = (#prop o rep_thm) thm;
100.29 + val t2 = norm t1;
100.30 + val t3 = inst_bdv bdv t2;
100.31 +
100.32 + val thm4 = read_instantiate [("bdv","x")] thm;
100.33 + val t4 = (norm o #prop o rep_thm) thm4;
100.34 + *)
100.35 +(* val (thy, i, bdv, tless, rls, put_asm, r, t) =
100.36 + (thy, i,bdv, tless, rls, put_asm,
100.37 + (((inst_bdv bdv) o norm o #prop o rep_thm) thm), ct);
100.38 + val (thy, i, bdv, tless, rls, put_asm, lrd, r, t) =
100.39 + (thy, 1, [], ord, erls,false, [], r, t);
100.40 + val (thy, i, bdv, tless, rls, put_asm, lrd, r, t) =
100.41 + (thy, i, bdv, tless, rls, put_asm, [],
100.42 + ((inst_bdv bdv) o norm o #prop o rep_thm) thm, ct);
100.43 + *)
100.44 +and rew_sub thy i bdv tless rls put_asm lrd r t =
100.45 + ((*writeln ("@@@ rew_sub begin: t = "^(term2str t));*)
100.46 + let (* copy from Pure/thm.ML: fun rewritec *)
100.47 + (*val (lhs,rhs) = (dest_equals' o strip_trueprop
100.48 + o Logic.strip_imp_concl) r;
100.49 + val insts = Pattern.match (Sign.tsig_of (sign_of thy)) (lhs,t);
100.50 + val r' = ren_inst (insts, r, lhs, t);
100.51 + val p' = map strip_trueprop (Logic.strip_imp_prems r');
100.52 + val t' = (snd o dest_equals' o strip_trueprop
100.53 + o Logic.strip_imp_concl) r';*)
100.54 + val (lhs, rhs) = (HOLogic.dest_eq o HOLogic.dest_Trueprop
100.55 + o Logic.strip_imp_concl) r;
100.56 + val r' = Envir.subst_term (Pattern.match thy (lhs, t)
100.57 + (Vartab.empty, Vartab.empty)) r;
100.58 + val p' = (fst o Logic.strip_prems) (Logic.count_prems r', [], r');
100.59 + val t' = (snd o HOLogic.dest_eq o HOLogic.dest_Trueprop
100.60 + o Logic.strip_imp_concl) r';
100.61 + (*val _= writeln("@@@ rew_sub match: t'= "^(term2str t'));*)
100.62 + val _= if ! trace_rewrite andalso i < ! depth andalso p' <> []
100.63 + then writeln((idt"#"(i+1))^" eval asms: "^(term2str r')) else();
100.64 + val (t'',p'') = (*conditional rewriting*)
100.65 + let val (simpl_p', nofalse) = eval__true thy (i+1) p' bdv rls
100.66 + in if nofalse
100.67 + then (if ! trace_rewrite andalso i < ! depth andalso p' <> []
100.68 + then writeln((idt"#"(i+1))^" asms accepted: "^(terms2str p')^
100.69 + " stored: "^(terms2str simpl_p'))
100.70 + else(); (t',simpl_p')) (* + uncond.rew. *)
100.71 + else
100.72 + (if ! trace_rewrite andalso i < ! depth
100.73 + then writeln((idt"#"(i+1))^" asms false: "^(terms2str p'))
100.74 + else(); raise STOP_REW_SUB (*dont go into subterms of cond*))
100.75 + end
100.76 + in if perm lhs rhs andalso not (tless bdv (t',t)) (*ordered rewriting*)
100.77 + then (if ! trace_rewrite andalso i < ! depth
100.78 + then writeln((idt"#"i)^" not: \""^
100.79 + (term2str t)^"\" > \""^
100.80 + (term2str t')^"\"") else ();
100.81 + raise NO_REWRITE )
100.82 + else ((*writeln("##@ rew_sub: (t''= "^(term2str t'')^
100.83 + ", p'' ="^(terms2str p'')^", true)");*)
100.84 + (t'',p'',[],true))
100.85 + end
100.86 + ) handle _ (*NO_REWRITE WN050820 causes diff.behav. in tests + MATCH!*) =>
100.87 + ((*writeln ("@@@ rew_sub gosub: t = "^(term2str t));*)
100.88 + case t of
100.89 + Const(s,T) => (Const(s,T),[],lrd,false)
100.90 + | Free(s,T) => (Free(s,T),[],lrd,false)
100.91 + | Var(n,T) => (Var(n,T),[],lrd,false)
100.92 + | Bound i => (Bound i,[],lrd,false)
100.93 + | Abs(s,T,body) =>
100.94 + let val (t', asms, lrd, rew) =
100.95 + rew_sub thy i bdv tless rls put_asm (lrd@[D]) r body
100.96 + in (Abs(s,T,t'), asms, [], rew) end
100.97 + | t1 $ t2 =>
100.98 + let val (t2', asm2, lrd, rew2) =
100.99 + rew_sub thy i bdv tless rls put_asm (lrd@[R]) r t2
100.100 + in if rew2 then (t1 $ t2', asm2, lrd, true)
100.101 + else let val (t1', asm1, lrd, rew1) =
100.102 + rew_sub thy i bdv tless rls put_asm (lrd@[L]) r t1
100.103 + in if rew1 then (t1' $ t2, asm1, lrd, true)
100.104 + else (t1 $ t2,[], lrd, false) end
100.105 + end)
100.106 +(* val (cprems',rls)=([pre],prls);
100.107 + rewrite__set_ thy i false rls pre;
100.108 + *)
100.109 +and eval__true thy i asms bdv rls =
100.110 +(* val (thy, i, asms, bdv, rls) = (thy, (i+1), p', bdv, rls);
100.111 + *)
100.112 + if asms = [HOLogic.true_const] orelse asms = []
100.113 + then ([], true) else if asms = [HOLogic.false_const] then ([], false)
100.114 + else let
100.115 + fun chk indets [] = (indets, true)(*return asms<>True until false*)
100.116 + | chk indets (a::asms) =
100.117 +(* val (indets, (a::asms)) = ([], asms);
100.118 + *)
100.119 + (case rewrite__set_ thy (i+1) false bdv rls a of
100.120 + NONE => (chk (indets @ [a]) asms)
100.121 + | SOME (t, a') =>
100.122 + if t = HOLogic.true_const
100.123 + then (chk (indets @ a') asms)
100.124 + else if t = HOLogic.false_const then ([], false)
100.125 + (*asm false .. thm not applied ^^^; continue until False vvv*)
100.126 + else (chk (indets @ [t] @ a') asms));
100.127 + in chk [] asms end
100.128 +
100.129 +and rewrite__set_ _ _ __ Erls t =
100.130 + raise error("rewrite__set_ called with 'Erls' for '"^term2str t^"'")
100.131 + | rewrite__set_ thy i _ _ (rrls as Rrls _) t =
100.132 + let val _= if ! trace_rewrite andalso i < ! depth
100.133 + then writeln ((idt"#"i)^" rls: "^(id_rls rrls)^" on: "^
100.134 + (term2str t)) else ()
100.135 + val (t', asm, rew) = app_rev thy (i+1) rrls t
100.136 + in if rew then SOME (t', distinct asm)
100.137 + else NONE end
100.138 + | rewrite__set_ thy i put_asm bdv rls ct =
100.139 +(* val (thy, i, put_asm, bdv, rls, ct) = (thy, 1, bool, [], rls, term);
100.140 + *)
100.141 + let
100.142 + datatype switch = Appl | Noap;
100.143 + fun rew_once ruls asm ct Noap [] = (ct,asm)
100.144 + | rew_once ruls asm ct Appl [] =
100.145 + (case rls of Rls _ => rew_once ruls asm ct Noap ruls
100.146 + | Seq _ => (ct,asm))
100.147 + | rew_once ruls asm ct apno (rul::thms) =
100.148 +(* val (ruls, asm, ct, apno, (rul::thms)) = (ruls, [], ct, Noap, ruls);
100.149 + val Thm (thmid, thm) = rul;
100.150 + *)
100.151 + case rul of
100.152 + Thm (thmid, thm) =>
100.153 + (if !trace_rewrite andalso i < ! depth
100.154 + then writeln((idt"#"(i+1))^" try thm: "^thmid) else ();
100.155 + case rewrite__ thy (i+1) bdv ((snd o #rew_ord o rep_rls) rls)
100.156 + ((#erls o rep_rls) rls) put_asm thm ct of
100.157 + NONE => rew_once ruls asm ct apno thms
100.158 + | SOME (ct',asm') => (if ! trace_rewrite andalso i < ! depth
100.159 + then writeln((idt"="(i+1))^" rewrites to: "^
100.160 + (term2str ct')) else ();
100.161 + rew_once ruls (union (op =) asm asm') ct' Appl (rul::thms)))
100.162 + | Calc (cc as (op_,_)) =>
100.163 + (let val _= if !trace_rewrite andalso i < ! depth then
100.164 + writeln((idt"#"(i+1))^" try calc: "^op_^"'") else ();
100.165 + val ct = uminus_to_string ct
100.166 + in case get_calculation_ thy cc ct of
100.167 + NONE => ((*writeln "@@@ rewrite__set_: get_calculation_-> NONE";*)
100.168 + rew_once ruls asm ct apno thms)
100.169 + | SOME (thmid, thm') =>
100.170 + let
100.171 + val pairopt =
100.172 + rewrite__ thy (i+1) bdv ((snd o #rew_ord o rep_rls) rls)
100.173 + ((#erls o rep_rls) rls) put_asm thm' ct;
100.174 + val _ = if pairopt <> NONE then ()
100.175 + else raise error("rewrite_set_, rewrite_ \""^
100.176 + (string_of_thmI thm')^"\" "^(term2str ct)^" = NONE")
100.177 + val _ = if ! trace_rewrite andalso i < ! depth
100.178 + then writeln((idt"="(i+1))^" calc. to: "^
100.179 + (term2str ((fst o the) pairopt)))
100.180 + else()
100.181 + in rew_once ruls asm ((fst o the) pairopt) Appl(rul::thms) end
100.182 + end)
100.183 +(* use"Scripts/rewrite.sml";
100.184 + @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
100.185 + | Cal1 (cc as (op_,_)) =>
100.186 + (let val _= if !trace_rewrite andalso i < ! depth then
100.187 + writeln((idt"#"(i+1))^" try cal1: "^op_^"'") else ();
100.188 + val ct = uminus_to_string ct
100.189 + in case get_calculation1_ thy cc ct of
100.190 + NONE => (ct, asm)
100.191 + | SOME (thmid, thm') =>
100.192 + let
100.193 + val pairopt =
100.194 + rewrite__ thy (i+1) bdv ((snd o #rew_ord o rep_rls) rls)
100.195 + ((#erls o rep_rls) rls) put_asm thm' ct;
100.196 + val _ = if pairopt <> NONE then ()
100.197 + else raise error("rewrite_set_, rewrite_ \""^
100.198 + (string_of_thmI thm')^"\" "^(term2str ct)^" = NONE")
100.199 + val _ = if ! trace_rewrite andalso i < ! depth
100.200 + then writeln((idt"="(i+1))^" cal1. to: "^
100.201 + (term2str ((fst o the) pairopt)))
100.202 + else()
100.203 + in the pairopt end
100.204 + end)
100.205 +(*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
100.206 + | Rls_ rls' =>
100.207 + (case rewrite__set_ thy (i+1) put_asm bdv rls' ct of
100.208 + SOME (t',asm') => rew_once ruls (union (op =) asm asm') t' Appl thms
100.209 + | NONE => rew_once ruls asm ct apno thms);
100.210 +
100.211 + val ruls = (#rules o rep_rls) rls;
100.212 + val _= if ! trace_rewrite andalso i < ! depth
100.213 + then writeln ((idt"#"i)^" rls: "^(id_rls rls)^" on: "^
100.214 + (term2str ct)) else ()
100.215 + val (ct',asm') = rew_once ruls [] ct Noap ruls;
100.216 + in if ct = ct' then NONE else SOME (ct', distinct asm') end
100.217 +
100.218 +and app_rev thy i rrls t =
100.219 + let (*.check a (precond, pattern) of a rev-set; stops with 1st true.*)
100.220 + fun chk_prepat thy erls [] t = true
100.221 + | chk_prepat thy erls prepat t =
100.222 + let fun chk (pres, pat) =
100.223 + (let val subst: Type.tyenv * Envir.tenv =
100.224 + Pattern.match thy (pat, t)
100.225 + (Vartab.empty, Vartab.empty)
100.226 + in snd (eval__true thy (i+1)
100.227 + (map (Envir.subst_term subst) pres)
100.228 + [] erls)
100.229 + end)
100.230 + handle _ => false
100.231 + fun scan_ f [] = false (*scan_ NEVER called by []*)
100.232 + | scan_ f (pp::pps) = if f pp then true
100.233 + else scan_ f pps;
100.234 + in scan_ chk prepat end;
100.235 +
100.236 + (*.apply the normal_form of a rev-set.*)
100.237 + fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
100.238 + if chk_prepat thy erls prepat t
100.239 + then ((*writeln("### app_rev': t = "^(term2str t));*)
100.240 + normal_form t)
100.241 + else NONE;
100.242 +
100.243 + val opt = app_rev' thy rrls t
100.244 + in case opt of
100.245 + SOME (t', asm) => (t', asm, true)
100.246 + | NONE => app_sub thy i rrls t
100.247 + end
100.248 +and app_sub thy i rrls t =
100.249 + ((*writeln("### app_sub: subterm = "^(term2str t));*)
100.250 + case t of
100.251 + Const (s, T) => (Const(s, T), [], false)
100.252 + | Free (s, T) => (Free(s, T), [], false)
100.253 + | Var (n, T) => (Var(n, T), [], false)
100.254 + | Bound i => (Bound i, [], false)
100.255 + | Abs (s, T, body) =>
100.256 + let val (t', asm, rew) = app_rev thy i rrls body
100.257 + in (Abs(s, T, t'), asm, rew) end
100.258 + | t1 $ t2 =>
100.259 + let val (t2', asm2, rew2) = app_rev thy i rrls t2
100.260 + in if rew2 then (t1 $ t2', asm2, true)
100.261 + else let val (t1', asm1, rew1) = app_rev thy i rrls t1
100.262 + in if rew1 then (t1' $ t2, asm1, true)
100.263 + else (t1 $ t2, [], false) end
100.264 + end);
100.265 +
100.266 +
100.267 +
100.268 +(*.rewriting without argument [] for rew_ord.*)
100.269 +(*WN.11.6.03: shouldnt asm<>[] lead to false ????*)
100.270 +fun eval_true thy terms rls = (snd o (eval__true thy 1 terms [])) rls;
100.271 +
100.272 +
100.273 +(*.rewriting without internal argument [] for rew_ord.*)
100.274 +(* val (thy, rew_ord, erls, bool, thm, term) =
100.275 + (thy, (assoc_rew_ord ro), rls', false, (assoc_thm' thy thm'), f);
100.276 + val (thy, rew_ord, erls, bool, thm, term) =
100.277 + (thy, rew_ord, erls, false, thm, t'');
100.278 + *)
100.279 +fun rewrite_ thy rew_ord erls bool thm term =
100.280 + rewrite__ thy 1 [] rew_ord erls bool thm term;
100.281 +fun rewrite_set_ thy bool rls term =
100.282 +(* val (thy, bool, rls, term) = (thy, false, srls, t);
100.283 + *)
100.284 + rewrite__set_ thy 1 bool [] rls term;
100.285 +
100.286 +
100.287 +fun subs'2subst thy (s:subs') =
100.288 + (((map (apfst (term_of o the o (parse thy))))
100.289 + o (map (apsnd (term_of o the o (parse thy))))) s):subst;
100.290 +
100.291 +(*.variants of rewrite.*)
100.292 +(*FIXME 12.8.02: put_asm = true <==> rewrite_inst,
100.293 + thus the argument put_asm IS NOT NECESSARY -- FIXME*)
100.294 +(* val (rew_ord,rls,put_asm,thm,ct)=
100.295 + (e_rew_ord,poly_erls,false,num_str d1_isolate_add2,t);
100.296 + *)
100.297 +fun rewrite_inst_ (thy:theory) rew_ord (rls:rls) (put_asm:bool)
100.298 + (subst:(term * term) list) (thm:thm) (ct:term) =
100.299 + rewrite__ thy 1 subst rew_ord rls put_asm thm ct;
100.300 +
100.301 +fun rewrite_set_inst_ (thy:theory)
100.302 + (put_asm:bool) (subst:(term * term) list) (rls:rls) (ct:term) =
100.303 + (*let
100.304 + val subst = subs'2subst thy subs';
100.305 + val subrls = instantiate_rls subs' rls
100.306 + in*) rewrite__set_ thy 1 put_asm subst (*sub*)rls ct
100.307 + (*end*);
100.308 +
100.309 +(* val (thy, ord, erls, subte, t) = (thy, dummy_ord, Erls, subte, t);
100.310 + *)
100.311 +(*.rewrite using a list of terms.*)
100.312 +fun rewrite_terms_ thy ord erls subte t =
100.313 + let (*val _=writeln("### rewrite_terms_ subte= '"^terms2str subte^"' ..."^
100.314 + term_detail2str (hd subte)^
100.315 + "### rewrite_terms_ t= '"^term2str t^"' ..."^
100.316 + term_detail2str t);*)
100.317 + fun rew_ (t', asm') [] _ = (t', asm')
100.318 + (* 1st val (t', asm', rules as r::rs, t) = (e_term, [], subte, t);
100.319 + 2nd val (t', asm', rules as r::rs, t) = (t'', [], rules, t'');
100.320 + rew_ (t', asm') (r::rs) t;
100.321 + *)
100.322 + | rew_ (t', asm') (rules as r::rs) t =
100.323 + let val _ = writeln("rew_ "^term2str t);
100.324 + val (t'', asm'', lrd, rew) =
100.325 + rew_sub thy 1 [] ord erls false [] r t
100.326 + in if rew
100.327 + then (writeln("true rew_ "^term2str t'');
100.328 + rew_ (t'', asm' @ asm'') rules t'')
100.329 + else (writeln("false rew_ "^term2str t'');
100.330 + rew_ (t', asm') rs t')
100.331 + end
100.332 + val (t'', asm'') = rew_ (e_term, []) subte t
100.333 + in if t'' = e_term
100.334 + then NONE else SOME (t'', asm'')
100.335 + end;
100.336 +
100.337 +
100.338 +(*. search ct for adjacent numerals and calculate them by operator isa_fn .*)
100.339 +fun calculate_ thy isa_fn ct =
100.340 + let val ct = uminus_to_string ct
100.341 + in case get_calculation_ thy isa_fn ct of
100.342 + NONE => NONE
100.343 + | SOME (thmID, thm) =>
100.344 + (let val SOME (rew,_) = rewrite_ thy dummy_ord e_rls false thm ct
100.345 + in SOME (rew,(thmID, thm)) end)
100.346 + handle _ => error ("calculate_: "^thmID^" does not rewrite")
100.347 + end;
100.348 +(*
100.349 +> val thy = InsSort.thy;
100.350 +> val op_ = "le"; (* < *)
100.351 +> val ct = (the o (parse thy))
100.352 + "foldr ins [#2] (if #1 < #3 then #1 # ins [] #3 else [#3, #1])";
100.353 +> calculate_ thy op_ ct;
100.354 + SOME
100.355 + ("foldr ins [#2] (if True then #1 # ins [] #3 else [#3, #1])",
100.356 + "(#1 < #3) = True") : (cterm * thm) option *)
100.357 +
100.358 +
100.359 +(* for test-printouts:
100.360 +val _ = writeln("in rew_sub : "^( Sign.string_of_term (sign_of thy) t))
100.361 +val _ = writeln("in eval_true: prems= "^(commas (map (Sign.string_of_term (sign_of thy)) prems')))
100.362 +*)
100.363 +
100.364 +
100.365 +
100.366 +
100.367 +
100.368 +
100.369 +fun get_rls_scr rs' = ((#scr o rep_rls o #2 o the o assoc') (!ruleset',rs'))
100.370 + handle _ => raise error ("get_rls_scr: no script for "^rs');
100.371 +
100.372 +
100.373 +(*make_thm added to Pure/thm.ML*)
100.374 +fun mk_thm thy str =
100.375 + let val t = (term_of o the o (parse thy)) str
100.376 + val t' = case t of
100.377 + Const ("==>",_) $ _ $ _ => t
100.378 + | _ => Trueprop $ t
100.379 + in make_thm (Thm.cterm_of thy t') end;
100.380 +(*
100.381 + val str = "?r ^^^ 2 = ?r * ?r";
100.382 + val thm = realpow_twoI;
100.383 +
100.384 + val t1 = (#prop o rep_thm) (num_str thm);
100.385 + val t2 = Trueprop $ ((term_of o the o (parse thy)) str);
100.386 + t1 = t2;
100.387 +val it = true : bool ... !!!
100.388 + val th1 = (num_str thm);
100.389 + val th2 = ((*num_str*) (mk_thm thy str)) handle e => print_exn e;
100.390 + th1 = th2;
100.391 +ML> val it = false : bool ... HIDDEN DIFFERENCES IRRELEVANT FOR ISAC ?!
100.392 +
100.393 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
100.394 + val str = "k ~= 0 ==> m * k / (n * k) = m / n";
100.395 + val thm = real_mult_div_cancel2;
100.396 +
100.397 + val t1 = (#prop o rep_thm) (num_str thm);
100.398 + val t2 = ((term_of o the o (parse thy)) str);
100.399 + t1 = t2;
100.400 +val it = false : bool ... Var .. Free
100.401 + val th1 = (num_str thm);
100.402 + val th2 = ((*num_str*) (mk_thm thy str)) handle e => print_exn e;
100.403 + th1 = th2;
100.404 +ML> val it = false : bool ... PLUS HIDDEN DIFFERENCES IRRELEVANT FOR ISAC ?!
100.405 +*)
100.406 +
100.407 +
100.408 +(*prints subgoal etc.
100.409 +((goal thy);(topthm()) o ) str; *)
100.410 +(*assume rejects scheme variables
100.411 + assume (cterm_of (sign_of thy) (Trueprop $
100.412 + (term_of o the o (parse thy)) str)); *)
100.413 +
100.414 +
100.415 +(* outcommented 18.11.xx, xx < 02 -------
100.416 +fun rul2rul' (Thm (thmid, thm)) = Thm'(thmid, string_of_thmI thm)
100.417 + | rul2rul' (Calc op_) = Calc' op_;
100.418 +fun rul'2rul thy (Thm'(thmid, ct')) =
100.419 + Thm (thmid, mk_thm thy ct')
100.420 + | rul'2rul thy' (Calc' op_) = Calc op_;
100.421 +
100.422 +
100.423 +fun rls2rls' (Rls{preconds=preconds,rew_ord=rew_ord,rules=rules}:rls) =
100.424 + Rls'{preconds'= map string_of_cterm preconds,
100.425 + rew_ord' = fst rew_ord,
100.426 + rules' = map rul2rul' rules}:rlsdat';
100.427 +
100.428 +fun rls'2rls thy' (Rls'{preconds'=preconds,rew_ord'=rew_ord,
100.429 + rules'=rules}:rlsdat') =
100.430 + let val thy = the (assoc' (theory',thy'))
100.431 + in Rls{preconds = map (the o (parse thy)) preconds,
100.432 + rew_ord = (rew_ord, the (assoc'(rew_ord',rew_ord))),
100.433 + rules = map (rul'2rul thy) rules}:rls end;
100.434 +------- *)
100.435 +
100.436 +(*.get the theorem associated with the xstring-identifier;
100.437 + if the identifier starts with "sym_" then swap lhs = rhs around =
100.438 + (ATTENTION: "RS sym" attaches a [.] -- remove it with string_of_thmI);
100.439 + identifiers starting with "#" come from Calc and
100.440 + get a hand-made theorem (containing numerals only).*)
100.441 +fun assoc_thm' (thy:theory) ((thmid, ct'):thm') =
100.442 + (case explode thmid of
100.443 + "s"::"y"::"m"::"_"::id =>
100.444 + if hd id = "#"
100.445 + then mk_thm thy ct'
100.446 + else ((num_str o (PureThy.get_thm thy)) (implode id)) RS sym
100.447 + | id =>
100.448 + if hd id = "#"
100.449 + then mk_thm thy ct'
100.450 + else (num_str o (PureThy.get_thm thy)) thmid
100.451 + ) handle _ =>
100.452 + raise error ("assoc_thm': '"^thmid^"' not in '"^
100.453 + (theory2domID thy)^"' (and parents)");
100.454 +(*> assoc_thm' Isac.thy ("sym_#mult_2_3","6 = 2 * 3");
100.455 +val it = "6 = 2 * 3" : thm
100.456 +
100.457 +> assoc_thm' Isac.thy ("real_add_zero_left","");
100.458 +val it = "0 + ?z = ?z" : thm
100.459 +
100.460 +> assoc_thm' Isac.thy ("sym_real_add_zero_left","");
100.461 +val it = "?t = 0 + ?t" [.] : thm
100.462 +
100.463 +> assoc_thm' HOL.thy ("sym_real_add_zero_left","");
100.464 +*** Unknown theorem(s) "real_add_zero_left"
100.465 +*** assoc_thm': 'sym_real_add_zero_left' not in 'HOL.thy' (and parents)
100.466 + uncaught exception ERROR*)
100.467 +
100.468 +
100.469 +fun parse' (thy:theory') (ct:cterm') =
100.470 + case parse ((the o assoc')(!theory',thy)) ct of
100.471 + NONE => NONE
100.472 + | SOME ct => SOME ((term2str (term_of ct)):cterm');
100.473 +
100.474 +
100.475 +(*FIXME 12.8.02: put_asm = true <==> rewrite_inst, rewrite_set_inst
100.476 + thus the argument put_asm IS NOT NECESSARY -- FIXME ~~~~~*)
100.477 +fun rewrite (thy':theory') (rew_ord:rew_ord') (rls:rls')
100.478 + (put_asm:bool) (thm:thm') (ct:cterm') =
100.479 +(* val (rew_ord, rls, thm, ct) = (rew_ord', id_rls rls', thm', f);
100.480 + *)
100.481 + let val thy = (the o assoc')(!theory',thy');
100.482 + in
100.483 + case rewrite_ thy
100.484 + ((the o assoc')(!rew_ord',rew_ord))((#2 o the o assoc')(!ruleset',rls))
100.485 + put_asm ((assoc_thm' thy) thm)
100.486 + ((term_of o the o (parse thy)) ct) of
100.487 + NONE => NONE
100.488 + | SOME (t, ts) => SOME (term2str t, terms2str ts)
100.489 + end;
100.490 +
100.491 +(*
100.492 +val thy = "RatArith.thy";
100.493 +val rew_ord = "dummy_ord";
100.494 +> val rls = "eval_rls";
100.495 +val put_asm = true;
100.496 +val thm = ("square_equation_left","");
100.497 +val ct = "sqrt(#9+#4*x)=sqrt x + sqrt(#-3+x)";
100.498 +
100.499 +val Zthy = ((the o assoc')(!theory',thy));
100.500 +val Zrew_ord = ((the o assoc')(!rew_ord',rew_ord));
100.501 +val Zrls = ((the o assoc')(!ruleset',rls));
100.502 +val Zput_asm = put_asm;
100.503 +val Zthm = ((the o (assoc'_thm' thy)) thm);
100.504 +val Zct = ((the o (parse ((the o assoc')(!theory',thy)))) ct);
100.505 +
100.506 +rewrite_ Zthy Zrew_ord Zrls Zput_asm Zthm Zct;
100.507 +
100.508 + use"Isa99/interface_ME_ISA.sml";
100.509 +*)
100.510 +
100.511 +(*FIXME 12.8.02: put_asm = true <==> rewrite_inst, rewrite_set_inst
100.512 + thus the argument put_asm IS NOT NECESSARY -- FIXME ~~~~~*)
100.513 +fun rewrite_set (thy':theory') (put_asm:bool)
100.514 + (rls:rls') (ct:cterm') =
100.515 + let val thy = (the o assoc')(!theory',thy');
100.516 + in
100.517 + case rewrite_set_ thy put_asm ((#2 o the o assoc')(!ruleset',rls))
100.518 + ((term_of o the o (parse thy)) ct) of
100.519 + NONE => NONE
100.520 + | SOME (t, ts) => SOME (term2str t, terms2str ts)
100.521 + end;
100.522 +
100.523 +(*evaluate list-expressions
100.524 + should work on term, and stand in Isa99/rewrite-parse.sml,
100.525 + but there list_rls <- eval_binop is not yet defined*)
100.526 +(*fun eval_listexpr' ct =
100.527 + let val rew = rewrite_set "ListG.thy" false "list_rls" ct;
100.528 + in case rew of
100.529 + SOME (res,_) => res
100.530 + | NONE => ct end;-----------------30.9.02---*)
100.531 +fun eval_listexpr_ thy srls t =
100.532 +(* val (thy, srls, t) =
100.533 + ((assoc_thy th), sr, (subst_atomic (upd_env_opt E (a,v)) t));
100.534 + *)
100.535 + let val rew = rewrite_set_ thy false srls t;
100.536 + in case rew of
100.537 + SOME (res,_) => res
100.538 + | NONE => t end;
100.539 +
100.540 +
100.541 +fun get_calculation' (thy:theory') op_ (ct:cterm') =
100.542 + case get_calculation_ ((the o assoc')(!theory',thy)) op_
100.543 + ((uminus_to_string o term_of o the o
100.544 + (parse ((the o assoc')(!theory',thy)))) ct) of
100.545 + NONE => NONE
100.546 + | SOME (thmid, thm) =>
100.547 + SOME ((thmid, string_of_thmI thm):thm');
100.548 +
100.549 +fun calculate (thy':theory') op_ (ct:cterm') =
100.550 + let val thy = (the o assoc')(!theory',thy');
100.551 + in
100.552 + case calculate_ thy op_
100.553 + ((term_of o the o (parse thy)) ct) of
100.554 + NONE => NONE
100.555 + | SOME (ct,(thmID,thm)) =>
100.556 + SOME (term2str ct,
100.557 + (thmID, string_of_thmI thm):thm')
100.558 + end;
100.559 +(*
100.560 +fun instantiate'' thy' subs ((thmid,ct'):thm') =
100.561 + let val thmid_ = implode ("#"::(explode thmid)) (*see type thm'*)
100.562 + in (thmid_, (string_of_thmI o (read_instantiate subs))
100.563 + ((the o (assoc_thm' thy')) (thmid_,ct'))):thm' end;
100.564 +
100.565 +fun instantiate_rls' thy' subs (rls:rls') =
100.566 + rls2rls' (instantiate_rls subs ((the o (assoc_rls thy')) rls)):rlsdat';
100.567 +
100.568 +... problem with these functions:
100.569 +> val thm = mk_thm thy "(bdv + a = b) = (bdv = b - a)";
100.570 +val thm = "(bdv + a = b) = (bdv = b - a)" : thm
100.571 +> show_types:=true; thm;
100.572 +val it = "((bdv::'a) + (a::'a) = (b::'a)) = (bdv = b - a)" : thm
100.573 +... and this doesn't match because of too general typing (?!)
100.574 + and read_insitantiate doesn't instantiate the types (?!)
100.575 +=== solutions:
100.576 +(1) hard-coded type-instantiation ("'a", "RatArith.rat")
100.577 +(2) instantiate', instantiate ... no help by isabelle-users@ !!!
100.578 +=== conclusion:
100.579 + rewrite_inst, rewrite_set_inst circumvent the problem,
100.580 + according functions out-commented with 'instantiate''
100.581 +*)
100.582 +
100.583 +(* instantiate''
100.584 +fun instantiate'' thy' subs ((thmid,ct'):thm') =
100.585 + let
100.586 + val thmid_ = implode ("#"::(explode thmid)); (*see type thm'*)
100.587 + val thy = (the o assoc')(!theory',thy');
100.588 + val typs = map (#T o rep_cterm o the o (parse thy))
100.589 + ((snd o split_list) subs);
100.590 + val ctyps = map
100.591 + ((ctyp_of (sign_of thy)) o #T o rep_cterm o the o (parse thy))
100.592 + ((snd o split_list) subs);
100.593 +
100.594 +> val thy' = "RatArith.thy";
100.595 +> val subs = [("bdv","x::rat"),("zzz","z::nat")];
100.596 +> (the o (parse ((the o assoc')(!theory',thy')))) "x::rat";
100.597 +> (#T o rep_cterm o the o (parse ((the o assoc')(!theory',thy'))));
100.598 +
100.599 +> val ctyp = ((ctyp_of (sign_of thy)) o #T o rep_cterm o the o
100.600 + (parse ((the o assoc')(!theory',thy')))) "x::rat";
100.601 +> val bdv = (the o (parse thy)) "bdv";
100.602 +> val x = (the o (parse thy)) "x";
100.603 +> (instantiate ([(("'a",0),ctyp)],[(bdv,x)]) isolate_bdv_add)
100.604 + handle e => print_exn e;
100.605 +uncaught exception THM
100.606 + raised at: thm.ML:1085.18-1085.69
100.607 + thm.ML:1092.34
100.608 + goals.ML:536.61
100.609 +
100.610 +> val bdv = (the o (parse thy)) "bdv::nat";
100.611 +> val x = (the o (parse thy)) "x::nat";
100.612 +> (instantiate ([(("'a",0),ctyp)],[(bdv,x)]) isolate_bdv_add)
100.613 + handle e => print_exn e;
100.614 +uncaught exception THM
100.615 + raised at: thm.ML:1085.18-1085.69
100.616 + thm.ML:1092.34
100.617 + goals.ML:536.61
100.618 +
100.619 +> (instantiate' [SOME ctyp] [] isolate_bdv_add)
100.620 + handle e => print_exn e;
100.621 +uncaught exception TYPE
100.622 + raised at: drule.ML:613.13-615.44
100.623 + goals.ML:536.61
100.624 +
100.625 +> val repct = (rep_cterm o the o (parse ((the o assoc')(!theory',thy')))) "x::rat";
100.626 +*)
100.627 +
100.628 +(*FIXME 12.8.02: put_asm = true <==> rewrite_inst, rewrite_set_inst
100.629 + thus the argument put_asm IS NOT NECESSARY -- FIXME ~~~~~*)
100.630 +fun rewrite_inst (thy':theory') (rew_ord:rew_ord') (rls:rls')
100.631 + (put_asm:bool) subs (thm:thm') (ct:cterm') =
100.632 + let
100.633 + val thy = (the o assoc')(!theory',thy');
100.634 + val thm = assoc_thm' thy thm; (*28.10.02*)
100.635 + (*val subthm = read_instantiate subs ((assoc_thm' thy) thm)*)
100.636 + in
100.637 + case rewrite_ thy
100.638 + ((the o assoc')(!rew_ord',rew_ord)) ((#2 o the o assoc')(!ruleset',rls))
100.639 + put_asm (*sub*)thm ((term_of o the o (parse thy)) ct) of
100.640 + NONE => NONE
100.641 + | SOME (ctm, ctms) =>
100.642 + SOME ((term2str ctm):cterm', (map term2str ctms):cterm' list)
100.643 + end;
100.644 +
100.645 +(*FIXME 12.8.02: put_asm = true <==> rewrite_inst, rewrite_set_inst
100.646 + thus the argument put_asm IS NOT NECESSARY -- FIXME ~~~~~*)
100.647 +fun rewrite_set_inst (thy':theory') (put_asm:bool)
100.648 + subs' (rls:rls') (ct:cterm') =
100.649 + let
100.650 + val thy = (the o assoc')(!theory',thy');
100.651 + val rls = assoc_rls rls
100.652 + val subst = subs'2subst thy subs'
100.653 + (*val subrls = instantiate_rls subs ((the o assoc')(!ruleset',rls))*)
100.654 + in case rewrite_set_inst_ thy put_asm subst (*sub*)rls
100.655 + ((term_of o the o (parse thy)) ct) of
100.656 + NONE => NONE
100.657 + | SOME (t, ts) => SOME (term2str t, terms2str ts)
100.658 + end;
100.659 +
100.660 +
100.661 +(*vor check_elementwise: SqRoot_eval_rls .. wie *_simplify ?! TODO *)
100.662 +fun eval_true' (thy':theory') (rls':rls') (Const ("True",_)) = true
100.663 +
100.664 + | eval_true' (thy':theory') (rls':rls') (t:term) =
100.665 +(* val thy'="Isac.thy"; val rls'="eval_rls"; val t=hd pres';
100.666 + *)
100.667 + let val ct' = term2str t;
100.668 + in case rewrite_set thy' false rls' ct' of
100.669 + SOME ("True",_) => true
100.670 + | _ => false
100.671 + end;
100.672 +fun eval_true_ _ _ (Const ("True",_)) = true
100.673 + | eval_true_ (thy':theory') rls t =
100.674 + case rewrite_set_ (assoc_thy thy') false rls t of
100.675 + SOME (Const ("True",_),_) => true
100.676 + | _ => false;
100.677 +
100.678 +(*
100.679 +val test_rls =
100.680 + Rls{preconds = [], rew_ord = ("sqrt_right",sqrt_right),
100.681 + rules = [Calc ("matches",eval_matches "")
100.682 + ],
100.683 + scr = Script ((term_of o the o (parse thy))
100.684 + "empty_script")
100.685 + }:rls;
100.686 +
100.687 +
100.688 +
100.689 + rewrite_set_ Isac.thy eval_rls false test_rls
100.690 + ((the o (parse thy)) "matches (?a = ?b) (x = #0)");
100.691 + val xxx = (term_of o the o (parse thy))
100.692 + "matches (?a = ?b) (x = #0)";
100.693 + eval_matches """" xxx thy;
100.694 +SOME ("matches (?a = ?b) (x + #1 + #-1 * #2 = #0) = True",
100.695 + Const ("Trueprop","bool => prop") $ (Const # $ (# $ #) $ Const (#,#)))
100.696 +
100.697 +
100.698 +
100.699 + rewrite_set_ Isac.thy eval_rls false eval_rls
100.700 + ((the o (parse thy)) "contains_root (sqrt #0)");
100.701 +val it = SOME ("True",[]) : (cterm * cterm list) option
100.702 +
100.703 +*)
100.704 +
100.705 +
100.706 +(*----------WN:16.5.03 stuff below considered illdesigned, thus coded from scratch in appl.sml fun check_elementwise
100.707 +datatype det = TRUE | FALSE | INDET;(*FIXXME.WN:16.5.03
100.708 + introduced with quick-and-dirty code*)
100.709 +fun determine dts =
100.710 + let val false_indet =
100.711 + filter_out ((curry op= TRUE) o (#1:det * term -> det)) dts
100.712 + val ts = map (#2: det * term -> term) dts
100.713 + in if nil = false_indet then (TRUE, ts)
100.714 + else if nil = filter ((curry op= FALSE) o (#1:det * term -> det))
100.715 + false_indet
100.716 + then (INDET, ts)
100.717 + else (FALSE, ts) end;
100.718 +(* val dts = [(INDET,e_term), (FALSE,HOLogic.false_const),
100.719 + (INDET,e_term), (TRUE,HOLogic.true_const)];
100.720 + determine dts;
100.721 +val it =
100.722 + (FALSE,
100.723 + [Const ("empty","'a"),Const ("False","bool"),Const ("empty","'a"),
100.724 + Const ("True","bool")]) : det * term list*)
100.725 +
100.726 +fun eval__indet_ thy cs rls = (*FIXXME.WN:16.5.03 pull into eval__true_, update check (check_elementwise), and regard eval_true_ + eval_true*)
100.727 +if cs = [HOLogic.true_const] orelse cs = [] then (TRUE, [])
100.728 + else if cs = [HOLogic.false_const] then (FALSE, cs)
100.729 + else
100.730 + let fun eval t =
100.731 + let val taopt = rewrite__set_ thy 1 false [] rls t
100.732 + in case taopt of
100.733 + SOME (t,_) =>
100.734 + if t = HOLogic.true_const then (TRUE, t)
100.735 + else if t = HOLogic.false_const then (FALSE, t)
100.736 + else (INDET, t)
100.737 + | NONE => (INDET, t) end
100.738 + in (determine o (map eval)) cs end;
100.739 +WN.16.5.0-------------------------------------------------------------*)
101.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
101.2 +++ b/src/Pure/isac/Scripts/scrtools.sml Wed Jul 21 13:53:39 2010 +0200
101.3 @@ -0,0 +1,480 @@
101.4 +(* tools which depend on Script.thy and thus are not in term_G.sml
101.5 + (c) Walther Neuper 2000
101.6 +
101.7 +use"Scripts/scrtools.sml";
101.8 +use"scrtools.sml";
101.9 +*)
101.10 +
101.11 +
101.12 +fun is_reall_dsc
101.13 + (Const(_,Type("fun",[Type("List.list",
101.14 + [Type ("real",[])]),_]))) = true
101.15 + | is_reall_dsc
101.16 + (Const(_,Type("fun",[Type("List.list",
101.17 + [Type ("real",[])]),_])) $ t) = true
101.18 + | is_reall_dsc _ = false;
101.19 +fun is_booll_dsc
101.20 + (Const(_,Type("fun",[Type("List.list",
101.21 + [Type ("bool",[])]),_]))) = true
101.22 + | is_booll_dsc
101.23 + (Const(_,Type("fun",[Type("List.list",
101.24 + [Type ("bool",[])]),_])) $ t) = true
101.25 + | is_booll_dsc _ = false;
101.26 +(*
101.27 +> val t = (term_of o the o (parse thy)) "relations";
101.28 +> atomtyp (type_of t);
101.29 +*** Type (fun,[
101.30 +*** Type (List.list,[
101.31 +*** Type (bool,[])
101.32 +*** ]
101.33 +*** Type (Tools.una,[])
101.34 +*** ]
101.35 +> is_booll_dsc t;
101.36 +val it = true : bool
101.37 +> is_reall_dsc t;
101.38 +val it = false : bool
101.39 +*)
101.40 +
101.41 +fun is_list_dsc (Const(_,Type("fun",[Type("List.list",_),_]))) = true
101.42 + | is_list_dsc (Const(_,Type("fun",[Type("List.list",_),_])) $ t) = true
101.43 + (*WN:8.5.03: ??? ~~~~ ???*)
101.44 + | is_list_dsc _ = false;
101.45 +(*
101.46 +> val t = str2term "someList";
101.47 +> is_list_dsc t;
101.48 +val it = true : bool
101.49 +
101.50 +> val t = (term_of o the o (parse thy))
101.51 + "additional_relations [a=b,c=(d::real)]";
101.52 +> is_list_dsc t;
101.53 +val it = true : bool
101.54 +> is_list_dsc (head_of t);
101.55 +val it = true : bool
101.56 +
101.57 +> val t = (term_of o the o (parse thy))"max_relation (A=#2*a*b-a^^^#2)";
101.58 +> is_list_dsc t;
101.59 +val it = false : bool
101.60 +> is_list_dsc (head_of t);
101.61 +val it = false : bool
101.62 +> val t = (term_of o the o (parse thy)) "testdscforlist";
101.63 +> is_list_dsc (head_of t);
101.64 +val it = true : bool
101.65 +*)
101.66 +
101.67 +
101.68 +fun is_unl (Const(_,Type("fun",[_,Type("Tools.unl",_)]))) = true
101.69 + | is_unl _ = false;
101.70 +(*
101.71 +> val t = str2term "someList"; is_unl t;
101.72 +val it = true : bool
101.73 +> val t = (term_of o the o (parse thy)) "maximum";
101.74 +> is_unl t;
101.75 +val it = false : bool
101.76 +*)
101.77 +
101.78 +fun is_dsc (Const(_,Type("fun",[_,Type("Tools.nam",_)]))) = true
101.79 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.una",_)]))) = true
101.80 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.unl",_)]))) = true
101.81 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.str",_)]))) = true
101.82 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.toreal",_)]))) = true
101.83 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.toreall",_)])))= true
101.84 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.tobooll",_)])))= true
101.85 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.unknow",_)])))= true
101.86 + | is_dsc (Const(_,Type("fun",[_,Type("Tools.cpy",_)])))= true
101.87 + | is_dsc _ = false;
101.88 +fun is_dsc term =
101.89 + (case (range_type o type_of) term of
101.90 + Type("Tools.nam",_) => true
101.91 + | Type("Tools.una",_) => true
101.92 + | Type("Tools.unl",_) => true
101.93 + | Type("Tools.str",_) => true
101.94 + | Type("Tools.toreal",_) => true
101.95 + | Type("Tools.toreall",_) => true
101.96 + | Type("Tools.tobooll",_) => true
101.97 + | Type("Tools.unknow",_) => true
101.98 + | Type("Tools.cpy",_) => true
101.99 + | _ => false)
101.100 + handle Match => false;
101.101 +
101.102 +
101.103 +(*
101.104 +val t as t1 $ t2 = str2term "antiDerivativeName M_b";
101.105 +val Const (_, Type ("fun", [Type ("fun", _), Type ("Tools.una",[])])) $ _ = t;
101.106 +is_dsc t1;
101.107 +
101.108 +> val t = (term_of o the o (parse thy)) "maximum";
101.109 +> is_dsc t;
101.110 +val it = true : bool
101.111 +> val t = (term_of o the o (parse thy)) "testdscforlist";
101.112 +> is_dsc t;
101.113 +val it = true : bool
101.114 +
101.115 +> val t = (head_of o term_of o the o (parse thy)) "maximum A";
101.116 +> is_dsc t;
101.117 +val it = true : bool
101.118 +> val t = (head_of o term_of o the o (parse thy))
101.119 + "fixedValues [R=(R::real)]";
101.120 +> is_dsc t;
101.121 +val it = true : bool
101.122 +*)
101.123 +
101.124 +
101.125 +(*make the term 'Subproblem (domID, pblID)' to a formula for frontend;
101.126 + needs to be here after def. Subproblem in Script.thy*)
101.127 +val t as (subpbl_t $ (pair_t $ Free (domID,_) $ pblID)) =
101.128 + (term_of o the o (parse Script.thy))
101.129 + "Subproblem (Isac,[equation,univar])";
101.130 +val t as (pbl_t $ _) =
101.131 + (term_of o the o (parse Script.thy))
101.132 + "Problem (Isac,[equation,univar])";
101.133 +val Free (_, ID_type) = (term_of o the o (parse Script.thy)) "x::ID";
101.134 +
101.135 +
101.136 +fun subpbl domID pblID =
101.137 + subpbl_t $ (pair_t $ Free (domID,ID_type) $
101.138 + (((list2isalist ID_type) o (map (mk_free ID_type))) pblID));
101.139 +(*> subpbl "Isac" ["equation","univar"] = t;
101.140 +val it = true : bool *)
101.141 +
101.142 +
101.143 +fun pblterm (domID:domID) (pblID:pblID) =
101.144 + pbl_t $ (pair_t $ Free (domID,ID_type) $
101.145 + (((list2isalist ID_type) o (map (mk_free ID_type))) pblID));
101.146 +
101.147 +
101.148 +(**.construct scr-env from scr(created automatically) and Rewrite_Set.**)
101.149 +
101.150 +fun one_scr_arg (Const _ $ arg $ _) = arg
101.151 + | one_scr_arg t = raise error ("one_scr_arg: called by "^(term2str t));
101.152 +fun two_scr_arg (Const _ $ a1 $ a2 $ _) = (a1, a2)
101.153 + | two_scr_arg t = raise error ("two_scr_arg: called by "^(term2str t));
101.154 +
101.155 +
101.156 +(**.generate calc from a script.**)
101.157 +
101.158 +(*.instantiate a stactic or scriptexpr, and ev. attach (curried) argument
101.159 +args:
101.160 + E environment
101.161 + v current value, is attached to curried stactics
101.162 + stac stactic to be instantiated
101.163 +precond:
101.164 + not (a = None) /\ (v = e_term) /\ (stac curried, i.e. without last arg.)
101.165 + this ........................ is the initialization for assy with l=[],
101.166 + but the 1st stac is
101.167 + (a) curried: then (a = Some _), or
101.168 + (b) not curried: then the values of the initialization are not used
101.169 +.*)
101.170 +datatype stacexpr = STac of term | Expr of term
101.171 +fun rep_stacexpr (STac t ) = t
101.172 + | rep_stacexpr (Expr t) =
101.173 + raise error ("rep_stacexpr called with t= "^(term2str t));
101.174 +
101.175 +type env = (term * term) list;
101.176 +
101.177 +(*update environment; t <> empty if coming from listexpr*)
101.178 +fun upd_env (env:env) (v,t) =
101.179 + let val env' = if t = e_term then env else overwrite (env,(v,t));
101.180 + (*val _= writeln("### upd_env: = "^(subst2str env'));*)
101.181 + in env' end;
101.182 +
101.183 +(*.substitute the scripts environment in a leaf of the scripts parse-tree
101.184 + and attach the curried argument of a tactic, if any.
101.185 + a leaf is either a tactic or an 'exp' in 'let v = expr'
101.186 + where 'exp' does not contain a tactic.
101.187 +CAUTION: (1) currying with @@ requires 2 patterns for each tactic
101.188 + (2) the non-curried version must return None for a
101.189 + (3) non-matching patterns become an Expr by fall-through.
101.190 +WN060906 quick and dirty fix: due to (2) a is returned, too.*)
101.191 +fun subst_stacexpr E a v (t as (Const ("Script.Rewrite",_) $ _ $ _ $ _ ))=
101.192 + (None, STac (subst_atomic E t))
101.193 +
101.194 + | subst_stacexpr E a v (t as (Const ("Script.Rewrite",_) $ _ $ _ ))=
101.195 + (a, (*in these cases we hope, that a = Some _*)
101.196 + STac (case a of Some a' => (subst_atomic E (t $ a'))
101.197 + | None => ((subst_atomic E t) $ v)))
101.198 +
101.199 + | subst_stacexpr E a v
101.200 + (t as (Const ("Script.Rewrite'_Inst",_) $ _ $ _ $ _ $ _ )) =
101.201 + (None, STac (subst_atomic E t))
101.202 +
101.203 + | subst_stacexpr E a v (t as (Const ("Script.Rewrite'_Inst",_) $ _ $ _ $ _))=
101.204 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.205 + | None => ((subst_atomic E t) $ v)))
101.206 +
101.207 + | subst_stacexpr E a v (t as (Const ("Script.Rewrite'_Set",_) $ _ $ _ $ _ ))=
101.208 + (None, STac (subst_atomic E t))
101.209 +
101.210 + | subst_stacexpr E a v (t as (Const ("Script.Rewrite'_Set",_) $ _ $ _ )) =
101.211 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.212 + | None => ((subst_atomic E t) $ v)))
101.213 +
101.214 + | subst_stacexpr E a v
101.215 + (t as (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ _ $ _ $ _ )) =
101.216 + (None, STac (subst_atomic E t))
101.217 +
101.218 + | subst_stacexpr E a v
101.219 + (t as (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ _ $ _ )) =
101.220 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.221 + | None => ((subst_atomic E t) $ v)))
101.222 +
101.223 + | subst_stacexpr E a v (t as (Const ("Script.Calculate",_) $ _ $ _ )) =
101.224 + (None, STac (subst_atomic E t))
101.225 +
101.226 + | subst_stacexpr E a v (t as (Const ("Script.Calculate",_) $ _ )) =
101.227 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.228 + | None => ((subst_atomic E t) $ v)))
101.229 +
101.230 + | subst_stacexpr E a v
101.231 + (t as (Const("Script.Check'_elementwise",_) $ _ $ _ )) =
101.232 + (None, STac (subst_atomic E t))
101.233 +
101.234 + | subst_stacexpr E a v (t as (Const("Script.Check'_elementwise",_) $ _ )) =
101.235 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.236 + | None => ((subst_atomic E t) $ v)))
101.237 +
101.238 + | subst_stacexpr E a v (t as (Const("Script.Or'_to'_List",_) $ _ )) =
101.239 + (None, STac (subst_atomic E t))
101.240 +
101.241 + | subst_stacexpr E a v (t as (Const("Script.Or'_to'_List",_))) = (*t $ v*)
101.242 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.243 + | None => ((subst_atomic E t) $ v)))
101.244 +
101.245 + | subst_stacexpr E a v (t as (Const ("Script.SubProblem",_) $ _ $ _ )) =
101.246 + (None, STac (subst_atomic E t))
101.247 +
101.248 + | subst_stacexpr E a v (t as (Const ("Script.Take",_) $ _ )) =
101.249 + (None, STac (subst_atomic E t))
101.250 +
101.251 + | subst_stacexpr E a v (t as (Const ("Script.Substitute",_) $ _ $ _ )) =
101.252 + (None, STac (subst_atomic E t))
101.253 +
101.254 + | subst_stacexpr E a v (t as (Const ("Script.Substitute",_) $ _ )) =
101.255 + (a, STac (case a of Some a' => subst_atomic E (t $ a')
101.256 + | None => ((subst_atomic E t) $ v)))
101.257 +
101.258 + (*now all tactics are matched out and this leaf must be without a tactic*)
101.259 + | subst_stacexpr E a v t =
101.260 + (a, Expr (subst_atomic (case a of Some a => upd_env E (a,v)
101.261 + | None => E) t));
101.262 +(*> val t = str2term "SubProblem(Test_, [linear, univariate, equation, test], [Test, solve_linear]) [bool_ e_, real_ v_]";
101.263 +> subst_stacexpr [] None e_term t;*)
101.264 +
101.265 +
101.266 +fun stacpbls (h $ body) =
101.267 + let
101.268 + fun scan ts (Const ("Let",_) $ e $ (Abs (v,T,b))) =
101.269 + (scan ts e) @ (scan ts b)
101.270 + | scan ts (Const ("If",_) $ c $ e1 $ e2) = (scan ts e1) @ (scan ts e2)
101.271 + | scan ts (Const ("Script.While",_) $ c $ e $ _) = scan ts e
101.272 + | scan ts (Const ("Script.While",_) $ c $ e) = scan ts e
101.273 + | scan ts (Const ("Script.Repeat",_) $ e $ _) = scan ts e
101.274 + | scan ts (Const ("Script.Repeat",_) $ e) = scan ts e
101.275 + | scan ts (Const ("Script.Try",_) $ e $ _) = scan ts e
101.276 + | scan ts (Const ("Script.Try",_) $ e) = scan ts e
101.277 + | scan ts (Const ("Script.Or",_) $e1 $ e2 $ _) =
101.278 + (scan ts e1) @ (scan ts e2)
101.279 + | scan ts (Const ("Script.Or",_) $e1 $ e2) =
101.280 + (scan ts e1) @ (scan ts e2)
101.281 + | scan ts (Const ("Script.Seq",_) $e1 $ e2 $ _) =
101.282 + (scan ts e1) @ (scan ts e2)
101.283 + | scan ts (Const ("Script.Seq",_) $e1 $ e2) =
101.284 + (scan ts e1) @ (scan ts e2)
101.285 + | scan ts t = case subst_stacexpr [] None e_term t of
101.286 + (_, STac _) => [t] | (_, Expr _) => []
101.287 + in (distinct o (scan [])) body end;
101.288 + (*sc = Solve_root_equation ...
101.289 +> val ts = stacpbls sc;
101.290 +> writeln (terms2str thy ts);
101.291 +["Rewrite square_equation_left True e_",
101.292 + "Rewrite_Set SqRoot_simplify False e_",
101.293 + "Rewrite_Set rearrange_assoc False e_",
101.294 + "Rewrite_Set isolate_root False e_",
101.295 + "Rewrite_Set norm_equation False e_",
101.296 + "Rewrite_Set_Inst [(bdv, v_)] isolate_bdv False e_"]
101.297 +*)
101.298 +
101.299 +
101.300 +
101.301 +fun is_calc (Const ("Script.Calculate",_) $ _) = true
101.302 + | is_calc (Const ("Script.Calculate",_) $ _ $ _) = true
101.303 + | is_calc _ = false;
101.304 +fun op_of_calc (Const ("Script.Calculate",_) $ Free (op_,_)) = op_
101.305 + | op_of_calc (Const ("Script.Calculate",_) $ Free (op_,_) $ _) = op_
101.306 + | op_of_calc t = raise error ("op_of_calc called with"^term2str t);
101.307 +
101.308 +(*######################################################################
101.309 +
101.310 + val Script sc = (#scr o rep_rls) Test_simplify;
101.311 + val stacs = stacpbls sc;
101.312 +
101.313 + val calcs = filter is_calc stacs;
101.314 + val ids = map op_of_calc calcs;
101.315 + map (curry assoc1 (!calclist')) ids;
101.316 +
101.317 + (((map (curry assoc1 (!calclist'))) o (map op_of_calc) o
101.318 + (filter is_calc) o stacpbls) sc):calc list;
101.319 +
101.320 +######################################################################*)
101.321 +
101.322 +(**.for automatic creation of scripts from rls.**)
101.323 +
101.324 +val ScrStep $ _ $ _ = (*'z not affected by parse: 'a --> real*)
101.325 + ((inst_abs thy) o term_of o the o (parse thy))
101.326 + "Script Stepwise (t_::'z) =\
101.327 + \(Repeat\
101.328 + \ ((Try (Repeat (Rewrite real_diff_minus False))) @@ \
101.329 + \ (Try (Repeat (Rewrite real_add_commute False))) @@ \
101.330 + \ (Try (Repeat (Rewrite real_mult_commute False)))) \
101.331 + \ t_)";
101.332 +(*WN060605 script-arg (t_::'z) and "Free (t_, 'a)" at end of body
101.333 +are inconsistent !!!*)
101.334 +val ScrStep_inst $ Term $ Bdv $ _=(*'z not affected by parse: 'a --> real*)
101.335 + ((inst_abs thy) o term_of o the o (parse thy))
101.336 + "Script Stepwise_inst (t_::'z) (v_::real) =\
101.337 + \(Repeat\
101.338 + \ ((Try (Repeat (Rewrite_Inst [(bdv,v_)] real_diff_minus False))) @@ \
101.339 + \ (Try (Repeat (Rewrite_Inst [(bdv,v_)] real_add_commute False))) @@\
101.340 + \ (Try (Repeat (Rewrite_Inst [(bdv,v_)] real_mult_commute False)))) \
101.341 + \ t_)";
101.342 +val Repeat $ _ =
101.343 + ((inst_abs thy) o term_of o the o (parseN thy))
101.344 + "Repeat (Rewrite real_diff_minus False t_)";
101.345 +val Try $ _ =
101.346 + ((inst_abs thy) o term_of o the o (parseN thy))
101.347 + "Try (Rewrite real_diff_minus False t_)";
101.348 +val Cal $ _ =
101.349 + ((inst_abs thy) o term_of o the o (parseN thy))
101.350 + "Calculate plus";
101.351 +val Ca1 $ _ =
101.352 + ((inst_abs thy) o term_of o the o (parseN thy))
101.353 + "Calculate1 plus";
101.354 +val Rew $ (Free (_,IDtype)) $ _ $ t_ =
101.355 + ((inst_abs thy) o term_of o the o (parseN thy))
101.356 + "Rewrite real_diff_minus False t_";
101.357 +val Rew_Inst $ Subs $ _ $ _ =
101.358 + ((inst_abs thy) o term_of o the o (parseN thy))
101.359 + "Rewrite_Inst [(bdv,v_)] real_diff_minus False";
101.360 +val Rew_Set $ _ $ _ =
101.361 + ((inst_abs thy) o term_of o the o (parseN thy))
101.362 + "Rewrite_Set real_diff_minus False";
101.363 +val Rew_Set_Inst $ _ $ _ $ _ =
101.364 + ((inst_abs thy) o term_of o the o (parseN thy))
101.365 + "Rewrite_Set_Inst [(bdv,v_)] real_diff_minus False";
101.366 +val SEq $ _ $ _ $ _ =
101.367 + ((inst_abs thy) o term_of o the o (parseN thy))
101.368 + " ((Try (Repeat (Rewrite real_diff_minus False))) @@ \
101.369 + \ (Try (Repeat (Rewrite real_add_commute False))) @@ \
101.370 + \ (Try (Repeat (Rewrite real_mult_commute False)))) t_";
101.371 +
101.372 +fun rule2stac _ (Thm (thmID, _)) =
101.373 + Try $ (Repeat $ (Rew $ Free (thmID, IDtype) $ HOLogic.false_const))
101.374 + | rule2stac calc (Calc (c, _)) =
101.375 + Try $ (Repeat $ (Cal $ Free (assoc_calc (calc ,c), IDtype)))
101.376 + | rule2stac calc (Cal1 (c, _)) =
101.377 + Try $ (Repeat $ (Ca1 $ Free (assoc_calc (calc ,c), IDtype)))
101.378 + | rule2stac _ (Rls_ rls) =
101.379 + Try $ (Rew_Set $ Free (id_rls rls, IDtype) $ HOLogic.false_const);
101.380 +(*val t = rule2stac [] (Thm ("real_diff_minus", num_str real_diff_minus));
101.381 +atomt t; term2str t;
101.382 +val t = rule2stac calclist (Calc ("op +", eval_binop "#add_"));
101.383 +atomt t; term2str t;
101.384 +val t = rule2stac [] (Rls_ rearrange_assoc);
101.385 +atomt t; term2str t;
101.386 +*)
101.387 +fun rule2stac_inst _ (Thm (thmID, _)) =
101.388 + Try $ (Repeat $ (Rew_Inst $ Subs $ Free (thmID, IDtype) $
101.389 + HOLogic.false_const))
101.390 + | rule2stac_inst calc (Calc (c, _)) =
101.391 + Try $ (Repeat $ (Cal $ Free (assoc_calc (calc ,c), IDtype)))
101.392 + | rule2stac_inst calc (Cal1 (c, _)) =
101.393 + Try $ (Repeat $ (Cal $ Free (assoc_calc (calc ,c), IDtype)))
101.394 + | rule2stac_inst _ (Rls_ rls) =
101.395 + Try $ (Rew_Set_Inst $ Subs $ Free (id_rls rls, IDtype) $
101.396 + HOLogic.false_const);
101.397 +(*val t = rule2stac_inst [] (Thm ("real_diff_minus", num_str real_diff_minus));
101.398 +atomt t; term2str t;
101.399 +val t = rule2stac_inst calclist (Calc ("op +", eval_binop "#add_"));
101.400 +atomt t; term2str t;
101.401 +val t = rule2stac_inst [] (Rls_ rearrange_assoc);
101.402 +atomt t; term2str t;
101.403 +*)
101.404 +
101.405 +(*for appropriate nesting take stacs in _reverse_ order*)
101.406 +fun @@@ sts [s] = SEq $ s $ sts
101.407 + | @@@ sts (s::ss) = @@@ (SEq $ s $ sts) ss;
101.408 +fun @@ [stac] = stac
101.409 + | @@ [s1, s2] = SEq $ s1 $ s2 (*---------vvv--*)
101.410 + | @@ stacs =
101.411 + let val s3::s2::ss = rev stacs
101.412 + in @@@ (SEq $ s2 $ s3) ss end;
101.413 +(*
101.414 + val rules = (#rules o rep_rls) isolate_root;
101.415 + val rs = map (rule2stac calclist) rules;
101.416 + val tt = @@ rs;
101.417 + atomt tt; writeln (term2str tt);
101.418 + *)
101.419 +
101.420 +val contains_bdv = (not o null o (filter is_bdv) o ids2str o #prop o rep_thm);
101.421 +
101.422 +(*.does a rule contain a 'bdv'; descend recursively into Rls_.*)
101.423 +fun contain_bdv [] = false
101.424 + | contain_bdv (Thm (_, thm)::rs) =
101.425 + if (not o contains_bdv) thm
101.426 + then contain_bdv rs
101.427 + else true
101.428 + | contain_bdv (Calc _ ::rs) = contain_bdv rs
101.429 + | contain_bdv (Cal1 _ ::rs) = contain_bdv rs
101.430 + | contain_bdv (Rls_ rls ::rs) =
101.431 + contain_bdv (get_rules rls) orelse contain_bdv rs
101.432 + | contain_bdv (r::_) =
101.433 + raise error ("contain_bdv called with ["^(id_rule r)^",...]");
101.434 +
101.435 +
101.436 +fun rules2scr_Rls calc rules =
101.437 + if contain_bdv rules
101.438 + then ScrStep_inst $ Term $ Bdv $
101.439 + (Repeat $ (((@@ o (map (rule2stac_inst calc))) rules) $ t_))
101.440 + else ScrStep $ Term $
101.441 + (Repeat $ (((@@ o (map (rule2stac calc))) rules) $ t_));
101.442 +(* val (calc, rules) = (!calclist', rules);
101.443 + *)
101.444 +fun rules2scr_Seq calc rules =
101.445 + if contain_bdv rules
101.446 + then ScrStep_inst $ Term $ Bdv $
101.447 + (((@@ o (map (rule2stac_inst calc))) rules) $ t_)
101.448 + else ScrStep $ Term $
101.449 + (((@@ o (map (rule2stac calc))) rules) $ t_);
101.450 +
101.451 +(*.prepare the input for an rls for use:
101.452 + # generate a script for stepwise execution of the rls
101.453 + # filter the operators for Calc out of the script
101.454 + !!!use this function in ruleset' := !!! .*)
101.455 +fun prep_rls Erls = raise error "prep_rls not impl. for Erls"
101.456 + | prep_rls (Rls {id,preconds,rew_ord,erls,srls,calc,rules,...}) =
101.457 + let val sc = (rules2scr_Rls (!calclist') rules)
101.458 + in Rls {id=id,preconds=preconds,rew_ord=rew_ord,erls=erls,
101.459 + srls=srls,
101.460 + calc = (*FIXXXME.040207 use also for met*)
101.461 + ((map (curry assoc1 (!calclist'))) o (map op_of_calc) o
101.462 + (filter is_calc) o stacpbls) sc,
101.463 + rules=rules,
101.464 + scr = Script sc} end
101.465 +(* val (Seq {id,preconds,rew_ord,erls,srls,calc,rules,...}) = add_new_c;
101.466 + *)
101.467 + | prep_rls (Seq {id,preconds,rew_ord,erls,srls,calc,rules,...}) =
101.468 + let val sc = (rules2scr_Seq (!calclist') rules)
101.469 + in Seq {id=id,preconds=preconds,rew_ord=rew_ord,erls=erls,
101.470 + srls=srls,
101.471 + calc = ((map (curry assoc1 (!calclist'))) o (map op_of_calc) o
101.472 + (filter is_calc) o stacpbls) sc,
101.473 + rules=rules,
101.474 + scr = Script sc} end
101.475 + | prep_rls (Rrls {id,...}) =
101.476 + raise error ("prep_rls not required for Rrls \""^id^"\"");
101.477 +(*
101.478 + val Script sc = (#scr o rep_rls o prep_rls) isolate_root;
101.479 + (writeln o term2str) sc;
101.480 + val Script sc = (#scr o rep_rls o prep_rls) isolate_bdv;
101.481 + (writeln o term2str) sc;
101.482 + *)
101.483 +
102.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
102.2 +++ b/src/Pure/isac/Scripts/term_G.sml Wed Jul 21 13:53:39 2010 +0200
102.3 @@ -0,0 +1,1340 @@
102.4 +(* extends Isabelle/src/Pure/term.ML
102.5 + (c) Walther Neuper 1999
102.6 +
102.7 +use"Scripts/term_G.sml";
102.8 +use"term_G.sml";
102.9 +*)
102.10 +
102.11 +(*
102.12 +> cterm_of (sign_of thy) a_term;
102.13 +val it = "empty" : cterm *)
102.14 +
102.15 +(*1003 fun match thy t pat =
102.16 + (snd (Pattern.match (Sign.tsig_of (sign_of thy)) (pat, t)))
102.17 + handle _ => [];
102.18 +fn : Theory.theory ->
102.19 + Term.term -> Term.term -> (Term.indexname * Term.term) list*)
102.20 +(*see src/Tools/eqsubst.ML fun clean_match*)
102.21 +(*1003 fun matches thy tm pa = if match thy tm pa = [] then false else true;*)
102.22 +fun matches thy tm pa =
102.23 + (Pattern.match thy (pa, tm) (Vartab.empty, Vartab.empty); true)
102.24 + handle _ => false
102.25 +
102.26 +fun atomtyp t = (*see raw_pp_typ*)
102.27 + let
102.28 + fun ato n (Type (s,[])) =
102.29 + ("\n*** "^indent n^"Type ("^s^",[])")
102.30 + | ato n (Type (s,Ts)) =
102.31 + ("\n*** "^indent n^"Type ("^s^",["^ atol (n+1) Ts)
102.32 +
102.33 + | ato n (TFree (s,sort)) =
102.34 + ("\n*** "^indent n^"TFree ("^s^",["^ strs2str' sort)
102.35 +
102.36 + | ato n (TVar ((s,i),sort)) =
102.37 + ("\n*** "^indent n^"TVar (("^s^","^
102.38 + string_of_int i ^ strs2str' sort)
102.39 + and atol n [] =
102.40 + ("\n*** "^indent n^"]")
102.41 + | atol n (T::Ts) = (ato n T ^ atol n Ts)
102.42 +(*in print (ato 0 t ^ "\n") end; TODO TUM10*)
102.43 +in writeln(ato 0 t) end;
102.44 +
102.45 +(*Prog.Tutorial.p.34*)
102.46 +local
102.47 + fun pp_pair (x, y) = Pretty.list "(" ")" [x, y]
102.48 + fun pp_list xs = Pretty.list "[" "]" xs
102.49 + fun pp_str s = Pretty.str s
102.50 + fun pp_qstr s = Pretty.quote (pp_str s)
102.51 + fun pp_int i = pp_str (string_of_int i)
102.52 + fun pp_sort S = pp_list (map pp_qstr S)
102.53 + fun pp_constr a args = Pretty.block [pp_str a, Pretty.brk 1, args]
102.54 +in
102.55 +fun raw_pp_typ (TVar ((a, i), S)) =
102.56 + pp_constr "TVar" (pp_pair (pp_pair (pp_qstr a, pp_int i), pp_sort S))
102.57 + | raw_pp_typ (TFree (a, S)) =
102.58 + pp_constr "TFree" (pp_pair (pp_qstr a, pp_sort S))
102.59 + | raw_pp_typ (Type (a, tys)) =
102.60 + pp_constr "Type" (pp_pair (pp_qstr a, pp_list (map raw_pp_typ tys)))
102.61 +end
102.62 +(* install
102.63 +PolyML.addPrettyPrinter
102.64 + (fn _ => fn _ => ml_pretty o Pretty.to_ML o raw_pp_typ);
102.65 +de-install
102.66 +PolyML.addPrettyPrinter
102.67 + (fn _ => fn _ => ml_pretty o Pretty.to_ML o Proof_Display.pp_typ Pure.thy);
102.68 +*)
102.69 +
102.70 +(*
102.71 +> val T = (type_of o term_of o the o (parse thy)) "a::[real,int] => nat";
102.72 +> atomtyp T;
102.73 +*** Type (fun,[
102.74 +*** Type (RealDef.real,[])
102.75 +*** Type (fun,[
102.76 +*** Type (IntDef.int,[])
102.77 +*** Type (nat,[])
102.78 +*** ]
102.79 +*** ]
102.80 +*)
102.81 +
102.82 +fun atomt t =
102.83 + let fun ato (Const(a,T)) n =
102.84 + ("\n*** "^indent n^"Const ("^a^")")
102.85 + | ato (Free (a,T)) n =
102.86 + ("\n*** "^indent n^"Free ("^a^", "^")")
102.87 + | ato (Var ((a,ix),T)) n =
102.88 + ("\n*** "^indent n^"Var (("^a^", "^(string_of_int ix)^"), "^")")
102.89 + | ato (Bound ix) n =
102.90 + ("\n*** "^indent n^"Bound "^(string_of_int ix))
102.91 + | ato (Abs(a,T,body)) n =
102.92 + ("\n*** "^indent n^"Abs("^a^",..")^ato body (n+1)
102.93 + | ato (f$t') n = (ato f n; ato t' (n+1))
102.94 + in writeln("\n*** -------------"^ ato t 0 ^"\n***") end;
102.95 +
102.96 +fun term_detail2str t =
102.97 + let fun ato (Const (a, T)) n =
102.98 + "\n*** "^indent n^"Const ("^a^", "^string_of_typ T^")"
102.99 + | ato (Free (a, T)) n =
102.100 + "\n*** "^indent n^"Free ("^a^", "^string_of_typ T^")"
102.101 + | ato (Var ((a, ix), T)) n =
102.102 + "\n*** "^indent n^"Var (("^a^", "^string_of_int ix^"), "^
102.103 + string_of_typ T^")"
102.104 + | ato (Bound ix) n =
102.105 + "\n*** "^indent n^"Bound "^string_of_int ix
102.106 + | ato (Abs(a, T, body)) n =
102.107 + "\n*** "^indent n^"Abs ("^a^", "^
102.108 + (string_of_typ T)^",.."
102.109 + ^ato body (n + 1)
102.110 + | ato (f $ t') n = ato f n^ato t' (n+1)
102.111 + in "\n*** "^ato t 0^"\n***" end;
102.112 +fun atomty t = (writeln o term_detail2str) t;
102.113 +
102.114 +fun term_str thy (Const(s,_)) = s
102.115 + | term_str thy (Free(s,_)) = s
102.116 + | term_str thy (Var((s,i),_)) = s^(string_of_int i)
102.117 + | term_str thy (Bound i) = "B."^(string_of_int i)
102.118 + | term_str thy (Abs(s,_,_)) = s
102.119 + | term_str thy t = raise error("term_str not for "^term2str t);
102.120 +
102.121 +(*.contains the fst argument the second argument (a leave! of term).*)
102.122 +fun contains_term (Abs(_,_,body)) t = contains_term body t
102.123 + | contains_term (f $ f') t =
102.124 + contains_term f t orelse contains_term f' t
102.125 + | contains_term s t = t = s;
102.126 +(*.contains the term a VAR(("*",_),_) ?.*)
102.127 +fun contains_Var (Abs(_,_,body)) = contains_Var body
102.128 + | contains_Var (f $ f') = contains_Var f orelse contains_Var f'
102.129 + | contains_Var (Var _) = true
102.130 + | contains_Var _ = false;
102.131 +(* contains_Var (str2term "?z = 3") (*true*);
102.132 + contains_Var (str2term "z = 3") (*false*);
102.133 + *)
102.134 +
102.135 +(*fun int_of_str str =
102.136 + let val ss = explode str
102.137 + val str' = case ss of
102.138 + "("::s => drop_last s | _ => ss
102.139 + in case BasisLibrary.Int.fromString (implode str') of
102.140 + SOME i => SOME i
102.141 + | NONE => NONE end;*)
102.142 +fun int_of_str str =
102.143 + let val ss = explode str
102.144 + val str' = case ss of
102.145 + "("::s => drop_last s | _ => ss
102.146 + in (SOME (ThyOutput.integer (implode str'))) handle _ => NONE end;
102.147 +(*
102.148 +> int_of_str "123";
102.149 +val it = SOME 123 : int option > int_of_str "(-123)";
102.150 +val it = SOME 123 : int option > int_of_str "#123";
102.151 +val it = NONE : int option > int_of_str "-123";
102.152 +val it = SOME ~123 : int option *)
102.153 +fun int_of_str' str =
102.154 + case int_of_str str of
102.155 + SOME i => i
102.156 + | NONE => raise TERM ("int_of_string: no int-string",[]);
102.157 +val str2int = int_of_str';
102.158 +
102.159 +fun is_numeral str = case int_of_str str of
102.160 + SOME _ => true
102.161 + | NONE => false;
102.162 +val is_no = is_numeral;
102.163 +fun is_num (Free (s,_)) = if is_numeral s then true else false
102.164 + | is_num _ = false;
102.165 +(*>
102.166 +> is_num ((term_of o the o (parse thy)) "#1");
102.167 +val it = true : bool
102.168 +> is_num ((term_of o the o (parse thy)) "#-1");
102.169 +val it = true : bool
102.170 +> is_num ((term_of o the o (parse thy)) "a123");
102.171 +val it = false : bool
102.172 +*)
102.173 +
102.174 +(*fun int_of_Free (Free (intstr, _)) =
102.175 + (case BasisLibrary.Int.fromString intstr of
102.176 + SOME i => i
102.177 + | NONE => raise error ("int_of_Free ( "^ intstr ^", _)"))
102.178 + | int_of_Free t = raise error ("int_of_Free ( "^ term2str t ^" )");*)
102.179 +fun int_of_Free (Free (intstr, _)) = (ThyOutput.integer intstr
102.180 + handle _ => raise error ("int_of_Free ( "^ intstr ^", _)"))
102.181 + | int_of_Free t = raise error ("int_of_Free ( "^ term2str t ^" )");
102.182 +
102.183 +fun vars t =
102.184 + let
102.185 + fun scan vs (Const(s,T)) = vs
102.186 + | scan vs (t as Free(s,T)) = if is_no s then vs else t::vs
102.187 + | scan vs (t as Var((s,i),T)) = t::vs
102.188 + | scan vs (Bound i) = vs
102.189 + | scan vs (Abs(s,T,t)) = scan vs t
102.190 + | scan vs (t1 $ t2) = (scan vs t1) @ (scan vs t2)
102.191 + in (distinct o (scan [])) t end;
102.192 +
102.193 +fun is_Free (Free _) = true
102.194 + | is_Free _ = false;
102.195 +fun is_fun_id (Const _) = true
102.196 + | is_fun_id (Free _) = true
102.197 + | is_fun_id _ = false;
102.198 +fun is_f_x (f $ x) = is_fun_id f andalso is_Free x
102.199 + | is_f_x _ = false;
102.200 +(* is_f_x (str2term "q_0/2 * L * x") (*false*);
102.201 + is_f_x (str2term "M_b x") (*true*);
102.202 + *)
102.203 +fun vars_str t =
102.204 + let
102.205 + fun scan vs (Const(s,T)) = vs
102.206 + | scan vs (t as Free(s,T)) = if is_no s then vs else s::vs
102.207 + | scan vs (t as Var((s,i),T)) = (s^"_"^(string_of_int i))::vs
102.208 + | scan vs (Bound i) = vs
102.209 + | scan vs (Abs(s,T,t)) = scan vs t
102.210 + | scan vs (t1 $ t2) = (scan vs t1) @ (scan vs t2)
102.211 + in (distinct o (scan [])) t end;
102.212 +
102.213 +fun ids2str t =
102.214 + let
102.215 + fun scan vs (Const(s,T)) = if is_no s then vs else s::vs
102.216 + | scan vs (t as Free(s,T)) = if is_no s then vs else s::vs
102.217 + | scan vs (t as Var((s,i),T)) = (s^"_"^(string_of_int i))::vs
102.218 + | scan vs (Bound i) = vs
102.219 + | scan vs (Abs(s,T,t)) = scan (s::vs) t
102.220 + | scan vs (t1 $ t2) = (scan vs t1) @ (scan vs t2)
102.221 + in (distinct o (scan [])) t end;
102.222 +fun is_bdv str =
102.223 + case explode str of
102.224 + "b"::"d"::"v"::_ => true
102.225 + | _ => false;
102.226 +fun is_bdv_ (Free (s,_)) = is_bdv s
102.227 + | is_bdv_ _ = false;
102.228 +
102.229 +fun free2str (Free (s,_)) = s
102.230 + | free2str t = raise error ("free2str not for "^ term2str t);
102.231 +fun free2int (t as Free (s, _)) = ((str2int s)
102.232 + handle _ => raise error ("free2int: "^term_detail2str t))
102.233 + | free2int t = raise error ("free2int: "^term_detail2str t);
102.234 +
102.235 +(*27.8.01: unused*)
102.236 +fun var2free (t as Const(s,T)) = t
102.237 + | var2free (t as Free(s,T)) = t
102.238 + | var2free (Var((s,i),T)) = Free(s,T)
102.239 + | var2free (t as Bound i) = t
102.240 + | var2free (Abs(s,T,t)) = Abs(s,T,var2free t)
102.241 + | var2free (t1 $ t2) = (var2free t1) $ (var2free t2);
102.242 +
102.243 +(*27.8.01: doesn't find some subterm ???!???*)
102.244 +(*2010 Logic.varify !!!*)
102.245 +fun free2var (t as Const(s,T)) = t
102.246 + | free2var (t as Free(s,T)) = if is_no s then t else Var((s,0),T)
102.247 + | free2var (t as Var((s,i),T)) = t
102.248 + | free2var (t as Bound i) = t
102.249 + | free2var (Abs(s,T,t)) = Abs(s,T,free2var t)
102.250 + | free2var (t1 $ t2) = (free2var t1) $ (free2var t2);
102.251 +
102.252 +
102.253 +fun mk_listT T = Type ("List.list", [T]);
102.254 +fun list_const T =
102.255 + Const("List.list.Cons", [T, mk_listT T] ---> mk_listT T);
102.256 +(*28.8.01: TODO: get type from head of list: 1 arg less!!!*)
102.257 +fun list2isalist T [] = Const("List.list.Nil",mk_listT T)
102.258 + | list2isalist T (t::ts) = (list_const T) $ t $ (list2isalist T ts);
102.259 +(*
102.260 +> val tt = (term_of o the o (parse thy)) "R=(R::real)";
102.261 +> val TT = type_of tt;
102.262 +> val ss = list2isalist TT [tt,tt,tt];
102.263 +> cterm_of (sign_of thy) ss;
102.264 +val it = "[R = R, R = R, R = R]" : cterm *)
102.265 +
102.266 +fun isapair2pair (Const ("Pair",_) $ a $ b) = (a,b)
102.267 + | isapair2pair t =
102.268 + raise error ("isapair2pair called with "^term2str t);
102.269 +
102.270 +val listType = Type ("List.list",[Type ("bool",[])]);
102.271 +fun isalist2list ls =
102.272 + let
102.273 + fun get es (Const("List.list.Cons",_) $ t $ ls) = get (t::es) ls
102.274 + | get es (Const("List.list.Nil",_)) = es
102.275 + | get _ t =
102.276 + raise error ("isalist2list applied to NON-list '"^term2str t^"'")
102.277 + in (rev o (get [])) ls end;
102.278 +(*
102.279 +> val il = str2term "[a=b,c=d,e=f]";
102.280 +> val l = isalist2list il;
102.281 +> (writeln o terms2str) l;
102.282 +["a = b","c = d","e = f"]
102.283 +
102.284 +> val il = str2term "ss___::bool list";
102.285 +> val l = isalist2list il;
102.286 +[Free ("ss___", "bool List.list")]
102.287 +*)
102.288 +
102.289 +
102.290 +(*review Isabelle2009/src/HOL/Tools/hologic.ML*)
102.291 +val prop = Type ("prop",[]); (* ~/Diss.99/Integers-Isa/tools.sml*)
102.292 +val bool = Type ("bool",[]); (* 2002 Integ.int *)
102.293 +val Trueprop = Const("Trueprop",bool-->prop);
102.294 +fun mk_prop t = Trueprop $ t;
102.295 +val true_as_term = Const("True",bool);
102.296 +val false_as_term = Const("False",bool);
102.297 +val true_as_cterm = cterm_of HOL true_as_term;
102.298 +val false_as_cterm = cterm_of HOL false_as_term;
102.299 +
102.300 +infixr 5 -->; (*2002 /Pure/term.ML *)
102.301 +infixr --->; (*2002 /Pure/term.ML *)
102.302 +fun S --> T = Type("fun",[S,T]); (*2002 /Pure/term.ML *)
102.303 +val op ---> = foldr (op -->); (*2002 /Pure/term.ML *)
102.304 +fun list_implies ([], B) = B : term (*2002 /term.ML *)
102.305 + | list_implies (A::AS, B) = Logic.implies $ A $ list_implies(AS,B);
102.306 +
102.307 +
102.308 +
102.309 +(** substitution **)
102.310 +
102.311 +fun match_bvs(Abs(x,_,s),Abs(y,_,t), al) = (* = thm.ML *)
102.312 + match_bvs(s, t, if x="" orelse y="" then al
102.313 + else (x,y)::al)
102.314 + | match_bvs(f$s, g$t, al) = match_bvs(f,g,match_bvs(s,t,al))
102.315 + | match_bvs(_,_,al) = al;
102.316 +fun ren_inst(insts,prop,pat,obj) = (* = thm.ML *)
102.317 + let val ren = match_bvs(pat,obj,[])
102.318 + fun renAbs(Abs(x,T,b)) =
102.319 + Abs(case assoc_string(ren,x) of NONE => x
102.320 + | SOME(y) => y, T, renAbs(b))
102.321 + | renAbs(f$t) = renAbs(f) $ renAbs(t)
102.322 + | renAbs(t) = t
102.323 + in subst_vars insts (if null(ren) then prop else renAbs(prop)) end;
102.324 +
102.325 +
102.326 +
102.327 +
102.328 +
102.329 +
102.330 +fun dest_equals' (Const("op =",_) $ t $ u) = (t,u)(* logic.ML: Const("=="*)
102.331 + | dest_equals' t = raise TERM("dest_equals'", [t]);
102.332 +val lhs_ = (fst o dest_equals');
102.333 +val rhs_ = (snd o dest_equals');
102.334 +
102.335 +fun is_equality (Const("op =",_) $ t $ u) = true (* logic.ML: Const("=="*)
102.336 + | is_equality _ = false;
102.337 +fun mk_equality (t,u) = (Const("op =",[type_of t,type_of u]--->bool) $ t $ u);
102.338 +fun is_expliceq (Const("op =",_) $ (Free _) $ u) = true
102.339 + | is_expliceq _ = false;
102.340 +fun strip_trueprop (Const("Trueprop",_) $ t) = t
102.341 + | strip_trueprop t = t;
102.342 +(* | strip_trueprop t = raise TERM("strip_trueprop", [t]);
102.343 +*)
102.344 +
102.345 +(*.(A1==>...An==>B) goes to (A1==>...An==>).*)
102.346 +fun strip_imp_prems' (Const("==>", T) $ A $ t) =
102.347 + let fun coll_prems As (Const("==>", _) $ A $ t) =
102.348 + coll_prems (As $ (Logic.implies $ A)) t
102.349 + | coll_prems As _ = SOME As
102.350 + in coll_prems (Logic.implies $ A) t end
102.351 + | strip_imp_prems' _ = NONE; (* logic.ML: term -> term list*)
102.352 +(*
102.353 + val thm = real_mult_div_cancel1;
102.354 + val prop = (#prop o rep_thm) thm;
102.355 + atomt prop;
102.356 +*** -------------
102.357 +*** Const ( ==>)
102.358 +*** . Const ( Trueprop)
102.359 +*** . . Const ( Not)
102.360 +*** . . . Const ( op =)
102.361 +*** . . . . Var ((k, 0), )
102.362 +*** . . . . Const ( 0)
102.363 +*** . Const ( Trueprop)
102.364 +*** . . Const ( op =) *** .............
102.365 + val SOME t = strip_imp_prems' ((#prop o rep_thm) thm);
102.366 + atomt t;
102.367 +*** -------------
102.368 +*** Const ( ==>)
102.369 +*** . Const ( Trueprop)
102.370 +*** . . Const ( Not)
102.371 +*** . . . Const ( op =)
102.372 +*** . . . . Var ((k, 0), )
102.373 +*** . . . . Const ( 0)
102.374 +
102.375 + val thm = real_le_anti_sym;
102.376 + val prop = (#prop o rep_thm) thm;
102.377 + atomt prop;
102.378 +*** -------------
102.379 +*** Const ( ==>)
102.380 +*** . Const ( Trueprop)
102.381 +*** . . Const ( op <=)
102.382 +*** . . . Var ((z, 0), )
102.383 +*** . . . Var ((w, 0), )
102.384 +*** . Const ( ==>)
102.385 +*** . . Const ( Trueprop)
102.386 +*** . . . Const ( op <=)
102.387 +*** . . . . Var ((w, 0), )
102.388 +*** . . . . Var ((z, 0), )
102.389 +*** . . Const ( Trueprop)
102.390 +*** . . . Const ( op =)
102.391 +*** .............
102.392 + val SOME t = strip_imp_prems' ((#prop o rep_thm) thm);
102.393 + atomt t;
102.394 +*** -------------
102.395 +*** Const ( ==>)
102.396 +*** . Const ( Trueprop)
102.397 +*** . . Const ( op <=)
102.398 +*** . . . Var ((z, 0), )
102.399 +*** . . . Var ((w, 0), )
102.400 +*** . Const ( ==>)
102.401 +*** . . Const ( Trueprop)
102.402 +*** . . . Const ( op <=)
102.403 +*** . . . . Var ((w, 0), )
102.404 +*** . . . . Var ((z, 0), )
102.405 +*)
102.406 +
102.407 +(*. (A1==>...An==>) (B) goes to (A1==>...An==>B), where B is lowest branch.*)
102.408 +fun ins_concl (Const("==>", T) $ A $ t) B = Logic.implies $ A $ (ins_concl t B)
102.409 + | ins_concl (Const("==>", T) $ A ) B = Logic.implies $ A $ B
102.410 + | ins_concl t B = raise TERM("ins_concl", [t, B]);
102.411 +(*
102.412 + val thm = real_le_anti_sym;
102.413 + val prop = (#prop o rep_thm) thm;
102.414 + val concl = Logic.strip_imp_concl prop;
102.415 + val SOME prems = strip_imp_prems' prop;
102.416 + val prop' = ins_concl prems concl;
102.417 + prop = prop';
102.418 + atomt prop;
102.419 + atomt prop';
102.420 +*)
102.421 +
102.422 +
102.423 +fun vperm (Var _, Var _) = true (*2002 Pure/thm.ML *)
102.424 + | vperm (Abs (_, _, s), Abs (_, _, t)) = vperm (s, t)
102.425 + | vperm (t1 $ t2, u1 $ u2) = vperm (t1, u1) andalso vperm (t2, u2)
102.426 + | vperm (t, u) = (t = u);
102.427 +
102.428 +(*2002 cp from Pure/term.ML --- since 2009 in Pure/old_term.ML*)
102.429 +fun mem_term (_, []) = false
102.430 + | mem_term (t, t'::ts) = t aconv t' orelse mem_term(t,ts);
102.431 +fun subset_term ([], ys) = true
102.432 + | subset_term (x :: xs, ys) = mem_term (x, ys) andalso subset_term(xs, ys);
102.433 +fun eq_set_term (xs, ys) =
102.434 + xs = ys orelse (subset_term (xs, ys) andalso subset_term (ys, xs));
102.435 +(*a total, irreflexive ordering on index names*)
102.436 +fun xless ((a,i), (b,j): indexname) = i<j orelse (i=j andalso a<b);
102.437 +(*a partial ordering (not reflexive) for atomic terms*)
102.438 +fun atless (Const (a,_), Const (b,_)) = a<b
102.439 + | atless (Free (a,_), Free (b,_)) = a<b
102.440 + | atless (Var(v,_), Var(w,_)) = xless(v,w)
102.441 + | atless (Bound i, Bound j) = i<j
102.442 + | atless _ = false;
102.443 +(*insert atomic term into partially sorted list, suppressing duplicates (?)*)
102.444 +fun insert_aterm (t,us) =
102.445 + let fun inserta [] = [t]
102.446 + | inserta (us as u::us') =
102.447 + if atless(t,u) then t::us
102.448 + else if t=u then us (*duplicate*)
102.449 + else u :: inserta(us')
102.450 + in inserta us end;
102.451 +
102.452 +(*Accumulates the Vars in the term, suppressing duplicates*)
102.453 +fun add_term_vars (t, vars: term list) = case t of
102.454 + Var _ => insert_aterm(t,vars)
102.455 + | Abs (_,_,body) => add_term_vars(body,vars)
102.456 + | f$t => add_term_vars (f, add_term_vars(t, vars))
102.457 + | _ => vars;
102.458 +fun term_vars t = add_term_vars(t,[]);
102.459 +
102.460 +
102.461 +fun var_perm (t, u) = (*2002 Pure/thm.ML *)
102.462 + vperm (t, u) andalso eq_set_term (term_vars t, term_vars u);
102.463 +
102.464 +(*2002 fun decomp_simp, Pure/thm.ML *)
102.465 +fun perm lhs rhs = var_perm (lhs, rhs) andalso not (lhs aconv rhs)
102.466 + andalso not (is_Var lhs);
102.467 +
102.468 +
102.469 +fun str_of_int n =
102.470 + if n < 0 then "-"^((string_of_int o abs) n)
102.471 + else string_of_int n;
102.472 +(*
102.473 +> str_of_int 1;
102.474 +val it = "1" : string > str_of_int ~1;
102.475 +val it = "-1" : string
102.476 +*)
102.477 +
102.478 +
102.479 +fun power b 0 = 1
102.480 + | power b n =
102.481 + if n>0 then b*(power b (n-1))
102.482 + else raise error ("power "^(str_of_int b)^" "^(str_of_int n));
102.483 +(*
102.484 +> power 2 3;
102.485 +val it = 8 : int
102.486 +> power ~2 3;
102.487 +val it = ~8 : int
102.488 +> power ~3 2;
102.489 +val it = 9 : int
102.490 +> power 3 ~2;
102.491 +*)
102.492 +fun gcd 0 b = b
102.493 + | gcd a b = if a < b then gcd (b mod a) a
102.494 + else gcd (a mod b) b;
102.495 +fun sign n = if n < 0 then ~1
102.496 + else if n = 0 then 0 else 1;
102.497 +fun sign2 n1 n2 = (sign n1) * (sign n2);
102.498 +
102.499 +infix dvd;
102.500 +fun d dvd n = n mod d = 0;
102.501 +
102.502 +fun divisors n =
102.503 + let fun pdiv ds d n =
102.504 + if d=n then d::ds
102.505 + else if d dvd n then pdiv (d::ds) d (n div d)
102.506 + else pdiv ds (d+1) n
102.507 + in pdiv [] 2 n end;
102.508 +
102.509 +divisors 30;
102.510 +divisors 32;
102.511 +divisors 60;
102.512 +divisors 11;
102.513 +
102.514 +fun doubles ds = (* ds is ordered *)
102.515 + let fun dbls ds [] = ds
102.516 + | dbls ds [i] = ds
102.517 + | dbls ds (i::i'::is) = if i=i' then dbls (i::ds) is
102.518 + else dbls ds (i'::is)
102.519 + in dbls [] ds end;
102.520 +(*> doubles [2,3,4];
102.521 +val it = [] : int list
102.522 +> doubles [2,3,3,5,5,7];
102.523 +val it = [5,3] : int list*)
102.524 +
102.525 +fun squfact 0 = 0
102.526 + | squfact 1 = 1
102.527 + | squfact n = foldl op* (1, (doubles o divisors) n);
102.528 +(*> squfact 30;
102.529 +val it = 1 : int
102.530 +> squfact 32;
102.531 +val it = 4 : int
102.532 +> squfact 60;
102.533 +val it = 2 : int
102.534 +> squfact 11;
102.535 +val it = 1 : int*)
102.536 +
102.537 +
102.538 +fun dest_type (Type(T,[])) = T
102.539 + | dest_type T =
102.540 + (atomtyp T;
102.541 + raise error ("... dest_type: not impl. for this type"));
102.542 +
102.543 +fun term_of_num ntyp n = Free (str_of_int n, ntyp);
102.544 +
102.545 +fun pairT T1 T2 = Type ("*", [T1, T2]);
102.546 +(*> val t = str2term "(1,2)";
102.547 +> type_of t = pairT HOLogic.realT HOLogic.realT;
102.548 +val it = true : bool
102.549 +*)
102.550 +fun PairT T1 T2 = ([T1, T2] ---> Type ("*", [T1, T2]));
102.551 +(*> val t = str2term "(1,2)";
102.552 +> val Const ("Pair",pT) $ _ $ _ = t;
102.553 +> pT = PairT HOLogic.realT HOLogic.realT;
102.554 +val it = true : bool
102.555 +*)
102.556 +fun pairt t1 t2 =
102.557 + Const ("Pair", PairT (type_of t1) (type_of t2)) $ t1 $ t2;
102.558 +(*> val t = str2term "(1,2)";
102.559 +> val (t1, t2) = (str2term "1", str2term "2");
102.560 +> t = pairt t1 t2;
102.561 +val it = true : bool*)
102.562 +
102.563 +
102.564 +fun num_of_term (t as Free (s,_)) =
102.565 + (case int_of_str s of
102.566 + SOME s' => s'
102.567 + | NONE => raise error ("num_of_term not for "^ term2str t))
102.568 + | num_of_term t = raise error ("num_of_term not for "^term2str t);
102.569 +
102.570 +fun mk_factroot op_(*=thy.sqrt*) T fact root =
102.571 + Const ("op *", [T, T] ---> T) $ (term_of_num T fact) $
102.572 + (Const (op_, T --> T) $ term_of_num T root);
102.573 +(*
102.574 +val T = (type_of o term_of o the) (parse thy "#12::real");
102.575 +val t = mk_factroot "SqRoot.sqrt" T 2 3;
102.576 +cterm_of (sign_of thy) t;
102.577 +val it = "#2 * sqrt #3 " : cterm
102.578 +*)
102.579 +fun var_op_num v op_ optype ntyp n =
102.580 + Const (op_, optype) $ v $
102.581 + Free (str_of_int n, ntyp);
102.582 +
102.583 +fun num_op_var v op_ optype ntyp n =
102.584 + Const (op_,optype) $
102.585 + Free (str_of_int n, ntyp) $ v;
102.586 +
102.587 +fun num_op_num T1 T2 (op_,Top) n1 n2 =
102.588 + Const (op_,Top) $
102.589 + Free (str_of_int n1, T1) $ Free (str_of_int n2, T2);
102.590 +(*
102.591 +> val t = num_op_num "Int" 3 4;
102.592 +> atomty t;
102.593 +> string_of_cterm (cterm_of (sign_of thy) t);
102.594 +*)
102.595 +
102.596 +fun const_in str (Const _) = false
102.597 + | const_in str (Free (s,_)) = if strip_thy s = str then true else false
102.598 + | const_in str (Bound _) = false
102.599 + | const_in str (Var _) = false
102.600 + | const_in str (Abs (_,_,body)) = const_in str body
102.601 + | const_in str (f$u) = const_in str f orelse const_in str u;
102.602 +(*
102.603 +> val t = (term_of o the o (parse thy)) "6 + 5 * sqrt 4 + 3";
102.604 +> const_in "sqrt" t;
102.605 +val it = true : bool
102.606 +> val t = (term_of o the o (parse thy)) "6 + 5 * 4 + 3";
102.607 +> const_in "sqrt" t;
102.608 +val it = false : bool
102.609 +*)
102.610 +
102.611 +(*used for calculating built in binary operations in Isabelle2002->Float.ML*)
102.612 +(*fun calc "op +" (n1, n2) = n1+n2
102.613 + | calc "op -" (n1, n2) = n1-n2
102.614 + | calc "op *" (n1, n2) = n1*n2
102.615 + | calc "HOL.divide"(n1, n2) = n1 div n2
102.616 + | calc "Atools.pow"(n1, n2) = power n1 n2
102.617 + | calc op_ _ = raise error ("calc: operator = "^op_^" not defined");-----*)
102.618 +fun calc_equ "op <" (n1, n2) = n1 < n2
102.619 + | calc_equ "op <=" (n1, n2) = n1 <= n2
102.620 + | calc_equ op_ _ =
102.621 + raise error ("calc_equ: operator = "^op_^" not defined");
102.622 +fun sqrt (n:int) = if n < 0 then 0
102.623 + (*FIXME ~~~*) else (trunc o Math.sqrt o Real.fromInt) n;
102.624 +
102.625 +fun mk_thmid thmid op_ n1 n2 =
102.626 + thmid ^ (strip_thy n1) ^ "_" ^ (strip_thy n2);
102.627 +
102.628 +fun dest_binop_typ (Type("fun",[range,Type("fun",[arg2,arg1])])) =
102.629 + (arg1,arg2,range)
102.630 + | dest_binop_typ _ = raise error "dest_binop_typ: not binary";
102.631 +(* -----
102.632 +> val t = (term_of o the o (parse thy)) "#3^#4";
102.633 +> val hT = type_of (head_of t);
102.634 +> dest_binop_typ hT;
102.635 +val it = ("'a","nat","'a") : typ * typ * typ
102.636 + ----- *)
102.637 +
102.638 +
102.639 +(** transform binary numeralsstrings **)
102.640 +(*Makarius 100308, hacked by WN*)
102.641 +val numbers_to_string =
102.642 + let
102.643 + fun dest_num t =
102.644 + (case try HOLogic.dest_number t of
102.645 + SOME (T, i) =>
102.646 + (*if T = @{typ int} orelse T = @{typ real} then WN*)
102.647 + SOME (Free (signed_string_of_int i, T))
102.648 + (*else NONE WN*)
102.649 + | NONE => NONE);
102.650 +
102.651 + fun to_str (Abs (x, T, b)) = Abs (x, T, to_str b)
102.652 + | to_str (t as (u1 $ u2)) =
102.653 + (case dest_num t of
102.654 + SOME t' => t'
102.655 + | NONE => to_str u1 $ to_str u2)
102.656 + | to_str t = perhaps dest_num t;
102.657 + in to_str end
102.658 +
102.659 +(*.make uminus uniform:
102.660 + Const ("uminus", _) $ Free ("2", "RealDef.real") --> Free ("-2", _)
102.661 +to be used immediately before evaluation of numerals;
102.662 +see Scripts/calculate.sml .*)
102.663 +(*2002 fun(*app_num_tr'2 (Const("0",T)) = Free("0",T)
102.664 + | app_num_tr'2 (Const("1",T)) = Free("1",T)
102.665 + |*)app_num_tr'2 (t as Const("uminus",_) $ Free(s,T)) =
102.666 + (case int_of_str s of Some i =>
102.667 + if i > 0 then Free("-"^s,T) else Free(s,T)
102.668 + | None => t)
102.669 +(*| app_num_tr'2 (t as Const(s,T)) = t
102.670 + | app_num_tr'2 (Const("Numeral.number_of",Type ("fun", [_, T])) $ t) =
102.671 + Free(NumeralSyntax.dest_bin_str t, T)
102.672 + | app_num_tr'2 (t as Free(s,T)) = t
102.673 + | app_num_tr'2 (t as Var(n,T)) = t
102.674 + | app_num_tr'2 (t as Bound i) = t
102.675 +*)| app_num_tr'2 (Abs(s,T,body)) = Abs(s,T, app_num_tr'2 body)
102.676 + | app_num_tr'2 (t1 $ t2) = (app_num_tr'2 t1) $ (app_num_tr'2 t2)
102.677 + | app_num_tr'2 t = t;
102.678 +*)
102.679 +val uminus_to_string =
102.680 + let
102.681 + fun dest_num t =
102.682 + (case t of
102.683 + (Const ("HOL.uminus_class.uminus", _) $ Free (s, T)) =>
102.684 + (case int_of_str s of
102.685 + SOME i =>
102.686 + SOME (Free (signed_string_of_int (~1 * i), T))
102.687 + | NONE => NONE)
102.688 + | _ => NONE);
102.689 +
102.690 + fun to_str (Abs (x, T, b)) = Abs (x, T, to_str b)
102.691 + | to_str (t as (u1 $ u2)) =
102.692 + (case dest_num t of
102.693 + SOME t' => t'
102.694 + | NONE => to_str u1 $ to_str u2)
102.695 + | to_str t = perhaps dest_num t;
102.696 + in to_str end;
102.697 +
102.698 +
102.699 +(*2002 fun num_str thm =
102.700 + let
102.701 + val {sign_ref = sign_ref, der = der, maxidx = maxidx,
102.702 + shyps = shyps, hyps = hyps, (*tpairs = tpairs,*) prop = prop} =
102.703 + rep_thm_G thm;
102.704 + val prop' = app_num_tr'1 prop;
102.705 + in assbl_thm sign_ref der maxidx shyps hyps (*tpairs*) prop' end;*)
102.706 +fun num_str thm =
102.707 + let val (deriv,
102.708 + {thy_ref = thy_ref, tags = tags, maxidx = maxidx, shyps = shyps,
102.709 + hyps = hyps, tpairs = tpairs, prop = prop}) = rep_thm_G thm
102.710 + val prop' = numbers_to_string prop;
102.711 + in assbl_thm deriv thy_ref tags maxidx shyps hyps tpairs prop' end;
102.712 +
102.713 +fun get_thm' xstring = (*?covers 2009 Thm?!, replaces 2002 fun get_thm :
102.714 +val it = fn : Theory.theory -> xstring -> Thm.thm*)
102.715 + Thm (xstring,
102.716 + num_str (ProofContext.get_thm (ctxt_Isac"") xstring));
102.717 +
102.718 +(** get types of Free and Abs for parse' **)
102.719 +(*11.1.00: not used, fix-typed +,*,-,^ instead *)
102.720 +
102.721 +val dummyT = Type ("dummy",[]);
102.722 +val dummyT = TVar (("DUMMY",0),[]);
102.723 +
102.724 +(* assumes only 1 type for numerals
102.725 + and different identifiers for Const, Free and Abs *)
102.726 +fun get_types t =
102.727 + let
102.728 + fun get ts (Const(s,T)) = (s,T)::ts
102.729 + | get ts (Free(s,T)) = if is_no s
102.730 + then ("#",T)::ts else (s,T)::ts
102.731 + | get ts (Var(n,T)) = ts
102.732 + | get ts (Bound i) = ts
102.733 + | get ts (Abs(s,T,body)) = get ((s,T)::ts) body
102.734 + | get ts (t1 $ t2) = (get ts t1) @ (get ts t2)
102.735 + in distinct (get [] t) end;
102.736 +(*
102.737 +val t = (term_of o the o (parse thy)) "sqrt(#9+#4*x)=sqrt x + sqrt(#-3+x)";
102.738 +get_types t;
102.739 +*)
102.740 +
102.741 +(*11.1.00: not used, fix-typed +,*,-,^ instead *)
102.742 +fun set_types al (Const(s,T)) =
102.743 + (case assoc (al,s) of
102.744 + SOME T' => Const(s,T')
102.745 + | NONE => (warning ("set_types: no type for "^s); Const(s,dummyT)))
102.746 + | set_types al (Free(s,T)) =
102.747 + if is_no s then
102.748 + (case assoc (al,"#") of
102.749 + SOME T' => Free(s,T')
102.750 + | NONE => (warning ("set_types: no type for numerals"); Free(s,T)))
102.751 + else (case assoc (al,s) of
102.752 + SOME T' => Free(s,T')
102.753 + | NONE => (warning ("set_types: no type for "^s); Free(s,T)))
102.754 + | set_types al (Var(n,T)) = Var(n,T)
102.755 + | set_types al (Bound i) = Bound i
102.756 + | set_types al (Abs(s,T,body)) =
102.757 + (case assoc (al,s) of
102.758 + SOME T' => Abs(s,T', set_types al body)
102.759 + | NONE => (warning ("set_types: no type for "^s);
102.760 + Abs(s,T, set_types al body)))
102.761 + | set_types al (t1 $ t2) = (set_types al t1) $ (set_types al t2);
102.762 +(*
102.763 +val t = (term_of o the o (parse thy)) "sqrt(#9+#4*x)=sqrt x + sqrt(#-3+x)";
102.764 +val al = get_types t;
102.765 +
102.766 +val t = (term_of o the o (parse thy)) "x = #0 + #-1 * #-4";
102.767 +atomty t; (* 'a *)
102.768 +val t' = set_types al t;
102.769 +atomty t'; (*real*)
102.770 +cterm_of (sign_of thy) t';
102.771 +val it = "x = #0 + #-1 * #-4" : cterm
102.772 +
102.773 +val t = (term_of o the o (parse thy))
102.774 + "#5 * x + x ^^^ #2 = (#2 + x) ^^^ #2";
102.775 +atomty t;
102.776 +val t' = set_types al t;
102.777 +atomty t';
102.778 +cterm_of (sign_of thy) t';
102.779 +uncaught exception TYPE (*^^^ is new, NOT in al*)
102.780 +*)
102.781 +
102.782 +
102.783 +(** from Descript.ML **)
102.784 +
102.785 +(** decompose an isa-list to an ML-list
102.786 + i.e. [] belong to the meta-language, too **)
102.787 +
102.788 +fun is_list ((Const("List.list.Cons",_)) $ _ $ _) = true
102.789 + | is_list _ = false;
102.790 +(* val (SOME ct) = parse thy "lll::real list";
102.791 +> val ty = (#t o rep_cterm) ct;
102.792 +> is_list ty;
102.793 +val it = false : bool
102.794 +> val (SOME ct) = parse thy "[lll]";
102.795 +> val ty = (#t o rep_cterm) ct;
102.796 +> is_list ty;
102.797 +val it = true : bool *)
102.798 +
102.799 +
102.800 +
102.801 +fun mk_Free (s,T) = Free(s,T);
102.802 +fun mk_free T s = Free(s,T);
102.803 +
102.804 +(*instantiate let; necessary for ass_up*)
102.805 +fun inst_abs thy (Const sT) = Const sT
102.806 + | inst_abs thy (Free sT) = Free sT
102.807 + | inst_abs thy (Bound n) = Bound n
102.808 + | inst_abs thy (Var iT) = Var iT
102.809 + | inst_abs thy (Const ("Let",T1) $ e $ (Abs (v,T2,b))) =
102.810 + let val (v',b') = variant_abs (v,T2,b); (*fun variant_abs: term.ML*)
102.811 + in Const ("Let",T1) $ inst_abs thy e $ (Abs (v',T2,inst_abs thy b')) end
102.812 + | inst_abs thy (t1 $ t2) = inst_abs thy t1 $ inst_abs thy t2
102.813 + | inst_abs thy t =
102.814 + (writeln("inst_abs: unchanged t= "^ term2str t);
102.815 + t);
102.816 +(*val scr as (Script sc) = Script ((term_of o the o (parse thy))
102.817 + "Script Testeq (e_::bool) = \
102.818 + \While (contains_root e_) Do \
102.819 + \ (let e_ = Try (Repeat (Rewrite rroot_square_inv False e_)); \
102.820 + \ e_ = Try (Repeat (Rewrite square_equation_left True e_)) \
102.821 + \ in Try (Repeat (Rewrite radd_0 False e_))) ");
102.822 +ML> atomt sc;
102.823 +*** Const ( Script.Testeq)
102.824 +*** . Free ( e_, )
102.825 +*** . Const ( Script.While)
102.826 +*** . . Const ( RatArith.contains'_root)
102.827 +*** . . . Free ( e_, )
102.828 +*** . . Const ( Let)
102.829 +*** . . . Const ( Script.Try)
102.830 +*** . . . . Const ( Script.Repeat)
102.831 +*** . . . . . Const ( Script.Rewrite)
102.832 +*** . . . . . . Free ( rroot_square_inv, )
102.833 +*** . . . . . . Const ( False)
102.834 +*** . . . . . . Free ( e_, )
102.835 +*** . . . Abs( e_,..
102.836 +*** . . . . Const ( Let)
102.837 +*** . . . . . Const ( Script.Try)
102.838 +*** . . . . . . Const ( Script.Repeat)
102.839 +*** . . . . . . . Const ( Script.Rewrite)
102.840 +*** . . . . . . . . Free ( square_equation_left, )
102.841 +*** . . . . . . . . Const ( True)
102.842 +*** . . . . . . . . Bound 0 <-- !!!
102.843 +*** . . . . . Abs( e_,..
102.844 +*** . . . . . . Const ( Script.Try)
102.845 +*** . . . . . . . Const ( Script.Repeat)
102.846 +*** . . . . . . . . Const ( Script.Rewrite)
102.847 +*** . . . . . . . . . Free ( radd_0, )
102.848 +*** . . . . . . . . . Const ( False)
102.849 +*** . . . . . . . . . Bound 0 <-- !!!
102.850 +val it = () : unit
102.851 +ML> atomt (inst_abs thy sc);
102.852 +*** Const ( Script.Testeq)
102.853 +*** . Free ( e_, )
102.854 +*** . Const ( Script.While)
102.855 +*** . . Const ( RatArith.contains'_root)
102.856 +*** . . . Free ( e_, )
102.857 +*** . . Const ( Let)
102.858 +*** . . . Const ( Script.Try)
102.859 +*** . . . . Const ( Script.Repeat)
102.860 +*** . . . . . Const ( Script.Rewrite)
102.861 +*** . . . . . . Free ( rroot_square_inv, )
102.862 +*** . . . . . . Const ( False)
102.863 +*** . . . . . . Free ( e_, )
102.864 +*** . . . Abs( e_,..
102.865 +*** . . . . Const ( Let)
102.866 +*** . . . . . Const ( Script.Try)
102.867 +*** . . . . . . Const ( Script.Repeat)
102.868 +*** . . . . . . . Const ( Script.Rewrite)
102.869 +*** . . . . . . . . Free ( square_equation_left, )
102.870 +*** . . . . . . . . Const ( True)
102.871 +*** . . . . . . . . Free ( e_, ) <-- !!!
102.872 +*** . . . . . Abs( e_,..
102.873 +*** . . . . . . Const ( Script.Try)
102.874 +*** . . . . . . . Const ( Script.Repeat)
102.875 +*** . . . . . . . . Const ( Script.Rewrite)
102.876 +*** . . . . . . . . . Free ( radd_0, )
102.877 +*** . . . . . . . . . Const ( False)
102.878 +*** . . . . . . . . . Free ( e_, ) <-- ZUFALL vor 5.03!!!
102.879 +val it = () : unit*)
102.880 +
102.881 +
102.882 +
102.883 +
102.884 +fun inst_abs thy (Const sT) = Const sT
102.885 + | inst_abs thy (Free sT) = Free sT
102.886 + | inst_abs thy (Bound n) = Bound n
102.887 + | inst_abs thy (Var iT) = Var iT
102.888 + | inst_abs thy (Const ("Let",T1) $ e $ (Abs (v,T2,b))) =
102.889 + let val b' = subst_bound (Free(v,T2),b);
102.890 + (*fun variant_abs: term.ML*)
102.891 + in Const ("Let",T1) $ inst_abs thy e $ (Abs (v,T2,inst_abs thy b')) end
102.892 + | inst_abs thy (t1 $ t2) = inst_abs thy t1 $ inst_abs thy t2
102.893 + | inst_abs thy t =
102.894 + (writeln("inst_abs: unchanged t= "^ term2str t);
102.895 + t);
102.896 +(*val scr =
102.897 + "Script Make_fun_by_explicit (f_::real) (v_::real) (eqs_::bool list) = \
102.898 + \ (let h_ = (hd o (filterVar f_)) eqs_; \
102.899 + \ e_1 = hd (dropWhile (ident h_) eqs_); \
102.900 + \ vs_ = dropWhile (ident f_) (Vars h_); \
102.901 + \ v_1 = hd (dropWhile (ident v_) vs_); \
102.902 + \ (s_1::bool list)=(SubProblem(DiffApp_,[univar,equation],[no_met])\
102.903 + \ [bool_ e_1, real_ v_1])\
102.904 + \ in Substitute [(v_1 = (rhs o hd) s_1)] h_)";
102.905 +> val ttt = (term_of o the o (parse thy)) scr;
102.906 +> writeln(term2str ttt);
102.907 +> atomt ttt;
102.908 +*** -------------
102.909 +*** Const ( DiffApp.Make'_fun'_by'_explicit)
102.910 +*** . Free ( f_, )
102.911 +*** . Free ( v_, )
102.912 +*** . Free ( eqs_, )
102.913 +*** . Const ( Let)
102.914 +*** . . Const ( Fun.op o)
102.915 +*** . . . Const ( List.hd)
102.916 +*** . . . Const ( DiffApp.filterVar)
102.917 +*** . . . . Free ( f_, )
102.918 +*** . . . Free ( eqs_, )
102.919 +*** . . Abs( h_,..
102.920 +*** . . . Const ( Let)
102.921 +*** . . . . Const ( List.hd)
102.922 +*** . . . . . Const ( List.dropWhile)
102.923 +*** . . . . . . Const ( Atools.ident)
102.924 +*** . . . . . . . Bound 0 <---- Free ( h_, )
102.925 +*** . . . . . . Free ( eqs_, )
102.926 +*** . . . . Abs( e_1,..
102.927 +*** . . . . . Const ( Let)
102.928 +*** . . . . . . Const ( List.dropWhile)
102.929 +*** . . . . . . . Const ( Atools.ident)
102.930 +*** . . . . . . . . Free ( f_, )
102.931 +*** . . . . . . . Const ( Tools.Vars)
102.932 +*** . . . . . . . . Bound 1 <---- Free ( h_, )
102.933 +*** . . . . . . Abs( vs_,..
102.934 +*** . . . . . . . Const ( Let)
102.935 +*** . . . . . . . . Const ( List.hd)
102.936 +*** . . . . . . . . . Const ( List.dropWhile)
102.937 +*** . . . . . . . . . . Const ( Atools.ident)
102.938 +*** . . . . . . . . . . . Free ( v_, )
102.939 +*** . . . . . . . . . . Bound 0 <---- Free ( vs_, )
102.940 +*** . . . . . . . . Abs( v_1,..
102.941 +*** . . . . . . . . . Const ( Let)
102.942 +*** . . . . . . . . . . Const ( Script.SubProblem)
102.943 +*** . . . . . . . . . . . Const ( Pair)
102.944 +*** . . . . . . . . . . . . Free ( DiffApp_, )
102.945 +*** . . . . . . . . . . . . Const ( Pair)
102.946 +*** . . . . . . . . . . . . . Const ( List.list.Cons)
102.947 +*** . . . . . . . . . . . . . . Free ( univar, )
102.948 +*** . . . . . . . . . . . . . . Const ( List.list.Cons)
102.949 +*** . . . . . . . . . . . . . . . Free ( equation, )
102.950 +*** . . . . . . . . . . . . . . . Const ( List.list.Nil)
102.951 +*** . . . . . . . . . . . . . Const ( List.list.Cons)
102.952 +*** . . . . . . . . . . . . . . Free ( no_met, )
102.953 +*** . . . . . . . . . . . . . . Const ( List.list.Nil)
102.954 +*** . . . . . . . . . . . Const ( List.list.Cons)
102.955 +*** . . . . . . . . . . . . Const ( Script.bool_)
102.956 +*** . . . . . . . . . . . . . Bound 2 <----- Free ( e_1, )
102.957 +*** . . . . . . . . . . . . Const ( List.list.Cons)
102.958 +*** . . . . . . . . . . . . . Const ( Script.real_)
102.959 +*** . . . . . . . . . . . . . . Bound 0 <----- Free ( v_1, )
102.960 +*** . . . . . . . . . . . . . Const ( List.list.Nil)
102.961 +*** . . . . . . . . . . Abs( s_1,..
102.962 +*** . . . . . . . . . . . Const ( Script.Substitute)
102.963 +*** . . . . . . . . . . . . Const ( List.list.Cons)
102.964 +*** . . . . . . . . . . . . . Const ( Pair)
102.965 +*** . . . . . . . . . . . . . . Bound 1 <----- Free ( v_1, )
102.966 +*** . . . . . . . . . . . . . . Const ( Fun.op o)
102.967 +*** . . . . . . . . . . . . . . . Const ( Tools.rhs)
102.968 +*** . . . . . . . . . . . . . . . Const ( List.hd)
102.969 +*** . . . . . . . . . . . . . . . Bound 0 <----- Free ( s_1, )
102.970 +*** . . . . . . . . . . . . . Const ( List.list.Nil)
102.971 +*** . . . . . . . . . . . . Bound 4 <----- Free ( h_, )
102.972 +
102.973 +> val ttt' = inst_abs thy ttt;
102.974 +> writeln(term2str ttt');
102.975 +Script Make_fun_by_explicit f_ v_ eqs_ =
102.976 + ... as above ...
102.977 +> atomt ttt';
102.978 +*** -------------
102.979 +*** Const ( DiffApp.Make'_fun'_by'_explicit)
102.980 +*** . Free ( f_, )
102.981 +*** . Free ( v_, )
102.982 +*** . Free ( eqs_, )
102.983 +*** . Const ( Let)
102.984 +*** . . Const ( Fun.op o)
102.985 +*** . . . Const ( List.hd)
102.986 +*** . . . Const ( DiffApp.filterVar)
102.987 +*** . . . . Free ( f_, )
102.988 +*** . . . Free ( eqs_, )
102.989 +*** . . Abs( h_,..
102.990 +*** . . . Const ( Let)
102.991 +*** . . . . Const ( List.hd)
102.992 +*** . . . . . Const ( List.dropWhile)
102.993 +*** . . . . . . Const ( Atools.ident)
102.994 +*** . . . . . . . Free ( h_, ) <---- Bound 0
102.995 +*** . . . . . . Free ( eqs_, )
102.996 +*** . . . . Abs( e_1,..
102.997 +*** . . . . . Const ( Let)
102.998 +*** . . . . . . Const ( List.dropWhile)
102.999 +*** . . . . . . . Const ( Atools.ident)
102.1000 +*** . . . . . . . . Free ( f_, )
102.1001 +*** . . . . . . . Const ( Tools.Vars)
102.1002 +*** . . . . . . . . Free ( h_, ) <---- Bound 1
102.1003 +*** . . . . . . Abs( vs_,..
102.1004 +*** . . . . . . . Const ( Let)
102.1005 +*** . . . . . . . . Const ( List.hd)
102.1006 +*** . . . . . . . . . Const ( List.dropWhile)
102.1007 +*** . . . . . . . . . . Const ( Atools.ident)
102.1008 +*** . . . . . . . . . . . Free ( v_, )
102.1009 +*** . . . . . . . . . . Free ( vs_, ) <---- Bound 0
102.1010 +*** . . . . . . . . Abs( v_1,..
102.1011 +*** . . . . . . . . . Const ( Let)
102.1012 +*** . . . . . . . . . . Const ( Script.SubProblem)
102.1013 +*** . . . . . . . . . . . Const ( Pair)
102.1014 +*** . . . . . . . . . . . . Free ( DiffApp_, )
102.1015 +*** . . . . . . . . . . . . Const ( Pair)
102.1016 +*** . . . . . . . . . . . . . Const ( List.list.Cons)
102.1017 +*** . . . . . . . . . . . . . . Free ( univar, )
102.1018 +*** . . . . . . . . . . . . . . Const ( List.list.Cons)
102.1019 +*** . . . . . . . . . . . . . . . Free ( equation, )
102.1020 +*** . . . . . . . . . . . . . . . Const ( List.list.Nil)
102.1021 +*** . . . . . . . . . . . . . Const ( List.list.Cons)
102.1022 +*** . . . . . . . . . . . . . . Free ( no_met, )
102.1023 +*** . . . . . . . . . . . . . . Const ( List.list.Nil)
102.1024 +*** . . . . . . . . . . . Const ( List.list.Cons)
102.1025 +*** . . . . . . . . . . . . Const ( Script.bool_)
102.1026 +*** . . . . . . . . . . . . . Free ( e_1, ) <----- Bound 2
102.1027 +*** . . . . . . . . . . . . Const ( List.list.Cons)
102.1028 +*** . . . . . . . . . . . . . Const ( Script.real_)
102.1029 +*** . . . . . . . . . . . . . . Free ( v_1, ) <----- Bound 0
102.1030 +*** . . . . . . . . . . . . . Const ( List.list.Nil)
102.1031 +*** . . . . . . . . . . Abs( s_1,..
102.1032 +*** . . . . . . . . . . . Const ( Script.Substitute)
102.1033 +*** . . . . . . . . . . . . Const ( List.list.Cons)
102.1034 +*** . . . . . . . . . . . . . Const ( Pair)
102.1035 +*** . . . . . . . . . . . . . . Free ( v_1, ) <----- Bound 1
102.1036 +*** . . . . . . . . . . . . . . Const ( Fun.op o)
102.1037 +*** . . . . . . . . . . . . . . . Const ( Tools.rhs)
102.1038 +*** . . . . . . . . . . . . . . . Const ( List.hd)
102.1039 +*** . . . . . . . . . . . . . . . Free ( s_1, ) <----- Bound 0
102.1040 +*** . . . . . . . . . . . . . Const ( List.list.Nil)
102.1041 +*** . . . . . . . . . . . . Free ( h_, ) <----- Bound 4
102.1042 +
102.1043 +Note numbering of de Bruijn indexes !
102.1044 +
102.1045 +Script Make_fun_by_explicit f_ v_ eqs_ =
102.1046 + let h_ = (hd o filterVar f_) eqs_;
102.1047 + e_1 = hd (dropWhile (ident h_ BOUND_0) eqs_);
102.1048 + vs_ = dropWhile (ident f_) (Vars h_ BOUND_1);
102.1049 + v_1 = hd (dropWhile (ident v_) vs_ BOUND_0);
102.1050 + s_1 =
102.1051 + SubProblem (DiffApp_, [univar, equation], [no_met])
102.1052 + [bool_ e_1 BOUND_2, real_ v_1 BOUND_0]
102.1053 + in Substitute [(v_1 BOUND_1 = (rhs o hd) s_1 BOUND_0)] h_ BOUND_4
102.1054 +*)
102.1055 +
102.1056 +
102.1057 +fun T_a2real (Type (s, [])) =
102.1058 + if s = "'a" orelse s = "'b" orelse s = "'c" then HOLogic.realT else Type (s, [])
102.1059 + | T_a2real (Type (s, Ts)) = Type (s, map T_a2real Ts)
102.1060 + | T_a2real (TFree (s, srt)) =
102.1061 + if s = "'a" orelse s = "'b" orelse s = "'c" then HOLogic.realT else TFree (s, srt)
102.1062 + | T_a2real (TVar (("DUMMY",_),srt)) = HOLogic.realT;
102.1063 +
102.1064 +(*FIXME .. fixes the type (+see Typefix.thy*)
102.1065 +fun typ_a2real (Const( s, T)) = (Const( s, T_a2real T))
102.1066 + | typ_a2real (Free( s, T)) = (Free( s, T_a2real T))
102.1067 + | typ_a2real (Var( n, T)) = (Var( n, T_a2real T))
102.1068 + | typ_a2real (Bound i) = (Bound i)
102.1069 + | typ_a2real (Abs(s,T,t)) = Abs(s, T, typ_a2real t)
102.1070 + | typ_a2real (t1 $ t2) = (typ_a2real t1) $ (typ_a2real t2);
102.1071 +(*
102.1072 +----------------6.8.02---------------------------------------------------
102.1073 + val str = "1";
102.1074 + val t = read_cterm (sign_of thy) (str,(TVar(("DUMMY",0),[])));
102.1075 + atomty (term_of t);
102.1076 +*** -------------
102.1077 +*** Const ( 1, 'a)
102.1078 + val t = (app_num_tr' o term_of) t;
102.1079 + atomty t;
102.1080 +*** -------------
102.1081 +*** Const ( 1, 'a)
102.1082 + val t = typ_a2real t;
102.1083 + atomty t;
102.1084 +*** -------------
102.1085 +*** Const ( 1, real)
102.1086 +
102.1087 + val str = "2";
102.1088 + val t = read_cterm (sign_of thy) (str,(TVar(("DUMMY",0),[])));
102.1089 + atomty (term_of t);
102.1090 +*** -------------
102.1091 +*** Const ( Numeral.number_of, bin => 'a)
102.1092 +*** . Const ( Numeral.bin.Bit, [bin, bool] => bin)
102.1093 +*** . . Const ( Numeral.bin.Bit, [bin, bool] => bin)
102.1094 +*** . . . Const ( Numeral.bin.Pls, bin)
102.1095 +*** . . . Const ( True, bool)
102.1096 +*** . . Const ( False, bool)
102.1097 + val t = (app_num_tr' o term_of) t;
102.1098 + atomty t;
102.1099 +*** -------------
102.1100 +*** Free ( 2, 'a)
102.1101 + val t = typ_a2real t;
102.1102 + atomty t;
102.1103 +*** -------------
102.1104 +*** Free ( 2, real)
102.1105 +----------------6.8.02---------------------------------------------------
102.1106 +
102.1107 +
102.1108 +> val str = "R";
102.1109 +> val t = term_of (read_cterm(sign_of thy)(str,(TVar(("DUMMY",0),[]))));
102.1110 +val t = Free ("R","?DUMMY") : term
102.1111 +> val t' = typ_a2real t;
102.1112 +> cterm_of (sign_of thy) t';
102.1113 +val it = "R::RealDef.real" : cterm
102.1114 +
102.1115 +> val str = "R=R";
102.1116 +> val t = term_of (read_cterm(sign_of thy)(str,(TVar(("DUMMY",0),[]))));
102.1117 +> atomty (typ_a2real t);
102.1118 +*** -------------
102.1119 +*** Const ( op =, [RealDef.real, RealDef.real] => bool)
102.1120 +*** Free ( R, RealDef.real)
102.1121 +*** Free ( R, RealDef.real)
102.1122 +> val t' = typ_a2real t;
102.1123 +> cterm_of (sign_of thy) t';
102.1124 +val it = "(R::RealDef.real) = R" : cterm
102.1125 +
102.1126 +> val str = "fixed_values [R=R]";
102.1127 +> val t = term_of (read_cterm(sign_of thy)(str,(TVar(("DUMMY",0),[]))));
102.1128 +> val t' = typ_a2real t;
102.1129 +> cterm_of (sign_of thy) t';
102.1130 +val it = "fixed_values [(R::RealDef.real) = R]" : cterm
102.1131 +*)
102.1132 +
102.1133 +(*TODO.WN0609: parse should return a term or a string
102.1134 + (or even more comprehensive datastructure for error-messages)
102.1135 + i.e. in wrapping with SOME term or NONE the latter is not sufficient*)
102.1136 +(*2002 fun parseold thy str =
102.1137 + (let
102.1138 + val sgn = sign_of thy;
102.1139 + val t = ((*typ_a2real o*) app_num_tr'1 o term_of)
102.1140 + (read_cterm sgn (str,(TVar(("DUMMY",0),[]))));
102.1141 + in SOME (cterm_of sgn t) end)
102.1142 + handle _ => NONE;*)
102.1143 +
102.1144 +
102.1145 +
102.1146 +fun parseold thy str =
102.1147 + (let val t = ((*typ_a2real o*) numbers_to_string)
102.1148 + (Syntax.read_term_global thy str)
102.1149 + in SOME (cterm_of thy t) end)
102.1150 + handle _ => NONE;
102.1151 +(*2002 fun parseN thy str =
102.1152 + (let
102.1153 + val sgn = sign_of thy;
102.1154 + val t = ((*typ_a2real o app_num_tr'1 o*) term_of)
102.1155 + (read_cterm sgn (str,(TVar(("DUMMY",0),[]))));
102.1156 + in SOME (cterm_of sgn t) end)
102.1157 + handle _ => NONE;*)
102.1158 +fun parseN thy str =
102.1159 + (let val t = (*(typ_a2real o numbers_to_string)*)
102.1160 + (Syntax.read_term_global thy str)
102.1161 + in SOME (cterm_of thy t) end)
102.1162 + handle _ => NONE;
102.1163 +(*2002 fun parse thy str =
102.1164 + (let
102.1165 + val sgn = sign_of thy;
102.1166 + val t = (typ_a2real o app_num_tr'1 o term_of)
102.1167 + (read_cterm sgn (str,(TVar(("DUMMY",0),[]))));
102.1168 + in SOME (cterm_of sgn t) end) (*FIXXXXME 10.8.02: return term !!!*)
102.1169 + handle _ => NONE;*)
102.1170 +(*2010 fun parse thy str =
102.1171 + (let val t = (typ_a2real o app_num_tr'1) (Syntax.read_term_global thy str)
102.1172 + in SOME (cterm_of thy t) end) (*FIXXXXME 10.8.02: return term !!!*)
102.1173 + handle _ => NONE;*)
102.1174 +fun parse thy str =
102.1175 + (let val t = (typ_a2real o numbers_to_string)
102.1176 + (Syntax.read_term_global thy str)
102.1177 + in SOME (cterm_of thy t) end) (*FIXXXXME 10.8.02: return term !!!*)
102.1178 + handle _ => NONE;
102.1179 +
102.1180 +(* 10.8.02: for this reason we still have ^^^--------------------
102.1181 + val thy = SqRoot.thy;
102.1182 + val str = "(1::real) ^ (2::nat)";
102.1183 + val sgn = sign_of thy;
102.1184 + val ct = (read_cterm sgn (str,(TVar(("DUMMY",0),[])))) handle e =>print_exn e;
102.1185 +(*1*)"(1::real) ^ 2";
102.1186 + atomty (term_of ct);
102.1187 +*** -------------
102.1188 +*** Const ( Nat.power, [real, nat] => real)
102.1189 +*** . Const ( 1, real)
102.1190 +*** . Const ( Numeral.number_of, bin => nat)
102.1191 +*** . . Const ( Numeral.bin.Bit, [bin, bool] => bin)
102.1192 +*** . . . Const ( Numeral.bin.Bit, [bin, bool] => bin)
102.1193 +*** . . . . Const ( Numeral.bin.Pls, bin)
102.1194 +*** . . . . Const ( True, bool)
102.1195 +*** . . . Const ( False, bool)
102.1196 + val t = ((app_num_tr' o term_of)
102.1197 + (read_cterm sgn (str,(TVar(("DUMMY",0),[])))))handle e => print_exn e;
102.1198 + val ct = (cterm_of sgn t) handle e => print_exn e;
102.1199 +(*2*)"(1::real) ^ (2::nat)";
102.1200 + atomty (term_of ct);
102.1201 +*** -------------
102.1202 +*** Const ( Nat.power, [real, nat] => real)
102.1203 +*** . Free ( 1, real)
102.1204 +*** . Free ( 2, nat) (*1*) Const("2",_) (*2*) Free("2",_)
102.1205 +
102.1206 +
102.1207 + val str = "(2::real) ^ (2::nat)";
102.1208 + val t = (read_cterm sgn (str,(TVar(("DUMMY",0),[])))) handle e => print_exn e;
102.1209 +val t = "(2::real) ^ 2" : cterm
102.1210 + val t = ((app_num_tr' o term_of)
102.1211 + (read_cterm sgn (str,(TVar(("DUMMY",0),[])))))handle e => print_exn e;
102.1212 + val ct = (cterm_of sgn t) handle e => print_exn e;
102.1213 +Variable "2" has two distinct types
102.1214 +real
102.1215 +nat
102.1216 +uncaught exception TYPE
102.1217 + raised at: sign.ML:672.26-673.56
102.1218 + goals.ML:1100.61
102.1219 +
102.1220 +
102.1221 + val str = "(3::real) ^ (2::nat)";
102.1222 + val t = (read_cterm sgn (str,(TVar(("DUMMY",0),[])))) handle e => print_exn e;
102.1223 +val t = "(3::real) ^ 2" : cterm
102.1224 + val t = ((app_num_tr' o term_of)
102.1225 + (read_cterm sgn (str,(TVar(("DUMMY",0),[])))))handle e => print_exn e;
102.1226 + val ct = (cterm_of sgn t) handle e => print_exn e;
102.1227 +val ct = "(3::real) ^ (2::nat)" : cterm
102.1228 +
102.1229 +
102.1230 +Conclusion: The type inference allows different types
102.1231 + for one and the same Numeral.number_of
102.1232 + BUT the type inference doesn't allow
102.1233 + Free ( 2, real) and Free ( 2, nat) within one term
102.1234 +--------------- ~~~~ ~~~ *)
102.1235 +(*
102.1236 +> val (SOME ct) = parse thy "(-#5)^^^#3";
102.1237 +> atomty (term_of ct);
102.1238 +*** -------------
102.1239 +*** Const ( Nat.op ^, ['a, nat] => 'a)
102.1240 +*** Const ( uminus, 'a => 'a)
102.1241 +*** Free ( #5, 'a)
102.1242 +*** Free ( #3, nat)
102.1243 +> val (SOME ct) = parse thy "R=R";
102.1244 +> atomty (term_of ct);
102.1245 +*** -------------
102.1246 +*** Const ( op =, [real, real] => bool)
102.1247 +*** Free ( R, real)
102.1248 +*** Free ( R, real)
102.1249 +
102.1250 +THIS IS THE OUTPUT FOR VERSION (3) above at typ_a2real !!!!!
102.1251 +*** -------------
102.1252 +*** Const ( op =, [RealDef.real, RealDef.real] => bool)
102.1253 +*** Free ( R, RealDef.real)
102.1254 +*** Free ( R, RealDef.real) *)
102.1255 +
102.1256 +(*version for testing local to theories*)
102.1257 +fun str2t thy str = (term_of o the o (parse thy )) str;
102.1258 +
102.1259 +fun str2term str = (term_of o the o (parse (assoc_thy "Isac.thy"))) str;
102.1260 +fun str2termN str = (term_of o the o (parseN (assoc_thy "Isac.thy"))) str;
102.1261 +fun strs2terms ss = map str2term ss;
102.1262 +
102.1263 +(*+ makes a substitution from the output of Pattern.match +*)
102.1264 +(*fun mk_subs ((id, _):indexname, t:term) = (Free (id,type_of t), t);*)
102.1265 +fun mk_subs (subs: ((string * int) * (Term.typ * Term.term)) list) =
102.1266 +let fun mk_sub ((id, _), (ty, tm)) = (Free (id, ty), tm) in
102.1267 +map mk_sub subs end;
102.1268 +
102.1269 +val atomthm = atomt o #prop o rep_thm;
102.1270 +
102.1271 +(*.instantiate #prop thm with bound variables (as Free).*)
102.1272 +fun inst_bdv [] t = t : term
102.1273 + | inst_bdv (instl: (term*term) list) t =
102.1274 + let fun subst (v as Var((s,_),T)) =
102.1275 + (case explode s of
102.1276 + "b"::"d"::"v"::_ =>
102.1277 + if_none (assoc(instl,Free(s,T))) (Free(s,T))
102.1278 + | _ => v)
102.1279 + | subst (Abs(a,T,body)) = Abs(a, T, subst body)
102.1280 + | subst (f$t') = subst f $ subst t'
102.1281 + | subst t = if_none (assoc(instl,t)) t
102.1282 + in subst t end;
102.1283 +
102.1284 +
102.1285 +(*WN050829 caution: is_atom (str2term"q_0/2 * L * x") = true !!!
102.1286 + use length (vars term) = 1 instead*)
102.1287 +fun is_atom (Const ("Float.Float",_) $ _) = true
102.1288 + | is_atom (Const ("ComplexI.I'_'_",_)) = true
102.1289 + | is_atom (Const ("op *",_) $ t $ Const ("ComplexI.I'_'_",_)) = is_atom t
102.1290 + | is_atom (Const ("op +",_) $ t1 $ Const ("ComplexI.I'_'_",_)) = is_atom t1
102.1291 + | is_atom (Const ("op +",_) $ t1 $
102.1292 + (Const ("op *",_) $ t2 $ Const ("ComplexI.I'_'_",_))) =
102.1293 + is_atom t1 andalso is_atom t2
102.1294 + | is_atom (Const _) = true
102.1295 + | is_atom (Free _) = true
102.1296 + | is_atom (Var _) = true
102.1297 + | is_atom _ = false;
102.1298 +(* val t = str2term "q_0/2 * L * x";
102.1299 +
102.1300 +
102.1301 +*)
102.1302 +(*val t = str2term "Float ((1,2),(0,0))";
102.1303 +> is_atom t;
102.1304 +val it = true : bool
102.1305 +> val t = str2term "Float ((1,2),(0,0)) * I__";
102.1306 +> is_atom t;
102.1307 +val it = true : bool
102.1308 +> val t = str2term "Float ((1,2),(0,0)) + Float ((3,4),(0,0)) * I__";
102.1309 +> is_atom t;
102.1310 +val it = true : bool
102.1311 +> val t = str2term "1 + 2*I__";
102.1312 +> val Const ("op +",_) $ t1 $ (Const ("op *",_) $ t2 $ Const ("ComplexI.I'_'_",_)) = t;
102.1313 +*)
102.1314 +
102.1315 +(*.adaption from Isabelle/src/Pure/term.ML; reports if ALL Free's
102.1316 + have found a substitution (required for evaluating the preconditions
102.1317 + of _incomplete_ models).*)
102.1318 +fun subst_atomic_all [] t = (false, (*TODO may be 'true' for some terms ?*)
102.1319 + t : term)
102.1320 + | subst_atomic_all (instl: (term*term) list) t =
102.1321 + let fun subst (Abs(a,T,body)) =
102.1322 + let val (all, body') = subst body
102.1323 + in (all, Abs(a, T, body')) end
102.1324 + | subst (f$tt) =
102.1325 + let val (all1, f') = subst f
102.1326 + val (all2, tt') = subst tt
102.1327 + in (all1 andalso all2, f' $ tt') end
102.1328 + | subst (t as Free _) =
102.1329 + if is_num t then (true, t) (*numerals cannot be subst*)
102.1330 + else (case assoc(instl,t) of
102.1331 + SOME t' => (true, t')
102.1332 + | NONE => (false, t))
102.1333 + | subst t = (true, if_none (assoc(instl,t)) t)
102.1334 + in subst t end;
102.1335 +
102.1336 +(*.add two terms with a type given.*)
102.1337 +fun mk_add t1 t2 =
102.1338 + let val T1 = type_of t1
102.1339 + val T2 = type_of t2
102.1340 + in if T1 <> T2 then raise TYPE ("mk_add gets ",[T1, T2],[t1,t2])
102.1341 + else (Const ("op +", [T1, T2] ---> T1) $ t1 $ t2)
102.1342 + end;
102.1343 +
103.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
103.2 +++ b/src/Pure/isac/Test.thy Wed Jul 21 13:53:39 2010 +0200
103.3 @@ -0,0 +1,7 @@
103.4 +theory Test imports Main begin;
103.5 + theorem my_thm: " A & B --> B & A";
103.6 + proof;
103.7 + assume " A & B";
103.8 + then obtain B and A ..;
103.9 + then show "B & A" ..;
103.10 + qed;
104.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
104.2 +++ b/src/Pure/isac/calcelems.sml Wed Jul 21 13:53:39 2010 +0200
104.3 @@ -0,0 +1,654 @@
104.4 +(* elements of calculations.
104.5 + they are partially held in association lists as ref's for
104.6 + switching language levels (meta-string, object-values).
104.7 + in order to keep these ref's during re-evaluation of code,
104.8 + they are defined here at the beginning of the code.
104.9 + author: Walther Neuper
104.10 + (c) isac-team 2003
104.11 +
104.12 +use"calcelems.sml";
104.13 +*)
104.14 +
104.15 +val linefeed = (curry op^) "\n";
104.16 +type authors = string list;
104.17 +
104.18 +type cterm' = string;
104.19 +val empty_cterm' = "empty_cterm'";
104.20 +type thmID = string;
104.21 +type thm' = thmID * cterm';(*WN060610 deprecated in favour of thm''*)
104.22 +type thm'' = thmID * term;
104.23 +type rls' = string;
104.24 +(*.a 'guh'='globally unique handle' is a string unique for each element
104.25 + of isac's KEStore and persistent over time
104.26 + (in particular under shifts within the respective hierarchy);
104.27 + specialty for thys:
104.28 + # guh NOT resistant agains shifts from one thy to another
104.29 + (which is the price for Isabelle's design: thy's overwrite ids of subthy's)
104.30 + # requirement for matchTheory: induce guh from tac + current thy
104.31 + (see 'fun thy_containing_thm', 'fun thy_containing_rls' etc.)
104.32 + TODO: introduce to pbl, met.*)
104.33 +type guh = string;
104.34 +val e_guh = "e_guh":guh;
104.35 +
104.36 +type xml = string;
104.37 +
104.38 +(*. eval function calling sml code during rewriting.*)
104.39 +type eval_fn = (string -> term -> theory -> (string * term) option);
104.40 +fun e_evalfn (_:'a) (_:term) (_:theory) = NONE:(string * term) option;
104.41 +(*. op in isa-term 'Const(op,_)' .*)
104.42 +type calID = string;
104.43 +type cal = (calID * eval_fn);
104.44 +(*. fun calculate_ fetches the evaluation-function via this list. *)
104.45 +type calcID = string;
104.46 +type calc = (calcID * cal);
104.47 +
104.48 +type subs' = (cterm' * cterm') list; (*16.11.00 for FE-KE*)
104.49 +type subst = (term * term) list; (*here for ets2str*)
104.50 +val e_subst = []:(term * term) list;
104.51 +
104.52 +(*TODO.WN060610 make use of "type rew_ord" total*)
104.53 +type rew_ord' = string;
104.54 +val e_rew_ord' = "e_rew_ord" : rew_ord';
104.55 +type rew_ord_ = subst -> Term.term * Term.term -> bool;
104.56 +fun dummy_ord (_:subst) (_:term,_:term) = true;
104.57 +val e_rew_ord_ = dummy_ord;
104.58 +type rew_ord = rew_ord' * rew_ord_;
104.59 +val e_rew_ord = dummy_ord; (* TODO.WN071231 clarify identifiers..e_rew_ordX*)
104.60 +val e_rew_ordX = (e_rew_ord', e_rew_ord_) : rew_ord;
104.61 +
104.62 +
104.63 +datatype rule =
104.64 + Erule (*.the empty rule .*)
104.65 +| Thm of (string * thm)(*.a theorem, ie (identifier, Thm.thm).*)
104.66 +| Calc of string * (*.sml-code manipulating a (sub)term .*)
104.67 + (string -> term -> theory -> (string * term) option)
104.68 +| Cal1 of string * (*.sml-code applied only to whole term
104.69 + or left/right-hand-side of eqality .*)
104.70 + (string -> term -> theory -> (string * term) option)
104.71 +| Rls_ of rls (*.ie. rule sets may be nested.*)
104.72 +and scr =
104.73 + EmptyScr
104.74 + | Script of term (*for met*)
104.75 + | Rfuns of {init_state : term ->
104.76 + (term * (*the current formula:
104.77 + goes locate_gen -> next_tac via istate*)
104.78 + term * (*the final formula*)
104.79 + rule list (*of reverse rewrite set (#1#)*)
104.80 + list * (*may be serveral, eg. in norm_rational*)
104.81 + (rule * (*Thm (+ Thm generated from Calc) resulting in ...*)
104.82 + (term * (*... rewrite with ...*)
104.83 + term list)) (*... assumptions*)
104.84 + list), (*derivation from given term to normalform
104.85 + in reverse order with sym_thm;
104.86 + (#1#) could be extracted from here #1*)
104.87 +
104.88 + normal_form: term -> (term * term list) option,
104.89 + locate_rule: rule list list -> term -> rule
104.90 + -> (rule * (term * term list)) list,
104.91 + next_rule : rule list list -> term -> rule option,
104.92 + attach_form: rule list list -> term -> term
104.93 + -> (rule * (term * term list)) list}
104.94 +and rls =
104.95 + Erls (*for init e_rls*)
104.96 +
104.97 + | Rls of (*a confluent and terminating ruleset, in general *)
104.98 + {id : string, (*for trace_rewrite:=true *)
104.99 + preconds : term list, (*unused WN020820 *)
104.100 + (*WN060616 for efficiency...
104.101 + bdvs : false, (*set in prep_rls for get_bdvs *)*)
104.102 + rew_ord : rew_ord, (*for rules*)
104.103 + erls : rls, (*for the conditions in rules *)
104.104 + srls : rls, (*for evaluation of list_fns in script *)
104.105 + calc : calc list, (*for Calculate in scr, set by prep_rls *)
104.106 + rules : rule list,
104.107 + scr : scr} (*Script term: generating intermed.steps *)
104.108 + | Seq of (*a sequence of rules to be tried only once *)
104.109 + {id : string, (*for trace_rewrite:=true *)
104.110 + preconds : term list, (*unused 20.8.02 *)
104.111 + (*WN060616 for efficiency...
104.112 + bdvs : false, (*set in prep_rls for get_bdvs *)*)
104.113 + rew_ord : rew_ord, (*for rules *)
104.114 + erls : rls, (*for the conditions in rules *)
104.115 + srls : rls, (*for evaluation of list_fns in script *)
104.116 + calc : calc list, (*for Calculate in scr, set by prep_rls *)
104.117 + rules : rule list,
104.118 + scr : scr} (*Script term (how to restrict type ???)*)
104.119 + (*Rrls call SML-code and simulate an rls
104.120 + difference: there is always _ONE_ redex rewritten in 1 call,
104.121 + thus wrap Rrls by: Rls (Rls_ ...)*)
104.122 +
104.123 + | Rrls of (*for 'reverse rewriting' by SML-functions instead Script*)
104.124 + {id : string, (*for trace_rewrite:=true *)
104.125 + prepat : (term list *(*preconds, eval with subst from pattern *)
104.126 + term ) (*pattern matched in subterms *)
104.127 + list, (*meta-conjunction is or *)
104.128 + rew_ord : rew_ord, (*for rules *)
104.129 + erls : rls, (*for the conditions in rules and pat *)
104.130 + (* '^ because of rewrite in applicable_in
104.131 + compare type met*)
104.132 + calc : calc list, (*for Calculate in scr, set by prep_rls *)
104.133 + scr : scr}; (*Rfuns {...} (how to restrict type ???)*)
104.134 +(*1.8.02 ad (how to restrict type ???): scr should be usable indepentently
104.135 + from rls, and then contain both Script _AND_ Rfuns !!!*)
104.136 +
104.137 +
104.138 +(*ctxt for retrieval of all thms in HOL; FIXME make this local?*)
104.139 +val ctxt_HOL = ProofContext.init (theory "Complex_Main");
104.140 +val HOL = ProofContext.theory_of ctxt_HOL;
104.141 +(*lazy ctxt for retrieval of all thms used in isac; FIXME make this local?*)
104.142 +fun ctxt_Isac _ = ProofContext.init (theory "Isac");
104.143 +fun Isac _ = ProofContext.theory_of (ctxt_Isac"");
104.144 +
104.145 +val e_rule = Thm ("refl", ProofContext.get_thm ctxt_HOL "refl" );
104.146 +fun id_of_thm (Thm (id, _)) = id
104.147 + | id_of_thm _ = raise error "id_of_thm";
104.148 +fun thm_of_thm (Thm (_, thm)) = thm
104.149 + | thm_of_thm _ = raise error "thm_of_thm";
104.150 +fun rep_thm_G' (Thm (thmid, thm)) = (thmid, thm);
104.151 +fun eq_thmI ((thmid1 : thmID, _ : thm), (thmid2 : thmID, _ : thm)) =
104.152 + (strip_thy thmid1) = (strip_thy thmid2);
104.153 +
104.154 +
104.155 +val string_of_thm = Thm.get_name; (*FIXME.2009*)
104.156 +(*check for [.] as caused by "fun assoc_thm'"*)
104.157 +fun string_of_thmI thm =
104.158 + let val ct' = (de_quote o string_of_thm) thm
104.159 + val (a, b) = split_nlast (5, explode ct')
104.160 + in case b of
104.161 + [" ", " ","[", ".", "]"] => implode a
104.162 + | _ => ct'
104.163 + end;
104.164 +
104.165 +(*.id requested for all, Rls,Seq,Rrls.*)
104.166 +fun id_rls Erls = "e_rls" (*WN060714 quick and dirty: recursive defs!*)
104.167 + | id_rls (Rls {id,...}) = id
104.168 + | id_rls (Seq {id,...}) = id
104.169 + | id_rls (Rrls {id,...}) = id;
104.170 +val rls2str = id_rls;
104.171 +fun id_rule (Thm (id, _)) = id
104.172 + | id_rule (Calc (id, _)) = id
104.173 + | id_rule (Rls_ rls) = id_rls rls;
104.174 +
104.175 +fun get_rules (Rls {rules,...}) = rules
104.176 + | get_rules (Seq {rules,...}) = rules
104.177 + | get_rules (Rrls _) = [];
104.178 +
104.179 +fun rule2str Erule = "Erule"
104.180 + | rule2str (Thm (str, thm)) = "Thm (\""^str^"\","^(string_of_thmI thm)^")"
104.181 + | rule2str (Calc (str,f)) = "Calc (\""^str^"\",fn)"
104.182 + | rule2str (Cal1 (str,f)) = "Cal1 (\""^str^"\",fn)"
104.183 + | rule2str (Rls_ rls) = "Rls_ (\""^id_rls rls^"\")";
104.184 +fun rule2str' Erule = "Erule"
104.185 + | rule2str' (Thm (str, thm)) = "Thm (\""^str^"\",\"\")"
104.186 + | rule2str' (Calc (str,f)) = "Calc (\""^str^"\",fn)"
104.187 + | rule2str' (Cal1 (str,f)) = "Cal1 (\""^str^"\",fn)"
104.188 + | rule2str' (Rls_ rls) = "Rls_ (\""^id_rls rls^"\")";
104.189 +
104.190 +(*WN080102 compare eq_rule ?!?*)
104.191 +fun eqrule (Thm (id1,_), Thm (id2,_)) = id1 = id2
104.192 + | eqrule (Calc (id1,_), Calc (id2,_)) = id1 = id2
104.193 + | eqrule (Cal1 (id1,_), Cal1 (id2,_)) = id1 = id2
104.194 + | eqrule (Rls_ _, Rls_ _) = false (*{id=id1}{id=id2} = id1 = id2 FIXXME*)
104.195 + | eqrule _ = false;
104.196 +
104.197 +
104.198 +type rrlsstate = (*state for reverse rewriting*)
104.199 + (term * (*the current formula:
104.200 + goes locate_gen -> next_tac via istate*)
104.201 + term * (*the final formula*)
104.202 + rule list (*of reverse rewrite set (#1#)*)
104.203 + list * (*may be serveral, eg. in norm_rational*)
104.204 + (rule * (*Thm (+ Thm generated from Calc) resulting in ...*)
104.205 + (term * (*... rewrite with ...*)
104.206 + term list)) (*... assumptions*)
104.207 + list); (*derivation from given term to normalform
104.208 + in reverse order with sym_thm;
104.209 + (#1#) could be extracted from here #1*)
104.210 +val e_type = Type("empty",[]);
104.211 +val a_type = TFree("'a",[]);
104.212 +val e_term = Const("empty",e_type);
104.213 +val a_term = Free("empty",a_type);
104.214 +val e_rrlsstate = (e_term,e_term,[[e_rule]],[(e_rule,(e_term,[]))]):rrlsstate;
104.215 +
104.216 +
104.217 +
104.218 +
104.219 +(*22.2.02: ging auf Linux nicht (Stefan)
104.220 +val e_scr = Script ((term_of o the o (parse thy)) "e_script");*)
104.221 +val e_term = Const("empty", Type("'a", []));
104.222 +val e_scr = Script e_term;
104.223 +
104.224 +
104.225 +(*ad thm':
104.226 + there are two kinds of theorems ...
104.227 + (1) known by isabelle
104.228 + (2) not known, eg. calc_thm, instantiated rls
104.229 + the latter have a thmid "#..."
104.230 + and thus outside isa we ALWAYS transport both (thmid,string_of_thmI)
104.231 + and have a special assoc_thm / assoc_rls in this interface *)
104.232 +type theory' = string; (* = domID ^".thy" *)
104.233 +type domID = string; (* domID ^".thy" = theory' TODO.11.03replace by thyID*)
104.234 +type thyID = string; (*WN.3.11.03 TODO: replace domID with thyID*)
104.235 +
104.236 +(*2002 fun string_of_thy thy =
104.237 +((last_elem (Sign.stamp_names_of (sign_of thy)))^".thy"):theory';*)
104.238 +fun string_of_thy thy = Context.theory_name thy: theory';
104.239 +val theory2domID = string_of_thy;
104.240 +val theory2thyID = (get_thy o string_of_thy) : theory -> thyID;
104.241 +val theory2theory' = string_of_thy;
104.242 +val theory2str = string_of_thy; (*WN050903 ..most consistent naming*)
104.243 +val theory2str' = implode o (drop_last_n 4) o explode o string_of_thy;
104.244 +(*> theory2str' Isac.thy;
104.245 +al it = "Isac" : string
104.246 +*)
104.247 +
104.248 +fun thyID2theory' (thyID:thyID) =
104.249 + let val ss = explode thyID
104.250 + val ext = implode (takelast (4, ss))
104.251 + in if ext = ".thy" then thyID : theory' (*disarm abuse of thyID*)
104.252 + else thyID ^ ".thy"
104.253 + end;
104.254 +(* thyID2theory' "Isac" (*ok*);
104.255 +val it = "Isac.thy" : theory'
104.256 + > thyID2theory' "Isac.thy" (*abuse, goes ok...*);
104.257 +val it = "Isac.thy" : theory'
104.258 +*)
104.259 +
104.260 +fun theory'2thyID (theory':theory') =
104.261 + let val ss = explode theory'
104.262 + val ext = implode (takelast (4, ss))
104.263 + in if ext = ".thy" then ((implode o (drop_last_n 4)) ss) : thyID
104.264 + else theory' (*disarm abuse of theory'*)
104.265 + end;
104.266 +(* theory'2thyID "Isac.thy";
104.267 +val it = "Isac" : thyID
104.268 +> theory'2thyID "Isac";
104.269 +val it = "Isac" : thyID*)
104.270 +
104.271 +
104.272 +(*. WN0509 discussion:
104.273 +#############################################################################
104.274 +# How to manage theorys in subproblems wrt. the requirement, #
104.275 +# that scripts should be re-usable ? #
104.276 +#############################################################################
104.277 +
104.278 + eg. 'Script Solve_rat_equation' calls 'SubProblem (RatEq_,..'
104.279 + which would not allow to 'solve (y'' = -M_b / EI, M_b)' by this script
104.280 + because Biegelinie.thy is subthy of RatEq.thy and thus Biegelinie.M_b
104.281 + is unknown in RatEq.thy and M_b cannot be parsed into the scripts guard
104.282 + (see match_ags).
104.283 +
104.284 + Preliminary solution:
104.285 + # the thy in 'SubProblem (thy_, pbl, arglist)' is not taken automatically,
104.286 + # instead the 'maxthy (rootthy pt) thy_' is taken for each subpbl
104.287 + # however, a thy specified by the user in the rootpbl may lead to
104.288 + errors in far-off subpbls (which are not yet reported properly !!!)
104.289 + and interactively specifiying thys in subpbl is not very relevant.
104.290 +
104.291 + Other solutions possible:
104.292 + # always parse and type-check with Isac.thy
104.293 + (rejected tue to the vague idea eg. to re-use equations for R in C etc.)
104.294 + # regard the subthy-relation in specifying thys of subpbls
104.295 + # specifically handle 'SubProblem (undefined_, pbl, arglist)'
104.296 + # ???
104.297 +.*)
104.298 +(*WN0509 TODO "ProtoPure" ... would be more consistent
104.299 + with assoc_thy <--> theory2theory' +FIXME assoc_thy "e_domID" -> Script.thy*)
104.300 +val e_domID = "e_domID":domID;
104.301 +
104.302 +(*the key into the hierarchy ob theory elements*)
104.303 +type theID = string list;
104.304 +val e_theID = ["e_theID"];
104.305 +val theID2str = strs2str;
104.306 +(*theID eg. is ["IsacKnowledge", "Test", "Rulesets", "ac_plus_times"]*)
104.307 +fun theID2thyID (theID:theID) =
104.308 + if length theID >= 3 then (last_elem o (drop_last_n 2)) theID : thyID
104.309 + else raise error ("theID2thyID called with "^ theID2str theID);
104.310 +
104.311 +(*the key into the hierarchy ob problems*)
104.312 +type pblID = string list; (* domID::...*)
104.313 +val e_pblID = ["e_pblID"]:pblID;
104.314 +val pblID2str = strs2str;
104.315 +
104.316 +(*the key into the hierarchy ob methods*)
104.317 +type metID = string list;
104.318 +val e_metID = ["e_metID"]:metID;
104.319 +val metID2str = strs2str;
104.320 +
104.321 +(*either theID or pblID or metID*)
104.322 +type kestoreID = string list;
104.323 +val e_kestoreID = ["e_kestoreID"];
104.324 +val kestoreID2str = strs2str;
104.325 +
104.326 +(*for distinction of contexts*)
104.327 +datatype ketype = Exp_ | Thy_ | Pbl_ | Met_;
104.328 +fun ketype2str Exp_ = "Exp_"
104.329 + | ketype2str Thy_ = "Thy_"
104.330 + | ketype2str Pbl_ = "Pbl_"
104.331 + | ketype2str Met_ = "Met_";
104.332 +fun ketype2str' Exp_ = "Example"
104.333 + | ketype2str' Thy_ = "Theory"
104.334 + | ketype2str' Pbl_ = "Problem"
104.335 + | ketype2str' Met_ = "Method";
104.336 +
104.337 +(*see 'How to manage theorys in subproblems' at 'type thyID'*)
104.338 +val theory' = ref ([]:(theory' * theory) list);
104.339 +
104.340 +(*.all theories defined for Scripts, recorded in Scripts/Script.ML;
104.341 + in order to distinguish them from general IsacKnowledge defined later on.*)
104.342 +val script_thys = ref ([] : (theory' * theory) list);
104.343 +
104.344 +
104.345 +(*rewrite orders, also stored in 'type met' and type 'and rls'
104.346 + The association list is required for 'rewrite.."rew_ord"..'
104.347 + WN0509 tests not well-organized: see smltest/IsacKnowledge/termorder.sml*)
104.348 +val rew_ord' =
104.349 + ref ([]:(rew_ord' * (*the key for the association list *)
104.350 + (subst (*the bound variables - they get high order*)
104.351 + -> (term * term) (*(t1, t2) to be compared *)
104.352 + -> bool)) (*if t1 <= t2 then true else false *)
104.353 + list); (*association list *)
104.354 +rew_ord' := overwritel (!rew_ord', [("e_rew_ord", e_rew_ord),
104.355 + ("dummy_ord", dummy_ord)]);
104.356 +
104.357 +
104.358 +(*WN060120 a hack to get alltogether run again with minimal effort:
104.359 + theory' is inserted for creating thy_hierarchy; calls for assoc_rls
104.360 + need not be called*)
104.361 +val ruleset' = ref ([]:(rls' * (theory' * rls)) list);
104.362 +
104.363 +(*FIXME.040207 calclist': used by prep_rls, NOT in met*)
104.364 +val calclist'= ref ([]: calc list);
104.365 +
104.366 +(*.the hierarchy of thydata.*)
104.367 +
104.368 +(*.'a is for pbt | met.*)
104.369 +(*WN.24.4.03 -"- ... type parameters; afterwards naming inconsistent*)
104.370 +datatype 'a ptyp =
104.371 + Ptyp of string * (*element within pblID*)
104.372 + 'a list * (*several pbts with different domIDs/thy
104.373 + TODO: select by subthy (isaref.p.69)
104.374 + presently only _ONE_ elem*)
104.375 + ('a ptyp) list; (*the children nodes*)
104.376 +
104.377 +(*.datatype for collecting thydata for hierarchy.*)
104.378 +(*WN060720 more consistent naming would be 'type thyelem' or 'thelem'*)
104.379 +(*WN0606 Htxt contains html which does not belong to the sml-kernel*)
104.380 +datatype thydata = Html of {guh: guh,
104.381 + coursedesign: authors,
104.382 + mathauthors: authors,
104.383 + html: string} (*html; for demos before database*)
104.384 + | Hthm of {guh: guh,
104.385 + coursedesign: authors,
104.386 + mathauthors: authors,
104.387 + thm: Thm.thm}
104.388 + | Hrls of {guh: guh,
104.389 + coursedesign: authors,
104.390 + mathauthors: authors,
104.391 + (*like vvvvvvvvvvvvv val ruleset'
104.392 + WN060711 redesign together !*)
104.393 + thy_rls: (thyID * rls)}
104.394 + | Hcal of {guh: guh,
104.395 + coursedesign: authors,
104.396 + mathauthors: authors,
104.397 + calc: calc}
104.398 + | Hord of {guh: guh,
104.399 + coursedesign: authors,
104.400 + mathauthors: authors,
104.401 + ord: (subst -> (term * term) -> bool)};
104.402 +val e_thydata = Html {guh="e_guh", coursedesign=[], mathauthors=[], html=""};
104.403 +
104.404 +type thehier = (thydata ptyp) list;
104.405 +val thehier = ref ([] : thehier);
104.406 +
104.407 +(*.an association list, gets the value once in Isac.ML.*)
104.408 +val isab_thm_thy = ref ([] : (thmID * (thyID * thm)) list);
104.409 +
104.410 +
104.411 +type path = string;
104.412 +type filename = string;
104.413 +
104.414 +(*val xxx = fn: a b => (a,b); ??? fun-definition ???*)
104.415 +local
104.416 + fun ii (_:term) = e_rrlsstate;
104.417 + fun no (_:term) = SOME (e_term,[e_term]);
104.418 + fun lo (_:rule list list) (_:term) (_:rule) = [(e_rule,(e_term,[e_term]))];
104.419 + fun ne (_:rule list list) (_:term) = SOME e_rule;
104.420 + fun fo (_:rule list list) (_:term) (_:term) = [(e_rule,(e_term,[e_term]))];
104.421 +in
104.422 +val e_rfuns = Rfuns {init_state=ii,normal_form=no,locate_rule=lo,
104.423 + next_rule=ne,attach_form=fo};
104.424 +end;
104.425 +
104.426 +val e_rls =
104.427 + Rls{id = "e_rls",
104.428 + preconds = [],
104.429 + rew_ord = ("dummy_ord", dummy_ord),
104.430 + erls = Erls,srls = Erls,
104.431 + calc = [],
104.432 + rules = [], scr = EmptyScr}:rls;
104.433 +val e_rrls = Rrls {id = "e_rrls",
104.434 + prepat = [],
104.435 + rew_ord = ("dummy_ord", dummy_ord),
104.436 + erls = Erls,
104.437 + calc = [],
104.438 + (*asm_thm=[],*)
104.439 + scr=e_rfuns}:rls;
104.440 +ruleset' := overwritel (!ruleset', [("e_rls",("Tools",e_rls)),
104.441 + ("e_rrls",("Tools",e_rrls))
104.442 + ]);
104.443 +
104.444 +fun rep_rls (Rls {id,preconds,rew_ord,erls,srls,calc,(*asm_thm,*)rules,scr}) =
104.445 + {id=id,preconds=preconds,rew_ord=rew_ord,erls=erls,srls=srls,calc=calc,
104.446 + (*asm_thm=asm_thm,*)rules=rules,scr=scr}
104.447 + | rep_rls (Seq {id,preconds,rew_ord,erls,srls,calc,(*asm_thm,*)rules,scr}) =
104.448 + {id=id,preconds=preconds,rew_ord=rew_ord,erls=erls,srls=srls,calc=calc,
104.449 + (*asm_thm=asm_thm,*)rules=rules,scr=scr}
104.450 + | rep_rls Erls = rep_rls e_rls
104.451 + | rep_rls (Rrls {id,...}) = rep_rls e_rls
104.452 + (*raise error("rep_rls doesn't take apart reverse-rewrite-rule-sets: "^id)*);
104.453 +(*| rep_rls (Seq {id,...}) =
104.454 + raise error("rep_rls doesn't take apart reverse-rewrite-rule-sets: "^id);
104.455 +--1.7.03*)
104.456 +fun rep_rrls
104.457 + (Rrls {id,(*asm_thm,*) calc, erls, prepat, rew_ord,
104.458 + scr=Rfuns
104.459 + {attach_form,init_state,locate_rule,
104.460 + next_rule,normal_form}}) =
104.461 + {id=id,(*asm_thm=asm_thm,*) calc=calc, erls=erls, prepat=prepat,
104.462 + rew_ord=rew_ord, attach_form=attach_form, init_state=init_state,
104.463 + locate_rule=locate_rule, next_rule=next_rule, normal_form=normal_form}
104.464 + | rep_rrls (Rls {id,...}) =
104.465 + raise error ("rep_rrls doesn't take apart (normal) rule-sets: "^id)
104.466 + | rep_rrls (Seq {id,...}) =
104.467 + raise error ("rep_rrls doesn't take apart (normal) rule-sets: "^id);
104.468 +
104.469 +fun append_rls id (Rls {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.470 + rules =rs,scr=sc}) r =
104.471 + (Rls{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.472 + rules = rs @ r,scr=sc}:rls)
104.473 + | append_rls id (Seq {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.474 + rules =rs,scr=sc}) r =
104.475 + (Seq{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.476 + rules = rs @ r,scr=sc}:rls)
104.477 + | append_rls id (Rrls _) _ =
104.478 + raise error ("append_rls: not for reverse-rewrite-rule-set "^id);
104.479 +
104.480 +(*. are _atomic_ rules equal ?.*)
104.481 +(*WN080102 compare eqrule ?!?*)
104.482 +fun eq_rule (Thm (thm1,_), Thm (thm2,_)) = thm1 = thm2
104.483 + | eq_rule (Calc (id1,_), Calc (id2,_)) = id1 = id2
104.484 + | eq_rule (Rls_ rls1, Rls_ rls2) = id_rls rls1 = id_rls rls2
104.485 + (*id_rls checks for Rls, Seq, Rrls*)
104.486 + | eq_rule _ = false;
104.487 +
104.488 +fun merge_rls _ Erls rls = rls
104.489 + | merge_rls _ rls Erls = rls
104.490 + | merge_rls id
104.491 + (Rls {id=id1,preconds=pc1,rew_ord=ro1,erls=er1,srls=sr1,calc=ca1,
104.492 + (*asm_thm=at1,*)rules =rs1,scr=sc1})
104.493 + (r2 as Rls {id=id2,preconds=pc2,rew_ord=ro2,erls=er2,srls=sr2,calc=ca2,
104.494 + (*asm_thm=at2,*)rules =rs2,scr=sc2}) =
104.495 + (Rls {id=id,preconds=pc1 @ ((#preconds o rep_rls) r2),
104.496 + rew_ord=ro1,erls=merge_rls "" er1 er2(*er1*),
104.497 + srls=merge_rls ("merged_"^id1^"_"^((#id o rep_rls) r2)) sr1
104.498 + ((#srls o rep_rls) r2),
104.499 + calc=ca1 @ ((#calc o rep_rls) r2),
104.500 + (*asm_thm=at1 @ ((#asm_thm o rep_rls) r2),*)
104.501 + rules = gen_union eq_rule rule2str (rs1, (#rules o rep_rls) r2),
104.502 + scr=sc1}:rls)
104.503 + | merge_rls id
104.504 + (Seq {id=id1,preconds=pc1,rew_ord=ro1,erls=er1,srls=sr1,calc=ca1,
104.505 + (*asm_thm=at1,*)rules =rs1,scr=sc1})
104.506 + (r2 as Seq {id=id2,preconds=pc2,rew_ord=ro2,erls=er2,srls=sr2,calc=ca2,
104.507 + (*asm_thm=at2,*)rules =rs2,scr=sc2}) =
104.508 + (Seq {id=id,preconds=pc1 @ ((#preconds o rep_rls) r2),
104.509 + rew_ord=ro1,erls=merge_rls "" er1 er2(*er1*),
104.510 + srls=merge_rls ("merged_"^id1^"_"^((#id o rep_rls) r2)) sr1
104.511 + ((#srls o rep_rls) r2),
104.512 + calc=ca1 @ ((#calc o rep_rls) r2),
104.513 + (*asm_thm=at1 @ ((#asm_thm o rep_rls) r2),*)
104.514 + rules = gen_union eq_rule rule2str (rs1, (#rules o rep_rls) r2),
104.515 + scr=sc1}:rls)
104.516 + | merge_rls _ _ _ =
104.517 + raise error "merge_rls: not for reverse-rewrite-rule-sets\
104.518 + \and not for mixed Rls -- Seq";
104.519 +fun remove_rls id (Rls {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.520 + (*asm_thm=at,*)rules =rs,scr=sc}) r =
104.521 + (Rls{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.522 + (*asm_thm=at,*)rules = gen_rems eq_rule (rs, r),
104.523 + scr=sc}:rls)
104.524 + | remove_rls id (Seq {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.525 + (*asm_thm=at,*)rules =rs,scr=sc}) r =
104.526 + (Seq{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
104.527 + (*asm_thm=at,*)rules = gen_rems eq_rule (rs, r),
104.528 + scr=sc}:rls)
104.529 + | remove_rls id (Rrls _) _ = raise error
104.530 + ("remove_rls: not for reverse-rewrite-rule-set "^id);
104.531 +
104.532 +(*!!!> gen_rems (op=) ([1,2,3,4], [3,4,5]);
104.533 +val it = [1, 2] : int list*)
104.534 +
104.535 +(*elder version: migrated 3 calls in smtest to memrls
104.536 +fun mem_rls id rls =
104.537 + case find_first ((curry op=) id) (map id_rule ((#rules o rep_rls) rls)) of
104.538 + SOME _ => true | NONE => false;*)
104.539 +fun memrls r (Rls {rules,...}) = gen_mem eqrule (r, rules)
104.540 + | memrls r (Seq {rules,...}) = gen_mem eqrule (r, rules)
104.541 + | memrls r _ = raise error ("memrls: incomplete impl. r= "^(rule2str r));
104.542 +fun rls_get_thm rls (id: xstring) =
104.543 + case find_first (curry eq_rule e_rule)
104.544 + ((#rules o rep_rls) rls) of
104.545 + SOME thm => SOME thm | NONE => NONE;
104.546 +
104.547 +fun assoc' ([], key) = raise error ("ME_Isa: '"^key^"' not known")
104.548 + | assoc' ((keyi, xi) :: pairs, key) =
104.549 + if key = keyi then SOME xi else assoc' (pairs, key);
104.550 +
104.551 +fun assoc_thy (thy:theory') = ((the o assoc')(!theory',thy))
104.552 + handle _ => raise error ("ME_Isa: thy '"^thy^"' not in system");
104.553 +(*.associate an rls-identifier with an rls; related to 'fun assoc_rls';
104.554 + these are NOT compatible to "fun assoc_thm'" in that they do NOT handle
104.555 + overlays by re-using an identifier in different thys.*)
104.556 +fun assoc_rls (rls:rls') = ((#2 o the o assoc')(!ruleset',rls))
104.557 + handle _ => raise error ("ME_Isa: '"^rls^"' not in system");
104.558 +(*fun assoc_rls (rls:rls') = ((the o assoc')(!ruleset',rls))
104.559 + handle _ => raise error ("ME_Isa: '"^rls^"' not in system");*)
104.560 +
104.561 +(*.overwrite an element in an association list and pair it with a thyID
104.562 + in order to create the thy_hierarchy;
104.563 + overwrites existing rls' even if they are defined in a different thy;
104.564 + this is related to assoc_rls, TODO.WN060120: assoc_rew_ord, assoc_calc;.*)
104.565 +(*WN060120 ...these are NOT compatible to "fun assoc_thm'" in that
104.566 + they do NOT handle overlays by re-using an identifier in different thys;
104.567 + "thyID.rlsID" would be a good solution, if the "." would be possible
104.568 + in scripts...
104.569 + actually a hack to get alltogether run again with minimal effort*)
104.570 +fun insthy thy' (rls', rls) = (rls', (thy', rls));
104.571 +fun overwritelthy thy (al, bl:(rls' * rls) list) =
104.572 + let val bl' = map (insthy ((get_thy o theory2theory') thy)) bl
104.573 + in overwritel (al, bl') end;
104.574 +
104.575 +fun assoc_rew_ord ro = ((the o assoc') (!rew_ord',ro))
104.576 + handle _ => raise error ("ME_Isa: rew_ord '"^ro^"' not in system");
104.577 +(*get the string for stac from rule*)
104.578 +fun assoc_calc ([], key) = raise error ("assoc_calc: '"^ key ^"' not found")
104.579 + | assoc_calc ((calc, (keyi, xi)) :: pairs, key) =
104.580 + if key = keyi then calc else assoc_calc (pairs, key);
104.581 +(*only used for !calclist'...*)
104.582 +fun assoc1 ([], key) = raise error ("assoc1 (for met.calc=): '"^ key
104.583 + ^"' not found")
104.584 + | assoc1 ((all as (keyi, _)) :: pairs, key) =
104.585 + if key = keyi then all else assoc1 (pairs, key);
104.586 +
104.587 +(*TODO.WN080102 clarify usage of type cal and type calc..*)
104.588 +fun calID2calcID (calID : calID) =
104.589 + let fun ass [] = raise error ("calID2calcID: "^calID^"not in calclist'")
104.590 + | ass ((calci, (cali, eval_fn))::ids) =
104.591 + if calID = cali then calci
104.592 + else ass ids
104.593 + in ass (!calclist') : calcID end;
104.594 +
104.595 +(*fun termopt2str (SOME t) =
104.596 + "SOME " ^ (Sign.string_of_term (sign_of(assoc_thy "Isac.thy")) t)
104.597 + | termopt2str NONE = "NONE";*)
104.598 +fun termopt2str (SOME t) =
104.599 + "SOME " ^ (Syntax.string_of_term (ctxt_Isac"") t)
104.600 + | termopt2str NONE = "NONE";
104.601 +fun term2str t = Syntax.string_of_term (ctxt_Isac"") t;
104.602 +fun terms2str ts= (strs2str o (map (Syntax.string_of_term
104.603 + (ctxt_Isac"")))) ts;
104.604 +(*fun type2str typ = Sign.string_of_typ (sign_of (assoc_thy "Isac.thy")) typ;*)
104.605 +fun type2str typ = Syntax.string_of_typ (ctxt_Isac"") typ;
104.606 +val string_of_typ = type2str;
104.607 +
104.608 +fun subst2str (s:subst) =
104.609 + (strs2str o
104.610 + (map (linefeed o pair2str o
104.611 + (apsnd term2str) o
104.612 + (apfst term2str)))) s;
104.613 +fun subst2str' (s:subst) =
104.614 + (strs2str' o
104.615 + (map (pair2str o
104.616 + (apsnd term2str) o
104.617 + (apfst term2str)))) s;
104.618 +(*> subst2str' [(str2term "bdv", str2term "x"),
104.619 + (str2term "bdv_2", str2term "y")];
104.620 +val it = "[(bdv, x)]" : string
104.621 +*)
104.622 +val env2str = subst2str;
104.623 +
104.624 +
104.625 +(*recursive defs:*)
104.626 +fun scr2str (Script s) = "Script "^(term2str s)
104.627 + | scr2str (Rfuns _) = "Rfuns";
104.628 +
104.629 +
104.630 +fun maxthy thy1 thy2 = if Theory.subthy (thy1, thy2) then thy2 else thy1;
104.631 +
104.632 +
104.633 +(*.trace internal steps of isac's rewriter*)
104.634 +val trace_rewrite = ref false;
104.635 +(*.depth of recursion in traces of the rewriter, if trace_rewrite:=true.*)
104.636 +val depth = ref 99999;
104.637 +(*.no of rewrites exceeding this int -> NO rewrite.*)
104.638 +(*WN060829 still unused...*)
104.639 +val lim_rewrite = ref 99999;
104.640 +(*.no of derivation-elements exceeding this int -> SOME derivation-elements.*)
104.641 +val lim_deriv = ref 100;
104.642 +(*.switch for checking guhs unique before storing a pbl or met;
104.643 + set true at startup (done at begin of ROOT.ML)
104.644 + set false for editing IsacKnowledge (done at end of ROOT.ML).*)
104.645 +val check_guhs_unique = ref false;
104.646 +
104.647 +
104.648 +datatype lrd = (*elements of a path (=loc_) into an Isabelle term*)
104.649 + L (*go left at $*)
104.650 + | R (*go right at $*)
104.651 + | D; (*go down at Abs*)
104.652 +type loc_ = lrd list;
104.653 +fun ldr2str L = "L"
104.654 + | ldr2str R = "R"
104.655 + | ldr2str D = "D";
104.656 +fun loc_2str (k:loc_) = (strs2str' o (map ldr2str)) k;
104.657 +
105.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
105.2 +++ b/src/Pure/isac/library.sml Wed Jul 21 13:53:39 2010 +0200
105.3 @@ -0,0 +1,325 @@
105.4 +(* use"library.sml";
105.5 + WN.22.10.99
105.6 + for both, math-engine and isa-98-1-HOL-plus
105.7 + however, functions closely related to original isabelle-98-1 functions
105.8 + are in isa-98-1-HOL-plus/rewrite-parse/library_G
105.9 +*)
105.10 +
105.11 +(* Isabelle2002 -> Isabelle2009 library changed:
105.12 +signature LIBRARY =
105.13 +sig
105.14 + include BASIC_LIBRARY
105.15 + val foldl: ('a * 'b -> 'a) -> 'a * 'b list -> 'a
105.16 + val foldr: ('a * 'b -> 'b) -> 'a list * 'b -> 'b
105.17 + val foldl_map: ('a * 'b -> 'a * 'c) -> 'a * 'b list -> 'a * 'c list
105.18 + val take: int * 'a list -> 'a list
105.19 + val drop: int * 'a list -> 'a list
105.20 + val last_elem: 'a list -> 'a
105.21 +end;
105.22 +FIXME: overwritten again...*)
105.23 +fun foldl (f: 'a * 'b -> 'a) : 'a * 'b list -> 'a = (*FIXME.2009*)
105.24 + let fun itl (e, []) = e
105.25 + | itl (e, a::l) = itl (f(e, a), l)
105.26 + in itl end;
105.27 +fun foldr f (l, e) = (*FIXME.2009*)
105.28 + let fun itr [] = e
105.29 + | itr (a::l) = f(a, itr l)
105.30 + in itr l end;
105.31 +fun take (n, []) = [] (*FIXME.2009*)
105.32 + | take (n, x :: xs) =
105.33 + if n > 0 then x :: take (n - 1, xs) else [];
105.34 +fun drop (n, []) = [] (*FIXME.2009*)
105.35 + | drop (n, x :: xs) =
105.36 + if n > 0 then drop (n - 1, xs) else x :: xs;
105.37 +(*exn LIST has disappeared in 2009 ... replaced by error...*)
105.38 +fun last_elem [] = raise error "last_elem" (*FIXME.2009*)
105.39 + | last_elem [x] = x
105.40 + | last_elem (_ :: xs) = last_elem xs;
105.41 +
105.42 +fun gen_mem eq (x, []) = false (*FIXME.2009*)
105.43 + | gen_mem eq (x, y :: ys) = eq (x, y) orelse gen_mem eq (x, ys);
105.44 +fun gen_insert (les : 'a * 'a -> bool) ([], a) = [a]
105.45 + | gen_insert les (x::xs, a) = if les (x, a) then x::(gen_insert les (xs, a))
105.46 + else a::x::xs;
105.47 +fun gen_sort les xs = foldl (gen_insert les) (xs, []);
105.48 +fun gen_distinct eq lst =
105.49 + let
105.50 + val memb = gen_mem eq;
105.51 +
105.52 + fun dist (rev_seen, []) = rev rev_seen
105.53 + | dist (rev_seen, x :: xs) =
105.54 + if memb (x, rev_seen) then dist (rev_seen, xs)
105.55 + else dist (x :: rev_seen, xs);
105.56 + in
105.57 + dist ([], lst)
105.58 + end;
105.59 +fun gen_rems eq (xs, ys) = filter_out (fn x => gen_mem eq (x, ys)) xs;
105.60 +fun distinct l = gen_distinct (op =) l;
105.61 +
105.62 +
105.63 +
105.64 +(*.see 'fun (y :: ys) \ x' in Pure/library.ML.*)
105.65 +fun gen_dif eq (y :: ys, x) = if eq (y, x) then ys
105.66 + else y :: (gen_dif eq (ys, x))
105.67 + | gen_dif eq ([], x) = [];
105.68 +(* val (eq, (y :: ys, x)) = ();*)
105.69 +
105.70 +(*.see 'fun ys \\ xs' in Pure/library.ML.*)
105.71 +fun gen_diff eq (ys, xs) = foldl (gen_dif eq) (ys,xs);
105.72 +(* val (eq, (ys, xs)) = (eq_thmI, (isacrlsthms, isacthms));
105.73 + *)
105.74 +(* gen_diff op= ([1,2,3,4,5,6,7],[2,3,5]);
105.75 +val it = [1, 4, 6, 7] : int list*)
105.76 +
105.77 +
105.78 +(*an indulgent version of Isabelle/src/Pure/library.ML ~~*)
105.79 +infix ~~~;
105.80 +fun xs ~~~ ys =
105.81 + let fun aaa xys [] [] = xys
105.82 + | aaa xys [] (y :: ys) = xys
105.83 + | aaa xys (x :: xs) [] = xys
105.84 + | aaa xys (x :: xs) (y :: ys) = aaa (xys @ [(x, y)]) xs ys
105.85 + in aaa [] xs ys end;
105.86 +(*[1,2,3] ~~~ ["1","2","3"];
105.87 +val it = [(1, "1"), (2, "2"), (3, "3")] : (int * string) list
105.88 +> [1,2] ~~~ ["1","2","3"];
105.89 +val it = [(1, "1"), (2, "2")] : (int * string) list
105.90 +> [1,2,3] ~~~ ["1","2"];
105.91 +val it = [(1, "1"), (2, "2")] : (int * string) list*)
105.92 +
105.93 +(*from Isabelle2002/src/Pure/library.ML; has changed in 2009 FIXME replace*)
105.94 +fun gen_ins eq (x, xs) = if gen_mem eq (x, xs) then xs else x :: xs;
105.95 +fun gen_insI eq pr (x, xs) =
105.96 + if gen_mem eq (x, xs)
105.97 + then (writeln ("### occurs twice: "^(pr x)); xs)
105.98 + else x :: xs;
105.99 +fun gen_union eq pr (xs, []) = xs
105.100 + | gen_union eq pr ([], ys) = ys
105.101 + | gen_union eq pr (x :: xs, ys) = gen_union eq pr (xs, gen_ins eq (x, ys));
105.102 +
105.103 +fun cons2 (f,g) x = (f x, g x); (*PL softwareparadigmen*)
105.104 +
105.105 +fun nth _ [] = raise error "nth _ []"
105.106 + | nth 1 (x::_) = x
105.107 + | nth n (_::xs) = nth (n-1) xs;
105.108 +(*WN050106 quick for test: doesn't check for exns*)
105.109 +fun drop_nth ls (_, []) = ls
105.110 + | drop_nth ls (n, x :: xs) =
105.111 + if n = 1
105.112 + then ls @ xs
105.113 + else drop_nth (ls @ [x]) (n - 1, xs);
105.114 +(*> drop_nth [] (3,[1,2,3,4,5]);
105.115 +val it = [1, 2, 4, 5] : int list
105.116 + > drop_nth [] (1,[1,2,3,4,5]);
105.117 +val it = [2, 3, 4, 5] : int list
105.118 + > drop_nth [] (5,[1,2,3,4,5]);
105.119 +val it = [1, 2, 3, 4] : int list *)
105.120 +
105.121 +fun and_ (b1,b2) = b1 andalso b2;(* ~/Design.98/ModelSpec.sml/library_G.sml *)
105.122 +fun or_ (b1,b2) = b1 orelse b2;
105.123 +
105.124 +
105.125 +fun takerest (i, ls) = (rev o take) (length ls - i, rev ls);
105.126 +(*> takerest (3, ["normalize","polynomial","univariate","equation"]);
105.127 +val it = ["equation"] : string list
105.128 +*)
105.129 +fun takelast (i, ls) = (rev o take) (i, rev ls);
105.130 +(* > takelast (2, ["normalize","polynomial","univariate","equation"]);
105.131 +val it = ["univariate", "equation"] : pblID
105.132 +> takelast (2, ["equation"]);
105.133 +val it = ["equation"] : pblID
105.134 +> takelast (3, ["normalize","polynomial","univariate","equation"]);
105.135 +val it = ["polynomial", "univariate", "equation"]*)
105.136 +fun split_nlast (i, ls) =
105.137 + let val rv = rev ls
105.138 + in (rev (takelast (i - 1, rv)), rev (take (i, rv))) end;
105.139 +
105.140 +fun split_nlast (i, ls) = (take (length ls - i, ls), rev (take (i, rev ls)));
105.141 +(* val (a, b) = split_nlast (3, ["a","b","[",".","]"]);
105.142 +val a = ["a", "b"] : string list
105.143 +val b = ["[", ".", "]"] : string list
105.144 +> val (a, b) = split_nlast (3, [".","]"]);
105.145 +val a = [] : string list
105.146 +val b = [".", "]"] : string list *)
105.147 +
105.148 +(*.analoguous to dropwhile in Pure/libarary.ML.*)
105.149 +fun dropwhile P [] = []
105.150 + | dropwhile P (ys as x::xs) = if P x then dropwhile P xs else ys;
105.151 +fun takewhile col P [] = col
105.152 + | takewhile col P (ys as x::xs) = if P x then takewhile (col @ [x]) P xs
105.153 + else col;
105.154 +(* > takewhile [] (not o (curry op= 4)) [1,2,3,4,5,6,7];
105.155 + val it = [1, 2, 3] : int list*)
105.156 +fun dropuntil P [] = []
105.157 + | dropuntil P (ys as x::xs) = if P x then ys else dropuntil P xs;
105.158 +
105.159 +
105.160 +
105.161 +fun pair2tri ((a,b),c) = (a,b,c);
105.162 +fun fst3 (a,_,_) = a;
105.163 +fun snd3 (_,b,_) = b;
105.164 +fun thd3 (_,_,c) = c;
105.165 +
105.166 +fun skip_blanks strl =
105.167 + let
105.168 + fun skip strl [] = strl
105.169 + | skip strl (" "::ss) = skip strl ss
105.170 + | skip strl ( s ::ss) = skip (strl @ [s]) ss
105.171 + in skip [] strl end;
105.172 +
105.173 +
105.174 +
105.175 +fun de_quote str =
105.176 + let fun scan ss' [] = ss'
105.177 + | scan ss' ("\""::ss) = scan ss' ss
105.178 + | scan ss' (s::ss) = scan (ss' @ [s]) ss;
105.179 + in (implode o (scan []) o explode) str end;
105.180 +(*> de_quote "\"d_d ?bdv (?u + ?v) = d_d ?bdv ?u + d_d ?bdv ?v\"";
105.181 +val it = "d_d ?bdv (?u + ?v) = d_d ?bdv ?u + d_d ?bdv ?v" : string*)
105.182 +
105.183 +
105.184 +
105.185 +(* conversions to (quoted) strings
105.186 + FIXME: rename *2str --> *2strq (quoted elems)
105.187 + now *2str' (elems NOT quoted) instead of *2str *)
105.188 +
105.189 +val commas = space_implode ",";
105.190 +
105.191 +fun strs2str strl = "[" ^ (commas (map quote strl)) ^ "]";
105.192 +(*> val str = strs2str ["123","asd"]; writeln str;
105.193 +val it = "[\"123\", \"asd\"]" : string
105.194 +"123", "asd"] *)
105.195 +fun strs2str' strl = "[" ^ (commas strl) ^ "]";
105.196 +fun list2str strl = "[" ^ (commas strl) ^ "]";
105.197 +(*> val str = list2str ["123","asd"]; writeln str;
105.198 +val str = "[123, asd]" : string
105.199 +[123, asd] *)
105.200 +fun spair2str (s1,s2) = "(" ^ (quote s1) ^ ", " ^ (quote s2) ^ ")";
105.201 +fun pair2str (s1,s2) = "(" ^ s1 ^ ", " ^ s2 ^ ")";
105.202 +(*16.11.00
105.203 +fun subs2str (subs:(string * string) list) =
105.204 + (list2str o (map pair2str)) subs;*)
105.205 +fun subs2str (subs: string list) = list2str subs;
105.206 +(*> val sss = ["(bdv,x)","(err,#0)"];
105.207 +> subs2str sss;
105.208 +val it = "[(bdv,x),(err,#0)]" : string*)
105.209 +fun subs2str' (subs:(string * string) list) = (*12.12.99???*)
105.210 + (list2str o (map pair2str)) subs;
105.211 +(*> val subs = subs2str [("bdv","x")]; writeln subs;
105.212 +val subs = "[(\"bdv\", \"x\")]" : string
105.213 +[("bdv", "x")] *)
105.214 +fun con2str land_lor = quote " &| ";
105.215 +val int2str = string_of_int;
105.216 +fun ints2str ints = (strs2str o (map string_of_int)) ints;
105.217 +fun ints2str' ints = (strs2str' o (map string_of_int)) ints;
105.218 +
105.219 +
105.220 +(* use"library.sml";
105.221 + *)
105.222 +
105.223 +
105.224 +(*needed in Isa + ME*)
105.225 +fun get_thy str =
105.226 + let fun get strl [] = strl
105.227 + | get strl ("."::ss) = strl
105.228 + | get strl ( s ::ss) = get (strl @ [s]) ss
105.229 + in implode( get [] (explode str)) end;
105.230 +
105.231 +fun strip_thy str =
105.232 + let fun strip bdVar [] = implode (rev bdVar)
105.233 + | strip bdVar ("."::_ ) = implode (rev bdVar)
105.234 + | strip bdVar (c ::cs) = strip (bdVar @[c]) cs
105.235 + in strip [] (rev(explode str)) end;
105.236 +
105.237 +fun id_of (Var ((id,ix),_)) = if ix=0 then id else id^(string_of_int ix)
105.238 + | id_of (Free (id ,_)) = id
105.239 + | id_of (Const(id ,_)) = id
105.240 + | id_of _ = ""; (* never such an identifier *)
105.241 +
105.242 +fun ids_of t =
105.243 + let fun con ss (Const (s,_)) = s::ss
105.244 + | con ss (Free (s,_)) = s::ss
105.245 + | con ss (Abs (s,_,b)) = s::(con ss b)
105.246 + | con ss (t1 $ t2) = (con ss t1) @ (con ss t2)
105.247 + | con ss _ = ss
105.248 + in map strip_thy ((distinct o (con [])) t) end;
105.249 +(*
105.250 +> val t = (term_of o the o (parse thy))
105.251 + "solve_univar (R, [univar, equation], no_met) (a = b + #1) a";
105.252 +> ids_of t;
105.253 +["solve'_univar","Pair","R","Cons","univar","equation","Nil",...]*)
105.254 +
105.255 +
105.256 +(*FIXME.WN090819 fun overwrite missing in ..2009/../library.ML*)
105.257 +fun overwrite (al, p as (key, _)) = (*FIXME.2009*)
105.258 + let fun over ((q as (keyi, _)) :: pairs) =
105.259 + if keyi = key then p :: pairs else q :: (over pairs)
105.260 + | over [] = [p]
105.261 + in over al end;
105.262 +fun overwritel (al, []) = al
105.263 + | overwritel (al, b::bl) = overwritel (overwrite (al, b), bl);
105.264 +(*> val aaa = [(1,11),(2,22),(3,33)];
105.265 +> overwritel (aaa, [(2,2222),(4,4444)]);
105.266 +val it = [(1,11),(2,2222),(3,33),(4,4444)] : (int * int) list*)
105.267 +
105.268 +
105.269 +local
105.270 +fun intsto1 0 = []
105.271 + | intsto1 n = (intsto1 (n-1)) @ [n]
105.272 +in
105.273 +fun intsto n = if n < 0 then (raise error "intsto < 0") else intsto1 n
105.274 +end;
105.275 +
105.276 +
105.277 +type 'a stack = 'a list;
105.278 +fun top ((x::xs):'a stack) = x
105.279 + | top _ = raise error "top called for empty list";
105.280 +fun pop ((x::xs):'a stack) = xs:'a stack
105.281 + | pop _ = raise error "pop called for empty list";
105.282 +fun push x (xs:'a stack) = x::xs:'a stack;
105.283 +
105.284 +
105.285 +fun drop_last l = ((rev o tl o rev) l);
105.286 +fun drop_last_n n l = rev (takerest (n, rev l));
105.287 +(*> drop_last_n 2 [1,2,3,4,5];
105.288 +val it = [1, 2, 3] : int list
105.289 +> drop_last_n 3 [1,2,3,4,5];
105.290 +val it = [1, 2] : int list
105.291 +> drop_last_n 7 [1,2,3,4,5];
105.292 +val it = [] : int list
105.293 +*)
105.294 +
105.295 +fun bool2str true = "true"
105.296 + | bool2str false = "false";
105.297 +
105.298 +(*.take elements from b to e including both.*)
105.299 +fun take_fromto from to l =
105.300 + if from > to then raise error ("take_fromto from="^string_of_int from^
105.301 + " > to="^string_of_int to)
105.302 + else drop (from - 1, take (to, l));
105.303 +(*> take_fromto 3 5 [1,2,3,4,5,6,7];
105.304 +val it = [3,4,5] : int list
105.305 +> take_fromto 3 3 [1,2,3,4,5,6,7];
105.306 +val it = [3] : int list*)
105.307 +
105.308 +
105.309 +fun idt str 0 = " "
105.310 + | idt str n = str ^ idt str (n-1);
105.311 +(*fun indt 0 = ""
105.312 + | indt n = " " ^ indt (n-1);---------does not terminate with negatives*)
105.313 +fun indt n = if n <= 0 then "" else " " ^ indt (n-1);
105.314 +fun indent 0 = ""
105.315 + | indent n = ". " ^ indent(n-1);
105.316 +
105.317 +fun dashs i = if 0<i then "-"^ dashs (i-1) else "";
105.318 +fun dots i = if 0<i then "."^ dots (i-1) else "";
105.319 +
105.320 +fun assoc ([], key) = NONE(*cp 2002 Pure/library.ML FIXXXME take AList.lookup*)
105.321 + | assoc ((keyi, xi) :: pairs, key) =
105.322 + if key = keyi then SOME xi else assoc (pairs, key);
105.323 +(*association list lookup, optimized version for strings*)
105.324 +fun assoc_string ([], (key:string)) = NONE
105.325 + | assoc_string ((keyi, xi) :: pairs, key) =
105.326 + if key = keyi then SOME xi else assoc_string (pairs, key);
105.327 +fun if_none NONE y = y (*cp from 2002 Pure/library.ML FIXXXME replace*)
105.328 + | if_none (SOME x) _ = x;
106.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
106.2 +++ b/src/Pure/isac/print_exn_G.sml Wed Jul 21 13:53:39 2010 +0200
106.3 @@ -0,0 +1,19 @@
106.4 +(* W.N.11.99
106.5 +
106.6 +use"print_exn_G.sml";
106.7 +*)
106.8 +
106.9 +
106.10 +fun print_exn_unit e =
106.11 + case e of
106.12 + PTREE str =>
106.13 + (writeln ("Exception PTREE raised:\n" ^ str))
106.14 +(* | SCRIPT str =>
106.15 + (writeln ("Exception SCRIPT raised:\n" ^ str))
106.16 + | TERM (msg,ts) =>
106.17 + (writeln ("Exception TERM raised:\n" ^ msg);
106.18 + seq (writeln o Sign.string_of_term sign) ts)*)
106.19 + | e => raise e;
106.20 +
106.21 +(*raises the exception in order to have a polymorphic type!*)
106.22 +fun print_exn_G e = (print_exn_unit e; raise e);
107.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
107.2 +++ b/src/Pure/isac/smltest/FE-interface/interface.sml Wed Jul 21 13:53:39 2010 +0200
107.3 @@ -0,0 +1,1349 @@
107.4 +(* tests the interface of isac's SML-kernel in accordance to
107.5 + java-tests/isac.bridge.
107.6 +
107.7 +WN050707 ... if true, the test ist marked with a \label referring
107.8 +to the same UC in isac-docu.tex as the JUnit testcase.
107.9 +use"../smltest/FE-interface/interface.sml";
107.10 +use"interface.sml";
107.11 + *)
107.12 +
107.13 + print_depth 3;
107.14 +
107.15 +"-----------------------------------------------------------------";
107.16 +"table of contents -----------------------------------------------";
107.17 +"-----------------------------------------------------------------";
107.18 +"within struct ---------------------------------------------------";
107.19 +"-----------------------------------------------------------------";
107.20 +"--------- encode ^ -> ^^^ ---------------------------------------";
107.21 +"-----------------------------------------------------------------";
107.22 +"exported from struct --------------------------------------------";
107.23 +"-----------------------------------------------------------------";
107.24 +"---------------- empty rootpbl ----------------------------------";
107.25 +"---------------- solve_linear as rootpbl FE ---------------------";
107.26 +"--------- inspect the CalcTree No.1 with Iterator No.2 ----------";
107.27 +"---------------- miniscript with mini-subpbl --------------------";
107.28 +"--------- miniscript with mini-subpbl AUTOCALCULATE Step 1-------";
107.29 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalc ----";
107.30 +"--------- solve_linear as rootpbl AUTOCALC CompleteHead/Calc ----";
107.31 +"--------- miniscript with mini-subpbl AUTOCALCULATE CompleteCalc-";
107.32 +"--------- miniscript with mini-subpbl AUTO CompleteCalcHead------";
107.33 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
107.34 +"--------- setContext..Thy ---------------------------------------";
107.35 +"--------- miniscript with mini-subpbl AUTOCALC CompleteToSubpbl -";
107.36 +"---------------- rat-eq + subpbl: no_met, NO solution dropped ---";
107.37 +"--------- tryMatchProblem, tryRefineProblem -------------------UC";
107.38 +"--------- modifyCalcHead, resetCalcHead, modelProblem ------------";
107.39 +"--------- maximum-example, UC: Modeling an example --------------";
107.40 +"--------- solve_linear from pbl-hierarchy -----------------------";
107.41 +"--------- solve_linear as in an algebra system (CAS)-------------";
107.42 +"--------- interSteps: on 'miniscript with mini-subpbl' ----------";
107.43 +"--------- getTactic, fetchApplicableTactics ---------------------";
107.44 +"--------- getAssumptions, getAccumulatedAsms --------------------";
107.45 +"--------- arbitrary combinations of steps -----------------------";
107.46 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} right--";
107.47 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} other--";
107.48 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} oth 2--";
107.49 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} NOTok--";
107.50 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} right----";
107.51 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other----";
107.52 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other 2--";
107.53 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} NOTok----";
107.54 +"-----------------------------------------------------------------";
107.55 +
107.56 +"within struct ---------------------------------------------------";
107.57 +"within struct ---------------------------------------------------";
107.58 +"within struct ---------------------------------------------------";
107.59 +(*==================================================================
107.60 +
107.61 +
107.62 +"--------- encode ^ -> ^^^ ---------------------------------------";
107.63 +"--------- encode ^ -> ^^^ ---------------------------------------";
107.64 +"--------- encode ^ -> ^^^ ---------------------------------------";
107.65 +if encode "a^2+b^2=c^2" = "a^^^2+b^^^2=c^^^2" then ()
107.66 +else raise error "interface.sml: diff.behav. in encode ^ -> ^^^ ";
107.67 +
107.68 +if (decode o encode) "a^2+b^2=c^2" = "a^2+b^2=c^2" then ()
107.69 +else raise error "interface.sml: diff.behav. in de/encode ^ <-> ^^^ ";
107.70 +
107.71 +==================================================================*)
107.72 +"exported from struct --------------------------------------------";
107.73 +"exported from struct --------------------------------------------";
107.74 +"exported from struct --------------------------------------------";
107.75 +
107.76 +
107.77 +(*------------ set at startup of the Kernel --------------------------*)
107.78 + states:= []; (*resets all state information in Kernel *)
107.79 +(*----------------------------------------------------------------*)
107.80 +
107.81 +"---------------- empty rootpbl ----------------------------------";
107.82 +"---------------- empty rootpbl ----------------------------------";
107.83 +"---------------- empty rootpbl ----------------------------------";
107.84 + CalcTree [([], ("", [], []))];
107.85 + Iterator 1;
107.86 + moveActiveRoot 1;
107.87 + refFormula 1 (get_pos 1 1);
107.88 +(*WN.040222: stoert das sehr, dass e_domID etc. statt leer kommt ???*)
107.89 +
107.90 +
107.91 +"---------------- solve_linear as rootpbl FE ---------------------";
107.92 +"---------------- solve_linear as rootpbl FE ---------------------";
107.93 +"---------------- solve_linear as rootpbl FE ---------------------";
107.94 + states := [];
107.95 + CalcTree (*start of calculation, return No.1*)
107.96 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
107.97 + ("Test.thy",
107.98 + ["linear","univariate","equation","test"],
107.99 + ["Test","solve_linear"]))];
107.100 + Iterator 1; (*create an active Iterator on CalcTree No.1*)
107.101 +
107.102 + moveActiveRoot 1;(*sets the CalcIterator No.1 at the root of CalcTree No.1*);
107.103 + refFormula 1 (get_pos 1 1) (*gets CalcHead; model is still empty*);
107.104 +
107.105 + fetchProposedTactic 1 (*by using Iterator No.1*);
107.106 + setNextTactic 1 (Model_Problem (*["linear","univariate","equation","test"]*));
107.107 + (*by using Iterator No.1*)
107.108 + autoCalculate 1 (Step 1);
107.109 + refFormula 1 (get_pos 1 1) (*model contains descriptions for all items*);
107.110 + autoCalculate 1 (Step 1);
107.111 +(*-----since Model_Problem + complete_mod_ in case cas of Some-----*
107.112 + fetchProposedTactic 1;
107.113 + setNextTactic 1 (Add_Given "equality (1 + -1 * 2 + x = 0)");
107.114 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1); (*equality added*);
107.115 +
107.116 + fetchProposedTactic 1;
107.117 + setNextTactic 1 (Add_Given "solveFor x");
107.118 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.119 +
107.120 + fetchProposedTactic 1;
107.121 + setNextTactic 1 (Add_Find "solutions L");
107.122 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.123 +
107.124 + fetchProposedTactic 1;
107.125 + setNextTactic 1 (Specify_Theory "Test.thy");
107.126 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.127 +*-----since Model_Problem + complete_mod_ in case cas of Some-----*)
107.128 +
107.129 + fetchProposedTactic 1;
107.130 + setNextTactic 1 (Specify_Problem ["linear","univariate","equation","test"]);
107.131 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.132 +(*-------------------------------------------------------------------------*)
107.133 + fetchProposedTactic 1;
107.134 + val (ptp as (pt,p), tacis) = get_calc 1; get_pos 1 1;
107.135 +
107.136 + setNextTactic 1 (Specify_Method ["Test","solve_linear"]);
107.137 + val (ptp as (pt,p), tacis) = get_calc 1; get_pos 1 1;
107.138 +
107.139 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.140 + val (ptp as (pt,p), tacis) = get_calc 1; get_pos 1 1;
107.141 +
107.142 +(*-------------------------------------------------------------------------*)
107.143 + fetchProposedTactic 1;
107.144 + val (ptp as (pt,p), tacis) = get_calc 1; get_pos 1 1;
107.145 +
107.146 + setNextTactic 1 (Apply_Method ["Test","solve_linear"]);
107.147 + val (ptp as (pt,p), tacis) = get_calc 1; get_pos 1 1;
107.148 + is_complete_mod ptp;
107.149 + is_complete_spec ptp;
107.150 +
107.151 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.152 + val (ptp as (pt,p), tacis) = get_calc 1; get_pos 1 1;
107.153 + (*term2str (get_obj g_form pt [1]);*)
107.154 +(*-------------------------------------------------------------------------*)
107.155 +
107.156 + fetchProposedTactic 1;
107.157 + setNextTactic 1 (Rewrite_Set_Inst (["(bdv,x)"], "isolate_bdv"));
107.158 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.159 +
107.160 + fetchProposedTactic 1;
107.161 + setNextTactic 1 (Rewrite_Set "Test_simplify");
107.162 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.163 +
107.164 + fetchProposedTactic 1;
107.165 + setNextTactic 1 (Check_Postcond ["linear","univariate","equation","test"]);
107.166 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.167 +
107.168 + val ((pt,_),_) = get_calc 1;
107.169 + val ip = get_pos 1 1;
107.170 + val (Form f, tac, asms) = pt_extract (pt, ip);
107.171 + (*exception just above means: 'ModSpec' has been returned: error anyway*)
107.172 + if term2str f = "[x = 1]" then () else
107.173 + raise error "FE-Kernel-interface.sml: diff.behav. in solve_linear as rootpbl";
107.174 +
107.175 +
107.176 +
107.177 +"--------- inspect the CalcTree No.1 with Iterator No.2 ---------";
107.178 +"--------- inspect the CalcTree No.1 with Iterator No.2 ---------";
107.179 +"--------- inspect the CalcTree No.1 with Iterator No.2 ---------";
107.180 +(*WN041118: inspection shifted to Iterator No.1, because others need pos'*)
107.181 + moveActiveRoot 1;
107.182 + refFormula 1 ([],Pbl); getTactic 1 ([],Pbl);(*Error*)
107.183 + moveActiveDown 1;
107.184 + refFormula 1 ([1],Frm); getTactic 1 ([1],Frm);(*Error*)
107.185 + moveActiveDown 1 ;
107.186 + refFormula 1 ([1],Res); getTactic 1 ([1],Res);(*OK*)
107.187 + (*getAssumption 1 ([1],Res); TODO.WN041217*)
107.188 + moveActiveDown 1 ; refFormula 1 ([2],Res);
107.189 + moveActiveCalcHead 1; refFormula 1 ([],Pbl);
107.190 + moveActiveDown 1;
107.191 + moveActiveDown 1;
107.192 + moveActiveDown 1;
107.193 + if get_pos 1 1 = ([2], Res) then () else
107.194 + raise error "FE-interface.sml: diff.behav. in a inspect 1 with Iterator 2";
107.195 + moveActiveDown 1; refFormula 1 ([], Res);
107.196 + if get_pos 1 1 = ([], Res) then () else
107.197 + raise error "FE-interface.sml: diff.behav. in b inspect 1 with Iterator 2";
107.198 + moveActiveCalcHead 1; refFormula 1 ([],Pbl);
107.199 +
107.200 +
107.201 +
107.202 +"---------------- miniscript with mini-subpbl --------------------";
107.203 +"---------------- miniscript with mini-subpbl --------------------";
107.204 +"---------------- miniscript with mini-subpbl --------------------";
107.205 + states:=[];
107.206 + CalcTree (*start of calculation, return No.1*)
107.207 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.208 + ("Test.thy",
107.209 + ["sqroot-test","univariate","equation","test"],
107.210 + ["Test","squ-equ-test-subpbl1"]))];
107.211 + Iterator 1;
107.212 +
107.213 + moveActiveRoot 1;
107.214 + refFormula 1 (get_pos 1 1);
107.215 + fetchProposedTactic 1;
107.216 + setNextTactic 1 (Model_Problem);
107.217 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*gets ModSpec;model is still empty*)
107.218 +
107.219 + fetchProposedTactic 1;
107.220 + setNextTactic 1 (Add_Given "equality (x + 1 = 2)");
107.221 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.222 +
107.223 + fetchProposedTactic 1;
107.224 + setNextTactic 1 (Add_Given "solveFor x");
107.225 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.226 +
107.227 + fetchProposedTactic 1;
107.228 + setNextTactic 1 (Add_Find "solutions L");
107.229 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.230 +
107.231 + fetchProposedTactic 1;
107.232 + setNextTactic 1 (Specify_Theory "Test.thy");
107.233 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.234 +
107.235 + fetchProposedTactic 1;
107.236 + setNextTactic 1 (Specify_Problem
107.237 + ["sqroot-test","univariate","equation","test"]);
107.238 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.239 +"1-----------------------------------------------------------------";
107.240 +
107.241 + fetchProposedTactic 1;
107.242 + setNextTactic 1 (Specify_Method ["Test","squ-equ-test-subpbl1"]);
107.243 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.244 +
107.245 + fetchProposedTactic 1;
107.246 + setNextTactic 1 (Apply_Method ["Test","squ-equ-test-subpbl1"]);
107.247 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.248 +
107.249 + fetchProposedTactic 1;
107.250 + setNextTactic 1 (Rewrite_Set "norm_equation");
107.251 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.252 +
107.253 + fetchProposedTactic 1;
107.254 + setNextTactic 1 (Rewrite_Set "Test_simplify");
107.255 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.256 +
107.257 + fetchProposedTactic 1;(*----------------Subproblem--------------------*);
107.258 + setNextTactic 1 (Subproblem ("Test.thy",
107.259 + ["linear","univariate","equation","test"]));
107.260 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.261 +
107.262 + fetchProposedTactic 1;
107.263 + setNextTactic 1 (Model_Problem );
107.264 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.265 +
107.266 + fetchProposedTactic 1;
107.267 + setNextTactic 1 (Add_Given "equality (-1 + x = 0)");
107.268 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.269 +
107.270 + fetchProposedTactic 1;
107.271 + setNextTactic 1 (Add_Given "solveFor x");
107.272 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.273 +
107.274 + fetchProposedTactic 1;
107.275 + setNextTactic 1 (Add_Find "solutions x_i");
107.276 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.277 +
107.278 + fetchProposedTactic 1;
107.279 + setNextTactic 1 (Specify_Theory "Test.thy");
107.280 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.281 +
107.282 + fetchProposedTactic 1;
107.283 + setNextTactic 1 (Specify_Problem ["linear","univariate","equation","test"]);
107.284 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.285 +"2-----------------------------------------------------------------";
107.286 +
107.287 + fetchProposedTactic 1;
107.288 + setNextTactic 1 (Specify_Method ["Test","solve_linear"]);
107.289 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.290 +
107.291 + fetchProposedTactic 1;
107.292 + setNextTactic 1 (Apply_Method ["Test","solve_linear"]);
107.293 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.294 +
107.295 + fetchProposedTactic 1;
107.296 + setNextTactic 1 (Rewrite_Set_Inst (["(bdv,x)"], "isolate_bdv"));
107.297 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.298 +
107.299 + fetchProposedTactic 1;
107.300 + setNextTactic 1 (Rewrite_Set "Test_simplify");
107.301 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.302 +
107.303 + fetchProposedTactic 1;
107.304 + setNextTactic 1 (Check_Postcond ["linear","univariate","equation","test"]);
107.305 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.306 +
107.307 + fetchProposedTactic 1;
107.308 + setNextTactic 1 (Check_elementwise "Assumptions");
107.309 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.310 +
107.311 + val xml = fetchProposedTactic 1;
107.312 + setNextTactic 1 (Check_Postcond
107.313 + ["sqroot-test","univariate","equation","test"]);
107.314 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.315 +
107.316 + val ((pt,_),_) = get_calc 1;
107.317 + val str = pr_ptree pr_short pt;
107.318 + writeln str;
107.319 + val ip = get_pos 1 1;
107.320 + val (Form f, tac, asms) = pt_extract (pt, ip);
107.321 + (*exception just above means: 'ModSpec' has been returned: error anyway*)
107.322 + if term2str f = "[x = 1]" then () else
107.323 + raise error "FE-interface.sml: diff.behav. in miniscript with mini-subpb";
107.324 +
107.325 + DEconstrCalcTree 1;
107.326 +
107.327 +
107.328 +"--------- miniscript with mini-subpbl AUTOCALCULATE Step 1-------";
107.329 +"--------- miniscript with mini-subpbl AUTOCALCULATE Step 1-------";
107.330 +"--------- miniscript with mini-subpbl AUTOCALCULATE Step 1-------";
107.331 + states:=[];
107.332 + CalcTree
107.333 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.334 + ("Test.thy",
107.335 + ["sqroot-test","univariate","equation","test"],
107.336 + ["Test","squ-equ-test-subpbl1"]))];
107.337 + Iterator 1;
107.338 + moveActiveRoot 1;
107.339 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.340 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.341 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.342 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.343 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.344 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.345 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.346 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.347 + (*here the solve-phase starts*)
107.348 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.349 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.350 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.351 + (*------------------------------------*)
107.352 +(* print_depth 13; get_calc 1;
107.353 + *)
107.354 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.355 + (*calc-head of subproblem*)
107.356 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.357 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.358 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.359 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.360 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.361 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.362 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.363 + (*solve-phase of the subproblem*)
107.364 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.365 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.366 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.367 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.368 + (*finish subproblem*)
107.369 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.370 + (*finish problem*)
107.371 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.372 +
107.373 + (*this checks the test for correctness..*)
107.374 + val ((pt,_),_) = get_calc 1;
107.375 + val p = get_pos 1 1;
107.376 + val (Form f, tac, asms) = pt_extract (pt, p);
107.377 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.378 + raise error "FE-interface.sml: diff.behav. in miniscript with mini-subpb";
107.379 +
107.380 + DEconstrCalcTree 1;
107.381 +
107.382 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalc ----";
107.383 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalc ----";
107.384 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalc ----";
107.385 + states:=[];
107.386 + CalcTree
107.387 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
107.388 + ("Test.thy",
107.389 + ["linear","univariate","equation","test"],
107.390 + ["Test","solve_linear"]))];
107.391 + Iterator 1;
107.392 + moveActiveRoot 1;
107.393 +getFormulaeFromTo 1 ([],Pbl) ([],Pbl) 999 false;
107.394 +
107.395 + autoCalculate 1 CompleteCalc;
107.396 + val (unc, del, gen) = (([],Pbl), ([],Pbl), ([],Res));
107.397 + getFormulaeFromTo 1 unc gen 1 (*only level 1*) false;
107.398 +
107.399 + val ((pt,_),_) = get_calc 1;
107.400 + val p = get_pos 1 1;
107.401 + val (Form f, tac, asms) = pt_extract (pt, p);
107.402 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.403 + raise error "FE-interface.sml: diff.behav. in solve_linear/rt AUTOCALCULATE ";
107.404 +
107.405 +
107.406 +"--------- solve_linear as rootpbl AUTOCALC CompleteHead/Calc ----";
107.407 +"--------- solve_linear as rootpbl AUTOCALC CompleteHead/Calc ----";
107.408 +"--------- solve_linear as rootpbl AUTOCALC CompleteHead/Calc ----";
107.409 + states:=[];
107.410 + CalcTree
107.411 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
107.412 + ("Test.thy",
107.413 + ["linear","univariate","equation","test"],
107.414 + ["Test","solve_linear"]))];
107.415 + Iterator 1;
107.416 + moveActiveRoot 1;
107.417 + autoCalculate 1 CompleteCalcHead;
107.418 + refFormula 1 (get_pos 1 1);
107.419 + val ((pt,p),_) = get_calc 1;
107.420 +
107.421 +
107.422 +
107.423 + autoCalculate 1 CompleteCalc;
107.424 + val ((pt,p),_) = get_calc 1;
107.425 + if p=([], Res) then () else
107.426 + raise error "FE-interface.sml: diff.behav. in solve_linear AUTOC Head/Calc ";
107.427 +
107.428 +
107.429 +"--------- miniscript with mini-subpbl AUTOCALCULATE CompleteCalc-";
107.430 +"--------- miniscript with mini-subpbl AUTOCALCULATE CompleteCalc-";
107.431 +"--------- miniscript with mini-subpbl AUTOCALCULATE CompleteCalc-";
107.432 + states:=[];
107.433 + CalcTree
107.434 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.435 + ("Test.thy",
107.436 + ["sqroot-test","univariate","equation","test"],
107.437 + ["Test","squ-equ-test-subpbl1"]))];
107.438 + Iterator 1;
107.439 + moveActiveRoot 1;
107.440 + autoCalculate 1 CompleteCalc;
107.441 +
107.442 +(*
107.443 +getTactic 1 ([1],Frm);
107.444 +getTactic 1 ([1],Res);
107.445 +initContext 1 Thy_ ([1],Res);
107.446 +*)
107.447 +
107.448 + (*... returns calcChangedEvent with*)
107.449 + val (unc, del, gen) = (([],Pbl), ([],Pbl), ([],Res));
107.450 + getFormulaeFromTo 1 unc gen 0 (*only result*) false;
107.451 + getFormulaeFromTo 1 unc gen 1 (*only level 1*) false;
107.452 + getFormulaeFromTo 1 unc gen 99999 (*all levels*) false;
107.453 +
107.454 + val ((pt,_),_) = get_calc 1;
107.455 + val p = get_pos 1 1;
107.456 + val (Form f, tac, asms) = pt_extract (pt, p);
107.457 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.458 + raise error "FE-interface.sml: diff.behav. in mini-subpbl AUTOCALCULATE 6";
107.459 +
107.460 +
107.461 +"--------- miniscript with mini-subpbl AUTO CompleteCalcHead------";
107.462 +"--------- miniscript with mini-subpbl AUTO CompleteCalcHead------";
107.463 +"--------- miniscript with mini-subpbl AUTO CompleteCalcHead------";
107.464 + states:=[];
107.465 + CalcTree
107.466 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.467 + ("Test.thy",
107.468 + ["sqroot-test","univariate","equation","test"],
107.469 + ["Test","squ-equ-test-subpbl1"]))];
107.470 + Iterator 1;
107.471 +(* doesn't terminate !!!
107.472 + autoCalculate 1 CompleteCalcHead;
107.473 +*)
107.474 +
107.475 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
107.476 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
107.477 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
107.478 + states:=[];
107.479 + CalcTree
107.480 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
107.481 + ("Test.thy",
107.482 + ["linear","univariate","equation","test"],
107.483 + ["Test","solve_linear"]))];
107.484 + Iterator 1;
107.485 + moveActiveRoot 1;
107.486 + autoCalculate 1 CompleteModel;
107.487 + refFormula 1 (get_pos 1 1);
107.488 +
107.489 +setProblem 1 ["linear","univariate","equation","test"];
107.490 +val pos = get_pos 1 1;
107.491 +setContext 1 pos (kestoreID2guh Pbl_["linear","univariate","equation","test"]);
107.492 + refFormula 1 (get_pos 1 1);
107.493 +
107.494 +setMethod 1 ["Test","solve_linear"];
107.495 +setContext 1 pos (kestoreID2guh Met_ ["Test","solve_linear"]);
107.496 + refFormula 1 (get_pos 1 1);
107.497 + val ((pt,_),_) = get_calc 1;
107.498 + if get_obj g_spec pt [] = ("e_domID",
107.499 + ["linear", "univariate","equation","test"],
107.500 + ["Test","solve_linear"]) then ()
107.501 + else raise error "FE-interface.sml: diff.behav. in setProblem, setMethod";
107.502 +
107.503 + autoCalculate 1 CompleteCalcHead;
107.504 + refFormula 1 (get_pos 1 1);
107.505 + autoCalculate 1 CompleteCalc;
107.506 + moveActiveDown 1;
107.507 + moveActiveDown 1;
107.508 + moveActiveDown 1;
107.509 + refFormula 1 (get_pos 1 1);
107.510 + val ((pt,_),_) = get_calc 1;
107.511 + val p = get_pos 1 1;
107.512 + val (Form f, tac, asms) = pt_extract (pt, p);
107.513 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.514 + raise error "FE-interface.sml: diff.behav. in mini-subpbl AUTOCALCULATE 6";
107.515 +
107.516 +
107.517 +"--------- setContext..Thy ---------------------------------------";
107.518 +"--------- setContext..Thy ---------------------------------------";
107.519 +"--------- setContext..Thy ---------------------------------------";
107.520 +states:=[];
107.521 +CalcTree
107.522 +[(["equality (x+1=2)", "solveFor x","solutions L"],
107.523 + ("Test.thy",
107.524 + ["sqroot-test","univariate","equation","test"],
107.525 + ["Test","squ-equ-test-subpbl1"]))];
107.526 +Iterator 1; moveActiveRoot 1;
107.527 +autoCalculate 1 CompleteCalcHead;
107.528 +autoCalculate 1 (Step 1);
107.529 +val ((pt,p),_) = get_calc 1; show_pt pt;
107.530 +(*
107.531 +setNextTactic 1 (Rewrite_Set "Test_simplify");
107.532 +autoCalculate 1 (Step 1);
107.533 +val ((pt,p),_) = get_calc 1; show_pt pt;
107.534 +*)
107.535 +"-----^^^^^ and vvvvv do the same -----";
107.536 +setContext 1 p "thy_isac_Test-rls-Test_simplify";
107.537 +val ((pt,p),_) = get_calc 1; show_pt pt;
107.538 +
107.539 +autoCalculate 1 (Step 1);
107.540 +setContext 1 p "thy_isac_Test-rls-Test_simplify";
107.541 +val ((pt,p),_) = get_calc 1; show_pt pt;
107.542 +
107.543 +autoCalculate 1 CompleteCalc;
107.544 +
107.545 +
107.546 +
107.547 +"--------- miniscript with mini-subpbl AUTOCALC CompleteToSubpbl -";
107.548 +"--------- miniscript with mini-subpbl AUTOCALC CompleteToSubpbl -";
107.549 +"--------- miniscript with mini-subpbl AUTOCALC CompleteToSubpbl -";
107.550 + states:=[];
107.551 + CalcTree
107.552 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.553 + ("Test.thy",
107.554 + ["sqroot-test","univariate","equation","test"],
107.555 + ["Test","squ-equ-test-subpbl1"]))];
107.556 + Iterator 1; moveActiveRoot 1;
107.557 + autoCalculate 1 CompleteToSubpbl;
107.558 + refFormula 1 (get_pos 1 1); (*<ISA> -1 + x = 0 </ISA>*);
107.559 + val ((pt,_),_) = get_calc 1;
107.560 + val str = pr_ptree pr_short pt;
107.561 + writeln str;
107.562 + if str = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n"
107.563 + then () else
107.564 + raise error "FE-interface.sml: diff.behav. in mini-subpbl CompleteToSubpbl-1";
107.565 +
107.566 + autoCalculate 1 (Step 1); (*proceeds only, of NOT 1 step before subplb*)
107.567 + autoCalculate 1 CompleteToSubpbl;
107.568 + val ((pt,_),_) = get_calc 1;
107.569 + val str = pr_ptree pr_short pt;
107.570 + writeln str;
107.571 + autoCalculate 1 CompleteCalc; (*das geht ohnehin !*);
107.572 + val ((pt,_),_) = get_calc 1;
107.573 + val p = get_pos 1 1;
107.574 + val (Form f, tac, asms) = pt_extract (pt, p);
107.575 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.576 + raise error "FE-interface.sml: diff.behav. in mini-subpbl CompleteToSubpbl 1";
107.577 +
107.578 +
107.579 +
107.580 +"---------------- rat-eq + subpbl: no_met, NO solution dropped ---";
107.581 +"---------------- rat-eq + subpbl: no_met, NO solution dropped ---";
107.582 +"---------------- rat-eq + subpbl: no_met, NO solution dropped ---";
107.583 + states:=[];
107.584 + CalcTree
107.585 + [(["equality ((5*x)/(x - 2) - x/(x+2)=4)", "solveFor x","solutions L"],
107.586 + ("RatEq.thy", ["univariate","equation"], ["no_met"]))];
107.587 + Iterator 1;
107.588 + moveActiveRoot 1;
107.589 + fetchProposedTactic 1;
107.590 + setNextTactic 1 (Model_Problem );
107.591 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.592 +(*-----since Model_Problem + complete_mod_ in case cas of Some-----*
107.593 + setNextTactic 1 (Add_Given "equality (5 * x / (x - 2) - x / (x + 2) = 4)");
107.594 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.595 + setNextTactic 1 (Add_Given "solveFor x");
107.596 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.597 + setNextTactic 1 (Add_Find "solutions L");
107.598 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.599 +*-----since Model_Problem + complete_mod_ in case cas of Some-----*)
107.600 + setNextTactic 1 (Specify_Theory "RatEq.thy");
107.601 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.602 + setNextTactic 1 (Specify_Problem ["rational","univariate","equation"]);
107.603 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.604 + setNextTactic 1 (Specify_Method ["RatEq","solve_rat_equation"]);
107.605 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.606 + setNextTactic 1 (Apply_Method ["RatEq","solve_rat_equation"]);
107.607 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.608 + setNextTactic 1 (Rewrite_Set "RatEq_simplify");
107.609 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.610 + setNextTactic 1 (Rewrite_Set "norm_Rational");
107.611 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.612 + setNextTactic 1 (Rewrite_Set "RatEq_eliminate");
107.613 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.614 + (* __________ for "12 * x + 4 * x ^^^ 2 = 4 * (-4 + x ^^^ 2)"*)
107.615 + setNextTactic 1 (Subproblem ("PolyEq.thy", ["normalize","polynomial",
107.616 + "univariate","equation"]));
107.617 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.618 + setNextTactic 1 (Model_Problem );
107.619 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.620 +(*-----since Model_Problem + complete_mod_ in case cas of Some-----*
107.621 + setNextTactic 1 (Add_Given
107.622 + "equality (12 * x + 4 * x ^^^ 2 = 4 * (-4 + x ^^^ 2))");
107.623 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.624 + setNextTactic 1 (Add_Given "solveFor x");
107.625 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.626 + setNextTactic 1 (Add_Find "solutions x_i");
107.627 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.628 +*-----since Model_Problem + complete_mod_ in case cas of Some-----*)
107.629 + setNextTactic 1 (Specify_Theory "PolyEq.thy");
107.630 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.631 + setNextTactic 1 (Specify_Problem ["normalize","polynomial",
107.632 + "univariate","equation"]);
107.633 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.634 + setNextTactic 1 (Specify_Method ["PolyEq","normalize_poly"]);
107.635 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.636 + setNextTactic 1 (Apply_Method ["PolyEq","normalize_poly"]);
107.637 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.638 + setNextTactic 1 (Rewrite ("all_left",""));
107.639 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.640 + setNextTactic 1 (Rewrite_Set_Inst (["(bdv,x)"], "make_ratpoly_in"));
107.641 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.642 + (* __________ for "16 + 12 * x = 0"*)
107.643 + setNextTactic 1 (Subproblem ("PolyEq.thy",
107.644 + ["degree_1","polynomial","univariate","equation"]));
107.645 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.646 + setNextTactic 1 (Model_Problem );
107.647 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.648 +(*-----since Model_Problem + complete_mod_ in case cas of Some-----*
107.649 + setNextTactic 1 (Add_Given
107.650 + "equality (16 + 12 * x = 0)");
107.651 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.652 + setNextTactic 1 (Add_Given "solveFor x");
107.653 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.654 + setNextTactic 1 (Add_Find "solutions x_i");
107.655 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.656 +*-----since Model_Problem + complete_mod_ in case cas of Some-----*)
107.657 + setNextTactic 1 (Specify_Theory "PolyEq.thy");
107.658 + (*------------- some trials in the problem-hierarchy ---------------*)
107.659 + setNextTactic 1 (Specify_Problem ["linear","univariate","equation"]);
107.660 + autoCalculate 1 (Step 1); fetchProposedTactic 1; (*<ERROR> helpless </ERROR> !!!*)
107.661 + setNextTactic 1 (Refine_Problem ["univariate","equation"]);
107.662 +
107.663 +
107.664 +
107.665 +
107.666 +
107.667 + (*------------------------------------------------------------------*)
107.668 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.669 + setNextTactic 1 (Specify_Method ["PolyEq","solve_d1_polyeq_equation"]);
107.670 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.671 + setNextTactic 1 (Apply_Method ["PolyEq","solve_d1_polyeq_equation"]);
107.672 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.673 + setNextTactic 1 (Rewrite_Set_Inst (["(bdv,x)"], "d1_polyeq_simplify"));
107.674 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.675 + setNextTactic 1 (Rewrite_Set "polyeq_simplify");
107.676 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.677 + (*==================================================================*)
107.678 + setNextTactic 1 Or_to_List;
107.679 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.680 + setNextTactic 1 (Check_elementwise "Assumptions");
107.681 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.682 + setNextTactic 1 (Check_Postcond ["degree_1","polynomial",
107.683 + "univariate","equation"]);
107.684 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.685 + setNextTactic 1 (Check_Postcond ["normalize","polynomial",
107.686 + "univariate","equation"]);
107.687 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.688 + setNextTactic 1 (Check_elementwise "Assumptions");
107.689 + autoCalculate 1 (Step 1); fetchProposedTactic 1;
107.690 + setNextTactic 1 (Check_Postcond ["rational","univariate","equation"]);
107.691 + val (ptp,_) = get_calc 1;
107.692 + val (Form t,_,_) = pt_extract ptp;
107.693 + if get_pos 1 1 = ([], Res) andalso term2str t = "[x = -4 / 3]" then ()
107.694 + else writeln "FE-inteface.sml: diff.behav. in rat-eq + subpbl: no_met, NO ..";
107.695 +
107.696 +
107.697 +"---------------- tryMatchProblem, tryRefineProblem --------------";
107.698 +"---------------- tryMatchProblem, tryRefineProblem --------------";
107.699 +"---------------- tryMatchProblem, tryRefineProblem --------------";
107.700 +(*{\bf\UC{Having \isac{} Refine the Problem
107.701 + * Automatically}\label{SPECIFY:refine-auto}\\} test match and refine with
107.702 + * x^^^2 + 4*x + 5 = 2
107.703 +see isac.bridge.TestSpecify#testMatchRefine*)
107.704 + DEconstrCalcTree 1;
107.705 + CalcTree
107.706 + [(["equality (x^2 + 4*x + 5 = 2)", "solveFor x","solutions L"],
107.707 + ("Isac.thy",
107.708 + ["univariate","equation"],
107.709 + ["no_met"]))];
107.710 + Iterator 1;
107.711 + moveActiveRoot 1;
107.712 +
107.713 + fetchProposedTactic 1;
107.714 + setNextTactic 1 (Model_Problem );
107.715 + (*..this tactic should be done 'tacitly', too !*)
107.716 +
107.717 +(*
107.718 +autoCalculate 1 CompleteCalcHead;
107.719 +checkContext 1 ([],Pbl) "pbl_equ_univ";
107.720 +checkContext 1 ([],Pbl) (kestoreID2guh Pbl_ ["univariate","equation"]);
107.721 +*)
107.722 +
107.723 + autoCalculate 1 (Step 1);
107.724 +
107.725 + fetchProposedTactic 1;
107.726 + setNextTactic 1 (Add_Given "equality (x ^^^ 2 + 4 * x + 5 = 2)");
107.727 + autoCalculate 1 (Step 1);
107.728 +
107.729 + "--------- we go into the ProblemBrowser (_NO_ pblID selected) -";
107.730 +initContext 1 Pbl_ ([],Pbl);
107.731 +initContext 1 Met_ ([],Pbl);
107.732 +
107.733 + "--------- this match will show some incomplete items: ---------";
107.734 +checkContext 1 ([],Pbl) (kestoreID2guh Pbl_ ["univariate","equation"]);
107.735 +checkContext 1 ([],Pbl) (kestoreID2guh Met_ ["LinEq", "solve_lineq_equation"]);
107.736 +
107.737 +
107.738 + fetchProposedTactic 1;
107.739 + setNextTactic 1 (Add_Given "solveFor x"); autoCalculate 1 (Step 1);
107.740 +
107.741 + fetchProposedTactic 1;
107.742 + setNextTactic 1 (Add_Find "solutions L"); autoCalculate 1 (Step 1);
107.743 +
107.744 + "--------- this is a matching model (all items correct): -------";
107.745 +checkContext 1 ([],Pbl) (kestoreID2guh Pbl_ ["univariate","equation"]);
107.746 + "--------- this is a NOT matching model (some 'false': ---------";
107.747 +checkContext 1 ([],Pbl)(kestoreID2guh Pbl_["linear","univariate","equation"]);
107.748 +
107.749 + "--------- find out a matching problem: ------------------------";
107.750 + "--------- find out a matching problem (FAILING: no new pbl) ---";
107.751 + refineProblem 1([],Pbl)(pblID2guh ["linear","univariate","equation"]);
107.752 +
107.753 + "--------- find out a matching problem (SUCCESSFUL) ------------";
107.754 + refineProblem 1 ([],Pbl) (pblID2guh ["univariate","equation"]);
107.755 +
107.756 + "--------- tryMatch, tryRefine did not change the calculation -";
107.757 + "--------- this is done by <TRANSFER> on the pbl-browser: ------";
107.758 + setNextTactic 1 (Specify_Problem ["normalize","polynomial",
107.759 + "univariate","equation"]);
107.760 + autoCalculate 1 (Step 1);
107.761 +(*WN050904 fetchProposedTactic again --> Specify_Problem ["normalize",...
107.762 + and Specify_Theory skipped in comparison to below ---^^^-inserted *)
107.763 +(*------------vvv-inserted-----------------------------------------------*)
107.764 + fetchProposedTactic 1;
107.765 + setNextTactic 1 (Specify_Problem ["normalize","polynomial",
107.766 + "univariate","equation"]);
107.767 + autoCalculate 1 (Step 1);
107.768 +
107.769 +(*and Specify_Theory skipped by fetchProposedTactic ?!?*)
107.770 +
107.771 + fetchProposedTactic 1;
107.772 + setNextTactic 1 (Specify_Method ["PolyEq","normalize_poly"]);
107.773 + autoCalculate 1 (Step 1);
107.774 +
107.775 + fetchProposedTactic 1;
107.776 + setNextTactic 1 (Apply_Method ["PolyEq","normalize_poly"]);
107.777 + autoCalculate 1 CompleteCalc;
107.778 + val ((pt,_),_) = get_calc 1;
107.779 + show_pt pt;
107.780 + val p = get_pos 1 1;
107.781 + val (Form f, tac, asms) = pt_extract (pt, p);
107.782 + if term2str f = "[x = -1, x = -3]" andalso p = ([], Res) then () else
107.783 + raise error "FE-interface.sml: diff.behav. in tryMatchProblem, tryRefine";
107.784 +
107.785 +(*------------^^^-inserted-----------------------------------------------*)
107.786 +(*WN050904 the fetchProposedTactic's below may not have worked like that
107.787 + before, too, because there was no check*)
107.788 + fetchProposedTactic 1;
107.789 + setNextTactic 1 (Specify_Theory "PolyEq.thy");
107.790 + autoCalculate 1 (Step 1);
107.791 +
107.792 + fetchProposedTactic 1;
107.793 + setNextTactic 1 (Specify_Method ["PolyEq","normalize_poly"]);
107.794 + autoCalculate 1 (Step 1);
107.795 +
107.796 + fetchProposedTactic 1;
107.797 + "--------- now the calc-header is ready for enter 'solving' ----";
107.798 + autoCalculate 1 CompleteCalc;
107.799 +
107.800 + val ((pt,_),_) = get_calc 1;
107.801 +rootthy pt;
107.802 + show_pt pt;
107.803 + val p = get_pos 1 1;
107.804 + val (Form f, tac, asms) = pt_extract (pt, p);
107.805 + if term2str f = "[x = -1, x = -3]" andalso p = ([], Res) then () else
107.806 + raise error "FE-interface.sml: diff.behav. in tryMatchProblem, tryRefine";
107.807 +
107.808 +
107.809 +"--------- modifyCalcHead, resetCalcHead, modelProblem ------------";
107.810 +"--------- modifyCalcHead, resetCalcHead, modelProblem ------------";
107.811 +"--------- modifyCalcHead, resetCalcHead, modelProblem ------------";
107.812 +
107.813 + states:=[];
107.814 + DEconstrCalcTree 1;
107.815 + CalcTree
107.816 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.817 + ("Test.thy",
107.818 + ["sqroot-test","univariate","equation","test"],
107.819 + ["Test","squ-equ-test-subpbl1"]))];
107.820 + Iterator 1;
107.821 + moveActiveRoot 1;
107.822 +
107.823 + modifyCalcHead 1 (([],Pbl),(*the position from refFormula*)
107.824 + "solve (x+1=2, x)",(*the headline*)
107.825 + [Given ["equality (x+1=2)", "solveFor x"],
107.826 + Find ["solutions L"](*,Relate []*)],
107.827 + Pbl,
107.828 + ("Test.thy",
107.829 + ["sqroot-test","univariate","equation","test"],
107.830 + ["Test","squ-equ-test-subpbl1"]));
107.831 +resetCalcHead 1;
107.832 +modelProblem 1;
107.833 +
107.834 +
107.835 +"---------------- maximum-example, UC: Modeling an example -------";
107.836 +"---------------- maximum-example, UC: Modeling an example -------";
107.837 +"---------------- maximum-example, UC: Modeling an example -------";
107.838 +(* {\bf\UC{Editing the Model}\label{SPECIFY:enter}\label{SPECIFY:check}\\}
107.839 +see isac.bridge.TestModel#testEditItems
107.840 +*)
107.841 + val elems = ["fixedValues [r=Arbfix]","maximum A","valuesFor [a,b]",
107.842 + "relations [A=a*b, (a/2)^2 + (b/2)^2 = r^2]",
107.843 + "relations [A=a*b, (a/2)^2 + (b/2)^2 = r^2]",
107.844 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
107.845 + (*^^^ these are the elements for the root-problem (in variants)*)
107.846 + (*vvv these are elements required for subproblems*)
107.847 + "boundVariable a","boundVariable b","boundVariable alpha",
107.848 + "interval {x::real. 0 <= x & x <= 2*r}",
107.849 + "interval {x::real. 0 <= x & x <= 2*r}",
107.850 + "interval {x::real. 0 <= x & x <= pi}",
107.851 + "errorBound (eps=(0::real))"]
107.852 + (*specifying is not interesting for this example*)
107.853 + val spec = ("DiffApp.thy", ["maximum_of","function"],
107.854 + ["DiffApp","max_by_calculus"]);
107.855 + (*the empty model with descriptions for user-guidance by Model_Problem*)
107.856 + val empty_model = [Given ["fixedValues []"],
107.857 + Find ["maximum", "valuesFor"],
107.858 + Relate ["relations []"]];
107.859 + states:=[];
107.860 + DEconstrCalcTree 1;
107.861 + CalcTree [(elems, spec)];
107.862 + Iterator 1;
107.863 + moveActiveRoot 1;
107.864 + refFormula 1 (get_pos 1 1);
107.865 + (*this gives a completely empty model*)
107.866 +
107.867 + fetchProposedTactic 1;
107.868 +(*fill the CalcHead with Descriptions...*)
107.869 + setNextTactic 1 (Model_Problem );
107.870 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.871 +
107.872 + (*user input is !!!!!EITHER!!!!! _some_ (at least one) items of the model
107.873 + !!!!!OR!!!!! _one_ part of the specification !!!!!!!!!!!!!*)
107.874 + (*input of two items, 'fixedValues [r=Arbfix]' and 'maximum b'...*)
107.875 + modifyCalcHead 1 (([],Pbl) (*position, from previous refFormula*),
107.876 + "Problem (DiffApp.thy, [maximum_of, function])",
107.877 + (*the head-form ^^^ is not used for input here*)
107.878 + [Given ["fixedValues [r=Arbfix]"(*new input*)],
107.879 + Find ["maximum b"(*new input*), "valuesFor"],
107.880 + Relate ["relations"]],
107.881 + (*input (Arbfix will dissappear soon)*)
107.882 + Pbl (*belongsto*),
107.883 + e_spec (*no input to the specification*));
107.884 +
107.885 + (*the user does not know, what 'superfluous' for 'maximum b' may mean
107.886 + and asks what to do next*)
107.887 + fetchProposedTactic 1;
107.888 + (*the student follows the advice*)
107.889 + setNextTactic 1 (Add_Find "maximum A"); (*FIXME.17.11.03: does not yet work*)
107.890 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);
107.891 +
107.892 + (*this input completes the model*)
107.893 + modifyCalcHead 1 (([],Pbl), "not used here",
107.894 + [Given ["fixedValues [r=Arbfix]"],
107.895 + Find ["maximum A", "valuesFor [a,b]"(*new input*)],
107.896 + Relate ["relations [A=a*b, \
107.897 + \(a/2)^2 + (b/2)^2 = r^2]"]], Pbl, e_spec);
107.898 +
107.899 + (*specification is not interesting an should be skipped by the dialogguide;
107.900 + !!!!!!!!!!!!!!!!!!!! input of ONE part at a time !!!!!!!!!!!!!!!!!!!!!!*)
107.901 + modifyCalcHead 1 (([],Pbl), "not used here",
107.902 + [Given ["fixedValues [r=Arbfix]"],
107.903 + Find ["maximum A", "valuesFor [a,b]"(*new input*)],
107.904 + Relate ["relations [A=a*b, \
107.905 + \(a/2)^2 + (b/2)^2 = r^2]"]], Pbl,
107.906 + ("DiffApp.thy", ["e_pblID"], ["e_metID"]));
107.907 + modifyCalcHead 1 (([],Pbl), "not used here",
107.908 + [Given ["fixedValues [r=Arbfix]"],
107.909 + Find ["maximum A", "valuesFor [a,b]"(*new input*)],
107.910 + Relate ["relations [A=a*b, \
107.911 + \(a/2)^2 + (b/2)^2 = r^2]"]], Pbl,
107.912 + ("DiffApp.thy", ["maximum_of","function"],
107.913 + ["e_metID"]));
107.914 + modifyCalcHead 1 (([],Pbl), "not used here",
107.915 + [Given ["fixedValues [r=Arbfix]"],
107.916 + Find ["maximum A", "valuesFor [a,b]"(*new input*)],
107.917 + Relate ["relations [A=a*b, \
107.918 + \(a/2)^2 + (b/2)^2 = r^2]"]], Pbl,
107.919 + ("DiffApp.thy", ["maximum_of","function"],
107.920 + ["DiffApp","max_by_calculus"]));
107.921 + (*this final calcHead now has STATUS 'complete' !*)
107.922 + DEconstrCalcTree 1;
107.923 +
107.924 +
107.925 +"--------- solve_linear from pbl-hierarchy -----------------------";
107.926 +"--------- solve_linear from pbl-hierarchy -----------------------";
107.927 +"--------- solve_linear from pbl-hierarchy -----------------------";
107.928 + states:=[];
107.929 + val (fmz, sp) = ([], ("", ["linear","univariate","equation","test"], []));
107.930 + CalcTree [(fmz, sp)];
107.931 + Iterator 1; moveActiveRoot 1;
107.932 + refFormula 1 (get_pos 1 1);
107.933 + modifyCalcHead 1 (([],Pbl),"solve (1+-1*2+x=0)",
107.934 + [Given ["equality (1+-1*2+x=0)", "solveFor x"],
107.935 + Find ["solutions L"]],
107.936 + Pbl,
107.937 + ("Test.thy", ["linear","univariate","equation","test"],
107.938 + ["Test","solve_linear"]));
107.939 + autoCalculate 1 CompleteCalc;
107.940 + refFormula 1 (get_pos 1 1);
107.941 + val ((pt,_),_) = get_calc 1;
107.942 + val p = get_pos 1 1;
107.943 + val (Form f, tac, asms) = pt_extract (pt, p);
107.944 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.945 + raise error "FE-interface.sml: diff.behav. in from pbl-hierarchy";
107.946 +
107.947 +
107.948 +
107.949 +"--------- solve_linear as in an algebra system (CAS)-------------";
107.950 +"--------- solve_linear as in an algebra system (CAS)-------------";
107.951 +"--------- solve_linear as in an algebra system (CAS)-------------";
107.952 + states:=[];
107.953 + val (fmz, sp) = ([], ("", [], []));
107.954 + CalcTree [(fmz, sp)];
107.955 + Iterator 1; moveActiveRoot 1;
107.956 + modifyCalcHead 1 (([],Pbl),"solveTest (1+-1*2+x=0,x)", [], Pbl, ("", [], []));
107.957 + autoCalculate 1 CompleteCalc;
107.958 + refFormula 1 (get_pos 1 1);
107.959 + val ((pt,_),_) = get_calc 1;
107.960 + val p = get_pos 1 1;
107.961 + val (Form f, tac, asms) = pt_extract (pt, p);
107.962 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.963 + raise error "FE-interface.sml: diff.behav. in algebra system";
107.964 +
107.965 +
107.966 +
107.967 +"--------- interSteps: on 'miniscript with mini-subpbl' ----------";
107.968 +"--------- interSteps: on 'miniscript with mini-subpbl' ----------";
107.969 +"--------- interSteps: on 'miniscript with mini-subpbl' ----------";
107.970 + states:=[];
107.971 + CalcTree
107.972 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.973 + ("Test.thy",
107.974 + ["sqroot-test","univariate","equation","test"],
107.975 + ["Test","squ-equ-test-subpbl1"]))];
107.976 + Iterator 1;
107.977 + moveActiveRoot 1;
107.978 + autoCalculate 1 CompleteCalc;
107.979 + val ((pt,_),_) = get_calc 1;
107.980 + show_pt pt;
107.981 +
107.982 + (*UC\label{SOLVE:INFO:intermediate-steps}*)
107.983 + interSteps 1 ([2],Res);
107.984 + val ((pt,_),_) = get_calc 1; show_pt pt (*new ([2,1],Frm)..([2,6],Res)*);
107.985 + val (unc, del, gen) = (([1],Res),([1],Res),([2,6],Res));
107.986 + getFormulaeFromTo 1 unc gen 1 false;
107.987 +
107.988 + (*UC\label{SOLVE:INFO:intermediate-steps}*)
107.989 + interSteps 1 ([3,2],Res);
107.990 + val ((pt,_),_) = get_calc 1; show_pt pt (*new ([3,2,1],Frm)..([3,2,2],Res)*);
107.991 + val (unc, del, gen) = (([3,1],Res),([3,1],Res),([3,2,2],Res));
107.992 + getFormulaeFromTo 1 unc gen 1 false;
107.993 +
107.994 + (*UC\label{SOLVE:INFO:intermediate-steps}*)
107.995 + interSteps 1 ([3],Res) (*no new steps in subproblems*);
107.996 + val (unc, del, gen) = (([3],Pbl),([3],Pbl),([3,2],Res));
107.997 + getFormulaeFromTo 1 unc gen 1 false;
107.998 +
107.999 + (*UC\label{SOLVE:INFO:intermediate-steps}*)
107.1000 + interSteps 1 ([],Res) (*no new steps in subproblems*);
107.1001 + val (unc, del, gen) = (([],Pbl),([],Pbl),([4],Res));
107.1002 + getFormulaeFromTo 1 unc gen 1 false;
107.1003 +
107.1004 +
107.1005 +"--------- getTactic, fetchApplicableTactics ---------------------";
107.1006 +"--------- getTactic, fetchApplicableTactics ---------------------";
107.1007 +"--------- getTactic, fetchApplicableTactics ---------------------";
107.1008 + states:=[];
107.1009 + CalcTree
107.1010 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1011 + ("Test.thy",
107.1012 + ["sqroot-test","univariate","equation","test"],
107.1013 + ["Test","squ-equ-test-subpbl1"]))];
107.1014 + Iterator 1; moveActiveRoot 1;
107.1015 + autoCalculate 1 CompleteCalc;
107.1016 + val ((pt,_),_) = get_calc 1;
107.1017 + show_pt pt;
107.1018 +
107.1019 + (*UC\label{SOLVE:HIDE:getTactic}*)
107.1020 + getTactic 1 ([],Pbl);
107.1021 + getTactic 1 ([1],Res);
107.1022 + getTactic 1 ([3],Pbl);
107.1023 + getTactic 1 ([3,1],Frm);
107.1024 + getTactic 1 ([3],Res);
107.1025 + getTactic 1 ([],Res);
107.1026 +
107.1027 +(*UC\label{SOLVE:MANUAL:TACTIC:listall}*)
107.1028 + fetchApplicableTactics 1 99999 ([],Pbl);
107.1029 + fetchApplicableTactics 1 99999 ([1],Res);
107.1030 + fetchApplicableTactics 1 99999 ([3],Pbl);
107.1031 + fetchApplicableTactics 1 99999 ([3,1],Res);
107.1032 + fetchApplicableTactics 1 99999 ([3],Res);
107.1033 + fetchApplicableTactics 1 99999 ([],Res);
107.1034 +
107.1035 +
107.1036 +"--------- getAssumptions, getAccumulatedAsms --------------------";
107.1037 +"--------- getAssumptions, getAccumulatedAsms --------------------";
107.1038 +"--------- getAssumptions, getAccumulatedAsms --------------------";
107.1039 +states:=[];
107.1040 +CalcTree
107.1041 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
107.1042 + "solveFor x","solutions L"],
107.1043 + ("RatEq.thy",["univariate","equation"],["no_met"]))];
107.1044 +Iterator 1; moveActiveRoot 1;
107.1045 +autoCalculate 1 CompleteCalc;
107.1046 +val ((pt,_),_) = get_calc 1;
107.1047 +show_pt pt;
107.1048 +
107.1049 +(*UC\label{SOLVE:HELP:assumptions}*)
107.1050 +getAssumptions 1 ([3], Res);
107.1051 +getAssumptions 1 ([5], Res);
107.1052 +(*UC\label{SOLVE:HELP:assumptions-origin} WN0502 still without positions*)
107.1053 +getAccumulatedAsms 1 ([3], Res);
107.1054 +getAccumulatedAsms 1 ([5], Res);
107.1055 +
107.1056 +
107.1057 +"--------- arbitrary combinations of steps -----------------------";
107.1058 +"--------- arbitrary combinations of steps -----------------------";
107.1059 +"--------- arbitrary combinations of steps -----------------------";
107.1060 + states:=[];
107.1061 + CalcTree (*start of calculation, return No.1*)
107.1062 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
107.1063 + ("Test.thy",
107.1064 + ["linear","univariate","equation","test"],
107.1065 + ["Test","solve_linear"]))];
107.1066 + Iterator 1; moveActiveRoot 1;
107.1067 +
107.1068 + fetchProposedTactic 1;
107.1069 + setNextTactic 1 (Model_Problem );
107.1070 + autoCalculate 1 (Step 1);
107.1071 +
107.1072 + fetchProposedTactic 1;
107.1073 + fetchProposedTactic 1;
107.1074 +
107.1075 + setNextTactic 1 (Add_Find "solutions L");
107.1076 + setNextTactic 1 (Add_Find "solutions L");
107.1077 +
107.1078 + autoCalculate 1 (Step 1);
107.1079 + autoCalculate 1 (Step 1);
107.1080 +
107.1081 + setNextTactic 1 (Specify_Theory "Test.thy");
107.1082 + fetchProposedTactic 1;
107.1083 + autoCalculate 1 (Step 1);
107.1084 +
107.1085 + autoCalculate 1 (Step 1);
107.1086 + autoCalculate 1 (Step 1);
107.1087 + autoCalculate 1 (Step 1);
107.1088 + autoCalculate 1 (Step 1);
107.1089 +(*------------------------- end calc-head*)
107.1090 +
107.1091 + fetchProposedTactic 1;
107.1092 + setNextTactic 1 (Rewrite_Set_Inst (["(bdv,x)"], "isolate_bdv"));
107.1093 + autoCalculate 1 (Step 1);
107.1094 +
107.1095 + setNextTactic 1 (Rewrite_Set "Test_simplify");
107.1096 + fetchProposedTactic 1;
107.1097 + autoCalculate 1 (Step 1);
107.1098 +
107.1099 + autoCalculate 1 CompleteCalc;
107.1100 + val ((pt,_),_) = get_calc 1;
107.1101 + val p = get_pos 1 1;
107.1102 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1103 + if term2str f = "[x = 1]" andalso p = ([], Res) then () else
107.1104 + raise error "FE-interface.sml: diff.behav. in combinations of steps";
107.1105 +
107.1106 +
107.1107 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} right--";
107.1108 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} right--";
107.1109 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} right--";
107.1110 + states:=[];
107.1111 + CalcTree
107.1112 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1113 + ("Test.thy",
107.1114 + ["sqroot-test","univariate","equation","test"],
107.1115 + ["Test","squ-equ-test-subpbl1"]))];
107.1116 + Iterator 1;
107.1117 + moveActiveRoot 1;
107.1118 + autoCalculate 1 CompleteCalcHead;
107.1119 + autoCalculate 1 (Step 1);
107.1120 + autoCalculate 1 (Step 1);
107.1121 + appendFormula 1 "-1 + x = 0";
107.1122 + (*... returns calcChangedEvent with*)
107.1123 + val (unc, del, gen) = (([1],Res), ([1],Res), ([2],Res));
107.1124 + getFormulaeFromTo 1 unc gen 99999 (*all levels*) false;
107.1125 +
107.1126 + val ((pt,_),_) = get_calc 1;
107.1127 + val p = get_pos 1 1;
107.1128 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1129 + if term2str f = "-1 + x = 0" andalso p = ([2], Res) then () else
107.1130 + raise error "FE-interface.sml: diff.behav. in FORMULA:enter} right";
107.1131 +
107.1132 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} other--";
107.1133 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} other--";
107.1134 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} other--";
107.1135 + states:=[];
107.1136 + CalcTree
107.1137 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1138 + ("Test.thy",
107.1139 + ["sqroot-test","univariate","equation","test"],
107.1140 + ["Test","squ-equ-test-subpbl1"]))];
107.1141 + Iterator 1;
107.1142 + moveActiveRoot 1;
107.1143 + autoCalculate 1 CompleteCalcHead;
107.1144 + autoCalculate 1 (Step 1);
107.1145 + autoCalculate 1 (Step 1);
107.1146 + appendFormula 1 "x - 1 = 0";
107.1147 + val (unc, del, gen) = (([1],Res), ([1],Res), ([2],Res));
107.1148 + getFormulaeFromTo 1 unc gen 99999 (*all levels*) false;
107.1149 + (*11 elements !!!*)
107.1150 +
107.1151 + val ((pt,_),_) = get_calc 1;
107.1152 + val p = get_pos 1 1;
107.1153 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1154 + if term2str f = "x - 1 = 0" andalso p = ([2], Res) then () else
107.1155 + raise error "FE-interface.sml: diff.behav. in FORMULA:enter} other";
107.1156 +
107.1157 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} oth 2--";
107.1158 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} oth 2--";
107.1159 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} oth 2--";
107.1160 + states:=[];
107.1161 + CalcTree
107.1162 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1163 + ("Test.thy",
107.1164 + ["sqroot-test","univariate","equation","test"],
107.1165 + ["Test","squ-equ-test-subpbl1"]))];
107.1166 + Iterator 1;
107.1167 + moveActiveRoot 1;
107.1168 + autoCalculate 1 CompleteCalcHead;
107.1169 + autoCalculate 1 (Step 1);
107.1170 + autoCalculate 1 (Step 1);
107.1171 + appendFormula 1 "x = 1";
107.1172 + (*... returns calcChangedEvent with*)
107.1173 + val (unc, del, gen) = (([1],Res), ([1],Res), ([3,2],Res));
107.1174 + getFormulaeFromTo 1 unc gen 99999 (*all levels*) false;
107.1175 + (*6 elements !!!*)
107.1176 +
107.1177 + val ((pt,_),_) = get_calc 1;
107.1178 + val p = get_pos 1 1;
107.1179 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1180 + if term2str f = "x = 1" andalso p = ([3,2], Res) then () else
107.1181 + raise error "FE-interface.sml: diff.behav. in FORMULA:enter} oth 2";
107.1182 +
107.1183 +
107.1184 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} NOTok--";
107.1185 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} NOTok--";
107.1186 +"--------- appendFormula label{SOLVE:MANUAL:FORMULA:enter} NOTok--";
107.1187 + states:=[];
107.1188 + CalcTree
107.1189 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1190 + ("Test.thy",
107.1191 + ["sqroot-test","univariate","equation","test"],
107.1192 + ["Test","squ-equ-test-subpbl1"]))];
107.1193 + Iterator 1;
107.1194 + moveActiveRoot 1;
107.1195 + autoCalculate 1 CompleteCalcHead;
107.1196 + autoCalculate 1 (Step 1);
107.1197 + autoCalculate 1 (Step 1);
107.1198 + appendFormula 1 "x - 4711 = 0";
107.1199 + (*... returns <ERROR> no derivation found </ERROR>*)
107.1200 +
107.1201 + val ((pt,_),_) = get_calc 1;
107.1202 + val p = get_pos 1 1;
107.1203 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1204 + if term2str f = "x + 1 + -1 * 2 = 0" andalso p = ([1], Res) then () else
107.1205 + raise error "FE-interface.sml: diff.behav. in FORMULA:enter} NOTok";
107.1206 +
107.1207 +
107.1208 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} right----";
107.1209 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} right----";
107.1210 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} right----";
107.1211 + states:=[];
107.1212 + CalcTree
107.1213 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1214 + ("Test.thy",
107.1215 + ["sqroot-test","univariate","equation","test"],
107.1216 + ["Test","squ-equ-test-subpbl1"]))];
107.1217 + Iterator 1;
107.1218 + moveActiveRoot 1;
107.1219 + autoCalculate 1 CompleteCalc;
107.1220 + moveActiveFormula 1 ([2],Res);
107.1221 + replaceFormula 1 "-1 + x = 0" (*i.e. repeats input*);
107.1222 + (*... returns <ERROR> formula not changed </ERROR>*)
107.1223 +
107.1224 + val ((pt,_),_) = get_calc 1;
107.1225 + val p = get_pos 1 1;
107.1226 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1227 + if term2str f = "-1 + x = 0" andalso p = ([2], Res) then () else
107.1228 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} right 1";
107.1229 + if map fst (get_interval ([2],Res) ([],Res) 9999 pt) =
107.1230 + [([2], Res), ([3], Pbl), ([3, 1], Frm), ([3, 1], Res), ([3, 2], Res),
107.1231 + ([3], Res), ([4], Res), ([], Res)] then () (*nothing deleted!*) else
107.1232 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} right 2";
107.1233 +
107.1234 +(*WN050211 replaceFormula didn't work on second ctree: thus now tested...*)
107.1235 + CalcTree
107.1236 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1237 + ("Test.thy",
107.1238 + ["sqroot-test","univariate","equation","test"],
107.1239 + ["Test","squ-equ-test-subpbl1"]))];
107.1240 + Iterator 2;
107.1241 + moveActiveRoot 2;
107.1242 + autoCalculate 2 CompleteCalc;
107.1243 + moveActiveFormula 2 ([2],Res);
107.1244 + replaceFormula 2 "-1 + x = 0" (*i.e. repeats input*);
107.1245 + (*... returns <ERROR> formula not changed </ERROR>*)
107.1246 +
107.1247 + val ((pt,_),_) = get_calc 2;
107.1248 + val p = get_pos 2 1;
107.1249 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1250 + if term2str f = "-1 + x = 0" andalso p = ([2], Res) then () else
107.1251 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} right 1";
107.1252 + if map fst (get_interval ([2],Res) ([],Res) 9999 pt) =
107.1253 + [([2], Res), ([3], Pbl), ([3, 1], Frm), ([3, 1], Res), ([3, 2], Res),
107.1254 + ([3], Res), ([4], Res), ([], Res)] then () (*nothing deleted!*) else
107.1255 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} right 2b";
107.1256 +
107.1257 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other----";
107.1258 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other----";
107.1259 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other----";
107.1260 + states:=[];
107.1261 + CalcTree
107.1262 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1263 + ("Test.thy",
107.1264 + ["sqroot-test","univariate","equation","test"],
107.1265 + ["Test","squ-equ-test-subpbl1"]))];
107.1266 + Iterator 1;
107.1267 + moveActiveRoot 1;
107.1268 + autoCalculate 1 CompleteCalc;
107.1269 + moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
107.1270 + replaceFormula 1 "x - 1 = 0"; (*<-------------------------------------*)
107.1271 + (*... returns calcChangedEvent with*)
107.1272 + val (unc, del, gen) = (([1],Res), ([4],Res), ([2],Res));
107.1273 + getFormulaeFromTo 1 unc gen 99999 (*all levels*) false;
107.1274 +
107.1275 + val ((pt,_),_) = get_calc 1;
107.1276 + show_pt pt;
107.1277 + val p = get_pos 1 1;
107.1278 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1279 + if term2str f = "x - 1 = 0" andalso p = ([2], Res) then () else
107.1280 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} other 1";
107.1281 +(* for getting the list in whole length ...
107.1282 +print_depth 99;map fst (get_interval ([1],Res) ([],Res) 9999 pt);print_depth 3;
107.1283 + *)
107.1284 + if map fst (get_interval ([1],Res) ([],Res) 9999 pt) =
107.1285 + [([1], Res), ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
107.1286 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2, 7], Res),
107.1287 + ([2, 8], Res), ([2, 9], Res), ([2], Res)
107.1288 +(*WN060727 {cutlevup->test_trans} removed: ,
107.1289 + ([], Res)(*dropped, if test_trans doesnt stop at PblNd*)*)] then () else
107.1290 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} other 2";
107.1291 +
107.1292 +
107.1293 +
107.1294 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other 2--";
107.1295 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other 2--";
107.1296 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} other 2--";
107.1297 + states:=[];
107.1298 + CalcTree
107.1299 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1300 + ("Test.thy",
107.1301 + ["sqroot-test","univariate","equation","test"],
107.1302 + ["Test","squ-equ-test-subpbl1"]))];
107.1303 + Iterator 1;
107.1304 + moveActiveRoot 1;
107.1305 + autoCalculate 1 CompleteCalc;
107.1306 + moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
107.1307 + replaceFormula 1 "x = 1"; (*<-------------------------------------*)
107.1308 + (*... returns calcChangedEvent with ...*)
107.1309 + val (unc, del, gen) = (([1],Res), ([4],Res), ([3,2],Res));
107.1310 + getFormulaeFromTo 1 unc gen 99999 (*all levels*) false;
107.1311 + (*9 elements !!!*)
107.1312 +
107.1313 + val ((pt,_),_) = get_calc 1;
107.1314 + show_pt pt; (*error: ...get_interval drops ([3,2],Res) ...*)
107.1315 + val (t,_) = get_obj g_result pt [3,2]; term2str t;
107.1316 + if map fst (get_interval ([1],Res) ([],Res) 9999 pt) =
107.1317 + [([1], Res), ([2], Res), ([3], Pbl), ([3, 1], Frm), ([3, 1], Res),
107.1318 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
107.1319 + ([3,2],Res)] then () else
107.1320 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} oth2 1";
107.1321 +
107.1322 + val p = get_pos 1 1;
107.1323 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1324 + if term2str f = "x = 1" andalso p = ([3,2], Res) then () else
107.1325 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} oth2 2";
107.1326 +
107.1327 +
107.1328 +
107.1329 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} NOTok----";
107.1330 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} NOTok----";
107.1331 +"--------- replaceFormula {SOLVE:MANUAL:FORMULA:replace} NOTok----";
107.1332 + states:=[];
107.1333 + CalcTree
107.1334 + [(["equality (x+1=2)", "solveFor x","solutions L"],
107.1335 + ("Test.thy",
107.1336 + ["sqroot-test","univariate","equation","test"],
107.1337 + ["Test","squ-equ-test-subpbl1"]))];
107.1338 + Iterator 1;
107.1339 + moveActiveRoot 1;
107.1340 + autoCalculate 1 CompleteCalc;
107.1341 + moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
107.1342 + replaceFormula 1 "x - 4711 = 0";
107.1343 + (*... returns <ERROR> no derivation found </ERROR>*)
107.1344 +
107.1345 + val ((pt,_),_) = get_calc 1;
107.1346 + show_pt pt;
107.1347 + val p = get_pos 1 1;
107.1348 + val (Form f, tac, asms) = pt_extract (pt, p);
107.1349 + if term2str f = "-1 + x = 0" andalso p = ([2], Res) then () else
107.1350 + raise error "FE-interface.sml: diff.behav. in FORMULA:replace} NOTok";
107.1351 +
107.1352 +
108.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
108.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/algein.sml Wed Jul 21 13:53:39 2010 +0200
108.3 @@ -0,0 +1,158 @@
108.4 +(* tests on AlgEin, Algebra Einf"uhrung, , Unterrichtsversuch IMST-Projekt
108.5 + author: Walther Neuper 2007
108.6 + (c) due to copyright terms
108.7 +
108.8 +use"../smltest/IsacKnowledge/algein.sml";
108.9 +use"algein.sml";
108.10 +*)
108.11 +val thy = AlgEin.thy;
108.12 +
108.13 +"-----------------------------------------------------------------";
108.14 +"table of contents -----------------------------------------------";
108.15 +"-----------------------------------------------------------------";
108.16 +"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
108.17 +"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
108.18 +"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
108.19 +"----------- Widerspruch 3 = 777 ---------------------------------";
108.20 +"-----------------------------------------------------------------";
108.21 +"-----------------------------------------------------------------";
108.22 +"-----------------------------------------------------------------";
108.23 +
108.24 +
108.25 +
108.26 +(* use"../smltest/IsacKnowledge/algein.sml";
108.27 + *)
108.28 +
108.29 +"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
108.30 +"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
108.31 +"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
108.32 +val str =
108.33 +"Script RechnenSymbolScript (k_::bool) (q__::bool) \
108.34 +\(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =\
108.35 +\ (let t_ = (l_ = 1)\
108.36 +\ in t_)"
108.37 +;
108.38 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
108.39 +(*---^^^-OK-----------------------------------------------------------------*)
108.40 +val str =
108.41 +"Script RechnenSymbolScript (k_::bool) (q__::bool) \
108.42 +\(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =\
108.43 +\ (let t_ = Take (l_ = Oben + Senkrecht + Unten); \
108.44 +\ sum_ = boollist2sum o_;\
108.45 +\ t_ = Substitute [Oben = sum_] t_;\
108.46 +\ t_ = Substitute o_ t_;\
108.47 +\ t_ = Substitute [k_, q__] t_;\
108.48 +\ t_ = Repeat (Try (Rewrite_Set norm_Poly False)) t_\
108.49 +\ in t_)"
108.50 +;
108.51 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
108.52 +(*---vvv-NOTok--------------------------------------------------------------*)
108.53 +
108.54 +
108.55 +
108.56 +atomty sc;
108.57 +atomt sc;
108.58 +
108.59 +
108.60 +"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
108.61 +"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
108.62 +"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
108.63 +val fmz =
108.64 + ["KantenLaenge (k=10)","Querschnitt (q=1)",
108.65 + "KantenUnten [b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q ]",
108.66 + "KantenSenkrecht [v1 = k, v2 = k, v3 = k, v4 = k]",
108.67 + "KantenOben [t1 = k - 2*q, t2 = k - 2*q, t3 = k - 2*q, t4 = k - 2*q ]",
108.68 + "GesamtLaenge L"];
108.69 +val (dI',pI',mI') =
108.70 + ("Isac.thy",["numerischSymbolische", "Berechnung"],
108.71 + ["Berechnung","erstNumerisch"]);
108.72 +val p = e_pos'; val c = [];
108.73 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))](*nxt = ("Model_Pr*);
108.74 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenLaenge (k = 10)"*);
108.75 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "Querschnitt (q = 1)"*);
108.76 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenUnten [b1 = k - 2*q]"*);
108.77 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*..KantenUnten [b2 = k - 2 * q, b3=..b4*);
108.78 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenSenkrecht [v1 = k]"*);
108.79 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*..KantenSenkrecht [v2 = k, v3 = k, v4]*);
108.80 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenOben [b1 = k - 2 *q])*);
108.81 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*..KantenOben [b2 = k - 2 * q, b3 =, b4*);
108.82 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Find "GesamtLaenge L"*);
108.83 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Specify_Theory "AlgEin.thy"*);
108.84 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Specify_Problem ["numerischSymbolis,Be*);
108.85 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Specify_Method ["Berechnung", "erstSym*);
108.86 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Apply_Method*);
108.87 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Substitute["Oben = boollist2sum [b1 =*);
108.88 +f2str f;
108.89 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Substitute ["t1 = k - 2 * q", *);f2str f;
108.90 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Substitute ["k = 10", "q = 1"]*);f2str f;
108.91 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*Rewrite_Set "norm_Rational"*);f2str f;
108.92 +val (p,_,f,nxt,_,pt) = me nxt p c pt(**);
108.93 +if f2str f = "L = 32 + senkrecht + unten" then ()
108.94 +else raise error "algein.sml diff.behav. in erstSymbolisch 1";
108.95 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
108.96 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
108.97 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
108.98 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
108.99 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
108.100 +if f2str f = "L = 104" andalso nxt = ("End_Proof'", End_Proof') then ()
108.101 +else raise error "algein.sml diff.behav. in erstSymbolisch 99";
108.102 +
108.103 +
108.104 +"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
108.105 +"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
108.106 +"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
108.107 +states:=[];
108.108 +CalcTree
108.109 +[(["KantenLaenge (k=10)","Querschnitt (q=1)",
108.110 + "KantenUnten [b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q ]",
108.111 + "KantenSenkrecht [v1 = k, v2 = k, v3 = k, v4 = k]",
108.112 + "KantenOben [t1 = k - 2*q, t2 = k - 2*q, t3 = k - 2*q, t4 = k - 2*q ]",
108.113 + "GesamtLaenge L"],
108.114 + ("Isac.thy",["numerischSymbolische", "Berechnung"],
108.115 + ["Berechnung","erstSymbolisch"]))];
108.116 +Iterator 1;
108.117 +moveActiveRoot 1;
108.118 +autoCalculate 1 CompleteCalc;
108.119 +val ((pt,p),_) = get_calc 1; show_pt pt;
108.120 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "L = 104" then()
108.121 +else raise error "algein.sml: 'Berechnung' 'erstSymbolisch' changed";
108.122 +
108.123 +(*
108.124 +show_pt pt;
108.125 +trace_rewrite:=true;
108.126 +trace_rewrite:=false;
108.127 +trace_script:=true;
108.128 +trace_script:=false;
108.129 +*)
108.130 +
108.131 +"----------- Widerspruch 3 = 777 ---------------------------------";
108.132 +"----------- Widerspruch 3 = 777 ---------------------------------";
108.133 +"----------- Widerspruch 3 = 777 ---------------------------------";
108.134 +val thy = Isac.thy;
108.135 +val rew_ord = dummy_ord;
108.136 +val erls = Erls;
108.137 +
108.138 +val thm = assoc_thm' thy ("sym_real_mult_0_right","");
108.139 +val t = str2term "0 = 0";
108.140 +val Some (t',_) = rewrite_ thy rew_ord erls false thm t;
108.141 +term2str t';
108.142 +(********"0 = ?z1 * 0"*)
108.143 +
108.144 +(*testing code in ME/appl.sml*)
108.145 +val sube = ["?z1 = 3"];
108.146 +val subte = sube2subte sube;
108.147 +val subst = sube2subst thy sube;
108.148 +foldl and_ (true, map contains_Var subte);
108.149 +
108.150 +val t'' = subst_atomic subst t';
108.151 +term2str t'';
108.152 +(********"0 = 3 * 0"*)
108.153 +
108.154 +val thm = assoc_thm' thy ("sym","");
108.155 +(*----- GOON Widerspruch 3 = 777: sym contains "==>" instead of "=" !!!
108.156 +val Some (t''',_) = rewrite_ thy rew_ord erls false thm t'';
108.157 +*)
108.158 +
108.159 +(* use"../smltest/IsacKnowledge/algein.sml";
108.160 + *)
108.161 +
109.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
109.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/atools.sml Wed Jul 21 13:53:39 2010 +0200
109.3 @@ -0,0 +1,131 @@
109.4 +(* tests on Atools.thy and Atools.ML
109.5 + author: Walther Neuper
109.6 + 050814, 08:51
109.7 + (c) due to copyright terms
109.8 +
109.9 +use"../smltest/IsacKnowledge/atools.sml";
109.10 +use"atools.sml";
109.11 +*)
109.12 +
109.13 +"-----------------------------------------------------------------";
109.14 +"table of contents -----------------------------------------------";
109.15 +"-----------------------------------------------------------------";
109.16 +"----------- occurs_in -------------------------------------------";
109.17 +"----------- argument_of -----------------------------------------";
109.18 +"----------- sameFunId -------------------------------------------";
109.19 +"----------- filter_sameFunId ------------------------------------";
109.20 +"----------- boollist2sum ----------------------------------------";
109.21 +"-----------------------------------------------------------------";
109.22 +
109.23 +
109.24 +val thy = Atools.thy;
109.25 +
109.26 +"----------- occurs_in -------------------------------------------";
109.27 +"----------- occurs_in -------------------------------------------";
109.28 +"----------- occurs_in -------------------------------------------";
109.29 +fun str2t str = (term_of o the o (parse thy )) str;
109.30 +fun term2s t = Sign.string_of_term (sign_of thy) t;
109.31 +val t = str2t "x";
109.32 +if occurs_in t t then "OK" else raise error "atools.sml: occurs_in x x -> f";
109.33 +
109.34 +val t = str2term "x occurs_in x";
109.35 +val Some (str, t') = eval_occurs_in 0 "Atools.occurs'_in" t 0;
109.36 +if (term2s t') = "x occurs_in x = True" then ()
109.37 +else raise error "atools.sml: x occurs_in x = True ???";
109.38 +
109.39 +"------- some_occur_in";
109.40 +some_occur_in [str2term"c",str2term"c_2"] (str2term"a + b + c");
109.41 +val t = str2term "some_of [c, c_2, c_3, c_4] occur_in \
109.42 + \-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
109.43 +val Some (str,t') = eval_some_occur_in 0 "Atools.some'_occur'_in" t 0;
109.44 +if term2str t' =
109.45 + "some_of [c, c_2, c_3, c_4] occur_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 =\nTrue" then ()
109.46 +else raise error "atools.sml: some_occur_in true";
109.47 +
109.48 +val t = str2term "some_of [c_3, c_4] occur_in \
109.49 + \-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
109.50 +val Some (str,t') = eval_some_occur_in 0 "Atools.some'_occur'_in" t 0;
109.51 +if term2str t' =
109.52 + "some_of [c_3, c_4] occur_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = False" then ()
109.53 +else raise error "atools.sml: some_occur_in false";
109.54 +
109.55 +
109.56 +"----------- argument_of -----------------------------------------";
109.57 +"----------- argument_of -----------------------------------------";
109.58 +"----------- argument_of -----------------------------------------";
109.59 +val t = str2t "argument_in (M_b x)";
109.60 +val Some (str, t') = eval_argument_in 0 "Atools.argument'_in" t 0;
109.61 +if term2s t' = "(argument_in M_b x) = x" then ()
109.62 +else raise error "atools.sml:(argument_in M_b x) = x ???";
109.63 +
109.64 +"----------- sameFunId -------------------------------------------";
109.65 +"----------- sameFunId -------------------------------------------";
109.66 +"----------- sameFunId -------------------------------------------";
109.67 +val t = str2term "M_b L"; atomty t;
109.68 +val t as f1 $ _ = str2term "M_b L";
109.69 +val t as Const ("op =", _) $ (f2 $ _) $ _ = str2term "M_b x = c + L*x";
109.70 +f1 = f2 (*true*);
109.71 +val (p as Const ("Atools.sameFunId",_) $
109.72 + (f1 $ _) $
109.73 + (Const ("op =", _) $ (f2 $ _) $ _)) =
109.74 + str2term "sameFunId (M_b L) (M_b x = c + L*x)";
109.75 +f1 = f2 (*true*);
109.76 +eval_sameFunId "" "Atools.sameFunId"
109.77 + (str2term "sameFunId (M_b L) (M_b x = c + L*x)")""(*true*);
109.78 +eval_sameFunId "" "Atools.sameFunId"
109.79 + (str2term "sameFunId (M_b L) ( y' x = c + L*x)")""(*false*);
109.80 +eval_sameFunId "" "Atools.sameFunId"
109.81 + (str2term "sameFunId (M_b L) ( y x = c + L*x)")""(*false*);
109.82 +eval_sameFunId "" "Atools.sameFunId"
109.83 + (str2term "sameFunId ( y L) (M_b x = c + L*x)")""(*false*);
109.84 +eval_sameFunId "" "Atools.sameFunId"
109.85 + (str2term "sameFunId ( y L) ( y x = c + L*x)")""(*true*);
109.86 +
109.87 +"----------- filter_sameFunId ------------------------------------";
109.88 +"----------- filter_sameFunId ------------------------------------";
109.89 +"----------- filter_sameFunId ------------------------------------";
109.90 +val flhs as (fid $ _) = str2term "y' L";
109.91 +val fs = str2term "[M_b x = c + L*x, y' x = c + L*x, y x = c + L*x]";
109.92 +val (p as Const ("Atools.filter'_sameFunId",_) $ (fid $ _) $ fs) =
109.93 + str2term "filter_sameFunId (y' L) \
109.94 + \[M_b x = c + L*x, y' x = c + L*x, y x = c + L*x]";
109.95 +val Some (str, es) = eval_filter_sameFunId "" "Atools.filter'_sameFunId" p "";
109.96 +if term2str es = "(filter_sameFunId y' L [M_b x = c + L * x, y' x = c + L * x,\n y x = c + L * x]) =\n[y' x = c + L * x]" then ()
109.97 +else raise error "atools.slm diff.behav. in filter_sameFunId";
109.98 +
109.99 +
109.100 +"----------- boollist2sum ----------------------------------------";
109.101 +"----------- boollist2sum ----------------------------------------";
109.102 +"----------- boollist2sum ----------------------------------------";
109.103 +val u_ = str2term "[]";
109.104 +val u_ = str2term "[b1 = k - 2*q]";
109.105 +val u_ = str2term "[b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q]";
109.106 +val ut_ = isalist2list u_;
109.107 +val sum_ = map lhs ut_;
109.108 +val t = list2sum sum_;
109.109 +term2str t;
109.110 +
109.111 +val t = str2term
109.112 + "boollist2sum [b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q]";
109.113 +
109.114 +val p as Const ("Atools.boollist2sum", _) $ (Const ("List.list.Cons", _) $
109.115 + _ $ _) = t;
109.116 +
109.117 +
109.118 +val Some (str, pred) = eval_boollist2sum "" "Atools.boollist2sum" t "";
109.119 +if term2str pred = "boollist2sum\n [b1 = k - 2 * q, b2 = k - 2 * q, b3 = k - 2 * q, b4 = k - 2 * q] =\nb1 + b2 + b3 + b4" then ()
109.120 +else raise error "atools.sml diff.behav. in eval_boollist2sum";
109.121 +
109.122 +trace_rewrite:=true;
109.123 +val srls_ = append_rls "srls_..Berechnung-erstSymbolisch" e_rls
109.124 + [Calc ("Atools.boollist2sum", eval_boollist2sum "")];
109.125 +val t = str2term
109.126 + "boollist2sum [b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q]";
109.127 +case rewrite_set_ thy false srls_ t of Some _ => ()
109.128 +| _ => raise error "atools.sml diff.rewrite boollist2sum";
109.129 +trace_rewrite:=false;
109.130 +
109.131 +
109.132 +(* use"IsacKnowledge/Atools.ML";
109.133 + use"../smltest/IsacKnowledge/atools.sml";
109.134 + *)
109.135 \ No newline at end of file
110.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
110.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/biegelinie.sml Wed Jul 21 13:53:39 2010 +0200
110.3 @@ -0,0 +1,1040 @@
110.4 +(* tests on biegelinie
110.5 + author: Walther Neuper 050826
110.6 + (c) due to copyright terms
110.7 +
110.8 +use"../smltest/IsacKnowledge/biegelinie.sml";
110.9 +use"biegelinie.sml";
110.10 +*)
110.11 +val thy = Biegelinie.thy;
110.12 +
110.13 +"-----------------------------------------------------------------";
110.14 +"table of contents -----------------------------------------------";
110.15 +"-----------------------------------------------------------------";
110.16 +"----------- the rules -------------------------------------------";
110.17 +"----------- Script [IntegrierenUndKonstanteBestimmen] -----------";
110.18 +"----------- IntegrierenUndKonstanteBestimmen by rewriting -------";
110.19 +"----------- simplify_leaf for this script -----------------------";
110.20 +"----------- Bsp 7.27 me -----------------------------------------";
110.21 +"----------- Bsp 7.27 autoCalculate ------------------------------";
110.22 +"----------- SubProblem (_,[vonBelastungZu,Biegelinien] ----------";
110.23 +"----------- SubProblem (_,[setzeRandbedingungen,Biegelinien] ----";
110.24 +"----------- method [Biegelinien,setzeRandbedingungenEin] + exec -";
110.25 +"----------- method [Biegelinien,setzeRandbedingungenEin]FAST ----";
110.26 +"----------- IntegrierenUndKonstanteBestimmen2: Bsp.7.70. --------";
110.27 +"----------- investigate normalforms in biegelinien --------------";
110.28 +"-----------------------------------------------------------------";
110.29 +"-----------------------------------------------------------------";
110.30 +"-----------------------------------------------------------------";
110.31 +
110.32 +
110.33 +"----------- the rules -------------------------------------------";
110.34 +"----------- the rules -------------------------------------------";
110.35 +"----------- the rules -------------------------------------------";
110.36 +fun str2t str = (term_of o the o (parse Biegelinie.thy)) str;
110.37 +fun term2s t = Sign.string_of_term (sign_of Biegelinie.thy) t;
110.38 +fun rewrit thm str =
110.39 + fst (the (rewrite_ Biegelinie.thy tless_true e_rls true thm str));
110.40 +
110.41 +val t = rewrit Belastung_Querkraft (str2t "- q_ x = - q_0"); term2s t;
110.42 +if term2s t = "Q' x = - q_0" then ()
110.43 +else raise error "/biegelinie.sml: Belastung_Querkraft";
110.44 +
110.45 +val t = rewrit Querkraft_Moment (str2t "Q x = - q_0 * x + c"); term2s t;
110.46 +if term2s t = "M_b' x = - q_0 * x + c" then ()
110.47 +else raise error "/biegelinie.sml: Querkraft_Moment";
110.48 +
110.49 +val t = rewrit Moment_Neigung (str2t "M_b x = -q_0 * x^^^2/2 + q_0/2 *L*x");
110.50 + term2s t;
110.51 +if term2s t = "- EI * y'' x = - q_0 * x ^^^ 2 / 2 + q_0 / 2 * L * x" then ()
110.52 +else raise error "biegelinie.sml: Moment_Neigung";
110.53 +
110.54 +
110.55 +"----------- Script [IntegrierenUndKonstanteBestimmen] -----------";
110.56 +"----------- Script [IntegrierenUndKonstanteBestimmen] -----------";
110.57 +"----------- Script [IntegrierenUndKonstanteBestimmen] -----------";
110.58 +val str =
110.59 +"Script BiegelinieScript \
110.60 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
110.61 +\(rb_::bool list) (rm_::bool list) = \
110.62 +\ (let q___ = Take (q_ v_ = q__); \
110.63 +\ q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ \
110.64 +\ (Rewrite Belastung_Querkraft True)) q___; \
110.65 +\ (Q__:: bool) = \
110.66 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.67 +\ [diff,integration,named]) \
110.68 +\ [real_ (rhs q___), real_ v_, real_real_ Q]); \
110.69 +\ Q__ = Rewrite Querkraft_Moment True Q__; \
110.70 +\ (M__::bool) = \
110.71 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.72 +\ [diff,integration,named]) \
110.73 +\ [real_ (rhs Q__), real_ v_, real_real_ M_b]); \
110.74 +\ e1__ = nth_ 1 rm_; \
110.75 +\ (x1__::real) = argument_in (lhs e1__); \
110.76 +\ (M1__::bool) = (Substitute [v_ = x1__]) M__; \
110.77 +\ M1__ = (Substitute [e1__]) M1__ ; \
110.78 +\ M2__ = Take M__; "^
110.79 +(*without this Take 'Substitute [v_ = x2__]' takes _last formula from ctree_*)
110.80 +" e2__ = nth_ 2 rm_; \
110.81 +\ (x2__::real) = argument_in (lhs e2__); \
110.82 +\ (M2__::bool) = ((Substitute [v_ = x2__]) @@ \
110.83 +\ (Substitute [e2__])) M2__; \
110.84 +\ (c_1_2__::bool list) = \
110.85 +\ (SubProblem (Biegelinie_,[linear,system],[no_met]) \
110.86 +\ [booll_ [M1__, M2__], reall [c,c_2]]); \
110.87 +\ M__ = Take M__; \
110.88 +\ M__ = ((Substitute c_1_2__) @@ \
110.89 +\ (Try (Rewrite_Set_Inst [(bdv_1, c),(bdv_2, c_2)]\
110.90 +\ simplify_System False)) @@ \
110.91 +\ (Rewrite Moment_Neigung False) @@ \
110.92 +\ (Rewrite make_fun_explicit False)) M__; "^
110.93 +(*----------------------- and the same once more ------------------------*)
110.94 +" (N__:: bool) = \
110.95 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.96 +\ [diff,integration,named]) \
110.97 +\ [real_ (rhs M__), real_ v_, real_real_ y']); \
110.98 +\ (B__:: bool) = \
110.99 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.100 +\ [diff,integration,named]) \
110.101 +\ [real_ (rhs N__), real_ v_, real_real_ y]); \
110.102 +\ e1__ = nth_ 1 rb_; \
110.103 +\ (x1__::real) = argument_in (lhs e1__); \
110.104 +\ (B1__::bool) = (Substitute [v_ = x1__]) B__; \
110.105 +\ B1__ = (Substitute [e1__]) B1__ ; \
110.106 +\ B2__ = Take B__; \
110.107 +\ e2__ = nth_ 2 rb_; \
110.108 +\ (x2__::real) = argument_in (lhs e2__); \
110.109 +\ (B2__::bool) = ((Substitute [v_ = x2__]) @@ \
110.110 +\ (Substitute [e2__])) B2__; \
110.111 +\ (c_1_2__::bool list) = \
110.112 +\ (SubProblem (Biegelinie_,[linear,system],[no_met]) \
110.113 +\ [booll_ [B1__, B2__], reall [c,c_2]]); \
110.114 +\ B__ = Take B__; \
110.115 +\ B__ = ((Substitute c_1_2__) @@ \
110.116 +\ (Rewrite_Set_Inst [(bdv, x)] make_ratpoly_in False)) B__ \
110.117 +\ in B__)"
110.118 +;
110.119 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.120 +(*---^^^-OK-----------------------------------------------------------------*)
110.121 +(*---vvv-NOTok--------------------------------------------------------------*)
110.122 +atomty sc;
110.123 +atomt sc;
110.124 +
110.125 +(* use"../smltest/IsacKnowledge/biegelinie.sml";
110.126 + *)
110.127 +
110.128 +"----------- IntegrierenUndKonstanteBestimmen by rewriting -------";
110.129 +"----------- IntegrierenUndKonstanteBestimmen by rewriting -------";
110.130 +"----------- IntegrierenUndKonstanteBestimmen by rewriting -------";
110.131 +val t = str2t "M_b x = L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2";
110.132 +val t = rewrit Moment_Neigung t; term2s t;
110.133 +(*was "EI * ?y'' x = L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2"
110.134 + ### before declaring "y''" as a constant *)
110.135 +val t = rewrit make_fun_explicit t; term2s t;
110.136 +
110.137 +
110.138 +"----------- simplify_leaf for this script -----------------------";
110.139 +"----------- simplify_leaf for this script -----------------------";
110.140 +"----------- simplify_leaf for this script -----------------------";
110.141 +val srls = Rls {id="srls_IntegrierenUnd..",
110.142 + preconds = [],
110.143 + rew_ord = ("termlessI",termlessI),
110.144 + erls = append_rls "erls_in_srls_IntegrierenUnd.." e_rls
110.145 + [(*for asm in nth_Cons_ ...*)
110.146 + Calc ("op <",eval_equ "#less_"),
110.147 + (*2nd nth_Cons_ pushes n+-1 into asms*)
110.148 + Calc("op +", eval_binop "#add_")
110.149 + ],
110.150 + srls = Erls, calc = [],
110.151 + rules = [Thm ("nth_Cons_",num_str nth_Cons_),
110.152 + Calc("op +", eval_binop "#add_"),
110.153 + Thm ("nth_Nil_",num_str nth_Nil_),
110.154 + Calc("Tools.lhs", eval_lhs"eval_lhs_"),
110.155 + Calc("Tools.rhs", eval_rhs"eval_rhs_"),
110.156 + Calc("Atools.argument'_in",
110.157 + eval_argument_in "Atools.argument'_in")
110.158 + ],
110.159 + scr = EmptyScr};
110.160 +val rm_ = str2term"[M_b 0 = 0, M_b L = 0]";
110.161 +val M__ = str2term"M_b x = -1 * x ^^^ 2 / 2 + x * c + c_2";
110.162 +val Some (e1__,_) =
110.163 + rewrite_set_ thy false srls
110.164 + (str2term"(nth_::[real,bool list]=>bool) 1 " $ rm_);
110.165 +if term2str e1__ = "M_b 0 = 0" then ()
110.166 +else raise error "biegelinie.sml simplify nth_ 1 rm_";
110.167 +
110.168 +val Some (x1__,_) =
110.169 + rewrite_set_ thy false srls
110.170 + (str2term"argument_in (lhs (M_b 0 = 0))");
110.171 +if term2str x1__ = "0" then ()
110.172 +else raise error "biegelinie.sml simplify argument_in (lhs (M_b 0 = 0)";
110.173 +
110.174 +trace_rewrite:=true;
110.175 +trace_rewrite:=false;
110.176 +
110.177 +
110.178 +
110.179 +"----------- Bsp 7.27 me -----------------------------------------";
110.180 +"----------- Bsp 7.27 me -----------------------------------------";
110.181 +"----------- Bsp 7.27 me -----------------------------------------";
110.182 +val fmz = ["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
110.183 + "RandbedingungenBiegung [y 0 = 0, y L = 0]",
110.184 + "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
110.185 + "FunktionsVariable x"];
110.186 +val (dI',pI',mI') =
110.187 + ("Biegelinie.thy",["MomentBestimmte","Biegelinien"],
110.188 + ["IntegrierenUndKonstanteBestimmen"]);
110.189 +val p = e_pos'; val c = [];
110.190 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
110.191 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.192 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.193 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.194 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.195 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.196 +
110.197 +val pits = get_obj g_pbl pt (fst p);writeln (itms2str thy pits);
110.198 +(*if itms2str thy pits = ... all 5 model-items*)
110.199 +val mits = get_obj g_met pt (fst p); writeln (itms2str thy mits);
110.200 +if itms2str thy mits = "[]" then ()
110.201 +else raise error "biegelinie.sml: Bsp 7.27 #2";
110.202 +
110.203 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.204 +case nxt of (_,Add_Given "FunktionsVariable x") => ()
110.205 + | _ => raise error "biegelinie.sml: Bsp 7.27 #4a";
110.206 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.207 +val mits = get_obj g_met pt (fst p);writeln (itms2str thy mits);
110.208 +(*if itms2str thy mits = ... all 6 guard-items*)
110.209 +case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
110.210 + | _ => raise error "biegelinie.sml: Bsp 7.27 #4b";
110.211 +
110.212 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.213 +case pt of Nd (PblObj _, [Nd _]) => ((*Apply_Method + Take*))
110.214 + | _ => raise error "biegelinie.sml: Bsp 7.27 #4c";
110.215 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.216 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.217 +
110.218 +case nxt of
110.219 + (_,Subproblem ("Biegelinie.thy", ["named", "integrate", "function"])) => ()
110.220 + | _ => raise error "biegelinie.sml: Bsp 7.27 #4c";
110.221 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.222 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.223 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.224 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.225 +case nxt of (_, Apply_Method ["diff", "integration", "named"]) => ()
110.226 + | _ => raise error "biegelinie.sml: Bsp 7.27 #5";
110.227 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.228 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.229 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.230 +case nxt of
110.231 + ("Check_Postcond", Check_Postcond ["named", "integrate", "function"]) => ()
110.232 + | _ => raise error "biegelinie.sml: Bsp 7.27 #5a";
110.233 +
110.234 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.235 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.236 +case nxt of
110.237 + (_, Subproblem ("Biegelinie.thy", ["named", "integrate", "function"]))=>()
110.238 + | _ => raise error "biegelinie.sml: Bsp 7.27 #5b";
110.239 +
110.240 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.241 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.242 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.243 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.244 +case nxt of (_, Apply_Method ["diff", "integration","named"]) => ()
110.245 + | _ => raise error "biegelinie.sml: Bsp 7.27 #6";
110.246 +
110.247 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.248 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*nxt = Check_Postcond ["named", "int..*);
110.249 +f2str f;
110.250 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.251 +case nxt of (_, Substitute ["x = 0"]) => ()
110.252 + | _ => raise error "biegelinie.sml: Bsp 7.27 #7";
110.253 +
110.254 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.255 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.256 +if f2str f = "0 = c_2 + c * 0 + -1 * q_0 / 2 * 0 ^^^ 2" then ()
110.257 +else raise error "biegelinie.sml: Bsp 7.27 #8";
110.258 +
110.259 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.260 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.261 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.262 +if f2str f = "0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2" then ()
110.263 +else raise error "biegelinie.sml: Bsp 7.27 #9";
110.264 +
110.265 +(*val nxt = (+, Subproblem ("Biegelinie.thy", ["normalize", ..lin..sys]))*)
110.266 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.267 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.268 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.269 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.270 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.271 +case nxt of (_, Apply_Method ["EqSystem", "normalize", "2x2"]) => ()
110.272 + | _ => raise error "biegelinie.sml: Bsp 7.27 #10";
110.273 +
110.274 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.275 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.276 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.277 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.278 +(*val nxt = Subproblem ["triangular", "2x2", "linear", "system"]*)
110.279 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.280 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.281 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.282 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.283 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.284 +case nxt of (_, Apply_Method["EqSystem", "top_down_substitution", "2x2"]) => ()
110.285 + | _ => raise error "biegelinie.sml: Bsp 7.27 #11";
110.286 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.287 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.288 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.289 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.290 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.291 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.292 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.293 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.294 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.295 +case nxt of (_, Check_Postcond ["normalize", "2x2", "linear", "system"]) => ()
110.296 + | _ => raise error "biegelinie.sml: Bsp 7.27 #12";
110.297 +
110.298 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.299 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.300 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.301 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.302 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.303 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.304 +case nxt of
110.305 + (_, Subproblem ("Biegelinie.thy", ["named", "integrate", "function"]))=>()
110.306 + | _ => raise error "biegelinie.sml: Bsp 7.27 #13";
110.307 +
110.308 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.309 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.310 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.311 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.312 +case nxt of (_, Apply_Method ["diff", "integration", "named"]) => ()
110.313 + | _ => raise error "biegelinie.sml: Bsp 7.27 #14";
110.314 +
110.315 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.316 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.317 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.318 +case nxt of
110.319 + (_, Check_Postcond ["named", "integrate", "function"]) => ()
110.320 + | _ => raise error "biegelinie.sml: Bsp 7.27 #15";
110.321 +
110.322 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.323 +if f2str f =
110.324 + "y' x = c + 1 / (-1 * EI) * (L * q_0 / 4 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3)"
110.325 +then () else raise error "biegelinie.sml: Bsp 7.27 #16 f";
110.326 +case nxt of
110.327 + (_, Subproblem ("Biegelinie.thy", ["named", "integrate", "function"]))=>()
110.328 + | _ => raise error "biegelinie.sml: Bsp 7.27 #16";
110.329 +
110.330 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.331 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.332 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.333 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.334 +case nxt of (_, Apply_Method ["diff", "integration", "named"]) => ()
110.335 + | _ => raise error "biegelinie.sml: Bsp 7.27 #17";
110.336 +
110.337 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.338 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.339 +if f2str f =
110.340 + "y x =\nc_2 + c * x +\n\
110.341 + \1 / (-1 * EI) * (L * q_0 / 12 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)"
110.342 +then () else raise error "biegelinie.sml: Bsp 7.27 #18 f";
110.343 +case nxt of
110.344 + (_, Check_Postcond ["named", "integrate", "function"]) => ()
110.345 + | _ => raise error "biegelinie.sml: Bsp 7.27 #18";
110.346 +
110.347 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.348 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.349 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.350 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.351 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.352 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.353 +case nxt of
110.354 + (_, Subproblem
110.355 + ("Biegelinie.thy", ["normalize", "2x2", "linear", "system"])) => ()
110.356 + | _ => raise error "biegelinie.sml: Bsp 7.27 #19";
110.357 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.358 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.359 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.360 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.361 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.362 +case nxt of (_, Apply_Method ["EqSystem", "normalize", "2x2"]) => ()
110.363 + | _ => raise error "biegelinie.sml: Bsp 7.27 #20";
110.364 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.365 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.366 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.367 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.368 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.369 +if f2str f = "[c_2 = 0, L * c + c_2 = -1 * q_0 * L ^^^ 4 / (-24 * EI)]" then ()
110.370 +else raise error "biegelinie.sml: Bsp 7.27 #21 f";
110.371 +case nxt of
110.372 + (_, Subproblem
110.373 + ("Biegelinie.thy", ["triangular", "2x2", "linear", "system"])) =>()
110.374 + | _ => raise error "biegelinie.sml: Bsp 7.27 #21";
110.375 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.376 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.377 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.378 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.379 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.380 +case nxt of (_, Apply_Method["EqSystem", "top_down_substitution", "2x2"]) => ()
110.381 + | _ => raise error "biegelinie.sml: Bsp 7.27 #22";
110.382 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.383 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.384 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.385 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.386 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.387 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.388 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.389 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.390 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.391 +case nxt of (_, Check_Postcond ["normalize", "2x2", "linear", "system"]) => ()
110.392 + | _ => raise error "biegelinie.sml: Bsp 7.27 #23";
110.393 +
110.394 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.395 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.396 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.397 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.398 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.399 +if f2str f =
110.400 +"y x =\n-1 * q_0 * L ^^^ 4 / (-24 * EI * L) * x +\n\
110.401 + \(2 * L * q_0 / (-1 * 24 * EI) * x ^^^ 3 +\n\
110.402 + \ -1 * q_0 / (-1 * 24 * EI) * x ^^^ 4)" then ()
110.403 +else raise error "biegelinie.sml: Bsp 7.27 #24 f";
110.404 +case nxt of ("End_Proof'", End_Proof') => ()
110.405 + | _ => raise error "biegelinie.sml: Bsp 7.27 #24";
110.406 +
110.407 +(* use"../smltest/IsacKnowledge/biegelinie.sml";
110.408 + *)
110.409 +show_pt pt;
110.410 +(*(([], Frm), Problem (Biegelinie.thy, [MomentBestimmte, Biegelinien])),
110.411 +(([1], Frm), q_ x = q_0),
110.412 +(([1], Res), - q_ x = - q_0),
110.413 +(([2], Res), Q' x = - q_0),
110.414 +(([3], Pbl), Integrate (- q_0, x)),
110.415 +(([3,1], Frm), Q x = Integral - q_0 D x),
110.416 +(([3,1], Res), Q x = -1 * q_0 * x + c),
110.417 +(([3], Res), Q x = -1 * q_0 * x + c),
110.418 +(([4], Res), M_b' x = -1 * q_0 * x + c),
110.419 +(([5], Pbl), Integrate (-1 * q_0 * x + c, x)),
110.420 +(([5,1], Frm), M_b x = Integral -1 * q_0 * x + c D x),
110.421 +(([5,1], Res), M_b x = -1 * q_0 * x ^^^ 2 / 2 + x * c + c_2),
110.422 +(([5], Res), M_b x = -1 * q_0 * x ^^^ 2 / 2 + x * c + c_2),
110.423 +(([6], Res), M_b 0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2),
110.424 +(([7], Res), 0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2),
110.425 +(([8], Res), M_b L = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2),
110.426 +(([9], Res), 0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2),
110.427 +(([10], Pbl), solveSystem [0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2] [c_2]),
110.428 +(([10,1], Frm), [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
110.429 + 0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]),
110.430 +(([10,1], Res), [0 = c_2, 0 = -1 * (q_0 * L ^^^ 2) / 2 + (L * c + c_2)]),
110.431 +(([10,2], Res), [c_2 = 0, L * c + c_2 = 0 + -1 * (-1 * (q_0 * L ^^^ 2) / 2)]),
110.432 +(([10,3], Res), [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]),
110.433 +(([10,4], Pbl), solveSystem [L * c + c_2 = q_0 * L ^^^ 2 / 2] [c_2]),
110.434 +(([10,4,1], Frm), L * c + c_2 = q_0 * L ^^^ 2 / 2),
110.435 +(([10,4,1], Res), L * c + 0 = q_0 * L ^^^ 2 / 2),
110.436 +(([10,4,2], Res), L * c = q_0 * L ^^^ 2 / 2),
110.437 +(([10,4,3], Res), c = q_0 * L ^^^ 2 / 2 / L),
110.438 +(([10,4,4], Res), c = L * q_0 / 2),
110.439 +(([10,4,5], Res), [c = L * q_0 / 2, c_2 = 0]),
110.440 +(([10,4], Res), [c = L * q_0 / 2, c_2 = 0]),
110.441 +(([10], Res), [c = L * q_0 / 2, c_2 = 0]),
110.442 +(([11], Res), M_b x = -1 * q_0 * x ^^^ 2 / 2 + x * (L * q_0 / 2) + 0),
110.443 +(([12], Res), M_b x = L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2),
110.444 +(([13], Res), EI * y'' x = L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2),
110.445 +(([14], Res), y'' x = 1 / EI * (L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2)),
110.446 +(([15], Pbl), Integrate (1 / EI * (L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2), x)),
110.447 +(([15,1], Frm), y' x = Integral 1 / EI * (L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2) D x),
110.448 +(([15,1], Res), y' x =
110.449 +(Integral L * q_0 * x / 2 D x + Integral -1 * q_0 * x ^^^ 2 / 2 D x) / EI +
110.450 +c)]*)
110.451 +
110.452 +"----------- Bsp 7.27 autoCalculate ------------------------------";
110.453 +"----------- Bsp 7.27 autoCalculate ------------------------------";
110.454 +"----------- Bsp 7.27 autoCalculate ------------------------------";
110.455 + states:=[];
110.456 + CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
110.457 + "RandbedingungenBiegung [y 0 = 0, y L = 0]",
110.458 + "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
110.459 + "FunktionsVariable x"],
110.460 + ("Biegelinie.thy",
110.461 + ["MomentBestimmte","Biegelinien"],
110.462 + ["IntegrierenUndKonstanteBestimmen"]))];
110.463 + moveActiveRoot 1;
110.464 + autoCalculate 1 CompleteCalcHead;
110.465 +
110.466 + fetchProposedTactic 1 (*->"Apply_Method" IntegrierenUndKonstanteBestimmen*);
110.467 +(*
110.468 +> val (_,Apply_Method' (_, None, ScrState is), _)::_ = tacis;
110.469 +> is = e_scrstate;
110.470 +val it = true : bool
110.471 +*)
110.472 + autoCalculate 1 (Step 1) (*->GENERATED ([1], Frm)*);
110.473 + val ((pt,_),_) = get_calc 1;
110.474 + case pt of Nd (PblObj _, [Nd _]) => ((*Apply_Method + Take*))
110.475 + | _ => raise error "biegelinie.sml: Bsp 7.27 autoCalculate#4c";
110.476 +
110.477 + autoCalculate 1 CompleteCalc;
110.478 +val ((pt,p),_) = get_calc 1;
110.479 +if p = ([], Res) andalso length (children pt) = 23 andalso
110.480 +term2str (get_obj g_res pt (fst p)) =
110.481 +"y x =\n-1 * q_0 * L ^^^ 4 / (-24 * EI * L) * x +\n(2 * L * q_0 / (-1 * 24 * EI) * x ^^^ 3 +\n -1 * q_0 / (-1 * 24 * EI) * x ^^^ 4)"
110.482 +then () else raise error "biegelinie.sml: 1st biegelin.7.27 changed";
110.483 +
110.484 + val (unc, del, gen) = (([],Pbl), ([],Pbl), ([],Res));
110.485 + getFormulaeFromTo 1 unc gen 1 (*only level 1*) false;
110.486 + show_pt pt;
110.487 +
110.488 +(*check all formulae for getTactic*)
110.489 + getTactic 1 ([1],Frm) (*see smltest/../reverse-rew.sml*);
110.490 + getTactic 1 ([5],Res) (*tac2xml: not impl. for Substitute ["x = 0"]*);
110.491 + getTactic 1 ([6],Res) (* ---"--- ["M_b 0 = 0"]*);
110.492 + getTactic 1 ([7],Res) (*!!!!!Take!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*);
110.493 + getTactic 1 ([8],Frm) (*tac2xml: not impl. for Substitute ["x = L"]*);
110.494 + getTactic 1 ([8],Res) (* ---"--- ["M_b L = 0"]*);
110.495 +
110.496 +
110.497 +"----------- SubProblem (_,[vonBelastungZu,Biegelinien] ----------";
110.498 +"----------- SubProblem (_,[vonBelastungZu,Biegelinien] ----------";
110.499 +"----------- SubProblem (_,[vonBelastungZu,Biegelinien] ----------";
110.500 +val fmz =
110.501 + ["Streckenlast q_0","FunktionsVariable x",
110.502 + "Funktionen [Q x = c + -1 * q_0 * x, \
110.503 + \M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2,\
110.504 + \ y' x = c_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3),\
110.505 + \ y x = c_4 + c_3 * x + 1 / (-1 * EI) * (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)]"];
110.506 +val (dI',pI',mI') = ("Biegelinie.thy", ["vonBelastungZu","Biegelinien"],
110.507 + ["Biegelinien","ausBelastung"]);
110.508 +val p = e_pos'; val c = [];
110.509 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
110.510 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.511 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.512 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.513 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.514 +if nxt = ("Apply_Method", Apply_Method ["Biegelinien", "ausBelastung"])
110.515 +then () else raise error "biegelinie.sml met2 b";
110.516 +
110.517 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "q_ x = q_0";
110.518 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "- q_ x = - q_0";
110.519 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "Q' x = - q_0";
110.520 +case nxt of (_, Subproblem (_, ["named", "integrate", "function"])) => ()
110.521 +| _ => raise error "biegelinie.sml met2 c";
110.522 +
110.523 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.524 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.525 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.526 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.527 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.528 +
110.529 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "Q x = c + -1 * q_0 * x";
110.530 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "Q x = c + -1 * q_0 * x";
110.531 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "M_b' x = c + -1 * q_0 * x";
110.532 +case nxt of (_,Subproblem (_, ["named", "integrate", "function"])) => ()
110.533 +| _ => raise error "biegelinie.sml met2 d";
110.534 +
110.535 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.536 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.537 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.538 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.539 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.540 + "M_b x = Integral c + -1 * q_0 * x D x";
110.541 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.542 + "M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2";
110.543 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.544 + "M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2";
110.545 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.546 + "- EI * y'' x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2";
110.547 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.548 + "y'' x = 1 / - EI * (c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2)";
110.549 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.550 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.551 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.552 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.553 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.554 + "y' x = Integral 1 / - EI * (c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2) D x";
110.555 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.556 +"y' x = Integral 1 / (-1 * EI) * (c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2) D x";
110.557 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.558 +"y' x =\nc_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3)";
110.559 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.560 +"y' x =\nc_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3)";
110.561 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.562 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.563 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.564 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.565 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.566 +"y x =\nIntegral c_3 +\n 1 / (-1 * EI) *\n (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3) D x";
110.567 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.568 +"y x =\nc_4 + c_3 * x +\n1 / (-1 * EI) *\n(c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)";
110.569 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.570 + "y x =\nc_4 + c_3 * x +\n1 / (-1 * EI) *\n(c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)";
110.571 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.572 +if nxt = ("End_Proof'", End_Proof') andalso f2str f =
110.573 + "[Q x = c + -1 * q_0 * x, M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2,\n y' x =\n c_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3),\n y x =\n c_4 + c_3 * x +\n 1 / (-1 * EI) *\n (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)]" then ()
110.574 +else raise error "biegelinie.sml met2 e";
110.575 +
110.576 +
110.577 +
110.578 +"----------- SubProblem (_,[setzeRandbedingungen,Biegelinien] ----";
110.579 +"----------- SubProblem (_,[setzeRandbedingungen,Biegelinien] ----";
110.580 +"----------- SubProblem (_,[setzeRandbedingungen,Biegelinien] ----";
110.581 +val str =
110.582 +"Script Function2Equality (fun_::bool) (sub_::bool) =\
110.583 +\(equ___::bool)"
110.584 +;
110.585 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.586 +val str =
110.587 +"Script Function2Equality (fun_::bool) (sub_::bool) =\
110.588 +\ (let v_ = argument_in (lhs fun_)\
110.589 +\ in (equ___::bool))"
110.590 +;
110.591 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.592 +val str =
110.593 +"Script Function2Equality (fun_::bool) (sub_::bool) =\
110.594 +\ (let v_ = argument_in (lhs fun_);\
110.595 +\ (equ_) = (Substitute [sub_]) fun_\
110.596 +\ in (equ_::bool))"
110.597 +;
110.598 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.599 +val str =
110.600 +"Script Function2Equality (fun_::bool) (sub_::bool) =\
110.601 +\ (let v_ = argument_in (lhs fun_);\
110.602 +\ equ_ = (Substitute [sub_]) fun_\
110.603 +\ in (Rewrite_Set_Inst [(bdv, v_)] make_ratpoly_in False) equ_)"
110.604 +;
110.605 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.606 +(*---^^^-OK-----------------------------------------------------------------*)
110.607 +val str =
110.608 +(*(M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2) (M_b L = 0) -->
110.609 + 0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2*)
110.610 +"Script Function2Equality (fun_::bool) (sub_::bool) =\
110.611 +\ (let bdv_ = argument_in (lhs fun_);\
110.612 +\ val_ = argument_in (lhs sub_);\
110.613 +\ equ_ = (Substitute [bdv_ = val_]) fun_;\
110.614 +\ equ_ = (Substitute [sub_]) fun_\
110.615 +\ in (Rewrite_Set_Inst [(bdv_, v_)] make_ratpoly_in False) equ_)"
110.616 +;
110.617 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.618 +(*---vvv-NOTok--------------------------------------------------------------*)
110.619 +atomty sc;
110.620 +
110.621 +val fmz = ["functionEq (M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2)",
110.622 + "substitution (M_b L = 0)",
110.623 + "equality equ___"];
110.624 +val (dI',pI',mI') = ("Biegelinie.thy", ["makeFunctionTo","equation"],
110.625 + ["Equation","fromFunction"]);
110.626 +val p = e_pos'; val c = [];
110.627 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
110.628 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.629 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.630 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.631 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.632 +
110.633 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.634 + "M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2";
110.635 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.636 + "M_b L = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2";
110.637 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.638 + "0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2";
110.639 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.640 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.641 +if nxt = ("End_Proof'", End_Proof') andalso
110.642 +(* f2str f = "0 = c_2 + L * c + -1 * q_0 / 2 * L ^^^ 2"
110.643 +CHANGE NOT considered, already on leave*)
110.644 + f2str f = "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2"
110.645 +then () else raise error "biegelinie.sml: SubProblem (_,[setzeRandbed";
110.646 +
110.647 +
110.648 +"----------- method [Biegelinien,setzeRandbedingungenEin] + exec -";
110.649 +"----------- method [Biegelinien,setzeRandbedingungenEin] + exec -";
110.650 +"----------- method [Biegelinien,setzeRandbedingungenEin] + exec -";
110.651 +"----- check the scripts syntax";
110.652 +val str =
110.653 +"Script SetzeRandbedScript (funs_::bool list) (beds_::bool list) =\
110.654 +\ (let b1 = Take (nth_ 1 beds_)\
110.655 +\ in (equs_::bool list))"
110.656 +;
110.657 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.658 +val str =
110.659 +"Script SetzeRandbedScript (funs_::bool list) (beds_::bool list) =\
110.660 +\ (let b1_ = Take (nth_ 1 beds_); \
110.661 +\ fs_ = filter (sameFunId (lhs b1_)) funs_; \
110.662 +\ f1_ = hd fs_ \
110.663 +\ in (equs_::bool list))"
110.664 +;
110.665 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.666 +
110.667 +val ttt = str2term "sameFunId (lhs b1_) fun___"; atomty ttt;
110.668 +val ttt = str2term "filter"; atomty ttt;
110.669 +val ttt = str2term "filter::[real => bool, real list] => real list";atomty ttt;
110.670 +val ttt = str2term "filter::[bool => bool, bool list] => bool list";
110.671 +val ttt = str2term "filter (sameFunId (lhs b1_)) funs_"; atomty ttt;
110.672 +
110.673 +val str =
110.674 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) =\
110.675 +\ (let beds_ = rev beds_; \
110.676 +\ b1_ = Take (nth_ 1 beds_); \
110.677 +\ fs_ = filter (sameFunId (lhs b1_)) funs_; \
110.678 +\ f1_ = hd fs_ \
110.679 +\ in (equs_::bool list))"
110.680 +;
110.681 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.682 +val str =
110.683 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) =\
110.684 +\ (let b1_ = Take (nth_ 1 rb_); \
110.685 +\ fs_ = filter (sameFunId (lhs b1_)) funs_; \
110.686 +\ (equ_::bool) = \
110.687 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.688 +\ [Equation,fromFunction]) \
110.689 +\ [bool_ (hd fs_), bool_ b1_]) \
110.690 +\ in [equ_])"
110.691 +;
110.692 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.693 +val str =
110.694 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) =\
110.695 +\ (let b1_ = Take (nth_ 1 rb_); \
110.696 +\ fs_ = filter (sameFunId (lhs b1_)) funs_; \
110.697 +\ (e1_::bool) = \
110.698 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.699 +\ [Equation,fromFunction]) \
110.700 +\ [bool_ (hd fs_), bool_ b1_]); \
110.701 +\ b2_ = Take (nth_ 2 rb_); \
110.702 +\ fs_ = filter (sameFunId (lhs b2_)) funs_; \
110.703 +\ (e2_::bool) = \
110.704 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.705 +\ [Equation,fromFunction]) \
110.706 +\ [bool_ (hd fs_), bool_ b2_]) \
110.707 +\ in [e1_,e1_])"
110.708 +;
110.709 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.710 +(*---vvv-NOTok--------------------------------------------------------------*)
110.711 +(*---^^^-OK-----------------------------------------------------------------*)
110.712 +atomty sc;
110.713 +
110.714 +"----- execute script by manual rewriting";
110.715 +(*show_types := true;*)
110.716 +val funs_ = str2term "funs_::bool list";
110.717 +val funs = str2term
110.718 + "[Q x = c + -1 * q_0 * x,\
110.719 + \M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2,\
110.720 + \y' x = c_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3),\
110.721 + \y x = c_4 + c_3 * x + 1 / (-1 * EI) * (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)]";
110.722 +val rb_ = str2term "rb_::bool list";
110.723 +val rb = str2term "[y 0 = 0, y L = 0, M_b 0 = 0, M_b L = 0]";
110.724 +
110.725 +"--- script expression 1";
110.726 +val screxp1_ = str2term "Take (nth_ 1 (rb_::bool list))";
110.727 +val screxp1 = subst_atomic [(rb_, rb)] screxp1_; term2str screxp1;
110.728 +val Some (b1,_) = rewrite_set_ Isac.thy false srls2 screxp1; term2str b1;
110.729 +if term2str b1 = "Take (y 0 = 0)" then ()
110.730 +else raise error "biegelinie.sml: rew. Bieglie2 --1";
110.731 +val b1 = str2term "(y 0 = 0)";
110.732 +
110.733 +"--- script expression 2";
110.734 +val screxp2_ = str2term "filter (sameFunId (lhs b1_)) funs_";
110.735 +val b1_ = str2term "b1_::bool";
110.736 +val screxp2 = subst_atomic [(b1_,b1),(funs_,funs)] screxp2_; term2str screxp2;
110.737 +val Some (fs,_) = rewrite_set_ Isac.thy false srls2 screxp2; term2str fs;
110.738 +if term2str fs = "[y x =\n c_4 + c_3 * x +\n 1 / (-1 * EI) *\n (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)]" then ()
110.739 +else raise error "biegelinie.sml: rew. Bieglie2 --2";
110.740 +
110.741 +"--- script expression 3";
110.742 +val screxp3_ = str2term "SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.743 +\ [Equation,fromFunction]) \
110.744 +\ [bool_ (hd fs_), bool_ b1_]";
110.745 +val fs_ = str2term "fs_::bool list";
110.746 +val screxp3 = subst_atomic [(fs_,fs),(b1_,b1)] screxp3_;
110.747 +writeln (term2str screxp3);
110.748 +val Some (equ,_) = rewrite_set_ Isac.thy false srls2 screxp3;
110.749 +if term2str equ = "SubProblem\n (Biegelinie_, [makeFunctionTo, equation], [Equation, fromFunction])\n [bool_\n (y x =\n c_4 + c_3 * x +\n 1 / (-1 * EI) *\n (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)),\n bool_ (y 0 = 0)]" then ()
110.750 +else raise error "biegelinie.sml: rew. Bieglie2 --3";
110.751 +writeln (term2str equ);
110.752 +(*SubProblem
110.753 + (Biegelinie_, [makeFunctionTo, equation], [Equation, fromFunction])
110.754 + [bool_
110.755 + (y x =
110.756 + c_4 + c_3 * x +
110.757 + 1 / (-1 * EI) *
110.758 + (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)),
110.759 + bool_ (y 0 = 0)]*)
110.760 +show_types := false;
110.761 +
110.762 +
110.763 +"----- execute script by interpreter: setzeRandbedingungenEin";
110.764 +val fmz = ["Funktionen [Q x = c + -1 * q_0 * x,\
110.765 + \M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2,\
110.766 + \y' x = c_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3),\
110.767 + \y x = c_4 + c_3 * x + 1 / (-1 * EI) * (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)]",
110.768 + "Randbedingungen [y 0 = 0, y L = 0, M_b 0 = 0, M_b L = 0]",
110.769 + "Gleichungen equs___"];
110.770 +val (dI',pI',mI') = ("Biegelinie.thy", ["setzeRandbedingungen","Biegelinien"],
110.771 + ["Biegelinien","setzeRandbedingungenEin"]);
110.772 +val p = e_pos'; val c = [];
110.773 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
110.774 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.775 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.776 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.777 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.778 +
110.779 +"--- before 1.subpbl [Equation, fromFunction]";
110.780 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.781 +case nxt of (_, Apply_Method ["Biegelinien", "setzeRandbedingungenEin"])=>()
110.782 +| _ => raise error "biegelinie.sml: met setzeRandbed*Ein aa";
110.783 +"----- Randbedingung y 0 = 0 in SUBpbl with met [Equation, fromFunction]";
110.784 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.785 +if (#1 o (get_obj g_fmz pt)) (fst p) =
110.786 + ["functionEq\n (y x =\n c_4 + c_3 * x +\n 1 / (-1 * EI) *\n (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4))",
110.787 + "substitution (y 0 = 0)", "equality equ___"] then ()
110.788 +else raise error "biegelinie.sml met setzeRandbed*Ein bb";
110.789 +(writeln o istate2str) (get_istate pt p);
110.790 +"--- after 1.subpbl [Equation, fromFunction]";
110.791 +
110.792 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.793 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.794 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.795 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.796 +case nxt of (_, Apply_Method["Equation", "fromFunction"]) => ()
110.797 +| _ => raise error "biegelinie.sml met2 ff";
110.798 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f =
110.799 + "y x =\nc_4 + c_3 * x +\n1 / (-1 * EI) *\n(c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)";
110.800 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.801 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.802 +case nxt of (_, Check_Postcond ["makeFunctionTo", "equation"]) => ()
110.803 +| _ => raise error "biegelinie.sml met2 gg";
110.804 +
110.805 +"--- before 2.subpbl [Equation, fromFunction]";
110.806 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = c_4 + 0 / (-1 * EI)" ;
110.807 +case nxt of (_,Subproblem (_, ["makeFunctionTo", "equation"])) => ()
110.808 +| _ => raise error "biegelinie.sml met2 hh";
110.809 +"--- after 1st arrival at 2.subpbl [Equation, fromFunction]";
110.810 +
110.811 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.812 +if (#1 o (get_obj g_fmz pt)) (fst p) =
110.813 + ["functionEq\n (y x =\n c_4 + c_3 * x +\n 1 / (-1 * EI) *\n (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4))",
110.814 + "substitution (y L = 0)", "equality equ___"] then ()
110.815 +else raise error "biegelinie.sml metsetzeRandbed*Ein bb ";
110.816 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.817 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.818 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.819 +
110.820 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.821 +case nxt of (_, Apply_Method["Equation", "fromFunction"]) => ()
110.822 +| _ => raise error "biegelinie.sml met2 ii";
110.823 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "y x =\nc_4 + c_3 * x +\n1 / (-1 * EI) *\n(c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)";
110.824 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "y L =\nc_4 + c_3 * L +\n1 / (-1 * EI) *\n(c_2 / 2 * L ^^^ 2 + c / 6 * L ^^^ 3 + -1 * q_0 / 24 * L ^^^ 4)";
110.825 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 =\nc_4 + c_3 * L +\n1 / (-1 * EI) *\n(c_2 / 2 * L ^^^ 2 + c / 6 * L ^^^ 3 + -1 * q_0 / 24 * L ^^^ 4)";
110.826 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 =\nc_4 + L * c_3 +\n(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI)" ;
110.827 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 =\nc_4 + L * c_3 +\n(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI)";
110.828 +case nxt of (_,Subproblem (_, ["makeFunctionTo", "equation"])) => ()
110.829 +| _ => raise error "biegelinie.sml met2 jj";
110.830 +
110.831 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.832 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.833 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.834 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.835 +case nxt of (_, Apply_Method ["Equation", "fromFunction"])=>()
110.836 +| _ => raise error "biegelinie.sml met2 kk";
110.837 +
110.838 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2"(*true*);
110.839 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = c_2 + c * 0 + -1 * q_0 / 2 * 0 ^^^ 2";
110.840 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = c_2";
110.841 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = c_2";
110.842 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.843 +case nxt of (_,Subproblem (_, ["makeFunctionTo", "equation"])) => ()
110.844 +| _ => raise error "biegelinie.sml met2 ll";
110.845 +
110.846 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.847 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.848 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.849 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.850 +case nxt of (_, Apply_Method ["Equation", "fromFunction"])=>()
110.851 +| _ => raise error "biegelinie.sml met2 mm";
110.852 +
110.853 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2";
110.854 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "M_b L = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2";
110.855 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2";
110.856 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2";
110.857 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f = "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2";
110.858 +case nxt of (_, Check_Postcond ["setzeRandbedingungen", "Biegelinien"]) => ()
110.859 +| _ => raise error "biegelinie.sml met2 nn";
110.860 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.861 +if nxt = ("End_Proof'", End_Proof') andalso f2str f =
110.862 +(* "[0 = c_4,\n 0 =\n c_4 + L * c_3 +\n (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI),\n 0 = c_2, 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]" *)
110.863 +"[0 = c_4,\n 0 =\n c_4 + L * c_3 +\n (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) /\n (-1 * EI * 24),\n 0 = c_2, 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]"
110.864 +then () else raise error "biegelinie.sml met2 oo";
110.865 +
110.866 +(*
110.867 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
110.868 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.869 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.870 +*)
110.871 +
110.872 +"----------- method [Biegelinien,setzeRandbedingungenEin]FAST ----";
110.873 +"----------- method [Biegelinien,setzeRandbedingungenEin]FAST ----";
110.874 +"----------- method [Biegelinien,setzeRandbedingungenEin]FAST ----";
110.875 +(*---^^^-OK-----------------------------------------------------------------*)
110.876 +(*---vvv-NOTok--------------------------------------------------------------*)
110.877 +val str =
110.878 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = \
110.879 +\ (let b1_ = nth_ 1 rb_; \
110.880 +\ (fs_::bool list) = filter_sameFunId (lhs b1_) funs_; \
110.881 +\ (e1_::bool) = \
110.882 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.883 +\ [Equation,fromFunction]) \
110.884 +\ [bool_ (hd fs_), bool_ b1_]) \
110.885 +\ in [e1_,e2_,e3_,e4_])"
110.886 +;
110.887 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.888 +(*---vvv-NOTok--------------------------------------------------------------*)
110.889 +val str =
110.890 +"Script SetzeRandbedScript (funs_::bool list) (rb_::bool list) = \
110.891 +\ (let b1_ = nth_ 1 rb_; \
110.892 +\ fs_ = filter_sameFunId (lhs b1_) funs_; \
110.893 +\ (e1_::bool) = \
110.894 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.895 +\ [Equation,fromFunction]) \
110.896 +\ [bool_ (hd fs_), bool_ b1_]); \
110.897 +\ b2_ = nth_ 2 rb_; \
110.898 +\ fs_ = filter_sameFunId (lhs b2_) funs_; \
110.899 +\ (e2_::bool) = \
110.900 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.901 +\ [Equation,fromFunction]) \
110.902 +\ [bool_ (hd fs_), bool_ b2_]); \
110.903 +\ b3_ = nth_ 3 rb_; \
110.904 +\ fs_ = filter_sameFunId (lhs b3_) funs_; \
110.905 +\ (e3_::bool) = \
110.906 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.907 +\ [Equation,fromFunction]) \
110.908 +\ [bool_ (hd fs_), bool_ b3_]); \
110.909 +\ b4_ = nth_ 4 rb_; \
110.910 +\ fs_ = filter_sameFunId (lhs b4_) funs_; \
110.911 +\ (e4_::bool) = \
110.912 +\ (SubProblem (Biegelinie_,[makeFunctionTo,equation],\
110.913 +\ [Equation,fromFunction]) \
110.914 +\ [bool_ (hd fs_), bool_ b4_]) \
110.915 +\ in [e1_,e2_,e3_,e4_])"
110.916 +;
110.917 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.918 +
110.919 +
110.920 +
110.921 +"----------- IntegrierenUndKonstanteBestimmen2: Bsp.7.70. --------";
110.922 +"----------- IntegrierenUndKonstanteBestimmen2: Bsp.7.70. --------";
110.923 +"----------- IntegrierenUndKonstanteBestimmen2: Bsp.7.70. --------";
110.924 +"----- script ";
110.925 +val str =
110.926 +"Script Belastung2BiegelScript (q__::real) (v_::real) = \
110.927 +\ (let q___ = Take (q_ v_ = q__); \
110.928 +\ q___ = ((Rewrite sym_real_minus_eq_cancel True) @@ \
110.929 +\ (Rewrite Belastung_Querkraft True)) q___; \
110.930 +\ (Q__:: bool) = \
110.931 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.932 +\ [diff,integration,named]) \
110.933 +\ [real_ (rhs q___), real_ v_, real_real_ Q]); \
110.934 +\ M__ = Rewrite Querkraft_Moment True Q__; \
110.935 +\ (M__::bool) = \
110.936 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.937 +\ [diff,integration,named]) \
110.938 +\ [real_ (rhs M__), real_ v_, real_real_ M_b]); \
110.939 +\ N__ = ((Rewrite Moment_Neigung False) @@ \
110.940 +\ (Rewrite make_fun_explicit False)) M__; \
110.941 +\ (N__:: bool) = \
110.942 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.943 +\ [diff,integration,named]) \
110.944 +\ [real_ (rhs N__), real_ v_, real_real_ y']); \
110.945 +\ (B__:: bool) = \
110.946 +\ (SubProblem (Biegelinie_,[named,integrate,function], \
110.947 +\ [diff,integration,named]) \
110.948 +\ [real_ (rhs N__), real_ v_, real_real_ y]) \
110.949 +\ in [Q__, M__, N__, B__])"
110.950 +;
110.951 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
110.952 +(*---^^^-OK-----------------------------------------------------------------*)
110.953 +(*---vvv-NOTok--------------------------------------------------------------*)
110.954 +
110.955 +
110.956 +"----- Bsp 7.70 with me";
110.957 +val fmz = ["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
110.958 + "Randbedingungen [y 0 = 0, y L = 0, M_b 0 = 0, M_b L = 0]",
110.959 + "FunktionsVariable x"];
110.960 +val (dI',pI',mI') = ("Biegelinie.thy", ["Biegelinien"],
110.961 + ["IntegrierenUndKonstanteBestimmen2"]);
110.962 +val p = e_pos'; val c = [];
110.963 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
110.964 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.965 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.966 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.967 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.968 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
110.969 +if nxt = ("Apply_Method", Apply_Method ["IntegrierenUndKonstanteBestimmen2"])
110.970 +then () else raise error "biegelinie.sml met2 a";
110.971 +
110.972 +(*** actual arg(s) missing for '["(#Find, (Funktionen, funs_))"]' i.e. should be 'copy-named' by '*_._'
110.973 +... THIS MEANS:
110.974 +#a# "Script Biegelinie2Script ..
110.975 +\ ... (SubProblem (Biegelinie_,[vonBelastungZu,Biegelinien], \
110.976 +\ [Biegelinien,ausBelastung]) \
110.977 +\ [real_ q__, real_ v_]); \
110.978 +
110.979 +#b# prep_met ... (["Biegelinien","ausBelastung"],
110.980 + ... ("#Given" ,["Streckenlast q__","FunktionsVariable v_"]),
110.981 + "Script Belastung2BiegelScript (q__::real) (v_::real) = \
110.982 +
110.983 +#a#b# BOTH HAVE 2 ARGUMENTS q__ and v_ ...OK
110.984 +##########################################################################
110.985 +BUT THE (#Find, (Funktionen, funs_)) IS NOT COPYNAMED BY funs___ !!!3*_!!!
110.986 +##########################################################################*)
110.987 +"further 'me' see ----- SubProblem (_,[vonBelastungZu,Biegelinien] -------\
110.988 +\ ----- SubProblem (_,[setzeRandbedingungen,Biegelinien] -";
110.989 +
110.990 +"----- Bsp 7.70 with autoCalculate";
110.991 +states:=[];
110.992 +CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
110.993 + "Randbedingungen [Q 0 = q_0 * L, M_b L = 0, y 0 = 0, y' 0 = 0]",
110.994 + "FunktionsVariable x"],
110.995 + ("Biegelinie.thy", ["Biegelinien"],
110.996 + ["IntegrierenUndKonstanteBestimmen2"]))];
110.997 +moveActiveRoot 1;
110.998 +autoCalculate 1 CompleteCalc;
110.999 +val ((pt,p),_) = get_calc 1; show_pt pt;
110.1000 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) =
110.1001 +"y x =\n-6 * q_0 * L ^^^ 2 / (-24 * EI) * x ^^^ 2 +\n4 * L * q_0 / (-24 * EI) * x ^^^ 3 +\n-1 * q_0 / (-24 * EI) * x ^^^ 4" then ()
110.1002 +else raise error "biegelinie.sml: diff.behav.7.70 with autoCalculate";
110.1003 +
110.1004 +val is = get_istate pt ([],Res); writeln (istate2str is);
110.1005 +val t = str2term " last \
110.1006 +\[Q x = L * q_0 + -1 * q_0 * x, \
110.1007 +\ M_b x = -1 * q_0 * L ^^^ 2 / 2 + q_0 * L / 1 * x + -1 * q_0 / 2 * x ^^^ 2,\
110.1008 +\ y' x = \
110.1009 +\ -3 * q_0 * L ^^^ 2 / (-6 * EI) * x + 3 * L * q_0 / (-6 * EI) * x ^^^ 2 +\
110.1010 +\ -1 * q_0 / (-6 * EI) * x ^^^ 3, \
110.1011 +\ y x = \
110.1012 +\ -6 * q_0 * L ^^^ 2 / (-24 * EI) * x ^^^ 2 + \
110.1013 +\ 4 * L * q_0 / (-24 * EI) * x ^^^ 3 + \
110.1014 +\ -1 * q_0 / (-24 * EI) * x ^^^ 4]";
110.1015 +val srls = append_rls "erls_IntegrierenUndK.." e_rls
110.1016 + [Calc("Tools.rhs", eval_rhs"eval_rhs_"),
110.1017 + Calc ("Atools.ident",eval_ident "#ident_"),
110.1018 + Thm ("last_thmI",num_str last_thmI),
110.1019 + Thm ("if_True",num_str if_True),
110.1020 + Thm ("if_False",num_str if_False)
110.1021 + ]
110.1022 + ;
110.1023 +val t = str2term "last [1,2,3,4]";
110.1024 +trace_rewrite := true;
110.1025 +val Some (e1__,_) = rewrite_set_ thy false srls t;
110.1026 +trace_rewrite := false;
110.1027 +term2str e1__;
110.1028 +
110.1029 +trace_script := true;
110.1030 +trace_script := false;
110.1031 +
110.1032 +
110.1033 +"----------- investigate normalforms in biegelinien --------------";
110.1034 +"----------- investigate normalforms in biegelinien --------------";
110.1035 +"----------- investigate normalforms in biegelinien --------------";
110.1036 +"----- coming from integration:";
110.1037 +val Q = str2term "Q x = c + -1 * q_0 * x";
110.1038 +val M_b = str2term "M_b x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2";
110.1039 +val y' = str2term "y' x = c_3 + 1 / (-1 * EI) * (c_2 * x + c / 2 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3)";
110.1040 +val y = str2term "y x = c_4 + c_3 * x +\n1 / (-1 * EI) * (c_2 / 2 * x ^^^ 2 + c / 6 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)";
110.1041 +(*^^^ 1 / (-1 * EI) NOT distributed - ok! ^^^^^^^^^^^^^^^^^^^^^^^*)
110.1042 +
110.1043 +"----- functions comming from:";
111.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
111.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/complex.sml Wed Jul 21 13:53:39 2010 +0200
111.3 @@ -0,0 +1,37 @@
111.4 +(* tests for Complex.thy
111.5 +
111.6 +use"../smltest/IsacKnowledge/complex.sml";
111.7 +use"complex.sml";
111.8 +*)
111.9 +
111.10 +val thy = Isac.thy;
111.11 +subthy (Float.thy, ComplexI.thy);
111.12 +
111.13 + val t = (term_of o the o (parse ComplexI.thy)) "I__";
111.14 + atomt t;
111.15 + val t = str2term "I__";
111.16 + atomt t;
111.17 + val t = str2term "1 + 2 * I__";
111.18 + atomt t;
111.19 + val t = str2term "1 + 2 * I__ + 3 + 4 * I__ * (5 + 6 * I__) / (7 + 8 * I__)";
111.20 + atomt t;
111.21 +(*andere konkrete Syntax ???*)
111.22 +
111.23 + val t = str2term "Float ((1,2),(0,0)) * I__";
111.24 + atomt t;
111.25 + term2str t;
111.26 + val t = str2term "Float ((1,2),(0,0)) + Float ((3,4),(0,0)) * I__";
111.27 + atomt t;
111.28 + term2str t;
111.29 +
111.30 + (*--- (1.1 + 2.2 I) * (3.3 + 4.4 I) = - 6.05 + 12 I ---*)
111.31 + val t = str2term "(Float ((11,-1),(0,0)) + Float ((22,-1),(0,0)) * I__) *\
111.32 + \(Float ((33,-1),(0,0)) + Float ((44,-1),(0,0)) * I__)";
111.33 + val Some (t',_) =
111.34 + rewrite_set_ thy false
111.35 + (append_rls "simpl_complex" make_polynomial
111.36 + [Thm ("square_I", num_str square_I)]) t;
111.37 + term2str t';
111.38 + "Float ((363, -2), 0, 0) + I__ * Float ((484, -2), 0, 0) +\
111.39 + \I__ * Float ((726, -2), 0, 0) + -1 * Float ((968, -2), 0, 0)"
111.40 + (*--- mit dem rls make_polynomial geht ja schon allerhand !!!---*)
111.41 \ No newline at end of file
112.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
112.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/diff.sml Wed Jul 21 13:53:39 2010 +0200
112.3 @@ -0,0 +1,692 @@
112.4 +(*
112.5 +
112.6 +use"../smltest/IsacKnowledge/diff.sml";
112.7 +use"diff.sml";
112.8 +*)
112.9 +
112.10 +"-----------------------------------------------------------------";
112.11 +"table of contents -----------------------------------------------";
112.12 +"-----------------------------------------------------------------";
112.13 +" _________________ problemtype _________________ ";
112.14 +"----------- for correction of diff_const ------------------------";
112.15 +" _________________ for correction of diff_quot _________________ ";
112.16 +" _________________ differentiate by rewrite _________________ ";
112.17 +" ______________ differentiate: me (*+ tacs input*) ______________ ";
112.18 +" ________________ differentiate stdin: student active________________ ";
112.19 +" _________________ differentiate stdin: tutor active_________________ ";
112.20 +"---------------------1.5.02 me from script ---------------------";
112.21 +"----------- primed id -------------------------------------------";
112.22 +"----------- diff_conv, sym_diff_conv ----------------------------";
112.23 +"----------- autoCalculate differentiate_on_R 2/x^2 --------------";
112.24 +"----------- autoCalculate diff after_simplification -------------";
112.25 +"----------- autoCalculate differentiate_equality ----------------";
112.26 +"----------- tests for examples ----------------------------------";
112.27 +"------------inform for x^2+x+1 ----------------------------------";
112.28 +"-----------------------------------------------------------------";
112.29 +"-----------------------------------------------------------------";
112.30 +"-----------------------------------------------------------------";
112.31 +
112.32 +
112.33 +val thy = Diff.thy;
112.34 +
112.35 +" _________________ problemtype _________________ ";
112.36 +" _________________ problemtype _________________ ";
112.37 +" _________________ problemtype _________________ ";
112.38 +val pbt = {Given =["functionTerm f_", "differentiateFor v_"],
112.39 + Where =[],
112.40 + Find =["derivative f_'_"],
112.41 + With =[],
112.42 + Relate=[]}:string ppc;
112.43 +val chkpbt = ((map (the o (parse Diff.thy))) o ppc2list) pbt;
112.44 +
112.45 +val org = ["functionTerm (d_d x (x ^^^ 2 + 3 * x + 4))",
112.46 + "differentiateFor x","derivative f_'_"];
112.47 +val chkorg = map (the o (parse Diff.thy)) org;
112.48 +
112.49 +get_pbt ["derivative_of","function"];
112.50 +get_met ["diff","differentiate_on_R"];
112.51 +
112.52 +(*erls should not be in ruleset'! Here only for tests*)
112.53 +ruleset' :=
112.54 +overwritelthy thy
112.55 + (!ruleset',
112.56 + [("erls",
112.57 + Rls {id = "erls",preconds = [], rew_ord = ("termlessI",termlessI),
112.58 + erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
112.59 + rules = [Thm ("refl",num_str refl),
112.60 + Thm ("le_refl",num_str le_refl),
112.61 + Thm ("radd_left_cancel_le",num_str radd_left_cancel_le),
112.62 + Thm ("not_true",num_str not_true),
112.63 + Thm ("not_false",num_str not_false),
112.64 + Thm ("and_true",and_true),
112.65 + Thm ("and_false",and_false),
112.66 + Thm ("or_true",or_true),
112.67 + Thm ("or_false",or_false),
112.68 + Thm ("and_commute",num_str and_commute),
112.69 + Thm ("or_commute",num_str or_commute),
112.70 +
112.71 + Calc ("Atools.is'_const",eval_const "#is_const_"),
112.72 + Calc ("Atools.occurs'_in", eval_occurs_in ""),
112.73 + Calc ("Tools.matches",eval_matches ""),
112.74 +
112.75 + Calc ("op +",eval_binop "#add_"),
112.76 + Calc ("op *",eval_binop "#mult_"),
112.77 + Calc ("Atools.pow" ,eval_binop "#power_"),
112.78 +
112.79 + Calc ("op <",eval_equ "#less_"),
112.80 + Calc ("op <=",eval_equ "#less_equal_"),
112.81 +
112.82 + Calc ("Atools.ident",eval_ident "#ident_")],
112.83 + scr = Script ((term_of o the o (parse thy))
112.84 + "empty_script")
112.85 + }:rls
112.86 + )]);
112.87 +
112.88 +"----------- for correction of diff_const ------------------------";
112.89 +"----------- for correction of diff_const ------------------------";
112.90 +"----------- for correction of diff_const ------------------------";
112.91 +(*re-evaluate this file, otherwise > *** ME_Isa: 'erls' not known*)
112.92 +val thy' = "Diff.thy";
112.93 +val ct = "Not (x =!= a)";
112.94 +rewrite_set thy' false "erls" ct;
112.95 +val ct = "2 is_const";
112.96 +rewrite_set thy' false "erls" ct;
112.97 +
112.98 +val thm = ("diff_const","");
112.99 +val ct = "d_d x x";
112.100 +val None =
112.101 + (rewrite_inst thy' "tless_true" "erls" false [("bdv","x")] thm ct);
112.102 +val ct = "d_d x 2";
112.103 +val Some (ctt,_) =
112.104 + (rewrite_inst thy' "tless_true" "erls" false [("bdv","x")] thm ct);
112.105 +"----- for 'd_d s a' we got 'a is_const' --> False --------vvv-----";
112.106 +trace_rewrite := true;
112.107 +val ct = "d_d s a";
112.108 + (rewrite_inst thy' "tless_true" "erls" false [("bdv","s")] thm ct);
112.109 +(*got: None instead Some*)
112.110 +eval_true Isac.thy [str2term "a is_const"] (assoc_rls"erls");
112.111 +(*got: false instead true; ~~~~~~~~~~~ replaced by 'is_atom'*)
112.112 +val Some (ctt,_) =
112.113 + (rewrite_inst thy' "tless_true" "erls" false [("bdv","s")] thm ct);
112.114 +if ctt = "0" then () else raise error "diff.sml: thm 'diff_const' diff.behav.";
112.115 +trace_rewrite := false;
112.116 +"----- for 'd_d s a' we had 'a is_const' --> False --------^^^-----";
112.117 +
112.118 +val thm = ("diff_var","");
112.119 +val ct = "d_d x x";
112.120 +val Some (ctt,_) =
112.121 + (rewrite_inst thy' "tless_true" "erls" false [("bdv","x")] thm ct);
112.122 +val ct = "d_d x a";
112.123 +val None =
112.124 + (rewrite_inst thy' "tless_true" "erls" false [("bdv","x")] thm ct);
112.125 +val ct = "d_d x (x+x)";
112.126 +val None =
112.127 +(rewrite_inst thy' "tless_true" "erls" false [("bdv","x")] thm ct);
112.128 +
112.129 +
112.130 +" _________________ for correction of diff_quot _________________ ";
112.131 +" _________________ for correction of diff_quot _________________ ";
112.132 +" _________________ for correction of diff_quot _________________ ";
112.133 +val thy' = "Diff.thy";
112.134 +val ct = "Not (x = 0)";
112.135 +rewrite_set thy' false "erls" ct;
112.136 +
112.137 +val ct = "d_d x ((x+1) / (x - 1))";
112.138 +val thm = ("diff_quot","");
112.139 +val Some (ctt,_) =
112.140 + (rewrite_inst thy' "tless_true" "erls" true [("bdv","x")] thm ct);
112.141 +
112.142 +
112.143 +
112.144 +
112.145 +
112.146 +
112.147 +
112.148 +" _________________ differentiate by rewrite _________________ ";
112.149 +" _________________ differentiate by rewrite _________________ ";
112.150 +" _________________ differentiate by rewrite _________________ ";
112.151 +val thy' = "Diff.thy";
112.152 +val ct = "d_d x (x ^^^ 2 + 3 * x + 4)";
112.153 +"--- 1 ---";
112.154 +val thm = ("diff_sum","");
112.155 +val (ct,_) = the (rewrite_inst thy' "tless_true" "erls" true
112.156 + [("bdv","x::real")] thm ct);
112.157 +"--- 2 ---";
112.158 +val (ct,_) = the (rewrite_inst thy' "tless_true" "erls" true
112.159 + [("bdv","x::real")] thm ct);
112.160 +"--- 3 ---";
112.161 +val thm = ("diff_prod_const","");
112.162 +val (ct,_) = the (rewrite_inst thy' "tless_true" "erls" true
112.163 + [("bdv","x::real")] thm ct);
112.164 +"--- 4 ---";
112.165 +val thm = ("diff_pow","");
112.166 +val (ct,_) = the (rewrite_inst thy' "tless_true" "erls" true
112.167 + [("bdv","x::real")] thm ct);
112.168 +"--- 5 ---";
112.169 +val thm = ("diff_const","");
112.170 +val (ct,_) = the (rewrite_inst thy' "tless_true" "erls" true
112.171 + [("bdv","x::real")] thm ct);
112.172 +"--- 6 ---";
112.173 +val thm = ("diff_var","");
112.174 +val (ct,_) = the (rewrite_inst thy' "tless_true" "erls" true
112.175 + [("bdv","x::real")] thm ct);
112.176 +if ct = "2 * x ^^^ (2 - 1) + 3 * 1 + 0" then ()
112.177 +else raise error "diff.sml diff.behav. in rewrite 1";
112.178 +"--- 7 ---";
112.179 +val rls = ("Test_simplify");
112.180 +val (ct,_) = the (rewrite_set thy' false rls ct);
112.181 +if ct="3 + 2 * x" then () else raise error "new behaviour in test-example";
112.182 +
112.183 +val ct = "2 * x ^^^ (2 - 1) + 3 * 1 + 0";
112.184 +val (ct,_) = the (rewrite_set thy' true rls ct);
112.185 +
112.186 +
112.187 +(*---
112.188 +val t = str2term "x ^^^ (2 - 1)";
112.189 +val Some (t',_) = rewrite_set_ thy false Test_simplify t;
112.190 +term2str t';
112.191 +
112.192 +val t = str2term "-1 * 1";
112.193 +val Some (thmID,thm) = get_calculation_ thy (the(assoc(calclist,"times"))) t;
112.194 +*)
112.195 +
112.196 +
112.197 +" ______________ differentiate: me (*+ tacs input*) ______________ ";
112.198 +" ______________ differentiate: me (*+ tacs input*) ______________ ";
112.199 +" ______________ differentiate: me (*+ tacs input*) ______________ ";
112.200 +val fmz = ["functionTerm (x ^^^ 2 + 3 * x + 4)",
112.201 + "differentiateFor x","derivative f_'_"];
112.202 +val (dI',pI',mI') =
112.203 + ("Diff.thy",["derivative_of","function"],
112.204 + ["diff","diff_simpl"]);
112.205 +val p = e_pos'; val c = [];
112.206 +"--- s1 ---";
112.207 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
112.208 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.209 +"--- s2 ---";
112.210 +(*val nxt = ("Add_Given",
112.211 +Add_Given "functionTerm (d_d x (x ^^^ #2 + #3 * x + #4))");*)
112.212 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.213 +"--- s3 ---";
112.214 +(*val nxt = ("Add_Given",Add_Given "differentiateFor x");*)
112.215 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.216 +"--- s4 ---";
112.217 +(*val nxt = ("Add_Find",Add_Find "derivative f_'_");*)
112.218 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.219 +"--- s5 ---";
112.220 +(*val nxt = ("Specify_Theory",Specify_Theory dI');*)
112.221 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.222 +"--- s6 ---";
112.223 +(*val nxt = ("Specify_Problem",Specify_Problem pI');*)
112.224 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.225 +"--- s7 ---";
112.226 +(*val nxt = ("Specify_Method",Specify_Method mI');*)
112.227 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.228 +"--- s8 ---";
112.229 +(*val nxt = ("Apply_Method",Apply_Method mI');*)
112.230 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.231 +"--- 1 ---";
112.232 +(*val nxt = ("Rewrite_Inst",Rewrite_Inst (["(bdv,x)"],("diff_sum","")));*)
112.233 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.234 +"--- 2 ---";
112.235 +(*val nxt = ("Rewrite_Inst",Rewrite_Inst (["(bdv,x)"],("diff_sum","")));*)
112.236 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.237 +(*val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.238 +val (p,_,f,nxt,_,pt) = me nxt p c pt;*)
112.239 +"--- 3 ---";
112.240 +(*val nxt = ("Rewrite_Inst",Rewrite_Inst (["(bdv,x)"],("diff_prod_const",...;*)
112.241 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.242 +(*val (p,_,f,nxt,_,pt) = me nxt p c pt;*)
112.243 +"--- 4 ---";
112.244 +(*val nxt = ("Rewrite_Inst",Rewrite_Inst (["(bdv,x)"],("diff_pow","")));*)
112.245 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.246 +(*val (p,_,f,nxt,_,pt) = me nxt p c pt;*)
112.247 +"--- 5 ---";
112.248 +(*val nxt = ("Rewrite_Inst",Rewrite_Inst (["(bdv,x)"],("diff_prod_const",...;*)
112.249 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.250 +(*val (p,_,f,nxt,_,pt) = me nxt p c pt;*)
112.251 +"--- 6 ---";
112.252 +(*val nxt = ("Rewrite_Inst",Rewrite_Inst (["(bdv,x)"],("diff_var","")));*)
112.253 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.254 +if f2str f = "2 * x ^^^ (2 - 1) + 3 * 1 + 0" then ()
112.255 +else raise error "diff.sml: diff.behav. in d_d x ^^^ 2 + 3 * x + 4";
112.256 +"--- 7 ---";
112.257 +(*------------------------------11.3.03--------------------
112.258 + trace_rewrite:=true;
112.259 + val (_,_,f,_,_,_) = me nxt p c pt;
112.260 + val Form' (FormKF (_,_,_,_,res)) = f;
112.261 + trace_rewrite:=false;
112.262 +
112.263 + val ct = "2 * x ^^^ (2 - 1) + 3 * 1 + 0";
112.264 + val Some (ct',_) = rewrite_set "Isac.thy" false "make_polynomial" ct;
112.265 +
112.266 + trace_rewrite:=true;
112.267 + val t = str2term ct;
112.268 + term2str t;
112.269 + val Some (t',_) = rewrite_set_ Isac.thy false make_polynomial t;
112.270 + term2str t';
112.271 + trace_rewrite:=false;
112.272 +
112.273 + val Some (t'',_) = rewrite_set_ Isac.thy false make_polynomial t';
112.274 + term2str t'';
112.275 +
112.276 + val thm = num_str realpow_eq_oneI;
112.277 + case string_of_thm thm of
112.278 +
112.279 +
112.280 + val Rewrite_Set' ("Diff.thy",false,"make_polynomial",ff,(ff',[])) = m;
112.281 + term2str ff; term2str ff';
112.282 +
112.283 +
112.284 +
112.285 +--------------------------------11.3.03--------------------*)
112.286 +
112.287 +(*val nxt = ("Rewrite_Set",Rewrite_Set "make_polynomial");*)
112.288 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.289 +"--- 8 ---";
112.290 +(*val nxt =
112.291 +("Check_Postcond",Check_Postcond ("Diff.thy","differentiate_on_R"));*)
112.292 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.293 +"--- 9 ---";
112.294 +(*val nxt = ("End_Proof'",End_Proof');*)
112.295 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
112.296 +if nxt = ("End_Proof'",End_Proof') andalso f2str f = "3 + 2 * x" then ()
112.297 +else raise error "diff.sml: new.behav. in me (*+ tacs input*)";
112.298 +(*if f = EmptyMout then () else raise error "new behaviour in + tacs input";
112.299 +meNEW extracts Form once more*)
112.300 +
112.301 +
112.302 +
112.303 +
112.304 +(*---------------- 1.5.02 -----------------------------------------
112.305 +
112.306 +" _________________ script-eval corrected _________________ ";
112.307 +" _________________ script-eval corrected _________________ ";
112.308 +" _________________ script-eval corrected _________________ ";
112.309 +val scr = Script (((inst_abs (assoc_thy "Test.thy")) o
112.310 + term_of o the o (parse Diff.thy))
112.311 + "Script Differentiate (f_::real) (v_::real) = \
112.312 + \(let f_ = Try (Repeat (Rewrite frac_conv False f_)); \
112.313 + \ f_ = Try (Repeat (Rewrite root_conv False f_)); \
112.314 + \ f_ = Repeat \
112.315 + \ ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False f_)) Or \
112.316 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False f_)) Or \
112.317 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False f_)) Or \
112.318 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot False f_)) Or \
112.319 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False f_)) Or \
112.320 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False f_)) Or \
112.321 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False f_)) Or \
112.322 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False f_)) Or \
112.323 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False f_)) Or \
112.324 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False f_)) Or \
112.325 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False f_)) Or \
112.326 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False f_)) Or \
112.327 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False f_)) Or \
112.328 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False f_)) Or \
112.329 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False f_)) Or \
112.330 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False f_)) Or \
112.331 + \ (Repeat (Rewrite_Set Test_simplify False f_))); \
112.332 + \ f_ = Try (Repeat (Rewrite sym_frac_conv False f_)) \
112.333 + \ in Try (Repeat (Rewrite sym_root_conv False f_)))");
112.334 +val d = e_rls;
112.335 +val (dI',pI',mI') =
112.336 + ("Diff.thy",e_pblID,
112.337 + ("Diff.thy","differentiate_on_R"));
112.338 +val p = e_pos'; val c = [];
112.339 +val (mI,m) = ("Init_Proof",Init_Proof ([], (dI',pI',mI')));
112.340 +val (p,_,_,_,_,pt) = me (mI,m) p c EmptyPtree;
112.341 +val nxt = ("Specify_Theory",Specify_Theory dI');
112.342 +val (p,_,_,_,_,pt) = me nxt p c pt;
112.343 +val nxt = ("Specify_Method",Specify_Method mI');
112.344 +val (p,_,_,_,_,pt) = me nxt p c pt;
112.345 +val p = ([1],Frm):pos';
112.346 +
112.347 +
112.348 +val parseee = (term_of o the o (parse Diff.thy));
112.349 +val ct = "d_d x (x ^^^ #2 + #3 * x + #4)";
112.350 +val envvv = [(parseee"f_",parseee ct),(parseee"v_",parseee"x")];
112.351 +val ets0=[([],(Tac'(Script.thy,"BS","",""),envvv,envvv,empty,empty,Safe)),
112.352 + ([],(User', [], [], empty, empty,Sundef))]:ets;
112.353 +val l0 = [];
112.354 +" --------------- 1. ---------------------------------------------";
112.355 +val (pt,_) = cappend_atomic pt[1]e_loc ct (Rewrite("test","")) ct Complete;
112.356 +val Appl m'=applicable_in p pt (Rewrite_Inst (["(bdv,x)"],("diff_sum","")));
112.357 +
112.358 +val NextStep(l1,m') = nxt_tac "Diff.thy" (pt,p) scr ets0 l0;
112.359 +(*("diff_sum","")*)
112.360 +val Steps[(Form' (FormKF (_,_,_,_,res)),pt,p,_,s,ets1)] =
112.361 + locate_gen "Diff.thy" m' (pt,p) (scr,d) ets0 l0;
112.362 +val ets1 = (drop_last ets0) @ ets1;val pt = update_ets pt [] [(1,ets1)];
112.363 +" --------------- 2. ---------------------------------------------";
112.364 +val Appl m'=applicable_in p pt (Rewrite_Inst (["(bdv,x)"],("diff_sum","")));
112.365 +val NextStep(l2,m') = nxt_tac "Diff.thy" (pt,p) scr ets1 l1;
112.366 +(*("diff_sum","")*)
112.367 +val Steps[(Form' (FormKF (_,_,_,_,res)),pt,p,_,s,ets2)] =
112.368 + locate_gen "Diff.thy" m' (pt,p) (scr,d) ets1 l1;
112.369 +val ets2 = (drop_last ets1) @ ets2;val pt = update_ets pt [] [(1,ets2)];
112.370 +" --------------- 3. ---------------------------------------------";
112.371 +val Appl m'=applicable_in p pt (Rewrite_Inst (["(bdv,x)"],("diff_prod_const","")));
112.372 +val NextStep(l3,m') = nxt_tac "Diff.thy" (pt,p) scr ets2 l2;
112.373 +(*("diff_prod_const","")*)
112.374 +val Steps[(Form' (FormKF (_,_,_,_,res)),pt,p,_,s,ets3)] =
112.375 + locate_gen "Diff.thy" m' (pt,p) (scr,d) ets2 l2;
112.376 +val ets3 = (drop_last ets2) @ ets3; val pt = update_ets pt [] [(1,ets3)];
112.377 +" --------------- 4. ---------------------------------------------";
112.378 +val Appl m'=applicable_in p pt (Rewrite_Inst (["(bdv,x)"],("diff_pow","")));
112.379 +val NextStep(l4,m') = nxt_tac "Diff.thy" (pt,p) scr ets3 l3;
112.380 +(*("diff_pow","")*)
112.381 +val Steps[(Form' (FormKF (_,_,_,_,res)),pt,p,_,s,ets4)] =
112.382 + locate_gen "Diff.thy" m' (pt,p) (scr,d) ets3 l3;
112.383 +val ets4 = (drop_last ets3) @ ets4; val pt = update_ets pt [] [(1,ets4)];
112.384 +" --------------- 5. ---------------------------------------------";
112.385 +val Appl m'=applicable_in p pt (Rewrite_Inst (["(bdv,x)"],("diff_const","")));
112.386 +val NextStep(l5,m') = nxt_tac "Diff.thy" (pt,p) scr ets4 l4;
112.387 +(*("diff_const","")*)
112.388 +val Steps[ (Form' (FormKF (_,_,_,_,res)),pt,p,_,s,ets5)] =
112.389 + locate_gen "Diff.thy" m' (pt,p) (scr,d) ets4 l4;
112.390 +val ets5 = (drop_last ets4) @ ets5; val pt = update_ets pt [] [(1,ets5)];
112.391 +" --------------- 6. ---------------------------------------------";
112.392 +val Appl m'=applicable_in p pt (Rewrite_Inst (["(bdv,x)"],("diff_var","")));
112.393 +val NextStep(l6,m') = nxt_tac "Diff.thy" (pt,p) scr ets5 l5;
112.394 +(*("diff_var","")ok; here was("diff_const","")because of wrong rule in *.thy*)
112.395 +val Steps[(Form' (FormKF (_,_,_,_,res)),pt,p,_,s,ets6)] =
112.396 + locate_gen "Diff.thy" m' (pt,p) (scr,d) ets5 l5;
112.397 +val ets6 = (drop_last ets5) @ ets6; val pt = update_ets pt [] [(1,ets6)];
112.398 +" --------------- 7. ---------------------------------------------";
112.399 +val Appl m'=applicable_in p pt (Rewrite_Set "Test_simplify");
112.400 +
112.401 +
112.402 + ---------------- 1.5.02 -----------------------------------------*)
112.403 +
112.404 +
112.405 +
112.406 +
112.407 +" ________________ differentiate stdin: student active________________ ";
112.408 +" ________________ differentiate stdin: student active________________ ";
112.409 +" ________________ differentiate stdin: student active________________ ";
112.410 +(*
112.411 +proofs:= []; dials:=([],[],[]);
112.412 +StdinSML 0 0 0 0 New_User;
112.413 +set_dstate 1 test_hide 4 1;(*SelRule,St..PutRuleRes,TskipS..*)
112.414 +StdinSML 1 0 0 0 New_Proof;
112.415 +val fmz = ["functionTerm (d_d x (x ^^^ 2 + 3 * x + 4))",
112.416 + "differentiateFor x","derivative f_'_"];
112.417 +val (dI',pI',mI') =
112.418 + ("Diff.thy",["derivative_of","function"],
112.419 + ["diff","differentiate_on_R"]);
112.420 +*)
112.421 +
112.422 +
112.423 +" _________________ differentiate stdin: tutor active_________________ ";
112.424 +" _________________ differentiate stdin: tutor active_________________ ";
112.425 +" _________________ differentiate stdin: tutor active_________________ ";
112.426 +(*proofs:= []; dials:=([],[],[]);
112.427 +StdinSML 0 0 0 0 New_User;
112.428 +set_dstate 1 test_hide 0 2;(*PutRule,TskipS..PutRuleRes,Tt..*)
112.429 +StdinSML 1 0 0 0 New_Proof;
112.430 +val fmz = ["functionTerm (d_d x (x ^^^ 2 + 3 * x + 4))",
112.431 + "differentiateFor x","derivative f_'_"];
112.432 +val (dI',pI',mI') =
112.433 + ("Diff.thy",["derivative_of","function"],
112.434 + ["diff","differentiate_on_R"]);
112.435 +*)
112.436 +
112.437 +
112.438 +"---------------------1.5.02 me from script ---------------------";
112.439 +"---------------------1.5.02 me from script ---------------------";
112.440 +"---------------------1.5.02 me from script ---------------------";
112.441 +(*exp_Diff_No-1.xml*)
112.442 +val fmz = ["functionTerm (x ^^^ 2 + 3 * x + 4)",
112.443 + "differentiateFor x","derivative f_'_"];
112.444 +val (dI',pI',mI') =
112.445 + ("Diff.thy",["derivative_of","function"],
112.446 + ["diff","diff_simpl"]);
112.447 +(*val p = e_pos'; val c = [];
112.448 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
112.449 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
112.450 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
112.451 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.452 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.453 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.454 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.455 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.456 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.457 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.458 +(*nxt = ("Apply_Method",Apply_Method ("Diff.thy","differentiate_on_R*)
112.459 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.460 +
112.461 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.462 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.463 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.464 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.465 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.466 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.467 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.468 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
112.469 +if nxt = ("End_Proof'",End_Proof') then ()
112.470 +else raise error "new behaviour in tests/differentiate, 1.5.02 me from script";
112.471 +
112.472 +"----------- primed id -------------------------------------------";
112.473 +"----------- primed id -------------------------------------------";
112.474 +"----------- primed id -------------------------------------------";
112.475 +
112.476 +val f_ = str2term "f_::bool";
112.477 +val f = str2term "A = s * (a - s)";
112.478 +val v_ = str2term "v_";
112.479 +val v = str2term "s";
112.480 +val screxp0 = str2term "Take ((primed (lhs f_)) = d_d v_ (rhs f_))";
112.481 +atomty screxp0;
112.482 +
112.483 +val screxp1 = subst_atomic [(f_, f), (v_, v)] screxp0;
112.484 +term2str screxp1;
112.485 +atomty screxp1;
112.486 +
112.487 +val Some (f'_,_) = rewrite_set_ Isac.thy false srls_diff screxp1;
112.488 +if term2str f'_= "Take (A' = d_d s (s * (a - s)))" then ()
112.489 +else raise error "diff.sml: diff.behav. in 'primed'";
112.490 +atomty f'_;
112.491 +
112.492 +val str = "Script DiffEqScr (f_::bool) (v_::real) = \
112.493 +\ (let f'_ = Take ((primed (lhs f_)) = d_d v_ (rhs f_)) \
112.494 +\ in (((Try (Repeat (Rewrite frac_conv False))) @@ \
112.495 + \ (Try (Repeat (Rewrite root_conv False))) @@ \
112.496 + \ (Try (Repeat (Rewrite realpow_pow False))) @@ \
112.497 + \ (Repeat \
112.498 + \ ((Repeat (Rewrite_Inst [(bdv,v_)] diff_sum False)) Or \
112.499 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod_const False)) Or \
112.500 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_prod False)) Or \
112.501 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_quot True )) Or \
112.502 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin False)) Or \
112.503 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sin_chain False)) Or \
112.504 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos False)) Or \
112.505 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_cos_chain False)) Or \
112.506 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow False)) Or \
112.507 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_pow_chain False)) Or \
112.508 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln False)) Or \
112.509 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_ln_chain False)) Or \
112.510 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp False)) Or \
112.511 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_exp_chain False)) Or \
112.512 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sqrt False)) Or \
112.513 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_sqrt_chain False)) Or \
112.514 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_const False)) Or \
112.515 + \ (Repeat (Rewrite_Inst [(bdv,v_)] diff_var False)) Or \
112.516 + \ (Repeat (Rewrite_Set make_polynomial False)))) @@ \
112.517 + \ (Try (Repeat (Rewrite sym_frac_conv False))) @@ \
112.518 + \ (Try (Repeat (Rewrite sym_root_conv False))))) f'_)"
112.519 +;
112.520 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
112.521 +
112.522 +
112.523 +"----------- diff_conv, sym_diff_conv ----------------------------";
112.524 +"----------- diff_conv, sym_diff_conv ----------------------------";
112.525 +"----------- diff_conv, sym_diff_conv ----------------------------";
112.526 +val subs = [(str2term "bdv", str2term "x")];
112.527 +val rls = diff_conv;
112.528 +
112.529 +val t = str2term "2/x^^^2";
112.530 +val Some (t,_) = rewrite_set_inst_ thy false subs rls t; term2str t;
112.531 +if term2str t = "2 * x ^^^ -2" then () else raise error "diff.sml 1/x";
112.532 +
112.533 +val t = str2term "sqrt (x^^^3)";
112.534 +val Some (t,_) = rewrite_set_inst_ thy false subs rls t; term2str t;
112.535 +if term2str t = "x ^^^ (3 / 2)" then () else raise error "diff.sml x^1/2";
112.536 +
112.537 +val t = str2term "2 / sqrt x^^^3";
112.538 +val Some (t,_) = rewrite_set_inst_ thy false subs rls t; term2str t;
112.539 +if term2str t = "2 * x ^^^ (-3 / 2)" then () else raise error"diff.sml x^-1/2";
112.540 +(* trace_rewrite := true;
112.541 + trace_rewrite := false;
112.542 + *)
112.543 +val rls = diff_sym_conv;
112.544 +
112.545 +val t = str2term "2 * x ^^^ -2";
112.546 +val Some (t,_) = rewrite_set_inst_ thy false subs rls t; term2str t;
112.547 +if term2str t = "2 / x ^^^ 2" then () else raise error "diff.sml sym 1/x";
112.548 +
112.549 +
112.550 +val t = str2term "x ^^^ (3 / 2)";
112.551 +val Some (t,_) = rewrite_set_inst_ thy false subs rls t; term2str t;
112.552 +if term2str t = "sqrt (x ^^^ 3)" then () else raise error"diff.sml sym x^1/x";
112.553 +
112.554 +val t = str2term "2 * x ^^^ (-3 / 2)";
112.555 +val Some (t,_) = rewrite_set_inst_ thy false subs rls t; term2str t;
112.556 +if term2str t ="2 / sqrt (x ^^^ 3)"then()else raise error"diff.sml sym x^-1/x";
112.557 +
112.558 +
112.559 +(* trace_rewrite:=true;
112.560 + *)
112.561 +(* trace_rewrite:=false;
112.562 + *)
112.563 +(*@@@@*)
112.564 +
112.565 +
112.566 +"----------- autoCalculate differentiate_on_R 2/x^2 --------------";
112.567 +"----------- autoCalculate differentiate_on_R 2/x^2 --------------";
112.568 +"----------- autoCalculate differentiate_on_R 2/x^2 --------------";
112.569 +states:=[];
112.570 +CalcTree
112.571 +[(["functionTerm (x^2 + x+ 1/x + 2/x^2)",
112.572 + (*"functionTerm ((x^3)^5)",*)
112.573 + "differentiateFor x", "derivative f_'_"],
112.574 + ("Isac.thy", ["derivative_of","function"],
112.575 + ["diff","differentiate_on_R"]))];
112.576 +Iterator 1;
112.577 +moveActiveRoot 1;
112.578 +autoCalculate 1 CompleteCalc;
112.579 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.580 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) =
112.581 + "1 + 2 * x + -1 / x ^^^ 2 + -4 / x ^^^ 3" then ()
112.582 +else raise error "diff.sml: differentiate_on_R 2/x^2 changed";
112.583 +
112.584 +"-----------------------------------------------------------------";
112.585 +states:=[];
112.586 +CalcTree
112.587 +[(["functionTerm (x^3 * x^5)",
112.588 + "differentiateFor x", "derivative f_'_"],
112.589 + ("Isac.thy", ["derivative_of","function"],
112.590 + ["diff","differentiate_on_R"]))];
112.591 +Iterator 1;
112.592 +moveActiveRoot 1;
112.593 +(* trace_rewrite := true;
112.594 + trace_script := true;
112.595 + *)
112.596 +autoCalculate 1 CompleteCalc;
112.597 +(* trace_rewrite := false;
112.598 + trace_script := false;
112.599 + *)
112.600 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.601 +
112.602 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) =
112.603 + "8 * x ^^^ 7" then ()
112.604 +else raise error "diff.sml: differentiate_on_R (x^3 * x^5) changed";
112.605 +
112.606 +
112.607 +"----------- autoCalculate diff after_simplification -------------";
112.608 +"----------- autoCalculate diff after_simplification -------------";
112.609 +"----------- autoCalculate diff after_simplification -------------";
112.610 +states:=[];
112.611 +CalcTree
112.612 +[(["functionTerm (x^3 * x^5)",
112.613 + "differentiateFor x", "derivative f_'_"],
112.614 + ("Isac.thy", ["derivative_of","function"],
112.615 + ["diff","after_simplification"]))];
112.616 +Iterator 1;
112.617 +moveActiveRoot 1;
112.618 +(* trace_rewrite := true;
112.619 + trace_script := true;
112.620 + *)
112.621 +autoCalculate 1 CompleteCalc;
112.622 +(* trace_rewrite := false;
112.623 + trace_script := false;
112.624 + *)
112.625 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.626 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "8 * x ^^^ 7"
112.627 +then () else raise error "biegelinie.sml: 1st biegelin.7.27 changed";
112.628 +
112.629 +"-----------------------------------------------------------------";
112.630 +states:=[];
112.631 +CalcTree
112.632 +[(["functionTerm ((x^3)^5)",
112.633 + "differentiateFor x", "derivative f_'_"],
112.634 + ("Isac.thy", ["derivative_of","function"],
112.635 + ["diff","after_simplification"]))];
112.636 +Iterator 1;
112.637 +moveActiveRoot 1;
112.638 +autoCalculate 1 CompleteCalc;
112.639 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.640 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "15 * x ^^^ 14"
112.641 +then () else raise error "biegelinie.sml: 1st biegelin.7.27 changed";
112.642 +
112.643 +
112.644 +
112.645 +"----------- autoCalculate differentiate_equality ----------------";
112.646 +"----------- autoCalculate differentiate_equality ----------------";
112.647 +"----------- autoCalculate differentiate_equality ----------------";
112.648 +states:=[];
112.649 +CalcTree
112.650 +[(["functionEq (A = s * (a - s))", "differentiateFor s", "derivativeEq f_'_"],
112.651 + ("Isac.thy", ["named","derivative_of","function"],
112.652 + ["diff","differentiate_equality"]))];
112.653 +Iterator 1;
112.654 +moveActiveRoot 1;
112.655 +autoCalculate 1 CompleteCalc;
112.656 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.657 +
112.658 +
112.659 +"----------- tests for examples ----------------------------------";
112.660 +"----------- tests for examples ----------------------------------";
112.661 +"----------- tests for examples ----------------------------------";
112.662 +"----- parse errors";
112.663 +(*str2term "F = sqrt( y^2 - O) * (z + O^2)";
112.664 +str2term "O";*)
112.665 +str2term "OO";
112.666 +
112.667 +"----- thm 'diff_prod_const'";
112.668 +val subs = [(str2term "bdv", str2term "l")];
112.669 +val f = str2term "G' = d_d l (l * sqrt (7 * s ^ 2 - l ^ 2))";
112.670 +(*
112.671 +trace_rewrite := true;
112.672 +rewrite_inst_ Isac.thy tless_true erls_diff true subs diff_prod_const f;
112.673 +trace_rewrite := false;
112.674 +*)
112.675 +
112.676 +"------------inform for x^2+x+1 ----------------------------------";
112.677 +"------------inform for x^2+x+1 ----------------------------------";
112.678 +"------------inform for x^2+x+1 ----------------------------------";
112.679 +states:=[];
112.680 +CalcTree
112.681 +[(["functionTerm (x^2 + x + 1)",
112.682 + "differentiateFor x", "derivative f_'_"],
112.683 + ("Isac.thy", ["derivative_of","function"],
112.684 + ["diff","differentiate_on_R"]))];
112.685 +Iterator 1;
112.686 +moveActiveRoot 1;
112.687 +autoCalculate 1 CompleteCalcHead;
112.688 +autoCalculate 1 (Step 1);
112.689 +autoCalculate 1 (Step 1);
112.690 +autoCalculate 1 (Step 1);
112.691 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.692 +appendFormula 1 "2*x + d_d x x + d_d x 1";
112.693 +val ((pt,p),_) = get_calc 1; show_pt pt;
112.694 +if existpt' ([3], Res) pt then ()
112.695 +else raise error "diff.sml: inform d_d x (x^2 + x + 1) doesnt work";
113.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
113.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/diffapp.sml Wed Jul 21 13:53:39 2010 +0200
113.3 @@ -0,0 +1,752 @@
113.4 +(* tests for IsacKnowledge/DiffApp
113.5 + author Walther Neuper 000301
113.6 + (c) due to copyright terms
113.7 +
113.8 + use"../smltest/IsacKnowledge/diffapp.sml";
113.9 + use"diffapp.sml";
113.10 +*)
113.11 +
113.12 +"Contents----------------------------------------------";
113.13 +" Specify_Problem (match_itms_oris) ";
113.14 +" test specify, fmz <> [] ";
113.15 +" test specify, fmz = [] ";
113.16 +" problemtypes + formalizations ";
113.17 +"-------------------- ptree of {(a,b). is-max ... ----------------";
113.18 +"--------- me .. scripts for maximum-example ---------------------";
113.19 +"--------- autoCalc .. scripts for maximum-example ---------------";
113.20 +
113.21 +"--------------------- 30.4.03: maximum .. rewrite_set_ list_rls ---------";
113.22 +"---------------------- 1.5.03: Make_fun_by_explicit ---------------------";
113.23 +"---------------------- 2.5.03: Make_fun_by_new_variable -----------------";
113.24 +
113.25 +
113.26 +
113.27 +
113.28 +
113.29 +" #################################################### ";
113.30 +" problemtypes + formalizations ";
113.31 +" #################################################### ";
113.32 +" -------------- [maximum_of,function] --------------- ";
113.33 +val pbt =
113.34 + ["fixedValues fix_","maximum m_","valuesFor vs_","relations rs_"];
113.35 +map (the o (parseold thy)) pbt;
113.36 +val fmz =
113.37 + ["fixedValues [r=Arbfix]","maximum A",
113.38 + "valuesFor [a,b]",
113.39 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
113.40 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
113.41 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
113.42 +
113.43 + "boundVariable a","boundVariable b","boundVariable alpha",
113.44 + "interval {x::real. 0 <= x & x <= 2*r}",
113.45 + "interval {x::real. 0 <= x & x <= 2*r}",
113.46 + "interval {x::real. 0 <= x & x <= pi}",
113.47 + "errorBound (eps=(0::real))"];
113.48 +map (the o (parseold thy)) fmz;
113.49 +" -------------- [make,function] -------------- ";
113.50 +val pbt =
113.51 + ["functionOf f_","boundVariable v_","equalities eqs_",
113.52 + "functionTerm f_0_"];
113.53 +map (the o (parseold thy)) pbt;
113.54 +val fmz12 =
113.55 + ["functionOf A","boundVariable a","boundVariable b",
113.56 + "equalities [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
113.57 + (*28.11.00: "functionTerm (A_0=Undef)"*)"functionTerm (Undef)"];
113.58 +map (the o (parseold thy)) fmz12;
113.59 +val fmz3 =
113.60 + ["functionOf A","boundVariable a","boundVariable b",
113.61 + "equalities [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
113.62 + (*28.11.00: "functionTerm (A_0=Undef)"*)"functionTerm (Undef)"];
113.63 +map (the o (parseold thy)) fmz3;
113.64 +" --------- [univar,equation] --------- ";
113.65 +val pbt =
113.66 + ["equality e_","solveFor v_","solutions v_i_"];
113.67 +map (the o (parseold thy)) pbt;
113.68 +val fmz =
113.69 + ["equality ((a/2)^^^2 + (b/2)^^^2 = r^^^2)",
113.70 + "solveFor b","solutions b_i"];
113.71 +map (the o (parseold thy)) fmz;
113.72 +" ---- [on_interval,maximum_of,function] ---- ";
113.73 +val pbt =
113.74 + ["functionTerm t_","boundVariable v_","interval itv_",
113.75 + "errorBound err_","maxArgument v_0_"];
113.76 +map (the o (parseold thy)) pbt;
113.77 +val fmz12 =
113.78 + [(*28.11.00: "functionTerm (A_0 = a*sqrt(#4*r^^^#2 - a^^^#2))",*)
113.79 + "functionTerm (a*sqrt(4*r^^^2 - a^^^2))",
113.80 + (*28.11.00: "functionTerm (A_0 = b*sqrt(#4*r^^^#2 - b^^^#2))",*)
113.81 + "functionTerm (b*sqrt(4*r^^^2 - b^^^2))",
113.82 + "boundVariable a","boundVariable b",
113.83 + "interval {x::real. 0 <= x & x <= 2*r}",
113.84 + "errorBound (eps=0)","maxArgument (a_0=Undef)"];
113.85 +map (the o (parseold thy)) fmz12;
113.86 +val fmz3 =
113.87 + [(*28.11.00: "functionTerm (A_0 = (#2*r*sin alpha)*(#2*r*cos alpha))",*)
113.88 + "functionTerm ((2*r*sin alpha)*(2*r*cos alpha))",
113.89 + "boundVariable alpha",
113.90 + "interval {x::real. 0 <= x & x <= pi}",
113.91 + "errorBound (eps=0)","maxArgument (a_0=Undef)"];
113.92 +map (the o (parseold thy)) fmz3;
113.93 +" --------- [derivative_of,function] --------- ";
113.94 +val pbt =
113.95 + ["functionTerm f_","boundVariable v_","derivative f_'_"];
113.96 +map (the o (parseold thy)) pbt;
113.97 +val fmz =
113.98 + [(*28.11.00: "functionTerm (A_0=a*#2*sqrt r^^^#2 - (a//#2)^^^#2)",*)
113.99 + "functionTerm (a*2*sqrt r^^^2 - (a/2)^^^2)",
113.100 + "boundVariable a",
113.101 + (*28.11.00: "derivative (A_0'=Undef)"*)"derivative (Undef)"];
113.102 +map (the o (parseold thy)) fmz;
113.103 +" --------- [find_values,tool] --------- ";
113.104 +val pbt =
113.105 + ["maxArgument ma_","functionTerm f_","boundVariable v_",
113.106 + "valuesFor vls_","additionalRels rs_"];
113.107 +map (the o (parseold thy)) pbt;
113.108 +val fmz1 =
113.109 + ["maxArgument (a_0=(srqt 2)*r)",
113.110 + (*28.11.00: "functionTerm (A_0=a*#2*sqrt r^^^#2 - (a//#2)^^^#2)",*)
113.111 + "functionTerm (a*2*sqrt r^^^2 - (a/2)^^^2)",
113.112 + "boundVariable a",
113.113 + "valuesFor [a,b]","maximum A",
113.114 + "additionalRels [(a/2)^^^2 + (b/2)^^^2 = r^^^2]"];
113.115 +map (the o (parseold thy)) fmz1;
113.116 +
113.117 +
113.118 +
113.119 +"-------------------- ptree of {(a,b). is-max ... --------------------------";
113.120 +"-------------------- ptree of {(a,b). is-max ... --------------------------";
113.121 +"-------------------- ptree of {(a,b). is-max ... --------------------------";
113.122 +
113.123 +(* Teil von max-on-surface.sml,
113.124 + der nach Init_Proof -> prep_ori wieder l"auft
113.125 + (f"ur tests mit neuer pos')
113.126 + use"test-max-surf1.sml";
113.127 +
113.128 + Compiler.Control.Print.printDepth:=7; (*4 is default*)
113.129 + Compiler.Control.Print.printDepth:=4; (*4 is default*)
113.130 + *)
113.131 +
113.132 +(* --vvv-- ausgeliehen von test-root-equ/sml *)
113.133 +val loc = e_istate;
113.134 +val (dI',pI',mI') =
113.135 + ("Script.thy",["sqroot-test","univariate","equation"],
113.136 + ["Script","squ-equ-test2"]);
113.137 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
113.138 + "solveFor x","errorBound (eps=0)",
113.139 + "solutions L"];
113.140 +(*
113.141 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
113.142 +val ((p,p_),_,_,_,_,(_,pt,_)) = do_ (mI,m) e_pos'[1](e_scr,EmptyPtree,[]);
113.143 + --^^^-- ausgeliehen von test-root-equ/sml *)
113.144 +(*-------------- 9.6.03 --- cappend_ ... term -------irreparabler test
113.145 +val (pt,_) =
113.146 + cappend_problem EmptyPtree [] loc ([],(dI',pI',mI'));
113.147 +val pos = (lev_on o lev_dn) [];
113.148 +(* val pos = ([1]) *)
113.149 +val (pt,_) = cappend_parent pt pos loc "{(a,b). is-max ..."
113.150 + Empty_Tac TransitiveB;
113.151 +val pos = (lev_on o lev_dn) pos;
113.152 +(*val pos = ([1,1])*)
113.153 +val (pt,_) = cappend_atomic pt pos loc "{(a,b). is-max ..."
113.154 + Empty_Tac ("[1,1]:{(a,b). is-extremum ...",[]) Complete;
113.155 +val pos = lev_on pos;
113.156 +(*val pos = ([1,2])*)
113.157 +val (pt,_) = cappend_atomic pt pos loc "{(a,b). is-extremum ..."
113.158 + Empty_Tac ("[1,2]:{(a,b). f_x(a,b) ...",[]) Complete;
113.159 +val pos = lev_up pos;
113.160 +(*val pos = ([1])*)
113.161 +val (pt,_) = append_result pt pos e_istate ("[1#]:{(a,b). f_x(a,b) ...",[])
113.162 + Complete;
113.163 +
113.164 +val pos = lev_on pos;
113.165 +(*val pos = ([2]) *)
113.166 +val (pt,_) = cappend_atomic pt pos loc "{(a,b). f_x(a,b) ..."
113.167 + Empty_Tac ("[2]:{(a,b). f_x & f_xx &...",[]) Complete;
113.168 +val pos = lev_on pos;
113.169 +(*al pos = [3] : pos*)
113.170 +val (pt,_) = cappend_parent pt pos loc "{(a,b). f_x & f_xx &..."
113.171 + Empty_Tac TransitiveB;
113.172 +val pos = (lev_on o lev_dn) pos;
113.173 +(*pos = ([3,1]) *)
113.174 +val (pt,_) = cappend_atomic pt pos loc "{(a,b). f_x & f_xx & ..."
113.175 + Empty_Tac ("[3,1]:{(a,b). f_x & f_xx } cup ...",[]) Complete;
113.176 +val pos = lev_on pos;
113.177 +(*pos = ([3,2]) *)
113.178 +val (pt,_) = cappend_atomic pt pos loc "{(a,b). f_x & f_xx } cup.."
113.179 + Empty_Tac ("[3,2]:{(a,b). f_x ..} cup ...",[]) Complete;
113.180 +
113.181 +val pos = lev_up pos;
113.182 +(*pos = ([3]) *)
113.183 +val (pt,_) = append_result pt pos e_istate ("[3#]:{(a,b). f_x ..} cup..",[])
113.184 + Complete;
113.185 +val pos = lev_on pos;
113.186 +(*val pos = [4] : pos *)
113.187 +val (pt,_) = cappend_parent pt pos loc "{(a,b). f_x ..} cup ..."
113.188 + Empty_Tac IntersectB;
113.189 +val pos = (lev_on o lev_dn) pos;
113.190 +(*val pos = ([4,1]) *)
113.191 +val (pt,_) = cappend_parent pt pos loc "set_1 = ..."
113.192 + Empty_Tac SequenceB;
113.193 +
113.194 +
113.195 +val pos = (lev_on o lev_dn) pos;
113.196 +(*val pos = ([4,1,1]) *)
113.197 +val (pt,_) = cappend_parent(*pbl*) pt pos loc"f_x = d/dx x^3 ..."
113.198 + Empty_Tac TransitiveB;
113.199 +val pos = (lev_on o lev_dn) pos;
113.200 +(*val pos = ([4,1,1,1]) *)
113.201 +val (pt,_) = cappend_parent pt pos loc "d/dx x^3 ..."
113.202 + Empty_Tac TransitiveB;
113.203 +val pos = (lev_on o lev_dn) pos;
113.204 +(*val pos = ([4,1,1,1,1]) *)
113.205 +val (pt,_) = cappend_atomic pt pos loc "d/dx x^3 ..."
113.206 + Empty_Tac ("[4,1,1,1,1]:3x^2 + d/dx ...",[]) Complete;
113.207 +val pos = lev_on pos;
113.208 +(*val pos = ([4,1,1,1,2]) *)
113.209 +val (pt,_) = cappend_atomic pt pos loc "3x^2 + d/dx ..."
113.210 + Empty_Tac ("[4,1,1,1,2]:3x^2 + 0 + d/dx ...",[]) Complete;
113.211 +val pos = lev_on pos;
113.212 +(*pos = ([4,1,1,1,3]) *)
113.213 +val (pt,_) = cappend_atomic pt pos loc "3x^2 + 0 + d/dx ..."
113.214 + Empty_Tac ("[4,1,1,1,3]:3x^2 + 0 -3 ...",[]) Complete;
113.215 +"--- 1 ---";
113.216 +val pos = lev_up pos;
113.217 +(*pos = ([4,1,1,1]) *)
113.218 +val (pt,_) = append_result pt pos e_istate ("[4,1,1,1#]:3x^2 -3.",[])Complete;
113.219 +"--- 2 ---";
113.220 +val pos = lev_up pos;
113.221 +(*val pos = ([4,1,1]) *)
113.222 +val (pt,_) = append_result pt pos e_istate ("[4,1,1#]:found 3x^2 -3 ...",[])
113.223 + Complete;
113.224 +"--- 3 ---";
113.225 +val pos = lev_on pos;
113.226 +(*val pos = ([4,1,2]+) *)
113.227 +val (pt,_) = cappend_parent(*pbl*) pt pos loc "f_y = d/dy x^3 ..."
113.228 + Empty_Tac TransitiveB;
113.229 +"--- 4 ---";
113.230 +writeln (pr_ptree pr_short pt);
113.231 +
113.232 +(*
113.233 +. ----- pblobj -----
113.234 +1. {(a,b). is-max ...
113.235 +1.1. {(a,b). is-max ...
113.236 +1.2. {(a,b). is-extremum ...
113.237 +2. {(a,b). f_x(a,b) ...
113.238 +3. {(a,b). f_x & f_xx &...
113.239 +3.1. {(a,b). f_x & f_xx & ...
113.240 +3.2. {(a,b). f_x & f_xx } cup..
113.241 +4. {(a,b). f_x ..} cup ...
113.242 +4.1. set_1 = ...
113.243 +4.1.1. f_x = d/dx x^3 ...
113.244 +4.1.1.1. d/dx x^3 ...
113.245 +4.1.1.1.1. d/dx x^3 ...
113.246 +4.1.1.1.2. 3x^2 + d/dx ...
113.247 +4.1.1.1.3. 3x^2 + 0 + d/dx ...
113.248 +4.1.2. f_y = d/dy x^3 ...
113.249 +
113.250 + use"test-max-surf1.sml";
113.251 + *)
113.252 +-------------- 9.6.03 --- cappend_ ... term -------irreparabler test---*)
113.253 +
113.254 +
113.255 +"--------- me .. scripts for maximum-example ---------------------";
113.256 +"--------- me .. scripts for maximum-example ---------------------";
113.257 +"--------- me .. scripts for maximum-example ---------------------";
113.258 +
113.259 +val fmz =
113.260 + ["fixedValues [r=Arbfix]","maximum A",
113.261 + "valuesFor [a,b]",
113.262 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
113.263 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
113.264 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
113.265 +
113.266 + "boundVariable a","boundVariable b","boundVariable alpha",
113.267 + "interval {x::real. 0 <= x & x <= 2*r}",
113.268 + "interval {x::real. 0 <= x & x <= 2*r}",
113.269 + "interval {x::real. 0 <= x & x <= pi}",
113.270 + "errorBound (eps=(0::real))"];
113.271 +val (dI',pI',mI') =
113.272 + ("DiffApp.thy",["maximum_of","function"],
113.273 + ["DiffApp","max_by_calculus"]);
113.274 +
113.275 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
113.276 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.277 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.278 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.279 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.280 +val (p,_,f,nxt,_,pt) = (me nxt p c pt) handle e => print_exn e;
113.281 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.282 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.283 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.284 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.285 +case nxt of (_, Specify_Method ["DiffApp","max_by_calculus"]) => ()
113.286 + | _ => raise error "diffapp.sml: max-exp me, nxt = Specify_Method";
113.287 +
113.288 +val oris = fst3 (get_obj g_origin pt (fst p)); writeln(oris2str oris);
113.289 +val pits = get_obj g_pbl pt (fst p); writeln(itms2str thy pits);
113.290 +
113.291 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.292 +val mits = get_obj g_met pt (fst p); writeln(itms2str thy mits);
113.293 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.294 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.295 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.296 +case nxt of (_,Apply_Method ["DiffApp","max_by_calculus"] ) => ()
113.297 + | _ => raise error "diffapp.sml: max-exp me, nxt = Apply_Method";
113.298 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.299 +
113.300 +(*since 0508 Apply_Method does the 1st step, if None init_form -------------
113.301 +(*val nxt = ("Subproblem",Subproblem ("DiffApp.thy",["make","function"]))*)
113.302 +val (p,_,f,nxt,_,pt) = (me nxt p c pt) handle e => print_exn_G e;
113.303 +(*val nxt = ("Refine_Tacitly",Refine_Tacitly ["make","function"])*)
113.304 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.305 +(*val nxt = ("Model_Problem",Model_Problem ["by_explicit","make","function"])*)
113.306 +----------------------------------------------------------------------------*)
113.307 +case nxt of (_, Model_Problem(*["by_explicit", "make", "function"]*)) => ()
113.308 + | _ => raise error "diffapp.sml: max-exp me, nxt = Model_Problem";
113.309 +
113.310 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.311 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.312 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.313 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.314 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.315 +
113.316 +val oris = fst3 (get_obj g_origin pt (fst p));writeln(oris2str oris);
113.317 +val pits = get_obj g_pbl pt (fst p);writeln(itms2str thy pits);
113.318 +
113.319 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.320 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.321 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.322 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.323 +case nxt of (_, Apply_Method ["DiffApp", "make_fun_by_explicit"]) => ()
113.324 + | _ => raise error "diffapp.sml: max-exp Apply_Method ([1], Met) ";
113.325 +
113.326 +(*----since WN050901 (ie. corr. mathengine#nxt_specify_ ..nxt_spec Pbl->p_
113.327 +we get at ...
113.328 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.329 +...
113.330 +### assod: NotAss m= Subproblem' ,
113.331 + stac= Substitute
113.332 + [(b, (rhs o hd)
113.333 + (Subproblem (thy, [normalize, polynomial, univariate, equation])))]
113.334 + (hd (filterVar A [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]))
113.335 +*** stac2tac_ TODO: no match for Substitute
113.336 +*** [(b, (rhs o hd)
113.337 +*** (Subproblem (thy, [normalize, polynomial, univariate, equation])))]
113.338 +*** (hd (filterVar A [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]))
113.339 +Exception- ERROR raised
113.340 +
113.341 +############################################################################
113.342 +# presumerably didnt work before either, but not detected due to Emtpy_Tac #
113.343 +############################################################################
113.344 +
113.345 +(*val nxt = Subproblem ("DiffApp.thy",["univariate","equation"])) *)
113.346 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.347 +(*val nxt = Refine_Tacitly ["univariate","equation"])*)
113.348 +
113.349 +val oris = fst3 (get_obj g_origin pt (fst p));writeln(oris2str oris);
113.350 +val pits = get_obj g_pbl pt (fst p);writeln(itms2str thy pits);
113.351 +
113.352 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.353 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.354 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.355 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.356 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.357 +(*val nxt = ("Apply_Method",Apply_Method ["PolyEq","normalize_poly"])*)
113.358 +
113.359 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.360 +(*val f = Form' (FormKF (~1,EdUndef,3,Nundef,"A = a * b"))*)
113.361 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.362 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.363 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.364 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.365 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.366 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.367 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.368 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.369 +(*val f = Form' (FormKF (~1,EdUndef,4,Nundef,"[b = A / a]"))*)
113.370 +
113.371 +------------------------------------------------------------------------*)
113.372 +
113.373 +(*val f =
113.374 +Error' (Error_ "Refine_Tacitly [\"univariate\",\"equation\"] not applicable")*)
113.375 +
113.376 +
113.377 +(*----postponed.15.5.03 run scripts for maximum-example: univariate equation
113.378 +
113.379 +val (p,_,f,nxt,_,pt) = (me nxt p c pt) handle e => print_exn e;
113.380 +
113.381 +val oris = fst3 (get_obj g_origin pt (fst p));writeln(oris2str oris);
113.382 +
113.383 +val pits = get_obj g_pbl pt (fst p);writeln(itms2str thy pits);
113.384 +val pits = get_obj g_pbl pt [];writeln(itms2str thy pits);
113.385 +
113.386 +val mits = get_obj g_met pt (fst p);writeln(itms2str thy mits);
113.387 +val mits = get_obj g_met pt [];writeln(itms2str thy mits);
113.388 +
113.389 +itms2args thy ["DiffApp","max_by_calculus"] mits;
113.390 +
113.391 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
113.392 +
113.393 +---*)
113.394 +
113.395 +"--------- autoCalc .. scripts for maximum-example ---------------";
113.396 +"--------- autoCalc .. scripts for maximum-example ---------------";
113.397 +"--------- autoCalc .. scripts for maximum-example ---------------";
113.398 +(*++++++++ see systest/inform.sml 'complete_metitms' ++++++++*)
113.399 + states:=[];
113.400 +val fmz =
113.401 + ["fixedValues [r=Arbfix]","maximum A",
113.402 + "valuesFor [a,b]",
113.403 + "relations [A=a*b, (a/2)^2 + (b/2)^2 = r^2]",
113.404 + "relations [A=a*b, (a/2)^2 + (b/2)^2 = r^2]",
113.405 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
113.406 +
113.407 + "boundVariable a","boundVariable b","boundVariable alpha",
113.408 + "interval {x::real. 0 <= x & x <= 2*r}",
113.409 + "interval {x::real. 0 <= x & x <= 2*r}",
113.410 + "interval {x::real. 0 <= x & x <= pi}",
113.411 + "errorBound (eps=(0::real))"];
113.412 +val (dI',pI',mI') =
113.413 + ("DiffApp.thy",["maximum_of","function"],
113.414 + ["DiffApp","max_by_calculus"]);
113.415 +
113.416 + CalcTree [(fmz, (dI',pI',mI'))];
113.417 + Iterator 1; moveActiveRoot 1;
113.418 + autoCalculate 1 CompleteCalcHead;
113.419 + refFormula 1 (get_pos 1 1);
113.420 +
113.421 + fetchProposedTactic 1;
113.422 + autoCalculate 1 (Step 1);
113.423 +
113.424 + fetchProposedTactic 1;
113.425 + autoCalculate 1 (Step 1);
113.426 + (*Subproblem on_interval maximum_of function*)
113.427 + autoCalculate 1 CompleteCalcHead;
113.428 +
113.429 + fetchProposedTactic 1;
113.430 + val ((pt,p),_) = get_calc 1;
113.431 + val mits = get_obj g_met pt (fst p);
113.432 + writeln (itms2str thy mits);
113.433 +(*
113.434 + if itms2str thy mits = "[\n(1 ,[1] ,true ,#Given ,Cor functionEq (hd rs_) ,(t_, [hd rs_])),\n(2 ,[1] ,true ,#Given ,Cor boundVariable v_ ,(v_, [v_])),\n(3 ,[1] ,true ,#Given ,Cor interval itv_ ,(itv_, [itv_])),\n(4 ,[1] ,true ,#Find ,Cor maxArgument v__0 ,(v_0_, [v__0]))]" then ()
113.435 + else raise error "diffapp.sml: diff.behav. in autoCalc .. scripts for max 1";
113.436 +*)
113.437 + (*FIXME: the environments contain identifers, and NOT values ?!?!?*)
113.438 +(* WN051209 while extending 'fun step' for initac, this became better ...
113.439 + if itms2str thy mits = "[\n(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),\n(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),\n(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(vs_, [[a],[b]])),\n(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2] ,(rs_, [[A = a * b],[(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]])),\n(6 ,[1] ,true ,#undef ,Cor boundVariable a ,(v_, [a])),\n(9 ,[1,2] ,true ,#undef ,Cor interval {x. 0 <= x & x <= 2 * r} ,(itv_, [{x. 0 <= x & x <= 2 * r}])),\n(11 ,[1,2,3] ,true ,#undef ,Cor errorBound (eps = 0) ,(err_, [eps = 0]))]" then ()
113.440 + else raise error "diffapp.sml: diff.behav. in autoCalc .. scripts for max 1";
113.441 +*)
113.442 +
113.443 +
113.444 +
113.445 +"--------------------- 30.4.03: maximum .. rewrite_set_ list_rls ---------";
113.446 +"--------------------- 30.4.03: maximum .. rewrite_set_ list_rls ---------";
113.447 +"--------------------- 30.4.03: maximum .. rewrite_set_ list_rls ---------";
113.448 +str2term
113.449 + "Script Maximum_value(fix_::bool list)(m_::real) (rs_::bool list)\
113.450 + \ (v_::real) (itv_::real set) (err_::bool) = \
113.451 + \ (let e_ = (hd o (filterVar m_)) rs_; \
113.452 + \ t_ = (if 1 < length_ rs_ \
113.453 + \ then (SubProblem (Reals_,[make,function],[no_met])\
113.454 + \ [real_ m_, real_ v_, bool_list_ rs_])\
113.455 + \ else (hd rs_)); \
113.456 + \ (mx_::real) = SubProblem (Reals_,[on_interval,max_of,function], \
113.457 + \ [Isac,maximum_on_interval])\
113.458 + \ [bool_ t_, real_ v_, real_set_ itv_]\
113.459 + \ in ((SubProblem (Reals_,[find_values,tool],[Isac,find_values]) \
113.460 + \ [real_ mx_, real_ (Rhs t_), real_ v_, real_ m_, \
113.461 + \ bool_list_ (dropWhile (ident e_) rs_)])::bool list))";
113.462 +
113.463 +val fix_ = (str2term "fix_::bool list",
113.464 + str2term "[r=Arbfix]");
113.465 +val m_ = (str2term "m_::real",
113.466 + str2term "A");
113.467 +val rs_ = (str2term "rs_::bool list",
113.468 + str2term "[A = a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]");
113.469 +val v_ = (str2term "v_::real",
113.470 + str2term "b");
113.471 +val itv_ = (str2term "itv_::real set",
113.472 + str2term "{x::real. 0 <= x & x <= 2*r}");
113.473 +val err_ = (str2term "err_::bool",
113.474 + str2term "eps=0");
113.475 +val env = [fix_, m_, rs_ ,v_, itv_, err_];
113.476 +
113.477 +(*--- 1.line in script ---*)
113.478 +val t = str2term "(hd o (filterVar m_)) (rs_::bool list)";
113.479 +val s = subst_atomic env t;
113.480 +term2str s;
113.481 +"(hd o filterVar A) [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]";
113.482 +val Some (s',_) = rewrite_set_ thy false list_rls s;
113.483 +val s'' = term2str s';
113.484 +if s''="A = a * b" then () else raise error "new behaviour with list_rls 1.1.";
113.485 +val env = env @ [(str2term "e_::bool",str2term "A = a * b")];
113.486 +
113.487 +(*--- 2.line: condition alone ---*)
113.488 +val t = str2term "1 < length_ (rs_::bool list)";
113.489 +val s = subst_atomic env t;
113.490 +term2str s;
113.491 +"1 < length_ [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]";
113.492 +val Some (s',_) = rewrite_set_ thy false list_rls s;
113.493 +val s'' = term2str s';
113.494 +if s''="True" then () else raise error "new behaviour with list_rls 1.2.";
113.495 +
113.496 +(*--- 2.line in script ---*)
113.497 +val t = str2term
113.498 + "(if 1 < length_ rs_ \
113.499 + \ then (SubProblem (Reals_,[make,function],[no_met])\
113.500 + \ [real_ m_, real_ v_, bool_list_ rs_])\
113.501 + \ else (hd rs_))";
113.502 +val s = subst_atomic env t;
113.503 +term2str s;
113.504 +"if 1 < length_ [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]\
113.505 +\then SubProblem (Reals_, [make, function], [no_met])\
113.506 +\ [real_ A, real_ b,\
113.507 +\ bool_list_ [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]]\
113.508 +\else hd [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]";
113.509 +val Some (s',_) = rewrite_set_ thy false list_rls s;
113.510 +val s'' = term2str s';
113.511 +if s'' =
113.512 +"SubProblem (Reals_, [make, function], [no_met])\n\
113.513 +\ [real_ A, real_ b,\n\
113.514 +\ bool_list_ [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]]" then ()
113.515 +else raise error "new behaviour with list_rls 1.3.";
113.516 +val env = env @ [(str2term "t_::bool",
113.517 + str2term "A = (2*sqrt(r^^^2-(b/2)^^^2)) * b")];
113.518 +
113.519 +
113.520 +
113.521 +"---------------------- 1.5.03: Make_fun_by_explicit ---------------------";
113.522 +"---------------------- 1.5.03: Make_fun_by_explicit ---------------------";
113.523 +"---------------------- 1.5.03: Make_fun_by_explicit ---------------------";
113.524 +str2term
113.525 + "Script Make_fun_by_explicit (f_::real) (v_::real) \
113.526 + \ (eqs_::bool list) = \
113.527 + \ (let h_ = (hd o (filterVar f_)) eqs_; \
113.528 + \ e_1 = hd (dropWhile (ident h_) eqs_); \
113.529 + \ vs_ = dropWhile (ident f_) (Vars h_); \
113.530 + \ v_1 = hd (dropWhile (ident v_) vs_); \
113.531 + \ (s_1::bool list)=(SubProblem(Reals_,[univar,equation],[no_met])\
113.532 + \ [bool_ e_1, real_ v_1])\
113.533 + \ in Substitute [(v_1 = (rhs o hd) s_1)] h_)";
113.534 +val f_ = (str2term "f_::real",
113.535 + str2term "A");
113.536 +val v_ = (str2term "v_::real",
113.537 + str2term "b");
113.538 +val eqs_=(str2term "eqs_::bool list",
113.539 + str2term "[A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]");
113.540 +val env = [f_, v_, eqs_];
113.541 +
113.542 +(*--- 1.line in script ---*)
113.543 +val t = str2term "(hd o (filterVar v_)) (eqs_::bool list)";
113.544 +val s = subst_atomic env t;
113.545 +term2str s;
113.546 +val t = str2term
113.547 + "(hd o filterVar b) [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]";
113.548 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.549 +val s' = term2str t';
113.550 +if s' = "A = a * b" then () else raise error "new behaviour with list_rls 2.1";
113.551 +val env = env @ [(str2term "h_::bool", str2term s')];
113.552 +
113.553 +(*--- 2.line in script ---*)
113.554 +val t = str2term "hd (dropWhile (ident h_) (eqs_::bool list))";
113.555 +val s = subst_atomic env t;
113.556 +term2str s;
113.557 +val t = str2term
113.558 + "hd (dropWhile (ident (A = a * b))\
113.559 + \ [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2])";
113.560 +mem_rls "dropWhile_Cons" list_rls;
113.561 +mem_rls "Atools.ident" list_rls;
113.562 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.563 +val s' = term2str t';
113.564 +if s' = "(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2" then ()
113.565 +else raise error "new behaviour with list_rls 2.2";
113.566 +val env = env @ [(str2term "e_1::bool", str2term s')];
113.567 +
113.568 +(*--- 3.line in script ---*)
113.569 +val t = str2term "dropWhile (ident f_) (Vars (h_::bool))";
113.570 +val s = subst_atomic env t;
113.571 +term2str s;
113.572 +val t = str2term "dropWhile (ident A) (Vars (A = a * b))";
113.573 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.574 +val s' = term2str t';
113.575 +if s' = "[a, b]" then () else raise error "new behaviour with list_rls 2.3";
113.576 +val env = env @ [(str2term "vs_::real list", str2term s')];
113.577 +
113.578 +(*--- 4.line in script ---*)
113.579 +val t = str2term "hd (dropWhile (ident v_) vs_)";
113.580 +val s = subst_atomic env t;
113.581 +term2str s;
113.582 +val t = str2term "hd (dropWhile (ident b) [a, b])";
113.583 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.584 +val s' = term2str t';
113.585 +if s' = "a" then () else raise error "new behaviour with list_rls 2.4.";
113.586 +val env = env @ [(str2term "v_1::real", str2term s')];
113.587 +
113.588 +(*--- 5.line in script ---*)
113.589 +val t = str2term "(SubProblem(Reals_,[univar,equation],[no_met])\
113.590 + \ [bool_ e_1, real_ v_1])";
113.591 +val s = subst_atomic env t;
113.592 +term2str s;
113.593 +"SubProblem (Reals_, [univar, equation], [no_met])\n\
113.594 +\ [bool_ ((a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2), real_ a]";
113.595 +val env = env @ [(str2term "s_1::bool list",
113.596 + str2term "[a = 2 * sqrt (r^^^2 - (b/2)^^^2)]")];
113.597 +
113.598 +(*--- 6.line in script ---*)
113.599 +val t = str2term "Substitute [(v_1 = (rhs o hd) (s_1::bool list))] (h_::bool)";
113.600 +val s = subst_atomic env t;
113.601 +term2str s;
113.602 +val t = str2term
113.603 +"Substitute [(a = (rhs o hd) [a = 2 * sqrt (r ^^^ 2 - (b / 2) ^^^ 2)])]\n\
113.604 +\ (A = a * b)";
113.605 +mem_rls "Tools.rhs" list_rls;
113.606 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.607 +val s' = term2str t';
113.608 +if s' = "Substitute [a = 2 * sqrt (r ^^^ 2 - (b / 2) ^^^ 2)] (A = a * b)"
113.609 +then () else raise error "new behaviour with list_rls 2.6.";
113.610 +
113.611 +
113.612 +"---------------------- 2.5.03: Make_fun_by_new_variable -----------------";
113.613 +"---------------------- 2.5.03: Make_fun_by_new_variable -----------------";
113.614 +"---------------------- 2.5.03: Make_fun_by_new_variable -----------------";
113.615 +str2term
113.616 + "Script Make_fun_by_new_variable (f_::real) (v_::real) \
113.617 + \ (eqs_::bool list) = \
113.618 + \(let h_ = (hd o (filterVar f_)) eqs_; \
113.619 + \ es_ = dropWhile (ident h_) eqs_; \
113.620 + \ vs_ = dropWhile (ident f_) (Vars h_); \
113.621 + \ v_1 = nth_ 1 vs_; \
113.622 + \ v_2 = nth_ 2 vs_; \
113.623 + \ e_1 = (hd o (filterVar v_1)) es_; \
113.624 + \ e_2 = (hd o (filterVar v_2)) es_; \
113.625 + \ (s_1::bool list) = (SubProblem (Reals_,[univar,equation],[no_met])\
113.626 + \ [bool_ e_1, real_ v_1]);\
113.627 + \ (s_2::bool list) = (SubProblem (Reals_,[univar,equation],[no_met])\
113.628 + \ [bool_ e_2, real_ v_2])\
113.629 + \in Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] h_)";
113.630 +val f_ = (str2term "f_::real",
113.631 + str2term "A");
113.632 +val v_ = (str2term "v_::real",
113.633 + str2term "alpha");
113.634 +val eqs_=(str2term "eqs_::bool list",
113.635 + str2term "[A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]");
113.636 +val env = [f_, v_, eqs_];
113.637 +
113.638 +(*--- 1.line in script ---*)
113.639 +val t = str2term "(hd o (filterVar (f_::real))) (eqs_::bool list)";
113.640 +val s = subst_atomic env t;
113.641 +term2str s;
113.642 +val t = str2term
113.643 +"(hd o filterVar A) [A = a * b, a / 2 = r * sin alpha, b / 2 = r * cos alpha]";
113.644 +trace_rewrite:=true;
113.645 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.646 +trace_rewrite:=false;
113.647 +val s' = term2str t';
113.648 +if s' = "A = a * b" then() else raise error "new behaviour with list_rls 3.1.";
113.649 +val env = env @ [(str2term "h_::bool", str2term s')];
113.650 +
113.651 +(*--- 2.line in script ---*)
113.652 +val t = str2term "dropWhile (ident (h_::bool)) (eqs_::bool list)";
113.653 +val s = subst_atomic env t;
113.654 +term2str s;
113.655 +val t = str2term
113.656 +"dropWhile (ident (A = a * b))\
113.657 +\ [A = a * b, a / 2 = r * sin alpha, b / 2 = r * cos alpha]";
113.658 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.659 +val s' = term2str t';
113.660 +if s' = "[a / 2 = r * sin alpha, b / 2 = r * cos alpha]"
113.661 +then () else raise error "new behaviour with list_rls 3.2.";
113.662 +val env = env @ [(str2term "es_::bool list", str2term s')];
113.663 +
113.664 +(*--- 3.line in script ---*)
113.665 +val t = str2term "dropWhile (ident (f_::real)) (Vars (h_::bool))";
113.666 +val s = subst_atomic env t;
113.667 +term2str s;
113.668 +val t = str2term "dropWhile (ident A) (Vars (A = a * b))";
113.669 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.670 +val s' = term2str t';
113.671 +if s' = "[a, b]" then () else raise error "new behaviour with list_rls 3.3.";
113.672 +val env = env @ [(str2term "vs_::real list", str2term s')];
113.673 +
113.674 +(*--- 4.line in script ---*)
113.675 +val t = str2term "nth_ 1 vs_";
113.676 +val s = subst_atomic env t;
113.677 +term2str s;
113.678 +val t = str2term "nth_ 1 [a, b]";
113.679 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.680 +val s' = term2str t';
113.681 +if s' = "a" then () else raise error "new behaviour with list_rls 3.4.";
113.682 +val env = env @ [(str2term "v_1", str2term s')];
113.683 +
113.684 +(*--- 5.line in script ---*)
113.685 +val t = str2term "nth_ 2 vs_";
113.686 +val s = subst_atomic env t;
113.687 +term2str s;
113.688 +val t = str2term "nth_ 2 [a, b]";
113.689 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.690 +val s' = term2str t';
113.691 +if s' = "b" then () else raise error "new behaviour with list_rls 3.5.";
113.692 +val env = env @ [(str2term "v_2", str2term s')];
113.693 +
113.694 +(*--- 6.line in script ---*)
113.695 +val t = str2term "(hd o (filterVar v_1)) (es_::bool list)";
113.696 +val s = subst_atomic env t;
113.697 +term2str s;
113.698 +val t = str2term
113.699 + "(hd o filterVar a) [a / 2 = r * sin alpha, b / 2 = r * cos alpha]";
113.700 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.701 +val s' = term2str t';
113.702 +if s' = "a / 2 = r * sin alpha" then ()
113.703 +else raise error "new behaviour with list_rls 3.6.";
113.704 +val e_1 = str2term "e_1::bool";
113.705 +val env = env @ [(e_1, str2term s')];
113.706 +
113.707 +(*--- 7.line in script ---*)
113.708 +val t = str2term "(hd o (filterVar v_2)) (es_::bool list)";
113.709 +val s = subst_atomic env t;
113.710 +term2str s;
113.711 +val t = str2term
113.712 + "(hd o filterVar b) [a / 2 = r * sin alpha, b / 2 = r * cos alpha]";
113.713 +val Some (t',_) = rewrite_set_ thy false list_rls t;
113.714 +val s' = term2str t';
113.715 +if s' = "b / 2 = r * cos alpha" then ()
113.716 +else raise error "new behaviour with list_rls 3.7.";
113.717 +val env = env @ [(str2term "e_2::bool", str2term s')];
113.718 +
113.719 +(*--- 8.line in script ---*)
113.720 +val t = str2term "(SubProblem (Reals_,[univar,equation],[no_met])\
113.721 + \ [bool_ e_1, real_ v_1])";
113.722 +val s = subst_atomic env t;
113.723 +term2str s;
113.724 +"SubProblem (Reals_, [univar, equation], [no_met])\
113.725 + \ [bool_ (a / 2 = r * sin alpha), real_ a]";
113.726 +val s_1 = str2term "[a = 2*r*sin alpha]";
113.727 +val env = env @ [(str2term "s_1::bool list", s_1)];
113.728 +
113.729 +(*--- 9.line in script ---*)
113.730 +val t = str2term "(SubProblem (Reals_,[univar,equation],[no_met])\
113.731 + \ [bool_ e_2, real_ v_2])";
113.732 +val s = subst_atomic env t;
113.733 +term2str s;
113.734 +"SubProblem (Reals_, [univar, equation], [no_met])\
113.735 + \ [bool_ (b / 2 = r * cos alpha), real_ b]";
113.736 +val s_2 = str2term "[b = 2*r*cos alpha]";
113.737 +val env = env @ [(str2term "s_2::bool list", s_2)];
113.738 +
113.739 +(*--- 10.line in script ---*)
113.740 +val t = str2term
113.741 +"Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] (h_::bool)";
113.742 +val s = subst_atomic env t;
113.743 +term2str s;
113.744 +"Substitute\n [(a = (rhs o hd) [a = 2 * r * sin alpha]),\
113.745 +\ (b = (rhs o hd) [b = 2 * r * cos alpha])] (A = a * b)";
113.746 +val Some (s',_) = rewrite_set_ thy false list_rls s;
113.747 +val s'' = term2str s';
113.748 +if s'' =
113.749 +"Substitute [a = 2 * r * sin alpha, b = 2 * r * cos alpha] (A = a * b)"
113.750 +then () else raise error "new behaviour with list_rls 3.10.";
113.751 +
113.752 +
113.753 +
113.754 +
113.755 +
114.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
114.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/eqsystem.sml Wed Jul 21 13:53:39 2010 +0200
114.3 @@ -0,0 +1,1443 @@
114.4 +(* tests on systems of equations
114.5 + author: Walther Neuper
114.6 + 050826,
114.7 + (c) due to copyright terms
114.8 +
114.9 +use"../smltest/IsacKnowledge/eqsystem.sml";
114.10 +use"eqsystem.sml";
114.11 +*)
114.12 +val thy = EqSystem.thy;
114.13 +
114.14 +"-----------------------------------------------------------------";
114.15 +"table of contents -----------------------------------------------";
114.16 +"-----------------------------------------------------------------";
114.17 +"----------- occur_exactly_in ------------------------------------";
114.18 +"----------- problems --------------------------------------------";
114.19 +"----------- rewrite-order ord_simplify_System -------------------";
114.20 +"----------- rewrite in [EqSystem,normalize,2x2] -----------------";
114.21 +"----------- rewrite example from 2nd [EqSystem,normalize,2x2] ---";
114.22 +"----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
114.23 +"----------- rewrite in [EqSystem,normalize,4x4] -----------------";
114.24 +"----------- script [EqSystem,normalize,2x2] ---------------------";
114.25 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.1 --";
114.26 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.2 --";
114.27 +"----------- refine [linear,system]-------------------------------";
114.28 +"----------- refine [2x2,linear,system] search error--------------";
114.29 +"----------- me [EqSystem,normalize,2x2] -------------------------";
114.30 +"----------- me [linear,system] ..normalize..top_down_sub..-------";
114.31 +"----------- all systems from Biegelinie -------------------------";
114.32 +"----------- 4x4 systems from Biegelinie -------------------------";
114.33 +"-----------------------------------------------------------------";
114.34 +"-----------------------------------------------------------------";
114.35 +"-----------------------------------------------------------------";
114.36 +
114.37 +
114.38 +"----------- occur_exactly_in ------------------------------------";
114.39 +"----------- occur_exactly_in ------------------------------------";
114.40 +"----------- occur_exactly_in ------------------------------------";
114.41 +val all = [str2term"c", str2term"c_2", str2term"c_3"];
114.42 +val t = str2term"0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
114.43 +
114.44 +if occur_exactly_in [str2term"c", str2term"c_2"] all t
114.45 +then () else raise error "eqsystem.sml occur_exactly_in 1";
114.46 +
114.47 +if not (occur_exactly_in [str2term"c", str2term"c_2", str2term"c_3"] all t)
114.48 +then () else raise error "eqsystem.sml occur_exactly_in 2";
114.49 +
114.50 +if not (occur_exactly_in [str2term"c_2"] all t)
114.51 +then () else raise error "eqsystem.sml occur_exactly_in 3";
114.52 +
114.53 +
114.54 +val t = str2term"[c,c_2] from_ [c,c_2,c_3] occur_exactly_in \
114.55 + \-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
114.56 +val Some (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
114.57 +if str = "[c, c_2] from_ [c, c_2,\n c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = True" then ()
114.58 +else raise error "eval_occur_exactly_in [c, c_2]";
114.59 +
114.60 +val t = str2term"[c,c_2,c_3] from_ [c,c_2,c_3] occur_exactly_in \
114.61 + \-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
114.62 +val Some (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
114.63 +if str = "[c, c_2,\n c_3] from_ [c, c_2,\n c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = False" then ()
114.64 +else raise error "eval_occur_exactly_in [c, c_2, c_3]";
114.65 +
114.66 +val t = str2term"[c_2] from_ [c,c_2,c_3] occur_exactly_in \
114.67 + \-1 * q_0 * L ^^^ 2 / 2 + L * c + c_2";
114.68 +val Some (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
114.69 +if str = "[c_2] from_ [c, c_2,\n c_3] occur_exactly_in -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2 = False" then ()
114.70 +else raise error "eval_occur_exactly_in [c, c_2, c_3]";
114.71 +
114.72 +val t = str2term"[] from_ [c,c_2,c_3] occur_exactly_in 0";
114.73 +val Some (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
114.74 +if str = "[] from_ [c, c_2, c_3] occur_exactly_in 0 = True" then ()
114.75 +else raise error "eval_occur_exactly_in [c, c_2, c_3]";
114.76 +
114.77 +val t =
114.78 + str2term
114.79 + "[] from_ [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) /2";
114.80 +val Some (str, t') = eval_occur_exactly_in 0 "EqSystem.occur'_exactly'_in" t 0;
114.81 +if str = "[] from_ [c, c_2, c_3, c_4] occur_exactly_in \
114.82 + \-1 * (q_0 * L ^^^ 2) / 2 = True" then ()
114.83 +else raise error "eval_occur_exactly_in [c, c_2, c_3, c_4]";
114.84 +
114.85 +
114.86 +"----------- problems --------------------------------------------";
114.87 +"----------- problems --------------------------------------------";
114.88 +"----------- problems --------------------------------------------";
114.89 +val t = str2term "length_ [x+y=1,y=2] = 2";
114.90 +atomty t;
114.91 +val testrls = append_rls "testrls" e_rls
114.92 + [(Thm ("length_Nil_",num_str length_Nil_)),
114.93 + (Thm ("length_Cons_",num_str length_Cons_)),
114.94 + Calc ("op +", eval_binop "#add_"),
114.95 + Calc ("op =",eval_equal "#equal_")
114.96 + ];
114.97 +val Some (t',_) = rewrite_set_ thy false testrls t;
114.98 +if term2str t' = "True" then ()
114.99 +else raise error "eqsystem.sml: length_ [x+y=1,y=2] = 2";
114.100 +
114.101 +val Some t = parse EqSystem.thy "solution L";
114.102 +atomty (term_of t);
114.103 +val Some t = parse Biegelinie.thy "solution L";
114.104 +atomty (term_of t);
114.105 +
114.106 +val t = str2term
114.107 +"(tl (tl (tl vs_))) from_ vs_ occur_exactly_in (nth_ 1 (es_::bool list))";
114.108 +atomty t;
114.109 +val t = str2term
114.110 +"(tl (tl (tl [c,c_2,c_3,c_4]))) from_ [c,c_2,c_3,c_4] occur_exactly_in \
114.111 +\(nth_ 1 [c_4 = 1, 2=2,3=3,4=4])";
114.112 +val Some (t,_) =
114.113 + rewrite_set_ thy true
114.114 + (append_rls "prls_" e_rls
114.115 + [Thm ("nth_Cons_",num_str nth_Cons_),
114.116 + Thm ("nth_Nil_",num_str nth_Nil_),
114.117 + Thm ("tl_Cons",num_str tl_Cons),
114.118 + Thm ("tl_Nil",num_str tl_Nil),
114.119 + Calc ("EqSystem.occur'_exactly'_in",
114.120 + eval_occur_exactly_in
114.121 + "#eval_occur_exactly_in_")
114.122 + ]) t;
114.123 +if t = HOLogic.true_const then ()
114.124 +else raise error "eqsystem.sml ..occur_exactly_in (nth_ 1 [c_4..";
114.125 +
114.126 +
114.127 +"----------- rewrite-order ord_simplify_System -------------------";
114.128 +"----------- rewrite-order ord_simplify_System -------------------";
114.129 +"----------- rewrite-order ord_simplify_System -------------------";
114.130 +"M_b x = c * x + -1 * q_0 * (x ^^^ 2 / 2) + c_2";
114.131 +"--- add_commute ---";
114.132 +if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2)",
114.133 + str2term"c * x") then ()
114.134 +else raise error "integrate.sml, (-1 * q_0 * (x ^^^ 2 / 2)) < (c * x) not#1";
114.135 +
114.136 +if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2)",
114.137 + str2term"c_2") then ()
114.138 +else raise error "integrate.sml, (-1 * q_0 * (x ^^^ 2 / 2)) < (c_2) not#2";
114.139 +
114.140 +if ord_simplify_System false thy [] (str2term"c * x",
114.141 + str2term"c_2") then ()
114.142 +else raise error "integrate.sml, (c * x) < (c_2) not#3";
114.143 +
114.144 +"--- mult_commute ---";
114.145 +if ord_simplify_System false thy [] (str2term"x * c",
114.146 + str2term"c * x") then ()
114.147 +else raise error "integrate.sml, (x * c) < (c * x) not#4";
114.148 +
114.149 +if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2) * c",
114.150 + str2term"-1 * q_0 * c * (x ^^^ 2 / 2)")
114.151 +then () else raise error "integrate.sml, (. * .) < (. * .) not#5";
114.152 +
114.153 +if ord_simplify_System false thy [] (str2term"-1 * q_0 * (x ^^^ 2 / 2) * c",
114.154 + str2term"c * -1 * q_0 * (x ^^^ 2 / 2)")
114.155 +then () else raise error "integrate.sml, (. * .) < (. * .) not#6";
114.156 +
114.157 +
114.158 +"----------- rewrite in [EqSystem,normalize,2x2] -----------------";
114.159 +"----------- rewrite in [EqSystem,normalize,2x2] -----------------";
114.160 +"----------- rewrite in [EqSystem,normalize,2x2] -----------------";
114.161 +val t = str2term"[0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2,\
114.162 + \0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2]";
114.163 +val bdvs = [(str2term"bdv_1",str2term"c"),
114.164 + (str2term"bdv_2",str2term"c_2")];
114.165 +val Some(t,_)= rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
114.166 +if term2str t = "[0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2), 0 = c_2]"
114.167 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System_par.1";
114.168 +
114.169 +val Some (t,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs t;
114.170 +if term2str t = "[L * c + c_2 = 0 + -1 * (-1 * q_0 * L ^^^ 2 / 2), c_2 = 0]"
114.171 +then () else raise error "eqsystem.sml rewrite in 2x2 isolate_bdvs";
114.172 +
114.173 +val Some(t,_)= rewrite_set_inst_ thy true bdvs simplify_System t;
114.174 +if term2str t = "[L * c + c_2 = q_0 * L ^^^ 2 / 2, c_2 = 0]"
114.175 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System_par.2";
114.176 +
114.177 +val Some (t,_) = rewrite_set_ thy true order_system t;
114.178 +if term2str t = "[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]"
114.179 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System_par.3";
114.180 +
114.181 +
114.182 +"----------- rewrite example from 2nd [EqSystem,normalize,2x2] ---";
114.183 +"----------- rewrite example from 2nd [EqSystem,normalize,2x2] ---";
114.184 +"----------- rewrite example from 2nd [EqSystem,normalize,2x2] ---";
114.185 +val thy = Isac.thy (*because of Undeclared constant "Biegelinie.EI*);
114.186 +val t =
114.187 + str2term"[0 = c_2 + c * 0 + 1 / EI * (L * q_0 / 12 * 0 ^^^ 3 + \
114.188 + \ -1 * q_0 / 24 * 0 ^^^ 4),\
114.189 + \ 0 = c_2 + c * L + 1 / EI * (L * q_0 / 12 * L ^^^ 3 + \
114.190 + \ -1 * q_0 / 24 * L ^^^ 4)]";
114.191 +val Some (t,_) = rewrite_set_ thy true norm_Rational t;
114.192 +if term2str t="[0 = c_2, 0 = c_2 + L * c + L ^^^ 4 * q_0 / (EI * 24)]"
114.193 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System_par.0b";
114.194 +
114.195 +val Some(t,_)= rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
114.196 +if term2str t = "[0 = c_2, 0 = q_0 * L ^^^ 4 / (24 * EI) + (L * c + c_2)]"
114.197 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System_par.1b";
114.198 +
114.199 +val Some (t,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs t;
114.200 +if term2str t = "[c_2 = 0, L * c + c_2 = 0 + -1 * (q_0 * L ^^^ 4 / (24 * EI))]"
114.201 +then () else raise error "eqsystem.sml rewrite in 2x2 isolate_bdvs b";
114.202 +
114.203 +val Some(t,_)= rewrite_set_inst_ thy true bdvs simplify_System t;
114.204 +if term2str t = "[c_2 = 0, L * c + c_2 = -1 * q_0 * L ^^^ 4 / (24 * EI)]"
114.205 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System.2b";
114.206 +
114.207 +val xxx = rewrite_set_ thy true order_system t;
114.208 +if is_none xxx
114.209 +then () else raise error "eqsystem.sml rewrite in 2x2 simplify_System.3b";
114.210 +
114.211 +
114.212 +"----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
114.213 +"----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
114.214 +"----------- rewrite in [EqSystem,top_down_substitution,2x2] -----";
114.215 +val e1__ = str2term "c_2 = 77";
114.216 +val e2__ = str2term "L * c + c_2 = q_0 * L ^^^ 2 / 2";
114.217 +val bdvs = [(str2term"bdv_1",str2term"c"),
114.218 + (str2term"bdv_2",str2term"c_2")];
114.219 +val Some (e2__,_) = rewrite_terms_ thy dummy_ord Erls [e1__] e2__;
114.220 +if term2str e2__ = "L * c + 77 = q_0 * L ^^^ 2 / 2" then ()
114.221 +else raise error "eqsystem.sml top_down_substitution,2x2] subst";
114.222 +
114.223 +val Some (e2__,_) =
114.224 + rewrite_set_inst_ thy true bdvs simplify_System_parenthesized e2__;
114.225 +if term2str e2__ = "77 + L * c = q_0 * L ^^^ 2 / 2" then ()
114.226 +else raise error "eqsystem.sml top_down_substitution,2x2] simpl_par";
114.227 +
114.228 +val Some (e2__,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs e2__;
114.229 +if term2str e2__ = "c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L" then ()
114.230 +else raise error "eqsystem.sml top_down_substitution,2x2] isolate";
114.231 +
114.232 +val t = str2term "[c_2 = 77, c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L]";
114.233 +val Some (t,_) = rewrite_set_ thy true order_system t;
114.234 +if term2str t = "[c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L, c_2 = 77]" then ()
114.235 +else raise error "eqsystem.sml top_down_substitution,2x2] order_system";
114.236 +
114.237 +if not (ord_simplify_System
114.238 + false thy []
114.239 + (str2term"[c_2 = 77, c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L]",
114.240 + str2term"[c = (q_0 * L ^^^ 2 / 2 + -1 * 77) / L, c_2 = 77]"))
114.241 +then () else raise error "eqsystem.sml, order_result rew_ord";
114.242 +
114.243 +trace_rewrite:=true;
114.244 +trace_rewrite:=false;
114.245 +
114.246 +
114.247 +"----------- rewrite in [EqSystem,normalize,4x4] -----------------";
114.248 +"----------- rewrite in [EqSystem,normalize,4x4] -----------------";
114.249 +"----------- rewrite in [EqSystem,normalize,4x4] -----------------";
114.250 +(*GOON??: revise rewrite in [EqSystem,normalize,4x4] from before 0609*)
114.251 +val t = str2term"[0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c_3 + c_4,\
114.252 + \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c_3 + c_4,\
114.253 + \c + c_2 + c_3 + c_4 = 0,\
114.254 + \c_2 + c_3 + c_4 = 0]";
114.255 +val bdvs = [(str2term"bdv_1",str2term"c"),
114.256 + (str2term"bdv_2",str2term"c_2"),
114.257 + (str2term"bdv_3",str2term"c_3"),
114.258 + (str2term"bdv_4",str2term"c_4")];
114.259 +val Some (t,_) =
114.260 + rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
114.261 +if term2str t = "[0 = c_4, 0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c_3 + c_4),\n\
114.262 + \ c + (c_2 + (c_3 + c_4)) = 0, c_2 + (c_3 + c_4) = 0]"
114.263 +then () else raise error "eqsystem.sml rewrite in 4x4 simplify_System_paren";
114.264 +
114.265 +val Some (t,_) = rewrite_set_inst_ thy true bdvs isolate_bdvs t;
114.266 +if term2str t = "[c_4 = 0, \
114.267 + \L * c_3 + c_4 = 0 + -1 * (-1 * q_0 * L ^^^ 2 / 2),\n \
114.268 + \c + (c_2 + (c_3 + c_4)) = 0, c_2 + (c_3 + c_4) = 0]"
114.269 +then () else raise error "eqsystem.sml rewrite in 4x4 isolate_bdvs";
114.270 +
114.271 +val Some(t,_)= rewrite_set_inst_ thy true bdvs simplify_System_parenthesized t;
114.272 +if term2str t = "[c_4 = 0,\
114.273 + \ L * c_3 + c_4 = q_0 * L ^^^ 2 / 2,\
114.274 + \ c + (c_2 + (c_3 + c_4)) = 0,\n\
114.275 + \ c_2 + (c_3 + c_4) = 0]"
114.276 +then () else raise error "eqsystem.sml rewrite in 4x4 simplify_System_p..2";
114.277 +
114.278 +val Some (t,_) = rewrite_set_ thy true order_system t;
114.279 +if term2str t = "[c_4 = 0,\
114.280 + \ L * c_3 + c_4 = q_0 * L ^^^ 2 / 2,\
114.281 + \ c_2 + (c_3 + c_4) = 0,\n\
114.282 + \ c + (c_2 + (c_3 + c_4)) = 0]"
114.283 +then () else raise error "eqsystem.sml rewrite in 4x4 order_system";
114.284 +
114.285 +
114.286 +"----------- script [EqSystem,normalize,2x2] ---------------------";
114.287 +"----------- script [EqSystem,normalize,2x2] ---------------------";
114.288 +"----------- script [EqSystem,normalize,2x2] ---------------------";
114.289 +val str =
114.290 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.291 +\ (let es__ = (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.292 +\ simplify_System_parenthesized False) es_ \
114.293 +\ in ([]))";
114.294 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.295 +val str =
114.296 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.297 +\ (let es__ = (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.298 +\ simplify_System_parenthesized False) es_ \
114.299 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.300 +\ []))";
114.301 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.302 +val str =
114.303 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.304 +\ (let es__ = (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.305 +\ simplify_System_parenthesized False) es_ \
114.306 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.307 +\ [bool_list_ es__, real_list_ vs_]))"
114.308 +;
114.309 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.310 +val str =
114.311 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.312 +\ (let es__ = Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.313 +\ simplify_System_parenthesized False) es_ \
114.314 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.315 +\ [bool_list_ es__, real_list_ vs_]))"
114.316 +;
114.317 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.318 +val str =
114.319 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.320 +\ (let es__ = (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.321 +\ simplify_System_parenthesized False)) es_ \
114.322 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.323 +\ [bool_list_ es__, real_list_ vs_]))"
114.324 +;
114.325 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.326 +val str =
114.327 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.328 +\ (let es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.329 +\ simplify_System_parenthesized False)) @@\
114.330 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.331 +\ simplify_System_parenthesized False))) es_\
114.332 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.333 +\ [bool_list_ es__, real_list_ vs_]))"
114.334 +;
114.335 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.336 +val str =
114.337 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.338 +\ (let es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.339 +\ simplify_System_parenthesized False)) @@\
114.340 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.341 +\ simplify_System_parenthesized False)) @@\
114.342 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.343 +\ simplify_System_parenthesized False))) es_\
114.344 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.345 +\ [bool_list_ es__, real_list_ vs_]))"
114.346 +;
114.347 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.348 +val str =
114.349 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.350 +\ (let es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.351 +\ simplify_System_parenthesized False)) @@\
114.352 +\ (Try (Rewrite_Set_Inst [] isolate_bdvs False)) @@\
114.353 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.354 +\ simplify_System_parenthesized False)) @@\
114.355 +\ (Try (Rewrite_Set order_system False))) es_\
114.356 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.357 +\ [bool_list_ es__, real_list_ vs_]))"
114.358 +;
114.359 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.360 +val str =
114.361 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.362 +\ (let es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.363 +\ simplify_System_parenthesized False)) @@\
114.364 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_)]\
114.365 +\ isolate_bdvs False)) @@\
114.366 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.367 +\ simplify_System_parenthesized False)) @@\
114.368 +\ (Try (Rewrite_Set order_system False))) es_\
114.369 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.370 +\ [bool_list_ es__, real_list_ vs_]))"
114.371 +;
114.372 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.373 +val str =
114.374 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.375 +\ (let es__ = ((Try (Rewrite_Set simplify_System_parenthesized False)) @@\
114.376 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.377 +\ isolate_bdvs False)) @@\
114.378 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.379 +\ simplify_System_parenthesized False)) @@\
114.380 +\ (Try (Rewrite_Set order_system False))) es_\
114.381 +\ in (SubProblem (Biegelinie_,[linear,system],[no_met])\
114.382 +\ [bool_list_ es__, real_list_ vs_]))"
114.383 +;
114.384 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.385 +(*---^^^-OK-----------------------------------------------------------------*)
114.386 +(*---vvv-NOT ok-------------------------------------------------------------*)
114.387 +
114.388 +
114.389 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.1 --";
114.390 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.1 --";
114.391 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.1 --";
114.392 +val str =
114.393 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.394 +\ (let es__ = (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.395 +\ simplify_System_parenthesized False) es_ \
114.396 +\ in ([]))";
114.397 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.398 +val str =
114.399 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.400 +\ (let e1__ = Take (hd es_) \
114.401 +\ in ([]))";
114.402 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.403 +val str =
114.404 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.405 +\ (let e1__ = Take (hd es_); \
114.406 +\ e1__ = Take (hd es_) \
114.407 +\ in ([]))";
114.408 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.409 +val str =
114.410 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.411 +\ (let e1__ = Take (hd es_); \
114.412 +\ e1__ = (Take (hd es_))\
114.413 +\ in ([]))";
114.414 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.415 +val str =
114.416 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.417 +\ (let e1__ = Take (hd es_); \
114.418 +\ e1__ = ((Rewrite_Set order_system False)) e1__\
114.419 +\ in ([]))";
114.420 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.421 +(*--------------------------------------------------------------------------*)
114.422 +val str =
114.423 +"(Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.424 +\ isolate_bdvs False) (e1__::bool)";
114.425 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.426 +(*--------------------------------------------------------------------------*)
114.427 +val str =
114.428 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.429 +\ (let e1__ = Take (hd es_); \
114.430 +\ e1__ = ((Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.431 +\ isolate_bdvs False)) e1__\
114.432 +\ in ([]))";
114.433 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.434 +val str =
114.435 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.436 +\ (let e1__ = Take (hd es_); \
114.437 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.438 +\ isolate_bdvs False)) @@\
114.439 +\ (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.440 +\ simplify_System False)) e1__\
114.441 +\ in ([]))";
114.442 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.443 +val str =
114.444 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.445 +\ (let e1__ = Take (hd es_); \
114.446 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.447 +\ isolate_bdvs False)) @@\
114.448 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.449 +\ simplify_System False))) e1__\
114.450 +\ in ([]))";
114.451 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.452 +val str =
114.453 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.454 +\ (let e1__ = Take (hd es_); \
114.455 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.456 +\ isolate_bdvs False)) @@ \
114.457 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.458 +\ simplify_System False))) e1__; \
114.459 +\ e2__ = Take (hd (tl es_)) \
114.460 +\ in ([]))";
114.461 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.462 +val str =
114.463 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.464 +\ (let e1__ = Take (hd es_); \
114.465 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.466 +\ isolate_bdvs False)) @@ \
114.467 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.468 +\ simplify_System False))) e1__; \
114.469 +\ e2__ = Take (hd (tl es_)); \
114.470 +\ e2__ = Substitute [e1__] e2__ \
114.471 +\ in ([]))";
114.472 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.473 +val str =
114.474 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.475 +\ (let e1__ = Take (hd es_); \
114.476 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.477 +\ isolate_bdvs False)) @@ \
114.478 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.479 +\ simplify_System False))) e1__; \
114.480 +\ e2__ = Take (hd (tl es_)); \
114.481 +\ e2__ = ((Substitute [e1__])) e2__ \
114.482 +\ in ([]))";
114.483 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.484 +val str =
114.485 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.486 +\ (let e1__ = Take (hd es_); \
114.487 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.488 +\ isolate_bdvs False)) @@ \
114.489 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.490 +\ simplify_System False))) e1__; \
114.491 +\ e2__ = Take (hd (tl es_)); \
114.492 +\ e2__ = ((Substitute [e1__]) @@ \
114.493 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.494 +\ isolate_bdvs False)) @@ \
114.495 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.496 +\ simplify_System False))) e2__ \
114.497 +\ in [e1__, e2__])"
114.498 +;
114.499 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.500 +val str =
114.501 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.502 +\ (let e1__ = Take (hd es_); \
114.503 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.504 +\ isolate_bdvs False)) @@ \
114.505 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.506 +\ simplify_System False))) e1__; \
114.507 +\ e2__ = Take (hd (tl es_)); \
114.508 +\ e2__ = ((Substitute [e1__]) @@ \
114.509 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.510 +\ simplify_System_parenthesized False)) @@ \
114.511 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.512 +\ isolate_bdvs False)) @@ \
114.513 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.514 +\ simplify_System False)) @@ \
114.515 +\ (Try (Rewrite_Set order_system False))) e2__ \
114.516 +\ in [e1__, e2__])"
114.517 +;
114.518 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.519 +(*---^^^-OK-----------------------------------------------------------------*)
114.520 +val str =
114.521 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.522 +\ (let e1__ = Take (hd es_); \
114.523 +\ e1__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.524 +\ isolate_bdvs False)) @@ \
114.525 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.526 +\ simplify_System False))) e1__; \
114.527 +\ e2__ = Take (hd (tl es_)); \
114.528 +\ e2__ = ((Substitute [e1__]) @@ \
114.529 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.530 +\ simplify_System_parenthesized False)) @@ \
114.531 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.532 +\ isolate_bdvs False)) @@ \
114.533 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.534 +\ simplify_System False))) e2__; \
114.535 +\ es__ = Take [e1__, e2__]\
114.536 +\ in (Try (Rewrite_Set order_system False)) es__)"
114.537 +;
114.538 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.539 +(*---vvv-NOT ok-------------------------------------------------------------*)
114.540 +atomty sc;
114.541 +
114.542 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.2 --";
114.543 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.2 --";
114.544 +"----------- script [EqSystem,top_down_substitution,2x2] Vers.2 --";
114.545 +val str =
114.546 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.547 +\ (let es__ = Take es_; \
114.548 +\ e1__ = hd es__\
114.549 +\ in ([]))"
114.550 +;
114.551 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.552 +val str =
114.553 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.554 +\ (let es__ = Take es_; \
114.555 +\ e1__ = hd es__; \
114.556 +\ e2__ = hd (tl es__)\
114.557 +\ in ([]))"
114.558 +;
114.559 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.560 +val str =
114.561 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.562 +\ (let es__ = Take es_; \
114.563 +\ e1__ = hd es__; \
114.564 +\ e2__ = hd (tl es__);\
114.565 +\ es__ = [1=2,3=4]\
114.566 +\ in ([]))"
114.567 +;
114.568 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.569 +val str =
114.570 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.571 +\ (let es__ = Take es_; \
114.572 +\ e1__ = hd es__; \
114.573 +\ e2__ = hd (tl es__);\
114.574 +\ es__ = [e1__,e2__]\
114.575 +\ in ([]))"
114.576 +;
114.577 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.578 +val str =
114.579 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.580 +\ (let es__ = Take es_; \
114.581 +\ e1__ = hd es__; \
114.582 +\ e2__ = hd (tl es__);\
114.583 +\ es__ = [e1__, Substitute [e1__] e2__];\
114.584 +\ es__ = (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.585 +\ simplify_System False)) es__ \
114.586 +\ in ([]))"
114.587 +;
114.588 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.589 +val str =
114.590 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.591 +\ (let es__ = Take es_; \
114.592 +\ e1__ = hd es__; \
114.593 +\ e2__ = hd (tl es__);\
114.594 +\ es__ = [e1__, Substitute [e1__] e2__];\
114.595 +\ es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.596 +\ isolate_bdvs False)) @@ \
114.597 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.598 +\ simplify_System False))) es__ \
114.599 +\ in ([]))"
114.600 +;
114.601 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.602 +val str =
114.603 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.604 +\ (let es__ = Take es_; \
114.605 +\ e1__ = hd es__; \
114.606 +\ e2__ = hd (tl es__);\
114.607 +\ es__ = [e1__, Substitute [e1__] e2__];\
114.608 +\ es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.609 +\ simplify_System_parenthesized False)) @@ \
114.610 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.611 +\ isolate_bdvs False)) @@ \
114.612 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.613 +\ simplify_System False))) es__ \
114.614 +\ in ([]))"
114.615 +;
114.616 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.617 +val str =
114.618 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.619 +\ (let es__ = Take es_; \
114.620 +\ e1__ = hd es__; \
114.621 +\ e2__ = hd (tl es__); \
114.622 +\ es__ = [e1__, Substitute [e1__] e2__]; \
114.623 +\ es__ = ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.624 +\ simplify_System_parenthesized False)) @@ \
114.625 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.626 +\ isolate_bdvs False)) @@ \
114.627 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.628 +\ simplify_System False))) es__ \
114.629 +\ in es__)"
114.630 +;
114.631 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.632 +val str =
114.633 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.634 +\ (let es__ = Take es_; \
114.635 +\ e1__ = hd es__; \
114.636 +\ e2__ = hd (tl es__); \
114.637 +\ es__ = [e1__, Substitute [e1__] e2__] \
114.638 +\ in ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.639 +\ simplify_System_parenthesized False)) @@ \
114.640 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))] \
114.641 +\ isolate_bdvs False)) @@ \
114.642 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.643 +\ simplify_System False))) es__)"
114.644 +;
114.645 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.646 +(*---^^^-OK-----------------------------------------------------------------*)
114.647 +val str =
114.648 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.649 +\ (let es__ = Take es_; \
114.650 +\ e1__ = hd es__; \
114.651 +\ e2__ = hd (tl es__); \
114.652 +\ es__ = [e1__, Substitute [e1__] e2__] "^
114.653 +(* this ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ is a script-'Expr'
114.654 + which is not yet searched for 'STac's; thus this script does not yet work*)
114.655 +" in ((Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.656 +\ simplify_System_parenthesized False)) @@ \
114.657 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))] \
114.658 +\ isolate_bdvs False)) @@ \
114.659 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.660 +\ simplify_System False))) es__)"
114.661 +;
114.662 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.663 +(*---vvv-NOT ok-------------------------------------------------------------*)
114.664 +atomty sc;
114.665 +
114.666 +
114.667 +"----------- refine [linear,system]-------------------------------";
114.668 +"----------- refine [linear,system]-------------------------------";
114.669 +"----------- refine [linear,system]-------------------------------";
114.670 +val fmz = ["equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\
114.671 + \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]",
114.672 + "solveForVars [c, c_2]", "solution L"];
114.673 +val matches = refine fmz ["linear","system"];
114.674 +case matches of [_,_,_,
114.675 + Matches (["normalize", "2x2", "linear", "system"],
114.676 + {Find = [Correct "solution L"],
114.677 + With = [],
114.678 + Given =
114.679 + [Correct
114.680 + "equalities\n [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\n 0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]",
114.681 + Correct "solveForVars [c, c_2]"],
114.682 + Where = [],
114.683 + Relate = []})] => ()
114.684 + | _ => raise error "eqsystem.sml refine ['normalize','2x2'...]";
114.685 +
114.686 +
114.687 +val fmz = ["equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]",
114.688 + "solveForVars [c, c_2]", "solution L"];
114.689 +val matches = refine fmz ["linear","system"];
114.690 +case matches of [_,_,
114.691 + Matches
114.692 + (["triangular", "2x2", "linear", "system"],
114.693 + {Find = [Correct "solution L"],
114.694 + With = [],
114.695 + Given =
114.696 + [Correct
114.697 + "equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]",
114.698 + Correct "solveForVars [c, c_2]"],
114.699 + Where =
114.700 + [Correct
114.701 + "tl [c, c_2] from_ [c, c_2] occur_exactly_in nth_ 1\n [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]",
114.702 + Correct
114.703 + "[c, c_2] from_ [c, c_2] occur_exactly_in nth_ 2\n [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]"],
114.704 + Relate = []})] => ()
114.705 + | _ => raise error "eqsystem.sml refine ['triangular','2x2'...]";
114.706 +
114.707 +
114.708 +(*WN051014----------------------------------------------------------------
114.709 + the above 'val matches = refine fmz ["linear","system"]'
114.710 + didn't work anymore; we investigated in these steps:*)
114.711 +val fmz = ["equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]",
114.712 + "solveForVars [c, c_2]", "solution L"];
114.713 +val matches = refine fmz ["triangular", "2x2", "linear","system"];
114.714 +(*... resulted in
114.715 + False "[c, c_2] from_ [c, c_2] occur_exactly_in nth_ 2\n
114.716 + [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]"]*)
114.717 +
114.718 +val t = str2term"[c, c_2] from_ [c, c_2] occur_exactly_in nth_ 2\
114.719 + \[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]";
114.720 +trace_rewrite:=true;
114.721 +val Some (t',_) = rewrite_set_ thy false prls_triangular t;
114.722 +(*found:...
114.723 +## try thm: nth_Cons_
114.724 +### eval asms: 1 < 2 + - 1
114.725 +==> nth_ (2 + - 1) [L * c + c_2 = q_0 * L ^^^ 2 / 2] =
114.726 + nth_ (2 + - 1 + - 1) []
114.727 +#### rls: erls_prls_triangular on: 1 < 2 + - 1
114.728 +##### try calc: op <'
114.729 +### asms accepted: ["1 < 2 + - 1"] stored: ["1 < 2 + -1"]
114.730 +
114.731 +... i.e Calc ("op +", eval_binop "#add_") was missing in erls_prls_triangular*)
114.732 +trace_rewrite:=false;
114.733 +(*WN051014------------------------------------------------------------------*)
114.734 +
114.735 +"----- relaxed preconditions for triangular system";
114.736 +val fmz = ["equalities [L * q_0 = c, \
114.737 + \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2,\
114.738 + \ 0 = c_4, \
114.739 + \ 0 = c_3]",
114.740 + "solveForVars [c, c_2, c_3, c_4]", "solution L"];
114.741 +val matches = refine fmz ["linear","system"];
114.742 +(* trace_rewrite := true;
114.743 + trace_rewrite := false;
114.744 + *)
114.745 +(*print_depth 6; matches; print_depth 3;*)
114.746 +case matches of
114.747 + [Matches (["linear", "system"], _),
114.748 + NoMatch (["2x2", "linear", "system"], _),
114.749 + NoMatch (["3x3", "linear", "system"], _),
114.750 + Matches (["4x4", "linear", "system"], _),
114.751 + NoMatch (["triangular", "4x4", "linear", "system"], _),
114.752 + Matches (["normalize", "4x4", "linear", "system"], _)] => ()
114.753 + | _ => raise error "eqsystem.sml: refine relaxed triangular sys NoMatch";
114.754 +(*WN060914 does NOT match, because 3rd and 4th equ are not ordered*)
114.755 +
114.756 +val fmz = ["equalities [L * q_0 = c, \
114.757 + \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2,\
114.758 + \ 0 = c_3, \
114.759 + \ 0 = c_4]",
114.760 + "solveForVars [c, c_2, c_3, c_4]", "solution L"];
114.761 +val matches = refine fmz ["triangular", "4x4", "linear","system"];
114.762 +(* print_depth 11; matches; print_depth 3;
114.763 + *)
114.764 +case matches of
114.765 + [Matches (["triangular", "4x4", "linear", "system"], _)] => ()
114.766 + | _ => raise error "eqsystem.sml: refine relaxed triangular sys Matches";
114.767 +val matches = refine fmz ["linear","system"];
114.768 +
114.769 +
114.770 +"----------- refine [2x2,linear,system] search error--------------";
114.771 +"----------- refine [2x2,linear,system] search error--------------";
114.772 +"----------- refine [2x2,linear,system] search error--------------";
114.773 +(*didn't go into ["2x2", "linear", "system"];
114.774 + we investigated in these steps:*)
114.775 +val fmz = ["equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\
114.776 + \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]",
114.777 + "solveForVars [c, c_2]", "solution L"];
114.778 +trace_rewrite:=true;
114.779 +val matches = refine fmz ["2x2", "linear","system"];
114.780 +trace_rewrite:=false;
114.781 +print_depth 11; matches; print_depth 3;
114.782 +(*brought: 'False "length_ es_ = 2"'*)
114.783 +
114.784 +(*-----fun refin' (pblRD:pblRD) fmz pbls ((Ptyp (pI,[py],[])):pbt ptyp) =
114.785 +(* val ((pblRD:pblRD), fmz, pbls, ((Ptyp (pI,[py],[])):pbt ptyp)) =
114.786 + (rev ["linear","system"], fmz, [(*match list*)],
114.787 + ((Ptyp ("2x2",[get_pbt ["2x2","linear","system"]],[])):pbt ptyp));
114.788 + *)
114.789 +> show_types:=true; term2str (hd where_); show_types:=false;
114.790 +val it = "length_ (es_::real list) = (2::real)" : string
114.791 +
114.792 +=========================================================================\
114.793 +-------fun prep_pbt
114.794 +(* val (thy, (pblID, dsc_dats: (string * (string list)) list,
114.795 + ev:rls, ca: string option, metIDs:metID list)) =
114.796 + (EqSystem.thy, (["system"],
114.797 + [("#Given" ,["equalities es_", "solveForVars vs_"]),
114.798 + ("#Find" ,["solution ss___"](*___ is copy-named*))
114.799 + ],
114.800 + append_rls "e_rls" e_rls [(*for preds in where_*)],
114.801 + Some "solveSystem es_ vs_",
114.802 + []));
114.803 + *)
114.804 +> val [("#Given", [equalities_es_, "solveForVars vs_"])] = gi;
114.805 +val equalities_es_ = "equalities es_" : string
114.806 +> val (dd, ii) = (split_did o term_of o the o (parse thy)) equalities_es_;
114.807 +> show_types:=true; term2str ii; show_types:=false;
114.808 +val it = "es_::bool list" : string
114.809 +~~~~~~~~~~~~~~~^^^^^^^^^ OK~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
114.810 +
114.811 +> val {where_,...} = get_pbt ["2x2", "linear","system"];
114.812 +> show_types:=true; term2str (hd where_); show_types:=false;
114.813 +
114.814 +=========================================================================/
114.815 +
114.816 +
114.817 +
114.818 +-----fun refin' ff:
114.819 +> (writeln o (itms2str Isac.thy)) itms;
114.820 +[
114.821 +(1 ,[1] ,true ,#Given ,Cor equalities
114.822 + [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
114.823 + 0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2] ,(es_, [[0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
114.824 + 0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]])),
114.825 +(2 ,[1] ,true ,#Given ,Cor solveForVars [c, c_2] ,(vs_, [[c, c_2]])),
114.826 +(3 ,[1] ,true ,#Find ,Cor solution L ,(ss___, [L]))]
114.827 +
114.828 +> (writeln o pres2str) pre';
114.829 +[
114.830 +(false, length_ es_ = 2),
114.831 +(true, length_ [c, c_2] = 2)]
114.832 +
114.833 +----- fun match_oris':
114.834 +> (writeln o (itms2str Isac.thy)) itms;
114.835 +> (writeln o pres2str) pre';
114.836 +..as in refin'
114.837 +
114.838 +----- fun check_preconds'
114.839 +> (writeln o env2str) env;
114.840 +["
114.841 +(es_, [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,
114.842 + 0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2])","
114.843 +(vs_, [c, c_2])","
114.844 +(ss___, L)"]
114.845 +
114.846 +> val es_ = (fst o hd) env;
114.847 +val es_ = Free ("es_", "bool List.list") : Term.term
114.848 +
114.849 +> val pre1 = hd pres;
114.850 +atomty pre1;
114.851 +***
114.852 +*** Const (op =, [real, real] => bool)
114.853 +*** . Const (ListG.length_, real list => real)
114.854 +*** . . Free (es_, real list)
114.855 +~~~~~~~~~~~~~~~~~~~^^^^^^^^^ should be bool list~~~~~~~~~~~~~~~~~~~
114.856 +*** . Free (2, real)
114.857 +***
114.858 +
114.859 +THE REASON WAS A non-type-constrained variable IN #WHERE OF PROBLEM
114.860 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
114.861 +*)
114.862 +
114.863 +
114.864 +"----------- me [EqSystem,normalize,2x2] -------------------------";
114.865 +"----------- me [EqSystem,normalize,2x2] -------------------------";
114.866 +"----------- me [EqSystem,normalize,2x2] -------------------------";
114.867 +val fmz = ["equalities [0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2,\
114.868 + \0 = -1 * q_0 * L ^^^ 2 / 2 + L * c + c_2]",
114.869 + "solveForVars [c, c_2]", "solution L"];
114.870 +val (dI',pI',mI') =
114.871 + ("Biegelinie.thy",["normalize", "2x2", "linear", "system"],
114.872 + ["EqSystem","normalize","2x2"]);
114.873 +val p = e_pos'; val c = [];
114.874 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
114.875 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.876 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.877 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.878 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.879 +case nxt of ("Specify_Method",_) => ()
114.880 + | _ => raise error "eqsystem.sml [EqSystem,normalize,2x2] specify";
114.881 +
114.882 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.883 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.884 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f(*["(bdv_1, c)", "(bdv_2, hd (tl [c, c_2] ... corrected srls; ran only AFTER use"RCODE-root.sml", store_met was NOT SUFFICIENT*);
114.885 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.886 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.887 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.888 +case nxt of
114.889 + (_, Subproblem ("Biegelinie.thy", ["triangular", "2x2", "linear",_])) => ()
114.890 + | _ => raise error "eqsystem.sml me [EqSystem,normalize,2x2] SubProblem";
114.891 +
114.892 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.893 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.894 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.895 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.896 +case nxt of
114.897 + (_, Specify_Method ["EqSystem", "top_down_substitution", "2x2"]) => ()
114.898 + | _ => raise error "eqsystem.sml me [EqSys...2x2] top_down_substitution";
114.899 +
114.900 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.901 +val PblObj {probl,...} = get_obj I pt [5];(writeln o(itms2str Isac.thy)) probl;
114.902 +(*[
114.903 +(1 ,[1] ,true ,#Given ,Cor equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2] ,(es_, [[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]])),
114.904 +(2 ,[1] ,true ,#Given ,Cor solveForVars [c, c_2] ,(vs_, [[c, c_2]])),
114.905 +(3 ,[1] ,true ,#Find ,Cor solution ss___ ,(ss___, [ss___]))]
114.906 +*)
114.907 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.908 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.909 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.910 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.911 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.912 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.913 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.914 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.915 +case nxt of
114.916 + (_, Check_Postcond ["triangular", "2x2", "linear", "system"]) => ()
114.917 + | _ => raise error "eqsystem.sml me Subpbl .[EqSys...2x2] finished";
114.918 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.919 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.920 +if f2str f = "[c = L * q_0 / 2, c_2 = 0]" then ()
114.921 +else raise error "eqsystem.sml me [EqSys...2x2] finished f2str f";
114.922 +case nxt of
114.923 + (_, End_Proof') => ()
114.924 + | _ => raise error "eqsystem.sml me [EqSys...2x2] finished End_Proof'";
114.925 +
114.926 +
114.927 +"----------- me [linear,system] ..normalize..top_down_sub..-------";
114.928 +"----------- me [linear,system] ..normalize..top_down_sub..-------";
114.929 +"----------- me [linear,system] ..normalize..top_down_sub..-------";
114.930 +val fmz =
114.931 + ["equalities\
114.932 + \[0 = c_2 + c * 0 + 1 / EI * (L * q_0 / 12 * 0 ^^^ 3 + \
114.933 + \ -1 * q_0 / 24 * 0 ^^^ 4),\
114.934 + \ 0 = c_2 + c * L + 1 / EI * (L * q_0 / 12 * L ^^^ 3 + \
114.935 + \ -1 * q_0 / 24 * L ^^^ 4)]",
114.936 + "solveForVars [c, c_2]", "solution L"];
114.937 +val (dI',pI',mI') =
114.938 + ("Biegelinie.thy",["linear", "system"], ["no_met"]);
114.939 +val p = e_pos'; val c = [];
114.940 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
114.941 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.942 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.943 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.944 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.945 +case nxt of (_,Specify_Method ["EqSystem", "normalize", "2x2"]) => ()
114.946 + | _ => raise error "eqsystem.sml [linear,system] specify b";
114.947 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.948 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.949 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.950 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.951 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.952 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.953 +if f2str f =
114.954 +"[c_2 = 0, L * c + c_2 = -1 * q_0 * L ^^^ 4 / (24 * EI)]"
114.955 +then () else raise error "eqsystem.sml me simpl. before SubProblem b";
114.956 +case nxt of
114.957 + (_, Subproblem ("Biegelinie.thy", ["triangular", "2x2", "linear",_])) => ()
114.958 + | _ => raise error "eqsystem.sml me [linear,system] SubProblem b";
114.959 +
114.960 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.961 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.962 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.963 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.964 +case nxt of
114.965 + (_, Specify_Method ["EqSystem", "top_down_substitution", "2x2"]) => ()
114.966 + | _ => raise error "eqsystem.sml me [EqSys...2x2] top_down_substitution b";
114.967 +
114.968 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.969 +val PblObj {probl,...} = get_obj I pt [5];(writeln o(itms2str Isac.thy)) probl;
114.970 +(*[
114.971 +(1 ,[1] ,true ,#Given ,Cor equalities [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2] ,(es_, [[c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]])),
114.972 +(2 ,[1] ,true ,#Given ,Cor solveForVars [c, c_2] ,(vs_, [[c, c_2]])),
114.973 +(3 ,[1] ,true ,#Find ,Cor solution ss___ ,(ss___, [ss___]))]
114.974 +*)
114.975 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.976 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.977 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.978 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.979 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.980 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.981 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.982 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.983 +case nxt of
114.984 + (_, Check_Postcond ["triangular", "2x2", "linear", "system"]) => ()
114.985 + | _ => raise error "eqsystem.sml me Subpbl .[EqSys...2x2] finished b";
114.986 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.987 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
114.988 +if f2str f =
114.989 +"[c = -1 * q_0 * L ^^^ 4 / (24 * EI * L), c_2 = 0]"
114.990 +then () else raise error "eqsystem.sml me [EqSys...2x2] finished f2str f b";
114.991 +case nxt of
114.992 + (_, End_Proof') => ()
114.993 + | _ => raise error "eqsystem.sml me [EqSys...2x2] finished End_Proof'" b;
114.994 +
114.995 +
114.996 +"----------- all systems from Biegelinie -------------------------";
114.997 +"----------- all systems from Biegelinie -------------------------";
114.998 +"----------- all systems from Biegelinie -------------------------";
114.999 +val subst = [(str2term "bdv_1", str2term "c"),
114.1000 + (str2term "bdv_2", str2term "c_2"),
114.1001 + (str2term "bdv_3", str2term "c_3"),
114.1002 + (str2term "bdv_4", str2term "c_4")];
114.1003 +"------- Bsp 7.27";
114.1004 +states:=[];
114.1005 +CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
114.1006 + "Randbedingungen [y 0 = 0, y L = 0, M_b 0 = 0, M_b L = 0]",
114.1007 + "FunktionsVariable x"],
114.1008 + ("Biegelinie.thy", ["Biegelinien"],
114.1009 + ["IntegrierenUndKonstanteBestimmen2"]))];
114.1010 +moveActiveRoot 1;
114.1011 +(*
114.1012 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1013 +##7.27## ordered substs
114.1014 + c_4 c_2
114.1015 +c c_2 c_3 c_4 c c_2 1->2: c
114.1016 + c_2 c_4
114.1017 +c c_2 c c_2 c_3 c_4 [2':c, 1:c_2, 3:c_4] -> 4:c_3*)
114.1018 +val t = str2term"[0 = c_4, \
114.1019 +\ 0 = c_4 + L * c_3 +(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI), \
114.1020 +\ 0 = c_2, \
114.1021 +\ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]";
114.1022 +val Some (t',_) = rewrite_set_ thy false isolate_bdvs_4x4 t;
114.1023 +term2str t';
114.1024 +"[c_4 = 0,\n (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI) =\n 0 + -1 * (c_4 + L * c_3),\n c_2 = 0, (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2 = 0]";
114.1025 +
114.1026 +
114.1027 +"----- 7.27 go through the rewrites in met_eqsys_norm_4x4";
114.1028 +val t = str2term "0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2";
114.1029 +val None = rewrite_set_ thy false norm_Rational t;
114.1030 +val Some (t,_) =
114.1031 + rewrite_set_inst_ thy false subst simplify_System_parenthesized t;
114.1032 +term2str t = "0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2)";
114.1033 +"--- isolate_bdvs_4x4";
114.1034 +(*
114.1035 +val Some (t,_) = rewrite_set_inst_ thy false subst isolate_bdvs_4x4 t;
114.1036 +term2str t;
114.1037 +val Some (t,_) = rewrite_set_inst_ thy false subst simplify_System t;
114.1038 +term2str t;
114.1039 +val Some (t,_) = rewrite_set_ thy false order_system t;
114.1040 +term2str t;
114.1041 +*)
114.1042 +
114.1043 +"------- Bsp 7.28 ---------------vvvvvvvvvvvvv Momentenlinie postponed";
114.1044 +states:=[];
114.1045 +CalcTree [(["Traegerlaenge L","Momentenlinie (-q_0 / L * x^3 / 6)",
114.1046 + "Biegelinie y",
114.1047 + "Randbedingungen [y L = 0, y' L = 0]",
114.1048 + "FunktionsVariable x"],
114.1049 + ("Biegelinie.thy", ["vonMomentenlinieZu","Biegelinien"],
114.1050 + ["Biegelinien", "AusMomentenlinie"]))];
114.1051 +moveActiveRoot 1;
114.1052 +(*
114.1053 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1054 +*)
114.1055 +
114.1056 +"------- Bsp 7.69";
114.1057 +states:=[];
114.1058 +CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
114.1059 + "Randbedingungen [y 0 = 0, y L = 0, y' 0 = 0, y' L = 0]",
114.1060 + "FunktionsVariable x"],
114.1061 + ("Biegelinie.thy", ["Biegelinien"],
114.1062 + ["IntegrierenUndKonstanteBestimmen2"] ))];
114.1063 +moveActiveRoot 1;
114.1064 +(*
114.1065 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1066 +##7.69## ordered subst 2x2
114.1067 + c_4 c_3
114.1068 +c c_2 c_3 c_4 c c_2 c_3 1:c_3 -> 2:c c_2 2: c c_2
114.1069 + c_3 c_4
114.1070 +c c_2 c_3 c c_2 c_3 c_4 3:c_4 -> 4:c c_2 c_3 1:c_3 -> 4:c c_2*)
114.1071 +val t = str2term"[0 = c_4 + 0 / (-1 * EI), \
114.1072 +\ 0 = c_4 + L * c_3 + (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI), \
114.1073 +\ 0 = c_3 + 0 / (-1 * EI), \
114.1074 +\ 0 = c_3 + (6 * L * c_2 + 3 * L ^^^ 2 * c + -1 * L ^^^ 3 * q_0) / (-6 * EI)]";
114.1075 +
114.1076 +"------- Bsp 7.70";
114.1077 +states:=[];
114.1078 +CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
114.1079 + "Randbedingungen [Q 0 = q_0 * L, M_b L = 0, y 0 = 0, y' 0 = 0]",
114.1080 + "FunktionsVariable x"],
114.1081 + ("Biegelinie.thy", ["Biegelinien"],
114.1082 + ["IntegrierenUndKonstanteBestimmen2"] ))];
114.1083 +moveActiveRoot 1;
114.1084 +(*
114.1085 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1086 +##7.70## |subst
114.1087 +c |
114.1088 +c c_2 |1:c -> 2:c_2
114.1089 + c_3 |
114.1090 + c_4 | GOON test methods @@@@@@@@@@@@@@@@@@@@@@@@@@@*)
114.1091 +
114.1092 +"----- 7.70 go through the rewrites in met_eqsys_norm_4x4";
114.1093 +val t = str2term"[L * q_0 = c, \
114.1094 + \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2,\
114.1095 + \ 0 = c_4, \
114.1096 + \ 0 = c_3]";
114.1097 +val Some (t,_) =
114.1098 + rewrite_ thy e_rew_ord e_rls false (num_str commute_0_equality) t;
114.1099 +val Some (t,_) =
114.1100 + rewrite_ thy e_rew_ord e_rls false (num_str commute_0_equality) t;
114.1101 +val Some (t,_) =
114.1102 + rewrite_ thy e_rew_ord e_rls false (num_str commute_0_equality) t;
114.1103 +term2str t =
114.1104 + "[L * q_0 = c, (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2 = 0, c_4 = 0,\n c_3 = 0]";
114.1105 +val Some (t,_) =
114.1106 + rewrite_set_inst_ thy false subst simplify_System_parenthesized t;
114.1107 +term2str t =
114.1108 +"[L * q_0 = c, -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2) = 0, c_4 = 0, c_3 = 0]";
114.1109 +val Some (t,_) = rewrite_set_inst_ thy false subst isolate_bdvs_4x4 t;
114.1110 +term2str t =
114.1111 + "[c = (-1 * (L * q_0) + 0) / -1,\n L * c + c_2 = -1 * (-1 * q_0 * L ^^^ 2 / 2) + 0, c_4 = 0, c_3 = 0]";
114.1112 +val Some (t,_) =
114.1113 + rewrite_set_inst_ thy false subst simplify_System_parenthesized t;
114.1114 +
114.1115 +term2str t ="[c = L * q_0, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_4 = 0, c_3 = 0]";
114.1116 +val Some (t,_) = rewrite_set_ thy false order_system t;
114.1117 +if term2str t ="[c = L * q_0, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_3 = 0, c_4 = 0]" then ()
114.1118 +else raise error "eqsystem.sml: exp 7.70 normalize 4x4 by rewrite changed";
114.1119 +
114.1120 +
114.1121 +"----- 7.70 with met normalize: ";
114.1122 +val fmz = ["equalities \
114.1123 + \[L * q_0 = c, \
114.1124 + \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2,\
114.1125 + \ 0 = c_4, \
114.1126 + \ 0 = c_3]",
114.1127 + "solveForVars [c, c_2, c_3, c_4]", "solution L"];
114.1128 +val (dI',pI',mI') =
114.1129 + ("Biegelinie.thy",["linear", "system"],["no_met"]);
114.1130 +val p = e_pos'; val c = [];
114.1131 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
114.1132 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1133 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1134 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1135 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1136 +case nxt of (_,Apply_Method ["EqSystem", "normalize", "4x4"]) => ()
114.1137 + | _ => raise error "eqsystem.sml [EqSystem,normalize,4x4] specify";
114.1138 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1139 +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbb outcommented vvvvvvvvvvvvvvvvvvvvvv";
114.1140 +(*vvvWN080102 Exception- Match raised
114.1141 + since assod Rewrite .. Rewrite'_Set
114.1142 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1143 +
114.1144 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1145 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1146 +
114.1147 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1148 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1149 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1150 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1151 +if f2str f ="[c = L * q_0, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_3 = 0, c_4 = 0]"
114.1152 +then () else raise error "eqsystem.sml: exp 7.70 normalize 4x4 by met changed";
114.1153 +--------------------------------------------------------------------------*)
114.1154 +
114.1155 +"----- 7.70 with met top_down_: ";
114.1156 +"--- scr [EqSystem,top_down_substitution,4x4] -- a saved trial";
114.1157 +(*---vvv-this script failed with if ?!?-------------------------------------*)
114.1158 +val str =
114.1159 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1160 +\ (let e1_ = hd es_; \
114.1161 +\ v1_ = hd vs_; \
114.1162 +\ xxx = if lhs e1_ =!= v1_ \
114.1163 +\ then 0=0 \
114.1164 +\ else let e1_ = Take e1_; \
114.1165 +\ e1_ = (Rewrite_Set_Inst [(bdv_1, hd vs_), \
114.1166 +\ (bdv_2, hd (tl vs_))] \
114.1167 +\ isolate_bdvs False) e1_; \
114.1168 +\ e2_ = Take (hd (tl es_)); \
114.1169 +\ e2_ = (Substitute [e1__]) e2_ \
114.1170 +\ in [e1_, e2_])";
114.1171 +(*val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;*)
114.1172 +val str =
114.1173 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1174 +\ (let e1_ = hd es_; \
114.1175 +\ v1_ = hd vs_; \
114.1176 +\ e2_ = Take (hd (tl es_)); \
114.1177 +\ e2_ = (Substitute [e1__]) e2_ \
114.1178 +\ in [e1_, e2_])";
114.1179 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1180 +(*---^^^-OK-----------------------------------------------------------------*)
114.1181 +(*---vvv-NOT ok-------------------------------------------------------------*)
114.1182 +val str =
114.1183 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1184 +\ (let e1_ = hd es_; \
114.1185 +\ v1_ = hd vs_; \
114.1186 +\ xxx = if ((lhs e1_) =!= v1_) then 1 else 2; \
114.1187 +\ e2_ = Take (hd (tl es_)); \
114.1188 +\ e2_ = (Substitute [e1__]) e2_ \
114.1189 +\ in [e1_, e2_])";
114.1190 +(*val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;*)
114.1191 +val str = "if lhs e1_ =!= v1_ then 1 else 2";
114.1192 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1193 +
114.1194 +val str = "let xxx = (if lhs e1_ =!= v1_ then 1 else 2) in xxx";
114.1195 +(*val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;*)
114.1196 +atomty sc; term2str sc;
114.1197 +
114.1198 +"--- scr [EqSystem,top_down_substitution,4x4] -- adapted only to 7.70";
114.1199 +val str =
114.1200 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1201 +\ (let e2__ = Take (hd (tl es_)); \
114.1202 +\ e2__ = ((Substitute [e1__]) @@ \
114.1203 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.1204 +\ simplify_System_parenthesized False)) @@ \
114.1205 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.1206 +\ isolate_bdvs False)) @@ \
114.1207 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.1208 +\ simplify_System False))) e2__;\
114.1209 +\ es__ = Take [e1__, e2__] \
114.1210 +\ in (Try (Rewrite_Set order_system False)) es__)"
114.1211 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1212 +val str =
114.1213 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1214 +\ (let e2__ = Take (nth_ 2 es_); \
114.1215 +\ e2__ = ((Substitute [e1__]) @@ \
114.1216 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.1217 +\ simplify_System_parenthesized False)) @@ \
114.1218 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.1219 +\ isolate_bdvs False)) @@ \
114.1220 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, hd (tl vs_))]\
114.1221 +\ simplify_System False))) e2__;\
114.1222 +\ es__ = Take [e1__, e2__] \
114.1223 +\ in (Try (Rewrite_Set order_system False)) es__)"
114.1224 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1225 +val str =
114.1226 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1227 +\ (let e2__ = Take (nth_ 2 es_); \
114.1228 +\ e2__ = ((Substitute [e1__]) @@ \
114.1229 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)] \
114.1230 +\ simplify_System_parenthesized False)) @@ \
114.1231 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)]\
114.1232 +\ isolate_bdvs False)) @@ \
114.1233 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)]\
114.1234 +\ simplify_System False))) e2__;\
114.1235 +\ es__ = Take [e1__, e2__] \
114.1236 +\ in (Try (Rewrite_Set order_system False)) es__)"
114.1237 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1238 +val str =
114.1239 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1240 +\ (let e2__ = Take (nth_ 2 es_); \
114.1241 +\ e2__ = ((Substitute [e1__]) @@ \
114.1242 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1243 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1244 +\ simplify_System_parenthesized False)) @@ \
114.1245 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)] \
114.1246 +\ isolate_bdvs False)) @@ \
114.1247 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)] \
114.1248 +\ norm_Rational False))) e2__; \
114.1249 +\ es__ = Take [e1__, e2__] \
114.1250 +\ in [])"
114.1251 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1252 +val str =
114.1253 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1254 +\ (let e2_ = Take (nth_ 2 es_); \
114.1255 +\ e2_ = ((Substitute [e1_]) @@ \
114.1256 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1257 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1258 +\ simplify_System_parenthesized False)) @@ \
114.1259 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)] \
114.1260 +\ isolate_bdvs False)) @@ \
114.1261 +\ (Try (Rewrite_Set_Inst [(bdv_1, hd vs_),(bdv_2, nth_ 2 vs_)] \
114.1262 +\ norm_Rational False))) e2_; \
114.1263 +\ es_ = Take [e1_, e2_] \
114.1264 +\ in [e1_, e2_,e3_, e4_])"
114.1265 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1266 +val str =
114.1267 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1268 +\ (let e2_ = Take (nth_ 2 es_); \
114.1269 +\ e2_ = ((Substitute [e1_]) @@ \
114.1270 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1271 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1272 +\ simplify_System_parenthesized False)) @@ \
114.1273 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1274 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1275 +\ isolate_bdvs False)) @@ \
114.1276 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1277 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1278 +\ norm_Rational False))) e2_; \
114.1279 +\ es_ = Take [e1_, e2_] \
114.1280 +\ in [e1_, e2_,e3_, e4_])"
114.1281 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1282 +(*---^^^-OK-----------------------------------------------------------------*)
114.1283 +val str =
114.1284 +"Script SolveSystemScript (es_::bool list) (vs_::real list) = \
114.1285 +\ (let e2_ = Take (nth_ 2 es_); \
114.1286 +\ e2_ = ((Substitute [e1_]) @@ \
114.1287 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1288 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1289 +\ simplify_System_parenthesized False)) @@ \
114.1290 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1291 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1292 +\ isolate_bdvs False)) @@ \
114.1293 +\ (Try (Rewrite_Set_Inst [(bdv_1,nth_ 1 vs_),(bdv_2,nth_ 2 vs_),\
114.1294 +\ (bdv_3,nth_ 3 vs_),(bdv_4,nth_ 4 vs_)]\
114.1295 +\ norm_Rational False))) e2_ \
114.1296 +\ in [e1_, e2_, nth_ 3 es_, nth_ 4 es_])"
114.1297 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
114.1298 +(*---vvv-NOT ok-------------------------------------------------------------*)
114.1299 +atomty sc; term2str sc;
114.1300 +
114.1301 +
114.1302 +"----- 7.70 with met top_down_: me";
114.1303 +val fmz = ["equalities \
114.1304 + \[c = L * q_0, L * c + c_2 = q_0 * L ^^^ 2 / 2, c_3 = 0, c_4 = 0]",
114.1305 + "solveForVars [c, c_2, c_3, c_4]", "solution L"];
114.1306 +val (dI',pI',mI') =
114.1307 + ("Biegelinie.thy",["linear", "system"],["no_met"]);
114.1308 +val p = e_pos'; val c = [];
114.1309 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
114.1310 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1311 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1312 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1313 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1314 +case nxt of (_,Apply_Method ["EqSystem", "top_down_substitution", "4x4"]) => ()
114.1315 + | _ => raise error "eqsystem.sml [EqSystem,top_down_,4x4] specify";
114.1316 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1317 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1318 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1319 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1320 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1321 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1322 +if nxt = ("End_Proof'", End_Proof') andalso
114.1323 + f2str f = "[c = L * q_0, c_2 = -1 * L ^^^ 2 * q_0 / 2, c_3 = 0, c_4 = 0]"
114.1324 +then () else raise error "eqsystem.sml: 7.70 with met top_down_: me";
114.1325 +
114.1326 +
114.1327 +"------- Bsp 7.71";
114.1328 +states:=[];
114.1329 +CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
114.1330 + "Randbedingungen [M_b L = 0, y 0 = 0, y L = 0, y' 0 = 0]",
114.1331 + "FunktionsVariable x"],
114.1332 + ("Biegelinie.thy", ["Biegelinien"],
114.1333 + ["IntegrierenUndKonstanteBestimmen2"] ))];
114.1334 +moveActiveRoot 1;
114.1335 +(*
114.1336 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1337 +##7.71## |ordered |subst.singles (recurs) |2x2 |diagonal
114.1338 +c c_2 |c c_2 |1' |1': c c_2 |
114.1339 + c_4 | c_3 |2:c_3 -> 4' :c c_2 c_4 | |
114.1340 +c c_2 c_3 c_4 | c_4 |3' | |
114.1341 + c_3 |c c_2 c_3 c_4 |3:c_4 -> 4'':c c_2 |4'':c c_2 | *)
114.1342 +val t = str2term"[0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2, \
114.1343 +\ 0 = c_4 + 0 / (-1 * EI), \
114.1344 +\ 0 = c_4 + L * c_3 +(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) /(-24 * EI),\
114.1345 +\ 0 = c_3 + 0 / (-1 * EI)]";
114.1346 +
114.1347 +"------- Bsp 7.72a ---------------vvvvvvvvvvvvv Momentenlinie postponed";
114.1348 +states:=[];
114.1349 +CalcTree [(["Traegerlaenge L",
114.1350 + "Momentenlinie ((q_0 * L)/ 6 * x - q_0 /(6 * L) * x^3)",
114.1351 + "Biegelinie y",
114.1352 + "Randbedingungen [y 0 = 0, y L = 0]",
114.1353 + "FunktionsVariable x"],
114.1354 + ("Biegelinie.thy", ["vonMomentenlinieZu","Biegelinien"],
114.1355 + ["Biegelinien", "AusMomentenlinie"]))];
114.1356 +moveActiveRoot 1;
114.1357 +(*
114.1358 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1359 +*)
114.1360 +
114.1361 +"------- Bsp 7.72b";
114.1362 +states:=[];
114.1363 +CalcTree [(["Traegerlaenge L","Streckenlast (q_0 / L * x)","Biegelinie y",
114.1364 + "Randbedingungen [M_b 0 = 0, M_b L = 0, y 0 = 0, y L = 0]",
114.1365 + "FunktionsVariable x"],
114.1366 + ("Biegelinie.thy", ["Biegelinien"],
114.1367 + ["IntegrierenUndKonstanteBestimmen2"] ))];
114.1368 +moveActiveRoot 1;
114.1369 +(*
114.1370 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1371 +##7.72b## |ord. |subst.singles |ord.triang.
114.1372 + c_2 | | |c_2
114.1373 +c c_2 | |1:c_2 -> 2':c |c_2 c
114.1374 + c_4 | | |
114.1375 +c c_2 c_3 c_4 | |3:c_4 -> 4':c c_2 c_3 |c_2 c c_3*)
114.1376 +val t = str2term"[0 = c_2, \
114.1377 +\ 0 = (6 * c_2 + 6 * L * c + -1 * L ^^^ 2 * q_0) / 6, \
114.1378 +\ 0 = c_4 + 0 / (-1 * EI), \
114.1379 +\ 0 = c_4 + L * c_3 + (60 * L ^^^ 2 * c_2 + 20 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-120 * EI)]";
114.1380 +
114.1381 +"------- Bsp 7.73 ---------------vvvvvvvvvvvvv Momentenlinie postponed";
114.1382 +states:=[];
114.1383 +CalcTree [(["Traegerlaenge L","Momentenlinie ???",(*description unclear*)
114.1384 + "Biegelinie y",
114.1385 + "Randbedingungen [y L = 0, y' L = 0]",
114.1386 + "FunktionsVariable x"],
114.1387 + ("Biegelinie.thy", ["vonMomentenlinieZu","Biegelinien"],
114.1388 + ["Biegelinien", "AusMomentenlinie"]))];
114.1389 +moveActiveRoot 1;
114.1390 +(*
114.1391 +trace_script := true; autoCalculate 1 CompleteCalc; trace_script := false;
114.1392 +*)
114.1393 +
114.1394 +
114.1395 +"----------- 4x4 systems from Biegelinie -------------------------";
114.1396 +"----------- 4x4 systems from Biegelinie -------------------------";
114.1397 +"----------- 4x4 systems from Biegelinie -------------------------";
114.1398 +(*GOON replace this test with 7.70 *)
114.1399 +"----- Bsp 7.27";
114.1400 +val fmz = ["equalities \
114.1401 + \[0 = c_4, \
114.1402 + \ 0 = c_4 + L * c_3 +(12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI), \
114.1403 + \ 0 = c_2, \
114.1404 + \ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]",
114.1405 + "solveForVars [c, c_2, c_3, c_4]", "solution L"];
114.1406 +val (dI',pI',mI') =
114.1407 + ("Biegelinie.thy",["normalize", "4x4", "linear", "system"],
114.1408 + ["EqSystem","normalize","4x4"]);
114.1409 +val p = e_pos'; val c = [];
114.1410 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
114.1411 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1412 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1413 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1414 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
114.1415 +"------------------------------------------- Apply_Method...";
114.1416 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1417 +"[0 = c_4, \
114.1418 +\ 0 = c_4 + L * c_3 +\n (12 * L ^^^ 2 * c_2 + 4 * L ^^^ 3 * c + -1 * L ^^^ 4 * q_0) / (-24 * EI), \
114.1419 +\ 0 = c_2, \
114.1420 +\ 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]";
114.1421 +(*vvvWN080102 Exception- Match raised
114.1422 + since assod Rewrite .. Rewrite'_Set
114.1423 +"------------------------------------------- simplify_System_parenthesized...";
114.1424 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1425 +"[0 = c_4, \
114.1426 +\ 0 = -1 * q_0 * L ^^^ 4 / (-24 * EI) + \
114.1427 +\ (4 * L ^^^ 3 * c / (-24 * EI) + \
114.1428 +\ (12 * L ^^^ 2 * c_2 / (-24 * EI) + \
114.1429 +\ (L * c_3 + c_4))), \
114.1430 +\ 0 = c_2, \
114.1431 +\ 0 = -1 * q_0 * L ^^^ 2 / 2 + (L * c + c_2)]";
114.1432 +(*? "(4 * L ^^^ 3 / (-24 * EI) * c" statt "(4 * L ^^^ 3 * c / (-24 * EI)" ?*)
114.1433 +"------------------------------------------- isolate_bdvs...";
114.1434 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1435 +"[c_4 = 0,\
114.1436 +\ c_4 = 0 + -1 * (-1 * q_0 * L ^^^ 4 / (-24 * EI)) + -1 * (4 * L ^^^ 3 * c / (-24 * EI)) + -1 * (12 * L ^^^ 2 * c_2 / (-24 * EI)) + -1 * (L * c_3),\
114.1437 +\ c_2 = 0, \
114.1438 +\ c_2 = 0 + -1 * (-1 * q_0 * L ^^^ 2 / 2) + -1 * (L * c)]";
114.1439 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
114.1440 +
114.1441 +---------------------------------------------------------------------*)
114.1442 +
114.1443 +(*
114.1444 +use"../smltest/IsacKnowledge/eqsystem.sml";
114.1445 +use"eqsystem.sml";
114.1446 +*)
115.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
115.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/equation.sml Wed Jul 21 13:53:39 2010 +0200
115.3 @@ -0,0 +1,33 @@
115.4 +(* tests on the equation solver
115.5 + author: Walther Neuper
115.6 + 070703
115.7 + (c) due to copyright terms
115.8 +
115.9 +use"../smltest/IsacKnowledge/equation.sml";
115.10 +use"equation.sml";
115.11 +*)
115.12 +val thy = Isac.thy;
115.13 +
115.14 +"-----------------------------------------------------------------";
115.15 +"table of contents -----------------------------------------------";
115.16 +"-----------------------------------------------------------------";
115.17 +"----------- CAS input -------------------------------------------";
115.18 +"-----------------------------------------------------------------";
115.19 +"-----------------------------------------------------------------";
115.20 +"-----------------------------------------------------------------";
115.21 +
115.22 +
115.23 +"----------- CAS input -------------------------------------------";
115.24 +"----------- CAS input -------------------------------------------";
115.25 +"----------- CAS input -------------------------------------------";
115.26 +states:=[];
115.27 +CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
115.28 +Iterator 1;
115.29 +moveActiveRoot 1;
115.30 +replaceFormula 1 "solve (x+1=2, x)";
115.31 +autoCalculate 1 CompleteCalc;
115.32 +val ((pt,p),_) = get_calc 1;
115.33 +val Form res = (#1 o pt_extract) (pt, ([],Res));
115.34 +show_pt pt;
115.35 +if p = ([], Res) andalso term2str res = "[x = 1]" then ()
115.36 +else raise error "equation.sml behav.changed for CAS solve (x+1=2, x))";
116.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
116.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/inssort.sml Wed Jul 21 13:53:39 2010 +0200
116.3 @@ -0,0 +1,138 @@
116.4 +(* use"test-inssort.sml";
116.5 + W.N.17.6.00
116.6 +*)
116.7 +
116.8 +(* insertion sort, would need lists different from script-lists WN.11.00
116.9 +WN.7.6.03: -"- started with someList :: 'a list => unl, fun dest_list *)
116.10 +
116.11 +"--------------- sort [1,4,3,2] by rewrite_set ----------------";
116.12 +val thy' = "InsSort.thy";
116.13 +val ct = "sort [1,4,3,2]";
116.14 +"--- 1 ---";
116.15 +val rls = "ins_sort";
116.16 +val (ct,_) = the (rewrite_set thy' "eval_rls" false rls ct);
116.17 +if ct="[1, 2, 3, 4]" then "sort [1,4,3,2] OK"
116.18 +else raise error "sort [1,4,3,2] didn't work";
116.19 +
116.20 +
116.21 +"---------------- sort [1,3,2] by rewrite stepwise ----------------";
116.22 +val thy' = "InsSort.thy";
116.23 +val ct = "sort [1,3,2]";
116.24 +"--- 1 ---";
116.25 +val thm = ("sort_def","");
116.26 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.27 +(*val ct = "foldr ins [#1::real, #3::real, #2::real] []"*)
116.28 +"--- 2 ---";
116.29 +val thm = ("foldr_rec","");
116.30 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.31 +(*val ct = "foldr ins [#3, #2] (ins [] #1)"*)
116.32 +"--- 3 ---";
116.33 +val thm = ("ins_base","");
116.34 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.35 +(*val ct = "foldr ins [#3, #2] [#1]"*)
116.36 +"--- 4 ---";
116.37 +val thm = ("foldr_rec","");
116.38 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.39 +(*val ct = "foldr ins [#2] (ins [#1] #3)"*)
116.40 +"--- 5 ---";
116.41 +val thm = ("ins_rec","");
116.42 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.43 +(*val ct = "foldr ins [#2] (if #1 < #3 then #1 # ins [] #3 else [#3, #1])"*)
116.44 +"--- 6 ---";
116.45 +val op_ = "le";
116.46 +val (ct,_) = the (calculate thy' op_ ct);
116.47 +(*val ct = "foldr ins [#2] (if True then #1 # ins [] #3 else [#3, #1])"*)
116.48 +"--- 7 ---";
116.49 +val thm = ("if_True","");
116.50 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.51 +(*val ct = "foldr ins [#2] (#1 # ins [] #3)"*)
116.52 +"--- 8 ---";
116.53 +val thm = ("ins_base","");
116.54 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.55 +(*val ct = "foldr ins [#2] [#1, #3]"*)
116.56 +"--- 9 ---";
116.57 +val thm = ("foldr_rec","");
116.58 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.59 +(*val ct = "foldr ins [] (ins [#1, #3] #2)"*)
116.60 +"--- 10 ---";
116.61 +val thm = ("ins_rec","");
116.62 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.63 +(*val ct = "foldr ins [] (if #1 < #2 then #1 # ins [#3] #2 else [#2, #1, #3])"*)
116.64 +"--- 11 ---";
116.65 +val op_ = "le";
116.66 +val (ct,_) = the (calculate thy' op_ ct);
116.67 +(*val ct = "foldr ins [] (if True then #1 # ins [#3] #2 else [#2, #1, #3])"*)
116.68 +"--- 12 ---";
116.69 +val thm = ("if_True","");
116.70 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.71 +(*"foldr ins [] (#1 # ins [#3] #2)"*)
116.72 +"--- 13 ---";
116.73 +val thm = ("ins_rec","");
116.74 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.75 +(*"foldr ins [] (#1 # (if #3 < #2 then #3 # ins [] #2 else [#2, #3]))"*)
116.76 +"--- 14 ---";
116.77 +val op_ = "le";
116.78 +val (ct,_) = the (calculate thy' op_ ct);
116.79 +(*val ct = "foldr ins [] (#1 # (if False then #3 # ins [] #2 else [#2, #3]))"*)
116.80 +"--- 15 ---";
116.81 +val thm = ("if_False","");
116.82 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.83 +(*val ct = "foldr ins [] [#1, #2, #3]"*)
116.84 +"--- 16 ---";
116.85 +val thm = ("foldr_base","");
116.86 +val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
116.87 +(*val ct = "[#1, #2, #3]"*)
116.88 +if ct="[1, 2, 3]" then "sort [1,3,2] OK"
116.89 +else raise error "sort [1,3,2] didn't work";
116.90 +
116.91 +
116.92 +"---------------- sort [1,3,2] from script ----------------";
116.93 +val fmz = ["unsorted [1,3,2]", "sorted S"];
116.94 +val (dI',pI',mI') =
116.95 + ("InsSort.thy", ["inssort","functional"], ("InsSort.thy","inssort"));
116.96 +val p = e_pos'; val c = [];
116.97 +
116.98 +
116.99 +
116.100 +(* ------- 17.6.00: mit kleinen problemen aufgegeben
116.101 +val scr=Script ((term_of o the o (parse thy))
116.102 + "Script Sort (u_::'a list) = \
116.103 + \ Rewrite_Set ins_sort False u_");
116.104 +
116.105 +val scr=Script ((term_of o the o (parse thy))
116.106 + "Script Ins_sort (u_::real list) = \
116.107 + \ (let u_ = Rewrite sort_def False u_; \
116.108 + \ u_ = Rewrite foldr_rec False u_; \
116.109 + \ u_ = Rewrite ins_base False u_; \
116.110 + \ u_ = Rewrite foldr_rec False u_; \
116.111 + \ u_ = Rewrite ins_rec False u_; \
116.112 + \ u_ = Calculate le u_; \
116.113 + \ u_ = Rewrite if_True False u_; \
116.114 + \ u_ = Rewrite ins_base False u_; \
116.115 + \ u_ = Rewrite foldr_rec False u_; \
116.116 + \ u_ = Rewrite ins_rec False u_; \
116.117 + \ u_ = Calculate le u_; \
116.118 + \ u_ = Rewrite if_True False u_; \
116.119 + \ u_ = Rewrite ins_rec False u_; \
116.120 + \ u_ = Calculate le u_; \
116.121 + \ u_ = Rewrite if_False False u_; \
116.122 + \ u_ = Rewrite foldr_base False u_ \
116.123 + \ in u_)");
116.124 +val scr=parse thy
116.125 + "Script Ins_sort (u_::real list) = \
116.126 + \ (let u_ = Rewrite sort_def False u_; \
116.127 + \ u_ = Rewrite foldr_rec False u_; \
116.128 + \ u_ = Rewrite ins_base False u_; \
116.129 + \ u_ = Rewrite foldr_rec False u_; \
116.130 + \ u_ = Rewrite ins_rec False u_; \
116.131 + \ u_ = Calculate le u_; \
116.132 + \ u_ = Rewrite if_True False u_; \
116.133 + \ u_ = Rewrite ins_base False u_; \
116.134 + \ u_ = Rewrite foldr_rec False u_; \
116.135 + \ u_ = Rewrite ins_rec False u_; \
116.136 + \ u_ = u_ \
116.137 + \ in u_)";
116.138 +
116.139 +atomty (term_of (the scr));
116.140 +
116.141 +------- *)
116.142 \ No newline at end of file
117.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
117.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/integrate.sml Wed Jul 21 13:53:39 2010 +0200
117.3 @@ -0,0 +1,579 @@
117.4 +(* tests on integration over the reals
117.5 + author: Walther Neuper
117.6 + 050814, 08:51
117.7 + (c) due to copyright terms
117.8 +
117.9 +use"../smltest/IsacKnowledge/integrate.sml";
117.10 +use"integrate.sml";
117.11 +*)
117.12 +val thy = Integrate.thy;
117.13 +
117.14 +"-----------------------------------------------------------------";
117.15 +"table of contents -----------------------------------------------";
117.16 +"-----------------------------------------------------------------";
117.17 +"----------- parsing ---------------------------------------------";
117.18 +"----------- integrate by rewriting ------------------------------";
117.19 +"----------- test add_new_c, is_f_x ------------------------------";
117.20 +"----------- simplify by ruleset reducing make_ratpoly_in --------";
117.21 +"----------- simplify by ruleset extending make_polynomial_in ----";
117.22 +"----------- integrate by ruleset --------------------------------";
117.23 +"----------- rewrite 3rd integration in 7.27 ---------------------";
117.24 +"----------- check probem type -----------------------------------";
117.25 +"----------- check Scripts ---------------------------------------";
117.26 +"----------- me method [diff,integration] ------------------------";
117.27 +"----------- me method [diff,integration,named] ------------------";
117.28 +"----------- me method [diff,integration,named] Biegelinie.Q -----";
117.29 +"----------- interSteps [diff,integration] -----------------------";
117.30 +"----------- method analog to rls 'integration' ------------------";
117.31 +"----------- Ambiguous input: Integral ?u + ?v D ?bdv = ..--------";
117.32 +"----------- CAS input -------------------------------------------";
117.33 +"-----------------------------------------------------------------";
117.34 +"-----------------------------------------------------------------";
117.35 +"-----------------------------------------------------------------";
117.36 +
117.37 +
117.38 +
117.39 +"----------- parsing ---------------------------------------------";
117.40 +"----------- parsing ---------------------------------------------";
117.41 +"----------- parsing ---------------------------------------------";
117.42 +fun str2t str = (term_of o the o (parse Integrate.thy)) str;
117.43 +fun term2s t = Sign.string_of_term (sign_of Integrate.thy) t;
117.44 +
117.45 +val t = str2t "Integral x D x";
117.46 +val t = str2t "Integral x^^^2 D x";
117.47 +atomty t;
117.48 +
117.49 +val t = str2t "ff x is_f_x";
117.50 +case t of Const ("Integrate.is'_f'_x", _) $ _ => ()
117.51 + | _ => raise error "integrate.sml: parsing: ff x is_f_x";
117.52 +
117.53 +
117.54 +"----------- integrate by rewriting ------------------------------";
117.55 +"----------- integrate by rewriting ------------------------------";
117.56 +"----------- integrate by rewriting ------------------------------";
117.57 +val conditions_in_integration_rules =
117.58 +Rls {id="conditions_in_integration_rules",
117.59 + preconds = [],
117.60 + rew_ord = ("termlessI",termlessI),
117.61 + erls = Erls,
117.62 + srls = Erls, calc = [],
117.63 + rules = [(*for rewriting conditions in Thm's*)
117.64 + Calc ("Atools.occurs'_in",
117.65 + eval_occurs_in "#occurs_in_"),
117.66 + Thm ("not_true",num_str not_true),
117.67 + Thm ("not_false",not_false)
117.68 + ],
117.69 + scr = EmptyScr};
117.70 +val subs = [(str2t "bdv", str2t "x")];
117.71 +fun rewrit thm str =
117.72 + fst (the (rewrite_inst_ Integrate.thy tless_true
117.73 + conditions_in_integration_rules
117.74 + true subs thm str));
117.75 +val str = rewrit integral_const (str2t "Integral 1 D x"); term2s str;
117.76 +val str = rewrit integral_const (str2t "Integral M'/EJ D x"); term2s str;
117.77 +val str = (rewrit integral_const (str2t "Integral x D x"))
117.78 + handle OPTION => str2t "no_rewrite";
117.79 +
117.80 +val str = rewrit integral_var (str2t "Integral x D x"); term2s str;
117.81 +val str = (rewrit integral_var (str2t "Integral a D x"))
117.82 + handle OPTION => str2t "no_rewrite";
117.83 +
117.84 +val str = rewrit integral_add (str2t "Integral x + 1 D x"); term2s str;
117.85 +
117.86 +val str = rewrit integral_mult (str2t "Integral M'/EJ * x^^^3 D x");term2s str;
117.87 +val str = (rewrit integral_mult (str2t "Integral x * x D x"))
117.88 + handle OPTION => str2t "no_rewrite";
117.89 +
117.90 +val str = rewrit integral_pow (str2t "Integral x^^^3 D x"); term2s str;
117.91 +
117.92 +
117.93 +"----------- test add_new_c, is_f_x ------------------------------";
117.94 +"----------- test add_new_c, is_f_x ------------------------------";
117.95 +"----------- test add_new_c, is_f_x ------------------------------";
117.96 +val term = str2term "x^^^2*c + c_2";
117.97 +val cc = new_c term;
117.98 +if term2str cc = "c_3" then () else raise error "integrate.sml: new_c ???";
117.99 +
117.100 +val Some (id,t') = eval_add_new_c "" "Integrate.add'_new'_c" term thy;
117.101 +if term2str t' = "x ^^^ 2 * c + c_2 = x ^^^ 2 * c + c_2 + c_3" then ()
117.102 +else raise error "intergrate.sml: diff. eval_add_new_c";
117.103 +
117.104 +val cc = ("Integrate.add'_new'_c", eval_add_new_c "add_new_c_");
117.105 +val Some (thmstr, thm) = get_calculation1_ thy cc term;
117.106 +
117.107 +val Some (t',_) = rewrite_set_ thy true add_new_c term;
117.108 +if term2str t' = "x ^^^ 2 * c + c_2 + c_3" then ()
117.109 +else raise error "intergrate.sml: diff. rewrite_set add_new_c 1";
117.110 +
117.111 +val term = str2term "ff x = x^^^2*c + c_2";
117.112 +val Some (t',_) = rewrite_set_ thy true add_new_c term;
117.113 +if term2str t' = "ff x = x ^^^ 2 * c + c_2 + c_3" then ()
117.114 +else raise error "intergrate.sml: diff. rewrite_set add_new_c 2";
117.115 +
117.116 +
117.117 +(*WN080222 replace call_new_c with add_new_c----------------------
117.118 +val term = str2t "new_c (c * x^^^2 + c_2)";
117.119 +val Some (_,t') = eval_new_c 0 0 term 0;
117.120 +if term2s t' = "new_c c * x ^^^ 2 + c_2 = c_3" then ()
117.121 +else raise error "integrate.sml: eval_new_c ???";
117.122 +
117.123 +val t = str2t "matches (?u + new_c ?v) (x ^^^ 2 / 2)";
117.124 +val Some (_,t') = eval_matches "" "Tools.matches" t thy; term2s t';
117.125 +if term2s t' = "matches (?u + new_c ?v) (x ^^^ 2 / 2) = False" then ()
117.126 +else raise error "integrate.sml: matches new_c = False";
117.127 +
117.128 +val t = str2t "matches (?u + new_c ?v) (x ^^^ 2 / 2 + new_c x ^^^ 2 / 2)";
117.129 +val Some (_,t') = eval_matches "" "Tools.matches" t thy; term2s t';
117.130 +if term2s t'="matches (?u + new_c ?v) (x ^^^ 2 / 2 + new_c x ^^^ 2 / 2) = True"
117.131 +then () else raise error "integrate.sml: matches new_c = True";
117.132 +
117.133 +val t = str2t "ff x is_f_x";
117.134 +val Some (_,t') = eval_is_f_x "" "" t thy; term2s t';
117.135 +if term2s t' = "(ff x is_f_x) = True" then ()
117.136 +else raise error "integrate.sml: eval_is_f_x --> true";
117.137 +
117.138 +val t = str2t "q_0/2 * L * x is_f_x";
117.139 +val Some (_,t') = eval_is_f_x "" "" t thy; term2s t';
117.140 +if term2s t' = "(q_0 / 2 * L * x is_f_x) = False" then ()
117.141 +else raise error "integrate.sml: eval_is_f_x --> false";
117.142 +
117.143 +val conditions_in_integration =
117.144 +Rls {id="conditions_in_integration",
117.145 + preconds = [],
117.146 + rew_ord = ("termlessI",termlessI),
117.147 + erls = Erls,
117.148 + srls = Erls, calc = [],
117.149 + rules = [Calc ("Tools.matches",eval_matches ""),
117.150 + Calc ("Integrate.is'_f'_x",
117.151 + eval_is_f_x "is_f_x_"),
117.152 + Thm ("not_true",num_str not_true),
117.153 + Thm ("not_false",num_str not_false)
117.154 + ],
117.155 + scr = EmptyScr};
117.156 +fun rewrit thm t =
117.157 + fst (the (rewrite_inst_ Integrate.thy tless_true
117.158 + conditions_in_integration true subs thm t));
117.159 +val t = rewrit call_for_new_c (str2t "x ^^^ 2 / 2"); term2s t;
117.160 +val t = (rewrit call_for_new_c t)
117.161 + handle OPTION => str2t "no_rewrite";
117.162 +
117.163 +val t = rewrit call_for_new_c
117.164 + (str2t "ff x = q_0/2 *L*x"); term2s t;
117.165 +val t = (rewrit call_for_new_c
117.166 + (str2t "ff x = q_0 / 2 * L * x + new_c q_0 / 2 * L * x"))
117.167 + handle OPTION => (*NOT: + new_c ..=..!!*)str2t "no_rewrite";
117.168 +--------------------------------------------------------------------*)
117.169 +
117.170 +
117.171 +"----------- simplify by ruleset reducing make_ratpoly_in --------";
117.172 +"----------- simplify by ruleset reducing make_ratpoly_in --------";
117.173 +"----------- simplify by ruleset reducing make_ratpoly_in --------";
117.174 +val thy = Isac.thy;
117.175 +val subs = [(str2term"bdv",str2term"x")];
117.176 +val t = str2term "1/EI * (L * q_0 * x / 2 + -1 * q_0 * x^^^2 / 2)";
117.177 +
117.178 +"----- stepwise from the rulesets in simplify_Integral and below-----";
117.179 +(*###*)val rls = norm_Rational_noadd_fractions;
117.180 +case rewrite_set_inst_ thy true subs rls t of
117.181 + Some _ => raise error "integrate.sml simplify by ruleset norm_Rational_.#2"
117.182 + | None => ();
117.183 +(* WN051028 Rational.ML 'rat_mult_div_pow' with erls = e_rls
117.184 +applies 'rat_mult_poly_r'="?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"
117.185 +to "(L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2) / EI"
117.186 +and keeps "..." is_polyexp" as an assumption.
117.187 +AFTER CORRECTION in Integrate.ML as above*)
117.188 +
117.189 +(*###*)val rls = order_add_mult_in;
117.190 +val Some (t,[]) = rewrite_set_ thy true rls t;
117.191 +if term2str t = "1 / EI * (L * (q_0 * x) / 2 + -1 * (q_0 * x ^^^ 2) / 2)"then()
117.192 +else raise error "integrate.sml simplify by ruleset order_add_mult_in #2";
117.193 +
117.194 +(*###*)val rls = discard_parentheses;
117.195 +val Some (t,[]) = rewrite_set_ thy true rls t;
117.196 +if term2str t = "1 / EI * (L * q_0 * x / 2 + -1 * q_0 * x ^^^ 2 / 2)" then ()
117.197 +else raise error "integrate.sml simplify by ruleset discard_parenth.. #3";
117.198 +
117.199 +(*###*)val rls =
117.200 + (append_rls "separate_bdv"
117.201 + collect_bdv
117.202 + [Thm ("separate_bdv", num_str separate_bdv),
117.203 + (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
117.204 + Thm ("separate_bdv_n", num_str separate_bdv_n),
117.205 + Thm ("separate_1_bdv", num_str separate_1_bdv),
117.206 + (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
117.207 + Thm ("separate_1_bdv_n", num_str separate_1_bdv_n)
117.208 + ]);
117.209 +val Some (t,[]) = rewrite_set_inst_ thy true subs rls t;
117.210 +if term2str t = "1 / EI * (L * q_0 / 2 * x + -1 * q_0 / 2 * x ^^^ 2)" then ()
117.211 +else raise error "integrate.sml simplify by ruleset separate_bdv.. #4";
117.212 +
117.213 +
117.214 +val t = str2term "1/EI * (L * q_0 * x / 2 + -1 * q_0 * x^^^2 / 2)";
117.215 +val rls = simplify_Integral;
117.216 +val Some (t,[]) = rewrite_set_inst_ thy true subs rls t;
117.217 +if term2str t = "1 / EI * (L * q_0 / 2 * x + -1 * q_0 / 2 * x ^^^ 2)" then ()
117.218 +else raise error "integrate.sml, simplify_Integral #99";
117.219 +
117.220 +"........... 2nd integral ........................................";
117.221 +"........... 2nd integral ........................................";
117.222 +"........... 2nd integral ........................................";
117.223 +val t = str2term
117.224 + "Integral 1 / EI * (L * q_0 / 2 * (x ^^^ 2 / 2) + \
117.225 + \-1 * q_0 / 2 * (x ^^^ 3 / 3)) D x";
117.226 +val rls = simplify_Integral;
117.227 +val Some (t,[]) = rewrite_set_inst_ thy true subs rls t;
117.228 +if term2str t =
117.229 + "Integral 1 / EI * (L * q_0 / 4 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3) D x"
117.230 +then () else raise error "integrate.sml, simplify_Integral #198";
117.231 +
117.232 +val rls = integration_rules;
117.233 +val Some (t,[]) = rewrite_set_ thy true rls t;
117.234 +if term2str t =
117.235 + "1 / EI * (L * q_0 / 4 * (x ^^^ 3 / 3) + -1 * q_0 / 6 * (x ^^^ 4 / 4))"
117.236 +then () else raise error "integrate.sml, simplify_Integral #199";
117.237 +
117.238 +
117.239 +
117.240 +"----------- simplify by ruleset extending make_polynomial_in ----";
117.241 +"----------- simplify by ruleset extending make_polynomial_in ----";
117.242 +"----------- simplify by ruleset extending make_polynomial_in ----";
117.243 +trace_rewrite:=true;
117.244 +trace_rewrite:=false;
117.245 +(*postponed: see *)
117.246 +
117.247 +
117.248 +"----------- integrate by ruleset --------------------------------";
117.249 +"----------- integrate by ruleset --------------------------------";
117.250 +"----------- integrate by ruleset --------------------------------";
117.251 +val rls = "integration_rules";
117.252 +val subs = [("bdv","x::real")];
117.253 +fun rewrit_sinst subs rls str =
117.254 + fst (the (rewrite_set_inst "Integrate.thy" true subs rls str));
117.255 +(*~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
117.256 +val str = rewrit_sinst subs rls "Integral x D x";
117.257 +val str = rewrit_sinst subs rls "Integral c * x ^^^ 2 + c_2 D x";
117.258 +if str = "c * (x ^^^ 3 / 3) + c_2 * x"
117.259 +then () else raise error "integrate.sml: diff.behav. in integration_rules";
117.260 +
117.261 +val rls = "add_new_c";
117.262 +val str = rewrit_sinst subs rls "c * (x ^^^ 3 / 3) + c_2 * x";
117.263 +if str = "c * (x ^^^ 3 / 3) + c_2 * x + c_3" then ()
117.264 +else raise error "integrate.sml: diff.behav. in add_new_c simpl.";
117.265 +
117.266 +val str = rewrit_sinst subs rls "F x = x ^^^ 3 / 3 + x";
117.267 +if str = "F x = x ^^^ 3 / 3 + x + c"(*not "F x + c =..."*) then ()
117.268 +else raise error "integrate.sml: diff.behav. in add_new_c equation";
117.269 +
117.270 +val rls = "simplify_Integral";
117.271 +(*~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
117.272 +val str = "ff x = c * x + -1 * q_0 * (x ^^^ 2 / 2) + c_2";
117.273 +val str = rewrit_sinst subs rls str;
117.274 +if str = "ff x = c_2 + c * x + -1 * q_0 / 2 * x ^^^ 2"
117.275 +then () else raise error "integrate.sml: diff.behav. in simplify_I #1";
117.276 +
117.277 +val rls = "integration";
117.278 +(*~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
117.279 +val str = rewrit_sinst subs rls "Integral c * x ^^^ 2 + c_2 D x";
117.280 +if str = "c_3 + c_2 * x + c / 3 * x ^^^ 3"
117.281 +then () else raise error "integrate.sml: diff.behav. in integration #1";
117.282 +
117.283 +val str = rewrit_sinst subs rls "Integral 3*x^^^2 + 2*x + 1 D x";
117.284 +if str = "c + x + x ^^^ 2 + x ^^^ 3" then ()
117.285 +else raise error "integrate.sml: diff.behav. in integration #2";
117.286 +
117.287 +val str = rewrit_sinst subs rls
117.288 +"Integral 1 / EI * (L * q_0 / 2 * x + -1 * q_0 / 2 * x ^^^ 2) D x";
117.289 +if str =
117.290 + "c + 1 / EI * (L * q_0 / 4 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3)"
117.291 +then () else raise error "integrate.sml: diff.behav. in integration #3";
117.292 +
117.293 +val str = "Integral "^str^" D x";
117.294 +val str = rewrit_sinst subs rls str;
117.295 +if str =
117.296 + "c_2 + c * x + 1 / EI * (L * q_0 / 12 * x ^^^ 3 + -1 * q_0 / 24 * x ^^^ 4)"
117.297 +then () else raise error "integrate.sml: diff.behav. in integration #4";
117.298 +
117.299 +
117.300 +"----------- rewrite 3rd integration in 7.27 ---------------------";
117.301 +"----------- rewrite 3rd integration in 7.27 ---------------------";
117.302 +"----------- rewrite 3rd integration in 7.27 ---------------------";
117.303 +val thy = Isac.thy (*because of Undeclared constant "Biegelinie.EI*);
117.304 +val bdv = [(str2term"bdv", str2term"x")];
117.305 +val t = str2term
117.306 + "Integral 1 / EI * ((L * q_0 * x + -1 * q_0 * x ^^^ 2) / 2) D x";
117.307 +val Some(t,_)= rewrite_set_inst_ thy true bdv simplify_Integral t;
117.308 +if term2str t =
117.309 + "Integral 1 / EI * (L * q_0 / 2 * x + -1 * q_0 / 2 * x ^^^ 2) D x" then ()
117.310 +else raise error "integrate.sml 3rd integration in 7.27, simplify_Integral";
117.311 +
117.312 +val Some(t,_)= rewrite_set_inst_ thy true bdv integration t;
117.313 +if term2str t = "c + 1 / EI * (L * q_0 / 4 * x ^^^ 2 + -1 * q_0 / 6 * x ^^^ 3)"
117.314 +then () else raise error "integrate.sml 3rd integration in 7.27, integration";
117.315 +
117.316 +
117.317 +"----------- check probem type -----------------------------------";
117.318 +"----------- check probem type -----------------------------------";
117.319 +"----------- check probem type -----------------------------------";
117.320 +val model = {Given =["functionTerm f_", "integrateBy v_"],
117.321 + Where =[],
117.322 + Find =["antiDerivative F_"],
117.323 + With =[],
117.324 + Relate=[]}:string ppc;
117.325 +val chkmodel = ((map (the o (parse Integrate.thy))) o ppc2list) model;
117.326 +val t1 = (term_of o hd) chkmodel;
117.327 +val t2 = (term_of o hd o tl) chkmodel;
117.328 +val t3 = (term_of o hd o tl o tl) chkmodel;
117.329 +case t3 of Const ("Integrate.antiDerivative", _) $ _ => ()
117.330 + | _ => raise error "integrate.sml: Integrate.antiDerivative ???";
117.331 +
117.332 +val model = {Given =["functionTerm f_", "integrateBy v_"],
117.333 + Where =[],
117.334 + Find =["antiDerivativeName F_"],
117.335 + With =[],
117.336 + Relate=[]}:string ppc;
117.337 +val chkmodel = ((map (the o (parse Integrate.thy))) o ppc2list) model;
117.338 +val t1 = (term_of o hd) chkmodel;
117.339 +val t2 = (term_of o hd o tl) chkmodel;
117.340 +val t3 = (term_of o hd o tl o tl) chkmodel;
117.341 +case t3 of Const ("Integrate.antiDerivativeName", _) $ _ => ()
117.342 + | _ => raise error "integrate.sml: Integrate.antiDerivativeName";
117.343 +
117.344 +"----- compare 'Find's from problem, script, formalization -------";
117.345 +val {ppc,...} = get_pbt ["named","integrate","function"];
117.346 +val ("#Find", (Const ("Integrate.antiDerivativeName", _),
117.347 + F1_ as Free ("F_", F1_type))) = last_elem ppc;
117.348 +val {scr = Script sc,... } = get_met ["diff","integration","named"];
117.349 +val [_,_, F2_] = formal_args sc;
117.350 +if F1_ = F2_ then () else raise error "integrate.sml: unequal find's";
117.351 +
117.352 +val ((dsc as Const ("Integrate.antiDerivativeName", _))
117.353 + $ Free ("ff", F3_type)) = str2t "antiDerivativeName ff";
117.354 +if is_dsc dsc then () else raise error "integrate.sml: no description";
117.355 +if F1_type = F3_type then ()
117.356 +else raise error "integrate.sml: unequal types in find's";
117.357 +
117.358 +show_ptyps();
117.359 +val pbl = get_pbt ["integrate","function"];
117.360 +case #cas pbl of Some (Const ("Integrate.Integrate",_) $ _) => ()
117.361 + | _ => raise error "integrate.sml: Integrate.Integrate ???";
117.362 +
117.363 +
117.364 +"----------- check Scripts ---------------------------------------";
117.365 +"----------- check Scripts ---------------------------------------";
117.366 +"----------- check Scripts ---------------------------------------";
117.367 +val str =
117.368 +"Script IntegrationScript (f_::real) (v_::real) = \
117.369 +\ (let t_ = Take (Integral f_ D v_) \
117.370 +\ in (Rewrite_Set_Inst [(bdv,v_)] integration False) (t_::real))";
117.371 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
117.372 +atomty sc;
117.373 +
117.374 +val str =
117.375 +"Script NamedIntegrationScript (f_::real) (v_::real) (F_::real=>real) = \
117.376 +\ (let t_ = Take (F_ v_ = Integral f_ D v_) \
117.377 +\ in (Rewrite_Set_Inst [(bdv,v_)] integration False) t_)";
117.378 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
117.379 +atomty sc;
117.380 +show_mets();
117.381 +
117.382 +
117.383 +"----------- me method [diff,integration] ---------------------";
117.384 +"----------- me method [diff,integration] ---------------------";
117.385 +"----------- me method [diff,integration] ---------------------";
117.386 +(*exp_CalcInt_No-1.xml*)
117.387 +val fmz = ["functionTerm (x^^^2 + 1)",
117.388 + "integrateBy x","antiDerivative FF"];
117.389 +val (dI',pI',mI') =
117.390 + ("Integrate.thy",["integrate","function"],
117.391 + ["diff","integration"]);
117.392 +val p = e_pos'; val c = [];
117.393 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
117.394 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.395 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.396 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.397 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.398 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.399 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.400 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*nxt <- Apply_Method*);
117.401 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
117.402 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
117.403 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
117.404 +if f2str f = "c + x + 1 / 3 * x ^^^ 3" then ()
117.405 +else raise error "integrate.sml: method [diff,integration]";
117.406 +
117.407 +
117.408 +"----------- me method [diff,integration,named] ------------------";
117.409 +"----------- me method [diff,integration,named] ------------------";
117.410 +"----------- me method [diff,integration,named] ------------------";
117.411 +(*exp_CalcInt_No-2.xml*)
117.412 +val fmz = ["functionTerm (x^^^2 + 1)",
117.413 + "integrateBy x","antiDerivativeName F"];
117.414 +val (dI',pI',mI') =
117.415 + ("Integrate.thy",["named","integrate","function"],
117.416 + ["diff","integration","named"]);
117.417 +val p = e_pos'; val c = [];
117.418 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
117.419 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.420 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.421 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*nxt <- Add_Find *);
117.422 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.423 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.424 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.425 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*nxt <- Apply_Method*);
117.426 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.427 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.428 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
117.429 +if f2str f = "F x = c + x + 1 / 3 * x ^^^ 3" then()
117.430 +else raise error "integrate.sml: method [diff,integration,named]";
117.431 +
117.432 +
117.433 +"----------- me method [diff,integration,named] Biegelinie.Q -----";
117.434 +"----------- me method [diff,integration,named] Biegelinie.Q -----";
117.435 +"----------- me method [diff,integration,named] Biegelinie.Q -----";
117.436 +(*exp_CalcInt_No-3.xml*)
117.437 +val fmz = ["functionTerm (- q_0)",
117.438 + "integrateBy x","antiDerivativeName Q"];
117.439 +val (dI',pI',mI') =
117.440 + ("Biegelinie.thy",["named","integrate","function"],
117.441 + ["diff","integration","named"]);
117.442 +val p = e_pos'; val c = [];
117.443 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
117.444 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.445 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.446 +(*Error Tac Q not in ...*)
117.447 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*nxt <- Add_Find *);
117.448 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.449 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.450 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.451 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*nxt <- Apply_Method*);
117.452 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.453 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
117.454 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
117.455 +
117.456 +if f2str f = "Q x = c + -1 * q_0 * x" then()
117.457 +else raise error "integrate.sml: method [diff,integration,named] .Q";
117.458 +
117.459 +
117.460 +"----------- interSteps [diff,integration] -----------------------";
117.461 +"----------- interSteps [diff,integration] -----------------------";
117.462 +"----------- interSteps [diff,integration] -----------------------";
117.463 +states:=[];
117.464 +CalcTree
117.465 +[(["functionTerm (x^2 + 1)","integrateBy x","antiDerivative FF"],
117.466 + ("Integrate.thy",["integrate","function"],
117.467 + ["diff","integration"]))];
117.468 +Iterator 1;
117.469 +moveActiveRoot 1;
117.470 +autoCalculate 1 CompleteCalc;
117.471 +val ((pt,p),_) = get_calc 1; show_pt pt;
117.472 +
117.473 +interSteps 1 ([1],Res);
117.474 +val ((pt,p),_) = get_calc 1; show_pt pt;
117.475 +if existpt' ([1,3], Res) pt then ()
117.476 +else raise error "integrate.sml: interSteps on Rewrite_Set_Inst 1";
117.477 +
117.478 +
117.479 +"----------- method analog to rls 'integration' ------------------";
117.480 +"----------- method analog to rls 'integration' ------------------";
117.481 +"----------- method analog to rls 'integration' ------------------";
117.482 +store_met
117.483 + (prep_met Integrate.thy "met_testint" [] e_metID
117.484 + (["diff","integration","test"],
117.485 + [("#Given" ,["functionTerm f_", "integrateBy v_"]),
117.486 + ("#Find" ,["antiDerivative F_"])
117.487 + ],
117.488 + {rew_ord'="tless_true", rls'=Atools_erls, calc = [],
117.489 + srls = e_rls,
117.490 + prls=e_rls,
117.491 + crls = Atools_erls, nrls = e_rls},
117.492 +"Script IntegrationScript (f_::real) (v_::real) = \
117.493 +\ (((Rewrite_Set_Inst [(bdv,v_)] integration_rules False) @@ \
117.494 +\ (Rewrite_Set_Inst [(bdv,v_)] add_new_c False) @@ \
117.495 +\ (Rewrite_Set_Inst [(bdv,v_)] simplify_Integral False)) (f_::real))"
117.496 +));
117.497 +
117.498 +states:=[];
117.499 +CalcTree
117.500 +[(["functionTerm (Integral x^2 + 1 D x)","integrateBy x",
117.501 + "antiDerivative FF"],
117.502 + ("Integrate.thy",["integrate","function"],
117.503 + ["diff","integration","test"]))];
117.504 +Iterator 1;
117.505 +moveActiveRoot 1;
117.506 +autoCalculate 1 CompleteCalcHead;
117.507 +
117.508 +fetchProposedTactic 1 (*..Apply_Method*);
117.509 +autoCalculate 1 (Step 1);
117.510 +getTactic 1 ([1], Frm) (*still empty*);
117.511 +
117.512 +fetchProposedTactic 1 (*Rewrite_Set_Inst integration_rules*);
117.513 +autoCalculate 1 (Step 1);
117.514 +
117.515 +fetchProposedTactic 1 (*Rewrite_Set_Inst add_new_c*);
117.516 +autoCalculate 1 (Step 1);
117.517 +
117.518 +fetchProposedTactic 1 (*Rewrite_Set_Inst simplify_Integral*);
117.519 +autoCalculate 1 (Step 1);
117.520 +
117.521 +autoCalculate 1 CompleteCalc;
117.522 +val ((pt,p),_) = get_calc 1; show_pt pt;
117.523 +if existpt' ([3], Res) pt then ()
117.524 +else raise error "integrate.sml: test-script doesnt work";
117.525 +
117.526 +
117.527 +"----------- Ambiguous input: Integral ?u + ?v D ?bdv = ..--------";
117.528 +"----------- Ambiguous input: Integral ?u + ?v D ?bdv = ..--------";
117.529 +"----------- Ambiguous input: Integral ?u + ?v D ?bdv = ..--------";
117.530 +states:=[];
117.531 +CalcTree
117.532 +[(["functionTerm (x^2 + 1)","integrateBy x","antiDerivative FF"],
117.533 + ("Integrate.thy",["integrate","function"],
117.534 + ["diff","integration"]))];
117.535 +Iterator 1;
117.536 +moveActiveRoot 1;
117.537 +autoCalculate 1 CompleteCalc;
117.538 +val ((pt,p),_) = get_calc 1; show_pt pt;
117.539 +
117.540 +interSteps 1 ([1],Res);
117.541 +val ((pt,p),_) = get_calc 1; show_pt pt;
117.542 +interSteps 1 ([1,1],Res);
117.543 +val ((pt,p),_) = get_calc 1; show_pt pt;
117.544 +getTactic 1 ([1,1,1],Frm);
117.545 +
117.546 +val str = (unenclose o string_of_thm) integral_add;
117.547 +writeln str;
117.548 +(*
117.549 +read_cterm (sign_of thy) (str,(TVar(("DUMMY",0),[])));
117.550 +
117.551 +*** More than one term is type correct:
117.552 +*** ((Integral (?u + ?v) D ?bdv) =
117.553 +*** (Integral ?u D (?bdv + (Integral ?v D ?bdv))))
117.554 + ###^^^###
117.555 +*** ((Integral (?u + ?v) D ?bdv) =
117.556 +*** ((Integral ?u D ?bdv) + (Integral ?v D ?bdv)))
117.557 +*)
117.558 +
117.559 +if existpt' ([1,1,5], Res) pt then ()
117.560 +else raise error "integrate.sml: interSteps on Rewrite_Set_Inst 2";
117.561 +
117.562 +"----------- CAS input -------------------------------------------";
117.563 +"----------- CAS input -------------------------------------------";
117.564 +"----------- CAS input -------------------------------------------";
117.565 +val t = str2term "Integrate (x^^^2 + x + 1, x)";
117.566 +case t of Const ("Integrate.Integrate", _) $ _ => ()
117.567 + | _ => raise error "diff.sml behav.changed for Integrate (..., x)";
117.568 +atomty t;
117.569 +
117.570 +states:=[];
117.571 +CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
117.572 +Iterator 1;
117.573 +moveActiveRoot 1;
117.574 +replaceFormula 1 "Integrate (x^2 + x + 1, x)";
117.575 +autoCalculate 1 CompleteCalc;
117.576 +val ((pt,p),_) = get_calc 1;
117.577 +val Form res = (#1 o pt_extract) (pt, ([],Res));
117.578 +show_pt pt;
117.579 +(* WN070703 does not work like Diff due to error in next-pos
117.580 +if p = ([], Res) andalso term2str res = "5 * a" then ()
117.581 +else raise error "diff.sml behav.changed for Integrate (x^2 + x + 1, x)";
117.582 +*)
117.583 \ No newline at end of file
118.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
118.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/logexp.sml Wed Jul 21 13:53:39 2010 +0200
118.3 @@ -0,0 +1,61 @@
118.4 +(* testexamples for LogExp, logarithms and exponential functions and terms
118.5 +
118.6 +use"../smltest/IsacKnowledge/logexp.sml";
118.7 +*)
118.8 +
118.9 +val thy = LogExp.thy;
118.10 +"-----------------------------------------------------------------";
118.11 +"table of contents -----------------------------------------------";
118.12 +"-----------------------------------------------------------------";
118.13 +"----------- setup presentation innsbruck ------------------------";
118.14 +"-----------------------------------------------------------------";
118.15 +"-----------------------------------------------------------------";
118.16 +"-----------------------------------------------------------------";
118.17 +
118.18 +
118.19 +"----------- setup presentation innsbruck ------------------------";
118.20 +"----------- setup presentation innsbruck ------------------------";
118.21 +"----------- setup presentation innsbruck ------------------------";
118.22 +(*
118.23 +NOT INCLUDED IN ROOT.ML and RTEST-root.sml, since the pbl and met
118.24 +defined in IsacKnowledge/Test.ML are out-commented
118.25 +in order to allow for demonstration of authoring !
118.26 +
118.27 +equality_power;
118.28 +exp_invers_log;
118.29 +(* WN071203 ???... wrong thy ?!? because parsing with Isac.thy works ?
118.30 +refine ["equality ((2 log x) = 3)","solveFor x", "solutions L"]
118.31 + ["equation","test"];
118.32 +*)
118.33 +
118.34 +val t = str2term "(2 log x)";
118.35 +val t = str2term "(2 log x) = 3";
118.36 +val t = str2term "matches ((?a log x) = ?b) ((2 log x) = 3)";
118.37 +atomty t;
118.38 +
118.39 +
118.40 +val fmz = ["equality ((2 log x) = 3)","solveFor x", "solutions L"];
118.41 +val (dI',pI',mI') =
118.42 + ("Isac.thy",["logarithmic","univariate","equation","test"],
118.43 + ["Test","solve_log"]);
118.44 +val p = e_pos'; val c = [];
118.45 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
118.46 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.47 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.48 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.49 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.50 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.51 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.52 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
118.53 +case nxt of ("Apply_Method",_) => ()
118.54 + | _ => raise error "logexp.sml setup innsbruck";
118.55 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
118.56 +
118.57 +
118.58 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
118.59 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
118.60 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
118.61 +val (p,_,f,nxt,_,pt) = me nxt p c pt;f2str f;
118.62 +show_pt pt;
118.63 +
118.64 +*-------------------------------------------------------------------*)
119.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
119.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/poly.sml Wed Jul 21 13:53:39 2010 +0200
119.3 @@ -0,0 +1,423 @@
119.4 +(* testexamples for Poly, polynomials
119.5 + author: Matthias Goldgruber 2003
119.6 + (c) due to copyright terms
119.7 +
119.8 +use"../smltest/IsacKnowledge/poly.sml";
119.9 +use"poly.sml";
119.10 +****************************************************************.*)
119.11 +
119.12 +(******************************************************************
119.13 + WN060104 'SPB' came into 'exp_IsacCore_Simp_Poly_Book.xml'
119.14 + 'SPO' came into 'exp_IsacCore_Simp_Poly_Other.xml'
119.15 +*******************************************************************)
119.16 +"-----------------------------------------------------------------";
119.17 +"table of contents -----------------------------------------------";
119.18 +"-----------------------------------------------------------------";
119.19 +"-------- investigate new uniary minus ---------------------------";
119.20 +"-------- Bsple aus Schalk I -------------------------------------";
119.21 +"-------- Script 'simplification for_polynomials' ----------------";
119.22 +"-------- check pbl 'polynomial simplification' -----------------";
119.23 +"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
119.24 +"-------- norm_Poly NOT COMPLETE ---------------------------------";
119.25 +"-------- ord_make_polynomial ------------------------------------";
119.26 +"-----------------------------------------------------------------";
119.27 +"-----------------------------------------------------------------";
119.28 +"-----------------------------------------------------------------";
119.29 +
119.30 +
119.31 +"-------- investigate new uniary minus ---------------------------";
119.32 +"-------- investigate new uniary minus ---------------------------";
119.33 +"-------- investigate new uniary minus ---------------------------";
119.34 +val t = (#prop o rep_thm) real_diff_0; (*"0 - ?x = - ?x"*)
119.35 +atomty t;
119.36 +(*** -------------
119.37 +*** Const ( Trueprop, bool => prop)
119.38 +*** . Const ( op =, [real, real] => bool)
119.39 +*** . . Const ( op -, [real, real] => real)
119.40 +*** . . . Const ( 0, real)
119.41 +*** . . . Var ((x, 0), real)
119.42 +*** . . Const ( uminus, real => real)
119.43 +*** . . . Var ((x, 0), real) *)
119.44 +
119.45 +val t = (term_of o the o (parse thy)) "-1";
119.46 +atomty t;
119.47 +(*** -------------
119.48 +*** Free ( -1, real) *)
119.49 +val t = (term_of o the o (parse thy)) "- 1";
119.50 +atomty t;
119.51 +(*** -------------
119.52 +*** Const ( uminus, real => real)
119.53 +*** . Free ( 1, real) *)
119.54 +
119.55 +val t = (term_of o the o (parse thy)) "-x"; (*1-x syntyx error !!!*)
119.56 +atomty t;
119.57 +(**** -------------
119.58 +*** Free ( -x, real)*)
119.59 +val t = (term_of o the o (parse thy)) "- x";
119.60 +atomty t;
119.61 +(**** -------------
119.62 +*** Free ( -x, real) !!!!!!!!!!!!!!!!!!!!!!!! is the same !!!*)
119.63 +val t = (term_of o the o (parse thy)) "-(x)";
119.64 +atomty t;
119.65 +(**** -------------
119.66 +*** Free ( -x, real)*)
119.67 +
119.68 +
119.69 +"-------- Bsple aus Schalk I -------------------------------------";
119.70 +"-------- Bsple aus Schalk I -------------------------------------";
119.71 +"-------- Bsple aus Schalk I -------------------------------------";
119.72 +(*SPB Schalk I p.63 No.267b*)
119.73 +val t = str2term
119.74 + "(5*x^^^2 + 3) * (2*x^^^7 + 3) - (3*x^^^5 + 8) * (6*x^^^4 - 1)";
119.75 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.76 +if (term2str t) =
119.77 +"17 + 15 * x ^^^ 2 + -48 * x ^^^ 4 + 3 * x ^^^ 5 + 6 * x ^^^ 7 + -8 * x ^^^ 9"
119.78 +then ()
119.79 +else raise error "poly.sml: diff.behav. in make_polynomial 1";
119.80 +
119.81 +(*SPB Schalk I p.63 No.275b*)
119.82 + val t = str2term
119.83 + "(3*x^^^2 - 2*x*y + y^^^2) * (x^^^2 - 2*y^^^2)";
119.84 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.85 + term2str t;
119.86 +if (term2str t) =
119.87 +"3 * x ^^^ 4 + -2 * x ^^^ 3 * y + -5 * x ^^^ 2 * y ^^^ 2 + \
119.88 +\4 * x * y ^^^ 3 +\n-2 * y ^^^ 4"
119.89 +then ()
119.90 +else raise error "poly.sml: diff.behav. in make_polynomial 2";
119.91 +
119.92 +(*SPB Schalk I p.63 No.279b*)
119.93 + val t = str2term
119.94 + "(x-a)*(x-b)*(x-c)*(x-d)";
119.95 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.96 + term2str t;
119.97 +(* Richtig! *)
119.98 +if (term2str t) =
119.99 +"a * b * c * d + -1 * a * b * c * x + -1 * a * b * d * x + a * b * x ^^^ 2 +\n-1 * a * c * d * x +\na * c * x ^^^ 2 +\na * d * x ^^^ 2 +\n-1 * a * x ^^^ 3 +\n-1 * b * c * d * x +\nb * c * x ^^^ 2 +\nb * d * x ^^^ 2 +\n-1 * b * x ^^^ 3 +\nc * d * x ^^^ 2 +\n-1 * c * x ^^^ 3 +\n-1 * d * x ^^^ 3 +\nx ^^^ 4"
119.100 +then ()
119.101 +else raise error "poly.sml: diff.behav. in make_polynomial 3";
119.102 +
119.103 +(*SPB Schalk I p.63 No.291*)
119.104 + val t = str2term
119.105 + "(5+96*x^^^3+8*x*(-4+(7- 3*x)*4*x))*(5*(2- 3*x)- (-15*x*(-8*x- 5)))";
119.106 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.107 + term2str t;
119.108 +if (term2str t) =
119.109 +"50 + -770 * x + 4520 * x ^^^ 2 + -16320 * x ^^^ 3 + -26880 * x ^^^ 4"
119.110 +then ()
119.111 +else raise error "poly.sml: diff.behav. in make_polynomial 4";
119.112 +
119.113 +(*SPB Schalk I p.64 No.295c*)
119.114 + val t = str2term
119.115 + "(13*a^^^4*b^^^9*c - 12*a^^^3*b^^^6*c^^^9)^^^2";
119.116 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.117 + term2str t;
119.118 +if (term2str t) =
119.119 +"169 * a ^^^ 8 * b ^^^ 18 * c ^^^ 2 + -312 * a ^^^ 7 * b ^^^ 15 * c ^^^ 10\
119.120 +\ +\n144 * a ^^^ 6 * b ^^^ 12 * c ^^^ 18"
119.121 +then ()
119.122 +else raise error "poly.sml: diff.behav. in make_polynomial 5";
119.123 +
119.124 +(*SPB Schalk I p.64 No.299a*)
119.125 + val t = str2term
119.126 + "(x - y)*(x + y)";
119.127 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.128 + term2str t;
119.129 +if (term2str t) =
119.130 +"x ^^^ 2 + -1 * y ^^^ 2"
119.131 +then ()
119.132 +else raise error "poly.sml: diff.behav. in make_polynomial 6";
119.133 +
119.134 +(*SPB Schalk I p.64 No.300c*)
119.135 + val t = str2term
119.136 + "(3*x^^^2*y - 1)*(3*x^^^2*y + 1)";
119.137 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.138 + term2str t;
119.139 +if (term2str t) =
119.140 +"-1 + 9 * x ^^^ 4 * y ^^^ 2"
119.141 +then ()
119.142 +else raise error "poly.sml: diff.behav. in make_polynomial 7";
119.143 +
119.144 +(*SPB Schalk I p.64 No.302*)
119.145 +val t = str2term
119.146 + "(13*x^^^2 + 5)*(13*x^^^2 - 5) - (5*x^^^2 + 3)*(5*x^^^2 - 3) - (12*x^^^2 + 4)*(12*x^^^2 - 4)";
119.147 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.148 +if term2str t = "0" then ()
119.149 +else raise error "poly.sml: diff.behav. in make_polynomial 8";
119.150 +(* Bei Berechnung sollte 3 mal real_plus_minus_binom1_p aus expand_poly verwendet werden *)
119.151 +
119.152 +
119.153 +(*SPB Schalk I p.64 No.306a*)
119.154 +val t = str2term "((x^^^2 + 1)*(x^^^2 - 1))^^^2";
119.155 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.156 +if (term2str t) = "1 + 2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 + x ^^^ 8" then ()
119.157 +else raise error "poly.sml: diff.behav. in make_polynomial: not confluent \
119.158 + \2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 = -2 * x ^^^ 4 works again";
119.159 +
119.160 +
119.161 +(*WN071729 when reducing "rls reduce_012_" for Schaerding,
119.162 +the above resulted in the term below ... but reduces from then correctly*)
119.163 +val t = str2term "1 + 2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 + x ^^^ 8";
119.164 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.165 +if (term2str t) = "1 + -2 * x ^^^ 4 + x ^^^ 8" then ()
119.166 +else raise error "poly.sml: diff.behav. in make_polynomial 9b";
119.167 +
119.168 +(*SPB Schalk I p.64 No.296a*)
119.169 +val t = str2term "(x - a)^^^3";
119.170 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.171 +if (term2str t) = "-1 * a ^^^ 3 + 3 * a ^^^ 2 * x + -3 * a * x ^^^ 2 + x ^^^ 3"
119.172 +then () else raise error "poly.sml: diff.behav. in make_polynomial 10";
119.173 +
119.174 +(*SPB Schalk I p.64 No.296c*)
119.175 +val t = str2term "(-3*x - 4*y)^^^3";
119.176 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.177 +if (term2str t) =
119.178 +"-27 * x ^^^ 3 + -108 * x ^^^ 2 * y + -144 * x * y ^^^ 2 + -64 * y ^^^ 3"
119.179 +then () else raise error "poly.sml: diff.behav. in make_polynomial 11";
119.180 +
119.181 +(*SPB Schalk I p.62 No.242c*)
119.182 +val t = str2term "x^^^(-4)*(x^^^(-4)*y^^^(-2))^^^(-1)*y^^^(-2)";
119.183 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.184 +if (term2str t) = "1" then ()
119.185 +else raise error "poly.sml: diff.behav. in make_polynomial 12";
119.186 +
119.187 +(*SPB Schalk I p.60 No.209a*)
119.188 +val t = str2term "a^^^(7-x) * a^^^x";
119.189 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.190 +if term2str t = "a ^^^ 7" then ()
119.191 +else raise error "poly.sml: diff.behav. in make_polynomial 13";
119.192 +
119.193 +(*SPB Schalk I p.60 No.209d*)
119.194 +val t = str2term "d^^^x * d^^^(x+1) * d^^^(2 - 2*x)";
119.195 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.196 +if term2str t = "d ^^^ 3" then ()
119.197 +else raise error "poly.sml: diff.behav. in make_polynomial 14";
119.198 +
119.199 +
119.200 +(*---------------------------------------------------------------------*)
119.201 +(*------------------ Bsple bei denen es Probleme gibt------------------*)
119.202 +(*---------------------------------------------------------------------*)
119.203 +
119.204 +(*Schalk I p.64 No.303*)
119.205 +val t = str2term "(a + 2*b)*(a^^^2 + 4*b^^^2)*(a - 2*b) - (a - 6*b)*(a^^^2 + 36*b^^^2)*(a + 6*b)";
119.206 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.207 +if term2str t = "1280 * b ^^^ 4" then ()
119.208 +else raise error "poly.sml: diff.behav. in make_polynomial 14b";
119.209 +(* Richtig - aber Binomische Formel wurde nicht verwendet! *)
119.210 +
119.211 +
119.212 +(*--------------------------------------------------------------------*)
119.213 +(*----------------------- Eigene Beispiele ---------------------------*)
119.214 +(*--------------------------------------------------------------------*)
119.215 +(*SPO*)
119.216 +val t = str2term "a^^^2*a^^^(-2)";
119.217 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.218 +if term2str t = "1" then ()
119.219 +else raise error "poly.sml: diff.behav. in make_polynomial 15";
119.220 +(*SPO*)
119.221 +val t = str2term "a + a + a";
119.222 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.223 +if term2str t = "3 * a" then ()
119.224 +else raise error "poly.sml: diff.behav. in make_polynomial 16";
119.225 +(*SPO*)
119.226 +val t = str2term "a + b + b + b";
119.227 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.228 +if term2str t = "a + 3 * b" then ()
119.229 +else raise error "poly.sml: diff.behav. in make_polynomial 17";
119.230 +(*SPO*)
119.231 +val t = str2term "a^^^2*b*b^^^(-1)";
119.232 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.233 +if term2str t = "a ^^^ 2" then ()
119.234 +else raise error "poly.sml: diff.behav. in make_polynomial 18";
119.235 +(*SPO*)
119.236 +val t = str2term "a^^^2*a^^^(-2)";
119.237 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.238 +if (term2str t) = "1" then ()
119.239 +else raise error "poly.sml: diff.behav. in make_polynomial 19";
119.240 +(*SPO*)
119.241 +val t = str2term "b + a - b";
119.242 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.243 +if (term2str t) = "a" then ()
119.244 +else raise error "poly.sml: diff.behav. in make_polynomial 20";
119.245 +(*SPO*)
119.246 +val t = str2term "b * a * a";
119.247 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.248 +if term2str t = "a ^^^ 2 * b" then ()
119.249 +else raise error "poly.sml: diff.behav. in make_polynomial 21";
119.250 +(*SPO*)
119.251 +val t = str2term "(a^^^2)^^^3";
119.252 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.253 +if term2str t = "a ^^^ 6" then ()
119.254 +else raise error "poly.sml: diff.behav. in make_polynomial 22";
119.255 +(*SPO*)
119.256 +val t = str2term "x^^^2 * y^^^2 + x * x^^^2 * y";
119.257 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.258 +if term2str t = "x ^^^ 3 * y + x ^^^ 2 * y ^^^ 2" then ()
119.259 +else raise error "poly.sml: diff.behav. in make_polynomial 23";
119.260 +(*SPO*)
119.261 +val t = (term_of o the o (parse thy)) "a^^^2 * (-a)^^^2";
119.262 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.263 +if (term2str t) = "a ^^^ 4" then ()
119.264 +else raise error "poly.sml: diff.behav. in make_polynomial 24";
119.265 +(*SPO*)
119.266 +val t = str2term "a * b * b^^^(-1) + a";
119.267 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.268 +if (term2str t) = "2 * a" then ()
119.269 +else raise error "poly.sml: diff.behav. in make_polynomial 25";
119.270 +(*SPO*)
119.271 +val t = str2term "a*c*b^^^(2*n) + 3*a + 5*b^^^(2*n)*c*b";
119.272 +val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
119.273 +if (term2str t) = "3 * a + 5 * b ^^^ (1 + 2 * n) * c + a * b ^^^ (2 * n) * c"
119.274 +then () else raise error "poly.sml: diff.behav. in make_polynomial 26";
119.275 +
119.276 +
119.277 +(*MG.27.6.03 -------------vvv-: Verschachtelte Terme -----------*)
119.278 +(*SPO*)
119.279 +val t = str2term "(1 + (x*y*a) + x)^^^(1 + (x*y*a) + x)";
119.280 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.281 + term2str t;
119.282 +if term2str t = "(1 + x + a * x * y) ^^^ (1 + x + a * x * y)"
119.283 + then () else raise error "poly.sml: diff.behav. in make_polynomial 27";(*SPO*)
119.284 +val t = str2term "(1 + x*(y*z)*zz)^^^(1 + x*(y*z)*zz)";
119.285 + val Some (t,_) = rewrite_set_ thy false make_polynomial t;
119.286 + term2str t;
119.287 +if term2str t = "(1 + x * y * z * zz) ^^^ (1 + x * y * z * zz)"
119.288 + then () else raise error "poly.sml: diff.behav. in make_polynomial 28";
119.289 +
119.290 +"-------- Script 'simplification for_polynomials' ----------------";
119.291 +"-------- Script 'simplification for_polynomials' ----------------";
119.292 +"-------- Script 'simplification for_polynomials' ----------------";
119.293 +val str =
119.294 +"Script SimplifyScript (t_::real) = \
119.295 +\ ((Rewrite_Set norm_Poly False) t_)";
119.296 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
119.297 +atomty sc;
119.298 +
119.299 +
119.300 +"-------- check pbl 'polynomial simplification' -----------------";
119.301 +"-------- check pbl 'polynomial simplification' -----------------";
119.302 +"-------- check pbl 'polynomial simplification' -----------------";
119.303 +val fmz = ["term ((5*x^^^2 + 3) * (2*x^^^7 + 3) \
119.304 + \- (3*x^^^5 + 8) * (6*x^^^4 - 1))",
119.305 + "normalform N"];
119.306 +(*0*)
119.307 +case refine fmz ["polynomial","simplification"]of
119.308 + [Matches (["polynomial", "simplification"], _)] => ()
119.309 + | _ => raise error "poly.sml diff.behav. in check pbl, refine";
119.310 +(*...if there is an error, then ...*)
119.311 +
119.312 +(*1*)
119.313 +print_depth 7;
119.314 +val pbt = get_pbt ["polynomial","simplification"];
119.315 +print_depth 3;
119.316 +(*if there is ...
119.317 +> val NoMatch' {Given=gi, Where=wh, Find=fi,...} = match_pbl fmz pbt;
119.318 +... then trace_rewrite:*)
119.319 +
119.320 +(*2*)
119.321 +trace_rewrite:=true;
119.322 +match_pbl fmz pbt;
119.323 +trace_rewrite:=false;
119.324 +(*... if there is no rewrite, then there is something wrong with prls*)
119.325 +
119.326 +(*3*)
119.327 +print_depth 7;
119.328 +val prls = (#prls o get_pbt) ["polynomial","simplification"];
119.329 +print_depth 3;
119.330 +val t = str2term "((5*x^^^2 + 3) * (2*x^^^7 + 3) \
119.331 + \- (3*x^^^5 + 8) * (6*x^^^4 - 1)) is_polyexp";
119.332 +trace_rewrite:=true;
119.333 +val Some (t',_) = rewrite_set_ thy false prls t;
119.334 +trace_rewrite:=false;
119.335 +if t' = HOLogic.true_const then ()
119.336 +else raise error "poly.sml: diff.behav. in check pbl 'polynomial..";
119.337 +(*... if this works, but (*1*) does still NOT work, check types:*)
119.338 +
119.339 +(*4*)
119.340 +show_types:=true;
119.341 +(*
119.342 +> val NoMatch' {Given=gi, Where=wh, Find=fi,...} = match_pbl fmz pbt;
119.343 +val wh = [False "(t_::real => real) (is_polyexp::real)"]
119.344 +......................^^^^^^^^^^^^...............^^^^*)
119.345 +val Matches' _ = match_pbl fmz pbt;
119.346 +show_types:=false;
119.347 +
119.348 +
119.349 +"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
119.350 +"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
119.351 +"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
119.352 +val fmz = ["term ((5*x^^^2 + 3) * (2*x^^^7 + 3) \
119.353 + \- (3*x^^^5 + 8) * (6*x^^^4 - 1))",
119.354 + "normalform N"];
119.355 +val (dI',pI',mI') =
119.356 + ("Poly.thy",["polynomial","simplification"],
119.357 + ["simplification","for_polynomials"]);
119.358 +val p = e_pos'; val c = [];
119.359 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
119.360 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
119.361 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
119.362 +(writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
119.363 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
119.364 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
119.365 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
119.366 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
119.367 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
119.368 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
119.369 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
119.370 +if f2str f =
119.371 +"17 + 15 * x ^^^ 2 + -48 * x ^^^ 4 + 3 * x ^^^ 5 + 6 * x ^^^ 7 + -8 * x ^^^ 9"
119.372 +then () else raise error "poly.sml diff.behav. in me Schalk I p.63 No.267b";
119.373 +
119.374 +
119.375 +"-------- interSteps for Schalk 299a -----------------------------";
119.376 +"-------- interSteps for Schalk 299a -----------------------------";
119.377 +"-------- interSteps for Schalk 299a -----------------------------";
119.378 +states:=[];
119.379 +CalcTree
119.380 +[(["term ((x - y)*(x + y))", "normalform N"],
119.381 + ("Poly.thy",["polynomial","simplification"],
119.382 + ["simplification","for_polynomials"]))];
119.383 +Iterator 1;
119.384 +moveActiveRoot 1;
119.385 +autoCalculate 1 CompleteCalc;
119.386 +val ((pt,p),_) = get_calc 1; show_pt pt;
119.387 +
119.388 +interSteps 1 ([1],Res)(*<ERROR> syserror in detailstep </ERROR>*);
119.389 +val ((pt,p),_) = get_calc 1; show_pt pt;
119.390 +if existpt' ([1,1], Frm) pt then ()
119.391 +else raise error "poly.sml: interSteps doesnt work again 1";
119.392 +
119.393 +interSteps 1 ([1,1],Res)(*<ERROR> syserror in detailstep </ERROR>*);
119.394 +val ((pt,p),_) = get_calc 1; show_pt pt;
119.395 +if existpt' ([1,1,1], Frm) pt then ()
119.396 +else raise error "poly.sml: interSteps doesnt work again 2";
119.397 +
119.398 +
119.399 +"-------- norm_Poly NOT COMPLETE ---------------------------------";
119.400 +"-------- norm_Poly NOT COMPLETE ---------------------------------";
119.401 +"-------- norm_Poly NOT COMPLETE ---------------------------------";
119.402 +trace_rewrite:=true;
119.403 +val Some (f',_) = rewrite_set_ thy false norm_Poly
119.404 +(str2term "L = k - 2 * q + (k - 2 * q) + (k - 2 * q) + (k - 2 * q) + senkrecht + oben")(*see poly.sml: -- norm_Poly NOT COMPLETE -- TODO MG*);
119.405 +trace_rewrite:=false;
119.406 +term2str f';
119.407 +
119.408 +"-------- ord_make_polynomial ------------------------------------";
119.409 +"-------- ord_make_polynomial ------------------------------------";
119.410 +"-------- ord_make_polynomial ------------------------------------";
119.411 +val t1 = str2term "2 * b + (3 * a + 3 * b)";
119.412 +val t2 = str2term "3 * a + 3 * b + 2 * b";
119.413 +
119.414 +if ord_make_polynomial true Poly.thy [] (t1, t2) then ()
119.415 +else raise error "poly.sml: diff.behav. in ord_make_polynomial";
119.416 +
119.417 +(*WN071202: ^^^ why then is there no rewriting ...*)
119.418 +val term = str2term "2*b + (3*a + 3*b)";
119.419 +val None = rewrite_set_ Isac.thy false order_add_mult term;
119.420 +
119.421 +(*or why is there no rewriting this way...*)
119.422 +val t1 = str2term "2 * b + (3 * a + 3 * b)";
119.423 +val t2 = str2term "3 * a + (2 * b + 3 * b)";
119.424 +
119.425 +
119.426 +
120.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
120.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/polyeq.sml Wed Jul 21 13:53:39 2010 +0200
120.3 @@ -0,0 +1,1178 @@
120.4 +(* testexamples for PolyEq, poynomial equations and equational systems
120.5 + author: Richard Lang
120.6 + 2003
120.7 + (c) due to copyright terms
120.8 +
120.9 +use"../smltest/IsacKnowledge/polyeq.sml";
120.10 +use"polyeq.sml";
120.11 +
120.12 +WN030609: some expls dont work due to unfinished handling of 'expanded terms';
120.13 + others marked with TODO have to be checked, too.
120.14 +*)
120.15 +
120.16 +"-----------------------------------------------------------------";
120.17 +"table of contents -----------------------------------------------";
120.18 +(*WN060608 some ----- are not in this table*)
120.19 +"-----------------------------------------------------------------";
120.20 +"----------- tests on predicates in problems ---------------------";
120.21 +"----------- test matching problems --------------------------0---";
120.22 +"----------- (-8 - 2*x + x^^^2 = 0), (*Schalk 2, S.67 Nr.31.b----";
120.23 +"----------- (-16 + 4*x + 2*x^^^2 = 0), --------------------------";
120.24 +"----------- (a*b - (a+b)*x + x^^^2 = 0), (*Schalk 2,S.68Nr.44.a*)";
120.25 +"----------- (-64 + x^^^2 = 0), (*Schalk 2, S.66 Nr.1.a~--------*)";
120.26 +"----------- (-147 + 3*x^^^2 = 0), (*Schalk 2, S.66 Nr.1.b------*)";
120.27 +"----------- (3*x - 1 - (5*x - (2 - 4*x)) = -11),(*Schalk Is86Bsp5";
120.28 +"----------- ((x+1)*(x+2) - (3*x - 2)^^^2=.. Schalk II s.68 Bsp 37";
120.29 +"----------- interSteps ([1],Res); on Schalk Is86Bsp5-------------";
120.30 +"-----------------------------------------------------------------";
120.31 +"-----------------------------------------------------------------";
120.32 +"-----------------------------------------------------------------";
120.33 +
120.34 +val c = [];
120.35 +
120.36 +"----------- tests on predicates in problems ---------------------";
120.37 +"----------- tests on predicates in problems ---------------------";
120.38 +"----------- tests on predicates in problems ---------------------";
120.39 +(*
120.40 + Compiler.Control.Print.printDepth:=5; (*4 default*)
120.41 + trace_rewrite:=true;
120.42 + trace_rewrite:=false;
120.43 +*)
120.44 + val t1 = (term_of o the o (parse thy)) "lhs (-8 - 2*x + x^^^2 = 0)";
120.45 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t1;
120.46 + if ((term2str t) = "-8 - 2 * x + x ^^^ 2") then ()
120.47 + else raise error "polyeq.sml: diff.behav. in lhs";
120.48 +
120.49 +
120.50 + val t2 = (term_of o the o (parse thy)) "(-8 - 2*x + x^^^2) is_expanded_in x";
120.51 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t2;
120.52 + if (term2str t) = "True" then ()
120.53 + else raise error "polyeq.sml: diff.behav. 1 in is_expended_in";
120.54 +
120.55 + val t0 = (term_of o the o (parse thy)) "(sqrt(x)) is_poly_in x";
120.56 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t0;
120.57 + if (term2str t) = "False" then ()
120.58 + else raise error "polyeq.sml: diff.behav. 2 in is_poly_in";
120.59 +
120.60 +
120.61 + val t3 = (term_of o the o (parse thy)) "(-8 + (-1)*2*x + x^^^2) is_poly_in x";
120.62 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t3;
120.63 + if (term2str t) = "True" then ()
120.64 + else raise error "polyeq.sml: diff.behav. 3 in is_poly_in";
120.65 +
120.66 +
120.67 + val t4 = (term_of o the o (parse thy)) "(lhs (-8 + (-1)*2*x + x^^^2 = 0)) is_expanded_in x";
120.68 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t4;
120.69 + if (term2str t) = "True" then ()
120.70 + else raise error "polyeq.sml: diff.behav. 4 in is_expended_in";
120.71 +
120.72 +
120.73 + val t6 = (term_of o the o (parse thy)) "(lhs (-8 - 2*x + x^^^2 = 0)) is_expanded_in x";
120.74 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t6;
120.75 + if (term2str t) = "True" then ()
120.76 + else raise error "polyeq.sml: diff.behav. 5 in is_expended_in";
120.77 +
120.78 + val t3 = (term_of o the o (parse thy))"((-8 - 2*x + x^^^2) has_degree_in x) = 2";
120.79 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t3;
120.80 + if (term2str t) = "True" then ()
120.81 + else raise error "polyeq.sml: diff.behav. in has_degree_in_in";
120.82 +
120.83 +
120.84 + val t3 = (term_of o the o (parse thy)) "((sqrt(x)) has_degree_in x) = 2";
120.85 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t3;
120.86 + if (term2str t) = "False" then ()
120.87 + else raise error "polyeq.sml: diff.behav. 6 in has_degree_in_in";
120.88 +
120.89 + val t4 = (term_of o the o (parse thy))
120.90 + "((-8 - 2*x + x^^^2) has_degree_in x) = 1";
120.91 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t4;
120.92 + if (term2str t) = "False" then ()
120.93 + else raise error "polyeq.sml: diff.behav. 7 in has_degree_in_in";
120.94 +
120.95 +
120.96 + val t5 = (term_of o the o (parse thy))
120.97 + "((-8 - 2*x + x^^^2) has_degree_in x) = 2";
120.98 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_prls t5;
120.99 + if (term2str t) = "True" then ()
120.100 + else raise error "polyeq.sml: diff.behav. 8 in has_degree_in_in";
120.101 +
120.102 +
120.103 +"----------- test matching problems --------------------------0---";
120.104 +"----------- test matching problems --------------------------0---";
120.105 +"----------- test matching problems --------------------------0---";
120.106 + val fmz = ["equality (-8 - 2*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.107 + val pbt as {thy = thy, where_ = pre, ppc = ppc,...} =
120.108 + get_pbt ["expanded","univariate","equation"];
120.109 +
120.110 + match_pbl fmz (get_pbt ["expanded","univariate","equation"]);
120.111 + (*Matches'
120.112 + {Find=[Correct "solutions L"],
120.113 + Given=[Correct "equality (-8 - 2 * x + x ^^^ 2 = 0)",
120.114 + Correct "solveFor x"],Relate=[],
120.115 + Where=[Correct "matches (?a = 0) (-8 - 2 * x + x ^^^ 2 = 0)",
120.116 + Correct "lhs (-8 - 2 * x + x ^^^ 2 = 0) is_expanded_in x"],With=[]}
120.117 + *)
120.118 + match_pbl fmz (get_pbt ["degree_2","expanded","univariate","equation"]);
120.119 + (*Matches'
120.120 + {Find=[Correct "solutions L"],
120.121 + Given=[Correct "equality (-8 - 2 * x + x ^^^ 2 = 0)",
120.122 + Correct "solveFor x"],Relate=[],
120.123 + Where=[Correct "lhs (-8 - 2 * x + x ^^^ 2 = 0) has_degree_in x =!= 2"],
120.124 + With=[]}*)
120.125 +
120.126 +"-------------------- test thm's degree_0 --------------------------------------";
120.127 +"-------------------- test thm's degree_0 --------------------------------------";
120.128 +"----- d0_false ------";
120.129 +(*EP*)
120.130 +val fmz = ["equality ( 1 = 0)", "solveFor x","solutions L"];
120.131 +val (dI',pI',mI') = ("PolyEq.thy",["degree_0","polynomial","univariate","equation"],
120.132 + ["PolyEq","solve_d0_polyeq_equation"]);
120.133 +(*val p = e_pos';
120.134 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.135 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.136 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.137 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.138 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.139 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.140 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.141 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.142 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.143 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[]")) => ()
120.144 + | _ => raise error "polyeq.sml: diff.behav. in 1 = 0 -> []";
120.145 +
120.146 +"----- d0_true ------";
120.147 +(*EP-7*)
120.148 +val fmz = ["equality ( 0 = 0)", "solveFor x","solutions L"];
120.149 +val (dI',pI',mI') = ("PolyEq.thy",["degree_0","polynomial","univariate","equation"],
120.150 + ["PolyEq","solve_d0_polyeq_equation"]);
120.151 +(*val p = e_pos'; val c = [];
120.152 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.153 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.154 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.155 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.156 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.157 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.158 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.159 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.160 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.161 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"UniversalList")) => ()
120.162 + | _ => raise error "polyeq.sml: diff.behav. in 0 = 0 -> UniversalList";
120.163 +
120.164 +"-------------------- test thm's degree_2 ------------------------------------------";
120.165 +"-------------------- test thm's degree_2 ------------------------------------------";
120.166 +
120.167 +"-------------------- test thm's d2_pq_formulsxx[_neg]-----";
120.168 +"-------------------- test thm's d2_pq_formulsxx[_neg]-----";
120.169 +"-------------------- test thm's d2_pq_formulsxx[_neg]-----";
120.170 +
120.171 +"----- d2_pqformula1 ------!!!!";
120.172 +val fmz = ["equality (-2 +(-1)*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.173 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"], ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.174 +(*val p = e_pos'; val c = [];
120.175 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.176 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.177 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.178 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.179 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.180 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.181 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.182 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.183 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.184 +(*### or2list _ | _
120.185 + ([3],Res) "x = 2 | x = -1" Or_to_List*)
120.186 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.187 +(*### or2list _ | _
120.188 + ### applicable_in Check_elementwise: --> ([x = 2, x = -1], [])
120.189 + ([4],Res) "[x = 2, x = -1]" Check_elementwise "Assumptions"*)
120.190 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.191 +(*### applicable_in Check_elementwise: --> ([x = 2, x = -1], [])
120.192 + ([5],Res) "[x = 2, x = -1]" Check_Postcond*)
120.193 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.194 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -1]")) => ()
120.195 + | _ => raise error "polyeq.sml: diff.behav. in -2 + (-1)*x + x^2 = 0 -> [x = 2, x = -1]";
120.196 +
120.197 +"----- d2_pqformula1_neg ------";
120.198 +(*EP-8*)
120.199 +val fmz = ["equality ( 2 +(-1)*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.200 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"], ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.201 +(*val p = e_pos'; val c = [];
120.202 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.203 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.204 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.205 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.206 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.207 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.208 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.209 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.210 +(*### or2list False
120.211 + ([1],Res) False Or_to_List)*)
120.212 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.213 +(*### or2list False
120.214 + ([2],Res) [] Check_elementwise "Assumptions"*)
120.215 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.216 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.217 +val asm = get_assumptions_ pt p;
120.218 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"[]")) andalso asm = [] then ()
120.219 +else raise error "polyeq.sml: diff.behav. in 2 +(-1)*x + x^^^2 = 0";
120.220 +
120.221 +"----- d2_pqformula2 ------";
120.222 +val fmz = ["equality (-2 +(-1)*x + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.223 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.224 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.225 +(*val p = e_pos'; val c = [];
120.226 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.227 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.228 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.229 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.230 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.231 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.232 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.233 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.234 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.235 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.236 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.237 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -1]")) => ()
120.238 + | _ => raise error "polyeq.sml: diff.behav. in -2 + (-1)*x + x^2 = 0 -> [x = 2, x = -1]";
120.239 +
120.240 +
120.241 +"----- d2_pqformula2_neg ------";
120.242 +val fmz = ["equality ( 2 +(-1)*x + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.243 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.244 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.245 +(*val p = e_pos'; val c = [];
120.246 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.247 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.248 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.249 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.250 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.251 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.252 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.253 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.254 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.255 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.256 +"TODO 2 +(-1)*x + 1*x^^^2 = 0";
120.257 +"TODO 2 +(-1)*x + 1*x^^^2 = 0";
120.258 +"TODO 2 +(-1)*x + 1*x^^^2 = 0";
120.259 +
120.260 +
120.261 +"----- d2_pqformula3 ------";
120.262 +(*EP-9*)
120.263 +val fmz = ["equality (-2 + x + x^^^2 = 0)", "solveFor x","solutions L"];
120.264 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.265 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.266 +(*val p = e_pos'; val c = [];
120.267 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.268 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.269 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.270 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.271 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.272 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.273 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.274 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.275 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.276 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.277 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.278 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1, x = -2]")) => ()
120.279 + | _ => raise error "polyeq.sml: diff.behav. in -2 + x + x^2 = 0-> [x = 1, x = -2]";
120.280 +
120.281 +"----- d2_pqformula3_neg ------";
120.282 +val fmz = ["equality ( 2 + x + x^^^2 = 0)", "solveFor x","solutions L"];
120.283 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.284 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.285 +(*val p = e_pos'; val c = [];
120.286 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.287 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.288 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.289 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.290 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.291 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.292 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.293 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.294 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.295 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.296 +"TODO 2 + x + x^^^2 = 0";
120.297 +"TODO 2 + x + x^^^2 = 0";
120.298 +"TODO 2 + x + x^^^2 = 0";
120.299 +
120.300 +
120.301 +"----- d2_pqformula4 ------";
120.302 +val fmz = ["equality (-2 + x + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.303 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.304 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.305 +(*val p = e_pos'; val c = [];
120.306 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.307 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.308 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.309 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.310 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.311 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.312 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.313 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.314 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.315 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.316 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.317 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1, x = -2]")) => ()
120.318 + | _ => raise error "polyeq.sml: diff.behav. in -2 + x + 1*x^^^2 = 0 -> [x = 1, x = -2]";
120.319 +
120.320 +"----- d2_pqformula4_neg ------";
120.321 +val fmz = ["equality ( 2 + x + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.322 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.323 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.324 +(*val p = e_pos'; val c = [];
120.325 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.326 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.327 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.328 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.329 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.330 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.331 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.332 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.333 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.334 +"TODO 2 + x + 1*x^^^2 = 0";
120.335 +"TODO 2 + x + 1*x^^^2 = 0";
120.336 +"TODO 2 + x + 1*x^^^2 = 0";
120.337 +
120.338 +"----- d2_pqformula5 ------";
120.339 +val fmz = ["equality (1*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.340 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.341 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.342 +(*val p = e_pos'; val c = [];
120.343 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.344 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.345 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.346 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.347 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.348 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.349 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.350 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.351 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.352 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.353 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.354 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1]")) => ()
120.355 + | _ => raise error "polyeq.sml: diff.behav. in 1*x + x^2 = 0 -> [x = 0, x = -1]";
120.356 +
120.357 +"----- d2_pqformula6 ------";
120.358 +val fmz = ["equality (1*x + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.359 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.360 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.361 +(*val p = e_pos'; val c = [];
120.362 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.363 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.364 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.365 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.366 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.367 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.368 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.369 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.370 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.371 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.372 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.373 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1]")) => ()
120.374 + | _ => raise error "polyeq.sml: diff.behav. in 1*x + 1*x^2 = 0 -> [x = 0, x = -1]";
120.375 +
120.376 +"----- d2_pqformula7 ------";
120.377 +(*EP-10*)
120.378 +val fmz = ["equality ( x + x^^^2 = 0)", "solveFor x","solutions L"];
120.379 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.380 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.381 +(*val p = e_pos'; val c = [];
120.382 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.383 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.384 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.385 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.386 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.387 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.388 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.389 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.390 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.391 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.392 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.393 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1]")) => ()
120.394 + | _ => raise error "polyeq.sml: diff.behav. in x + x^2 = 0 -> [x = 0, x = -1]";
120.395 +
120.396 +"----- d2_pqformula8 ------";
120.397 +val fmz = ["equality ( x + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.398 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.399 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.400 +(*val p = e_pos'; val c = [];
120.401 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.402 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.403 +
120.404 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.405 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.406 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.407 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.408 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.409 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.410 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.411 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.412 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.413 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1]")) => ()
120.414 + | _ => raise error "polyeq.sml: diff.behav. in x + 1*x^2 = 0 -> [x = 0, x = -1]";
120.415 +
120.416 +"----- d2_pqformula9 ------";
120.417 +val fmz = ["equality (-4 + x^^^2 = 0)", "solveFor x","solutions L"];
120.418 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.419 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.420 +(*val p = e_pos'; val c = [];
120.421 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.422 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.423 +
120.424 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.425 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.426 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.427 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.428 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.429 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.430 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.431 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.432 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -2]")) => ()
120.433 + | _ => raise error "polyeq.sml: diff.behav. in -4 + x^2 = 0 -> [x = 2, x = -2]";
120.434 +
120.435 +
120.436 +"----- d2_pqformula10_neg ------";
120.437 +val fmz = ["equality (4 + x^^^2 = 0)", "solveFor x","solutions L"];
120.438 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.439 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.440 +(*val p = e_pos'; val c = [];
120.441 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.442 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.443 +
120.444 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.445 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.446 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.447 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.448 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.449 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.450 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.451 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.452 +"TODO 4 + x^^^2 = 0";
120.453 +"TODO 4 + x^^^2 = 0";
120.454 +"TODO 4 + x^^^2 = 0";
120.455 +
120.456 +"----- d2_pqformula10 ------";
120.457 +val fmz = ["equality (-4 + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.458 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.459 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.460 +(*val p = e_pos'; val c = [];
120.461 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.462 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.463 +
120.464 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.465 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.466 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.467 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.468 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.469 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.470 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.471 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.472 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -2]")) => ()
120.473 + | _ => raise error "polyeq.sml: diff.behav. in -4 + 1*x^2 = 0 -> [x = 2, x = -2]";
120.474 +
120.475 +"----- d2_pqformula9_neg ------";
120.476 +val fmz = ["equality (4 + 1*x^^^2 = 0)", "solveFor x","solutions L"];
120.477 +val (dI',pI',mI') = ("PolyEq.thy",["pqFormula","degree_2","polynomial","univariate","equation"],
120.478 + ["PolyEq","solve_d2_polyeq_pq_equation"]);
120.479 +(*val p = e_pos'; val c = [];
120.480 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.481 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.482 +
120.483 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.484 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.485 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.486 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.487 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.488 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.489 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.490 +"TODO 4 + 1*x^^^2 = 0";
120.491 +"TODO 4 + 1*x^^^2 = 0";
120.492 +"TODO 4 + 1*x^^^2 = 0";
120.493 +
120.494 +"-------------------- test thm's d2_abc_formulsxx[_neg]-----";
120.495 +"-------------------- test thm's d2_abc_formulsxx[_neg]-----";
120.496 +"-------------------- test thm's d2_abc_formulsxx[_neg]-----";
120.497 +
120.498 +val fmz = ["equality (-1 +(-1)*x + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.499 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.500 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.501 +(*val p = e_pos'; val c = [];
120.502 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.503 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.504 +
120.505 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.506 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.507 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.508 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.509 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.510 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.511 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.512 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.513 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1, x = -1 / 2]")) => ()
120.514 + | _ => raise error "polyeq.sml: diff.behav. in -1 + (-1)*x + 2*x^2 = 0 -> [x = 1, x = -1/2]";
120.515 +
120.516 +val fmz = ["equality ( 1 +(-1)*x + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.517 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.518 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.519 +(*val p = e_pos'; val c = [];
120.520 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.521 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.522 +
120.523 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.524 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.525 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.526 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.527 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.528 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.529 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.530 +"TODO 1 +(-1)*x + 2*x^^^2 = 0";
120.531 +"TODO 1 +(-1)*x + 2*x^^^2 = 0";
120.532 +"TODO 1 +(-1)*x + 2*x^^^2 = 0";
120.533 +
120.534 +(*EP-11*)
120.535 +val fmz = ["equality (-1 + x + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.536 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.537 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.538 +(*val p = e_pos'; val c = [];
120.539 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.540 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.541 +
120.542 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.543 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.544 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.545 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.546 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.547 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.548 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.549 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.550 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1 / 2, x = -1]")) => ()
120.551 + | _ => raise error "polyeq.sml: diff.behav. in -1 + x + 2*x^2 = 0 -> [x = 1/2, x = -1]";
120.552 +
120.553 +val fmz = ["equality ( 1 + x + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.554 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.555 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.556 +(*val p = e_pos'; val c = [];
120.557 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.558 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.559 +
120.560 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.561 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.562 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.563 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.564 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.565 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.566 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.567 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.568 +"TODO 1 + x + 2*x^^^2 = 0";
120.569 +"TODO 1 + x + 2*x^^^2 = 0";
120.570 +"TODO 1 + x + 2*x^^^2 = 0";
120.571 +
120.572 +val fmz = ["equality (-2 + 1*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.573 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.574 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.575 +(*val p = e_pos'; val c = [];
120.576 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.577 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.578 +
120.579 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.580 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.581 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.582 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.583 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.584 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.585 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.586 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.587 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1, x = -2]")) => ()
120.588 + | _ => raise error "polyeq.sml: diff.behav. in -2 + 1*x + x^2 = 0 -> [x = 1, x = -2]";
120.589 +
120.590 +val fmz = ["equality ( 2 + 1*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.591 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.592 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.593 +(*val p = e_pos'; val c = [];
120.594 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.595 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.596 +
120.597 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.598 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.599 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.600 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.601 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.602 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.603 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.604 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.605 +"TODO 2 + 1*x + x^^^2 = 0";
120.606 +"TODO 2 + 1*x + x^^^2 = 0";
120.607 +"TODO 2 + 1*x + x^^^2 = 0";
120.608 +
120.609 +(*EP-12*)
120.610 +val fmz = ["equality (-2 + x + x^^^2 = 0)", "solveFor x","solutions L"];
120.611 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.612 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.613 +(*val p = e_pos'; val c = [];
120.614 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.615 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.616 +
120.617 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.618 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.619 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.620 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.621 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.622 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.623 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.624 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.625 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1, x = -2]")) => ()
120.626 + | _ => raise error "polyeq.sml: diff.behav. in -2 + x + x^2 = 0 -> [x = 1, x = -2]";
120.627 +
120.628 +val fmz = ["equality ( 2 + x + x^^^2 = 0)", "solveFor x","solutions L"];
120.629 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.630 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.631 +(*val p = e_pos'; val c = [];
120.632 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.633 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.634 +
120.635 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.636 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.637 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.638 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.639 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.640 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.641 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.642 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.643 +"TODO 2 + x + x^^^2 = 0";
120.644 +"TODO 2 + x + x^^^2 = 0";
120.645 +"TODO 2 + x + x^^^2 = 0";
120.646 +
120.647 +(*EP-13*)
120.648 +val fmz = ["equality (-8 + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.649 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.650 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.651 +(*val p = e_pos'; val c = [];
120.652 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.653 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.654 +
120.655 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.656 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.657 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.658 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.659 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.660 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.661 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.662 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.663 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -2]")) => ()
120.664 + | _ => raise error "polyeq.sml: diff.behav. in -8 + 2*x^2 = 0 -> [x = 2, x = -2]";
120.665 +
120.666 +val fmz = ["equality ( 8+ 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.667 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.668 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.669 +(*val p = e_pos'; val c = [];
120.670 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.671 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.672 +
120.673 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.674 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.675 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.676 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.677 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.678 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.679 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.680 +"TODO 8+ 2*x^^^2 = 0";
120.681 +"TODO 8+ 2*x^^^2 = 0";
120.682 +"TODO 8+ 2*x^^^2 = 0";
120.683 +
120.684 +(*EP-14*)
120.685 +val fmz = ["equality (-4 + x^^^2 = 0)", "solveFor x","solutions L"];
120.686 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"], ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.687 +(*val p = e_pos'; val c = [];
120.688 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.689 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.690 +
120.691 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.692 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.693 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.694 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.695 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.696 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.697 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.698 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.699 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -2]")) => ()
120.700 + | _ => raise error "polyeq.sml: diff.behav. in -4 + x^2 = 0 -> [x = 2, x = -2]";
120.701 +
120.702 +
120.703 +val fmz = ["equality ( 4+ x^^^2 = 0)", "solveFor x","solutions L"];
120.704 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"], ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.705 +(*val p = e_pos'; val c = [];
120.706 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.707 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.708 +
120.709 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.710 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.711 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.712 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.713 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.714 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.715 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.716 +"TODO 4+ x^^^2 = 0";
120.717 +"TODO 4+ x^^^2 = 0";
120.718 +"TODO 4+ x^^^2 = 0";
120.719 +
120.720 +(*EP-15*)
120.721 +val fmz = ["equality (2*x + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.722 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.723 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.724 +(*val p = e_pos'; val c = [];
120.725 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.726 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.727 +
120.728 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.729 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.730 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.731 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.732 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.733 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.734 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.735 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.736 +case f of Form' (FormKF (~1,EdUndef,_,Nundef,"[x = 0, x = -1]")) => ()
120.737 + | _ => raise error "polyeq.sml: diff.behav. in x + x^2 = 0 -> [x = 0, x = -1]";
120.738 +
120.739 +val fmz = ["equality (1*x + x^^^2 = 0)", "solveFor x","solutions L"];
120.740 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.741 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.742 +(*val p = e_pos'; val c = [];
120.743 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.744 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.745 +
120.746 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.747 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.748 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.749 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.750 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.751 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.752 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.753 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.754 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1]")) => ()
120.755 + | _ => raise error "polyeq.sml: diff.behav. in x + x^2 = 0 -> [x = 0, x = -1]";
120.756 +
120.757 +(*EP-16*)
120.758 +val fmz = ["equality (x + 2*x^^^2 = 0)", "solveFor x","solutions L"];
120.759 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.760 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.761 +(*val p = e_pos'; val c = [];
120.762 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.763 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.764 +
120.765 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.766 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.767 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.768 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.769 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.770 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.771 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.772 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.773 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1 / 2]")) => ()
120.774 + | _ => raise error "polyeq.sml: diff.behav. in x + x^2 = 0 -> [x = 0, x = -1 / 2]";
120.775 +
120.776 +(*EP-//*)
120.777 +val fmz = ["equality (x + x^^^2 = 0)", "solveFor x","solutions L"];
120.778 +val (dI',pI',mI') = ("PolyEq.thy",["abcFormula","degree_2","polynomial","univariate","equation"],
120.779 + ["PolyEq","solve_d2_polyeq_abc_equation"]);
120.780 +(*val p = e_pos'; val c = [];
120.781 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.782 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.783 +
120.784 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.785 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.786 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.787 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.788 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.789 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.790 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.791 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.792 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = -1]")) => ()
120.793 + | _ => raise error "polyeq.sml: diff.behav. in x + x^2 = 0 -> [x = 0, x = -1]";
120.794 +
120.795 +"----------- (-8 - 2*x + x^^^2 = 0), (*Schalk 2, S.67 Nr.31.b----";
120.796 +"----------- (-8 - 2*x + x^^^2 = 0), (*Schalk 2, S.67 Nr.31.b----";
120.797 +"----------- (-8 - 2*x + x^^^2 = 0), (*Schalk 2, S.67 Nr.31.b----";
120.798 + val fmz = ["equality (-8 - 2*x + x^^^2 = 0)", (*Schalk 2, S.67 Nr.31.b*)
120.799 + "solveFor x","solutions L"];
120.800 + val (dI',pI',mI') =
120.801 + ("PolyEq.thy",["degree_2","expanded","univariate","equation"],
120.802 + ["PolyEq","complete_square"]);
120.803 +(* val p = e_pos'; val c = [];
120.804 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.805 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.806 +
120.807 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.808 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.809 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.810 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.811 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.812 + (*Apply_Method ("PolyEq.thy","complete_square")*)
120.813 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.814 + (*"-8 - 2 * x + x ^^^ 2 = 0", nxt = Rewrite_Set_Inst ... "complete_square*)
120.815 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.816 + (*"-8 + (2 / 2 - x) ^^^ 2 = (2 / 2) ^^^ 2", nxt = Rewrite("square_explicit1"*)
120.817 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.818 + (*"(2 / 2 - x) ^^^ 2 = (2 / 2) ^^^ 2 - -8" nxt = Rewrite("root_plus_minus*)
120.819 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.820 + (*"2 / 2 - x = sqrt ((2 / 2) ^^^ 2 - -8) |
120.821 + 2 / 2 - x = - sqrt ((2 / 2) ^^^ 2 - -8)" nxt = Rewr_Inst("bdv_explicit2"*)
120.822 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.823 + (*"2 / 2 - x = sqrt ((2 / 2) ^^^ 2 - -8) |
120.824 + -1*x = - (2 / 2) + - sqrt ((2 / 2) ^^^ 2 - -8)"nxt = R_Inst("bdv_explt2"*)
120.825 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.826 + (*"-1 * x = - (2 / 2) + sqrt ((2 / 2) ^^^ 2 - -8) |
120.827 + -1 * x = (- (2 / 2) + - sqrt ((2 / 2) ^^^ 2 - -8))"nxt = bdv_explicit3*)
120.828 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.829 + (*"-1 * x = - (2 / 2) + sqrt ((2 / 2) ^^^ 2 - -8) |
120.830 + x = -1 * (- (2 / 2) + - sqrt ((2 / 2) ^^^ 2 - -8))" nxt = bdv_explicit3*)
120.831 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.832 + (*"x = -1 * (- (2 / 2) + sqrt ((2 / 2) ^^^ 2 - -8)) |
120.833 + x = -1 * (- (2 / 2) + - sqrt ((2 / 2) ^^^ 2 - -8))"nxt = calculate_Ration*)
120.834 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.835 + (*"x = -2 | x = 4" nxt = Or_to_List*)
120.836 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.837 + (*"[x = -2, x = 4]" nxt = Check_Postcond*)
120.838 + val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
120.839 +(* FIXXXME
120.840 + case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -2, x = 4]")) => () TODO
120.841 + | _ => raise error "polyeq.sml: diff.behav. in [x = -2, x = 4]";
120.842 +*)
120.843 +if f2str f = "[x = -1 * -1 + -1 * sqrt (1 ^^^ 2 - -8),\n x = -1 * -1 + -1 * (-1 * sqrt (1 ^^^ 2 - -8))]" then ()
120.844 +else raise error "polyeq.sml corrected?behav. in [x = -2, x = 4]";
120.845 +
120.846 +
120.847 +"-------------------- (3 - 10*x + 3*x^^^2 = 0), ----------------------";
120.848 +"-------------------- (3 - 10*x + 3*x^^^2 = 0), ----------------------";
120.849 +"-------------------- (3 - 10*x + 3*x^^^2 = 0), ----------------------";
120.850 +"---- test the erls ----";
120.851 + val t1 = (term_of o the o (parse thy)) "0 <= (10/3/2)^^^2 - 1";
120.852 + val Some (t,_) = rewrite_set_ PolyEq.thy false PolyEq_erls t1;
120.853 + val t' = term2str t;
120.854 + (*if t'= "True" then ()
120.855 + else raise error "polyeq.sml: diff.behav. in 'rewrite_set_.. PolyEq_erls";*)
120.856 +(* *)
120.857 + val fmz = ["equality (3 - 10*x + 3*x^^^2 = 0)",
120.858 + "solveFor x","solutions L"];
120.859 + val (dI',pI',mI') =
120.860 + ("PolyEq.thy",["degree_2","expanded","univariate","equation"],
120.861 + ["PolyEq","complete_square"]);
120.862 +(* val p = e_pos'; val c = [];
120.863 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.864 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.865 +
120.866 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.867 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.868 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.869 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.870 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.871 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.872 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.873 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.874 + (*Apply_Method ("PolyEq.thy","complete_square")*)
120.875 + val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
120.876 +
120.877 +"----------- (-16 + 4*x + 2*x^^^2 = 0), --------------------------";
120.878 +"----------- (-16 + 4*x + 2*x^^^2 = 0), --------------------------";
120.879 +"----------- (-16 + 4*x + 2*x^^^2 = 0), --------------------------";
120.880 + val fmz = ["equality (-16 + 4*x + 2*x^^^2 = 0)",
120.881 + "solveFor x","solutions L"];
120.882 + val (dI',pI',mI') =
120.883 + ("PolyEq.thy",["degree_2","expanded","univariate","equation"],
120.884 + ["PolyEq","complete_square"]);
120.885 +(* val p = e_pos'; val c = [];
120.886 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.887 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.888 +
120.889 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.890 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.891 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.892 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.893 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.894 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.895 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.896 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.897 + (*Apply_Method ("PolyEq.thy","complete_square")*)
120.898 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.899 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.900 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.901 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.902 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.903 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.904 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.905 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.906 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.907 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.908 +(* FIXXXXME n1.,
120.909 + case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -4]")) => () TODO
120.910 + | _ => raise error "polyeq.sml: diff.behav. in [x = 2, x = -4]";
120.911 +*)
120.912 +
120.913 +"----------- (a*b - (a+b)*x + x^^^2 = 0), (*Schalk 2,S.68Nr.44.a*)";
120.914 +"----------- (a*b - (a+b)*x + x^^^2 = 0), (*Schalk 2,S.68Nr.44.a*)";
120.915 +"----------- (a*b - (a+b)*x + x^^^2 = 0), (*Schalk 2,S.68Nr.44.a*)";
120.916 + val fmz = ["equality (a*b - (a+b)*x + x^^^2 = 0)",
120.917 + "solveFor x","solutions L"];
120.918 + val (dI',pI',mI') =
120.919 + ("PolyEq.thy",["degree_2","expanded","univariate","equation"],
120.920 + ["PolyEq","complete_square"]);
120.921 +(* val p = e_pos'; val c = [];
120.922 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.923 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.924 +
120.925 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.926 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.927 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.928 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.929 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.930 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.931 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.932 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.933 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.934 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.935 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.936 +
120.937 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.938 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.939 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.940 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.941 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.942 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.943 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.944 + val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
120.945 +(*WN.2.5.03 TODO FIXME Matthias ?
120.946 + case f of
120.947 + Form'
120.948 + (FormKF
120.949 + (~1,EdUndef,0,Nundef,
120.950 + "[x = (a + b) / 2 + -1 * sqrt ((a + b) ^^^ 2 / 2 ^^^ 2 - a * b),\n x = (a + b) / 2 + sqrt ((a + b) ^^^ 2 / 2 ^^^ 2 - a * b)]"))
120.951 + => ()
120.952 + | _ => raise error "polyeq.sml: diff.behav. in a*b - (a+b)*x + x^^^2 = 0";
120.953 + this will be simplified [x = a, x = b] to by Factor.ML*)
120.954 +
120.955 +
120.956 +"----------- (-64 + x^^^2 = 0), (*Schalk 2, S.66 Nr.1.a~--------*)";
120.957 +"----------- (-64 + x^^^2 = 0), (*Schalk 2, S.66 Nr.1.a~--------*)";
120.958 +"----------- (-64 + x^^^2 = 0), (*Schalk 2, S.66 Nr.1.a~--------*)";
120.959 + val fmz = ["equality (-64 + x^^^2 = 0)",(*Schalk 2, S.66 Nr.1.a~*)
120.960 + "solveFor x","solutions L"];
120.961 + val (dI',pI',mI') =
120.962 + ("PolyEq.thy",["degree_2","expanded","univariate","equation"],
120.963 + ["PolyEq","complete_square"]);
120.964 +(* val p = e_pos'; val c = [];
120.965 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.966 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.967 +
120.968 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.969 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.970 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.971 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.972 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.973 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.974 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.975 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.976 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.977 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.978 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.979 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.980 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.981 + val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
120.982 +(*WN.2.5.03 TODO "[x = sqrt (0 - -64), x = -1 * sqrt (0 - -64)]"
120.983 + case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 8, x = -8]")) => ()
120.984 + | _ => raise error "polyeq.sml: diff.behav. in [x = 8, x = -8]";
120.985 +*)
120.986 +
120.987 +"----------- (-147 + 3*x^^^2 = 0), (*Schalk 2, S.66 Nr.1.b------*)";
120.988 +"----------- (-147 + 3*x^^^2 = 0), (*Schalk 2, S.66 Nr.1.b------*)";
120.989 +"----------- (-147 + 3*x^^^2 = 0), (*Schalk 2, S.66 Nr.1.b------*)";
120.990 + val fmz = ["equality (-147 + 3*x^^^2 = 0)",(*Schalk 2, S.66 Nr.1.b*)
120.991 + "solveFor x","solutions L"];
120.992 + val (dI',pI',mI') =
120.993 + ("PolyEq.thy",["degree_2","expanded","univariate","equation"],
120.994 + ["PolyEq","complete_square"]);
120.995 +(* val p = e_pos'; val c = [];
120.996 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.997 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.998 +
120.999 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.1000 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1001 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1002 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1003 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1004 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1005 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1006 + val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1007 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
120.1008 +(*WN.2.5.03 TODO "[x = sqrt (0 - -49), x = -1 * sqrt (0 - -49)]"
120.1009 + case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 7, x = -7]")) => ()
120.1010 + | _ => raise error "polyeq.sml: diff.behav. in [x = 7, x = -7]";
120.1011 +*)
120.1012 +if f2str f = "[x = sqrt (0 - -49), x = -1 * sqrt (0 - -49)]" then ()
120.1013 +else raise error "polyeq.sml CORRECTED?behav. in [x = 7, x = -7]";
120.1014 +
120.1015 +
120.1016 +"----------- (3*x - 1 - (5*x - (2 - 4*x)) = -11),(*Schalk Is86Bsp5";
120.1017 +"----------- (3*x - 1 - (5*x - (2 - 4*x)) = -11),(*Schalk Is86Bsp5";
120.1018 +"----------- (3*x - 1 - (5*x - (2 - 4*x)) = -11),(*Schalk Is86Bsp5";
120.1019 +(*EP-17 Schalk_I_p86_n5*)
120.1020 +val fmz = ["equality (3*x - 1 - (5*x - (2 - 4*x)) = -11)","solveFor x","solutions L"];
120.1021 +(* refine fmz ["univariate","equation"];
120.1022 +*)
120.1023 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
120.1024 +(*val p = e_pos';
120.1025 +val c = [];
120.1026 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.1027 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.1028 +
120.1029 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.1030 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1031 +(* val nxt =
120.1032 + ("Model_Problem",
120.1033 + Model_Problem ["normalize","polynomial","univariate","equation"])
120.1034 + : string * tac*)
120.1035 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1036 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1037 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1038 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1039 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1040 +(* val nxt =
120.1041 + ("Subproblem",
120.1042 + Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))
120.1043 + : string * tac *)
120.1044 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1045 +(*val nxt =
120.1046 + ("Model_Problem",
120.1047 + Model_Problem ["degree_1","polynomial","univariate","equation"])
120.1048 + : string * tac *)
120.1049 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1050 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1051 +
120.1052 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1053 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1054 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1055 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1056 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1057 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2]")) => ()
120.1058 + | _ => raise error "polyeq.sml: diff.behav. in [x = 2]";
120.1059 +
120.1060 +
120.1061 +"----------- ((x+1)*(x+2) - (3*x - 2)^^^2=.. Schalk II s.68 Bsp 37";
120.1062 +"----------- ((x+1)*(x+2) - (3*x - 2)^^^2=.. Schalk II s.68 Bsp 37";
120.1063 +"----------- ((x+1)*(x+2) - (3*x - 2)^^^2=.. Schalk II s.68 Bsp 37";
120.1064 +(*is in rlang.sml, too*)
120.1065 +val fmz = ["equality ((x+1)*(x+2) - (3*x - 2)^^^2=(2*x - 1)^^^2+(3*x - 1)*(x+1))",
120.1066 + "solveFor x","solutions L"];
120.1067 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
120.1068 +
120.1069 +(*val p = e_pos'; val c = [];
120.1070 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.1071 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.1072 +
120.1073 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.1074 +(*val nxt = ("Refine_Tacitly",Refine_Tacitly ["univariate","equation"])*)
120.1075 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1076 +(* val nxt =
120.1077 + ("Model_Problem",
120.1078 + Model_Problem ["normalize","polynomial","univariate","equation"])
120.1079 + : string * tac *)
120.1080 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1081 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1082 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1083 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1084 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1085 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1086 +(* val nxt =
120.1087 + ("Subproblem",
120.1088 + Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))
120.1089 + : string * tac*)
120.1090 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1091 +(*val nxt =
120.1092 + ("Model_Problem",
120.1093 + Model_Problem ["abcFormula","degree_2","polynomial","univariate","equation"])
120.1094 + : string * tac*)
120.1095 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1096 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1097 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1098 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1099 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1100 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1101 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1102 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2 / 15, x = 1]")) => ()
120.1103 + | _ => raise error "polyeq.sml: diff.behav. in [x = 2 / 15, x = 1]";
120.1104 +
120.1105 +
120.1106 +" -4 + x^^^2 =0 ";
120.1107 +" -4 + x^^^2 =0 ";
120.1108 +" -4 + x^^^2 =0 ";
120.1109 +val fmz = ["equality ( -4 + x^^^2 =0)", "solveFor x","solutions L"];
120.1110 +(* val fmz = ["equality (1 + x^^^2 =0)", "solveFor x","solutions L"];*)
120.1111 +(*val fmz = ["equality (0 =0)", "solveFor x","solutions L"];*)
120.1112 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
120.1113 +(*val p = e_pos';
120.1114 +val c = [];
120.1115 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
120.1116 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
120.1117 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
120.1118 +
120.1119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1120 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1122 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1124 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
120.1126 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -2]")) => ()
120.1127 + | _ => raise error "polyeq.sml: diff.behav. in [x = 2, x = -2]";
120.1128 +
120.1129 +"----------------- polyeq.sml end ------------------";
120.1130 +
120.1131 +(*Punkte aus dem TestBericht, die ich in rlang.sml nicht zuordnen konnte:*)
120.1132 +(*WN.19.3.03 ---v-*)
120.1133 +(*3(b)*)val (bdv,v) = (str2term "bdv", str2term "R1");
120.1134 +val t = str2term "-1 * (R * R2) + R2 * R1 + -1 * (R * R1) = 0";
120.1135 +val Some (t',_) = rewrite_set_inst_ thy false [(bdv,v)] make_polynomial_in t;
120.1136 +term2str t';
120.1137 +"-1 * R * R2 + (R2 + -1 * R) * R1 = 0";
120.1138 +(*WN.19.3.03 ---^-*)
120.1139 +
120.1140 +(*3(c)*)val (bdv,v) = (str2term "bdv", str2term "p");
120.1141 +val t = str2term "y ^^^ 2 + -2 * (x * p) = 0";
120.1142 +val Some (t',_) = rewrite_set_inst_ thy false [(bdv,v)] make_polynomial_in t;
120.1143 +term2str t';
120.1144 +"y ^^^ 2 + -2 * x * p = 0";
120.1145 +
120.1146 +(*3(d)*)val (bdv,v) = (str2term "bdv", str2term "x2");
120.1147 +val t = str2term
120.1148 +"A + x1 * (y3 * (1 / 2)) + x3 * (y2 * (1 / 2)) + -1 * (x1 * (y2 * (1 / 2))) + -1 * (x3 * (y1 * (1 / 2 ))) + y1 * (1 / 2 * x2) + -1 * (y3 * (1 / 2 * x2)) = 0";
120.1149 +val Some (t',_) = rewrite_set_inst_ thy false [(bdv,v)] make_polynomial_in t;
120.1150 +term2str t';
120.1151 +"A + x1 * y3 * (1 / 2) + x3 * y2 * (1 / 2) + - x1 * y2 * (1 / 2) + - x3 * y1 * (1 / 2) + (y1 * (1 / 2) + - y3 * (1 / 2)) * x2 = 0";
120.1152 +val Some (t',_) = rewrite_set_inst_ thy false [(bdv,v)] make_ratpoly_in t;
120.1153 +term2str t';
120.1154 +"A + x1 * y3 * (1 / 2) + x3 * y2 * (1 / 2) + -1 * x1 * y2 * (1 / 2) + -1 * x3 * y1 * (1 / 2) + (y1 * (1 / 2) + -1 * y3 * (1 / 2)) * x2 = 0";
120.1155 +
120.1156 +(*3(e)*)val (bdv,v) = (str2term "bdv", str2term "a");
120.1157 +val t = str2term
120.1158 +"A ^^^ 2 + c ^^^ 2 * (c / d) ^^^ 2 + (-4 * (c / d) ^^^ 2) * a ^^^ 2 = 0";
120.1159 +val None = rewrite_set_inst_ thy false [(bdv,v)] make_polynomial_in t;
120.1160 +(*die _unsichtbare_ Klammern sind genau wie gew"unscht*)
120.1161 +
120.1162 +
120.1163 +val t = str2term "(x + 1) * (x + 2) - (3 * x - 2) ^^^ 2 - ((2 * x - 1) ^^^ 2 + (3 * x - 1) * (x + 1)) = 0";
120.1164 +trace_rewrite:=true;
120.1165 +rewrite_set_ thy false expand_binoms t;
120.1166 +trace_rewrite:=false;
120.1167 +
120.1168 +
120.1169 +"----------- interSteps ([1],Res); on Schalk Is86Bsp5-------------";
120.1170 +"----------- interSteps ([1],Res); on Schalk Is86Bsp5-------------";
120.1171 +"----------- interSteps ([1],Res); on Schalk Is86Bsp5-------------";
120.1172 +states:=[];
120.1173 +CalcTree
120.1174 +[(["equality (3*x - 1 - (5*x - (2 - 4*x)) = -11)","solveFor x","solutions L"],
120.1175 + ("PolyEq.thy",["univariate","equation"],["no_met"]))];
120.1176 +Iterator 1;
120.1177 +moveActiveRoot 1;
120.1178 +autoCalculate 1 CompleteCalc;
120.1179 +val ((pt,p),_) = get_calc 1; show_pt pt;
120.1180 +
120.1181 +interSteps 1 ([1],Res) (*no Rewrite_Set...*);
121.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
121.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/polyminus.sml Wed Jul 21 13:53:39 2010 +0200
121.3 @@ -0,0 +1,598 @@
121.4 +(* tests on PolyMinus
121.5 + author: Walther Neuper
121.6 + WN071207,
121.7 + (c) due to copyright terms
121.8 +
121.9 +use"../smltest/IsacKnowledge/polyminus.sml";
121.10 +use"polyminus.sml";
121.11 +*)
121.12 +val thy = PolyMinus.thy;
121.13 +
121.14 +"-----------------------------------------------------------------";
121.15 +"table of contents -----------------------------------------------";
121.16 +"-----------------------------------------------------------------";
121.17 +"----------- fun eval_ist_monom ----------------------------------";
121.18 +"----------- watch order_add_mult -------------------------------";
121.19 +"----------- build predicate for +- ordering ---------------------";
121.20 +"----------- build fasse_zusammen --------------------------------";
121.21 +"----------- build verschoenere ----------------------------------";
121.22 +"----------- met simplification for_polynomials with_minus -------";
121.23 +"----------- pbl polynom vereinfachen p.33 -----------------------";
121.24 +"----------- met probe fuer_polynom ------------------------------";
121.25 +"----------- pbl polynom probe -----------------------------------";
121.26 +"----------- pbl klammer polynom vereinfachen p.34 ---------------";
121.27 +"----------- try fun applyTactics --------------------------------";
121.28 +"----------- pbl binom polynom vereinfachen p.39 -----------------";
121.29 +"----------- pbl binom polynom vereinfachen: cube ----------------";
121.30 +"----------- refine Vereinfache ----------------------------------";
121.31 +"-----------------------------------------------------------------";
121.32 +"-----------------------------------------------------------------";
121.33 +"-----------------------------------------------------------------";
121.34 +
121.35 +
121.36 +"----------- fun eval_ist_monom ----------------------------------";
121.37 +"----------- fun eval_ist_monom ----------------------------------";
121.38 +"----------- fun eval_ist_monom ----------------------------------";
121.39 +ist_monom (str2term "12");
121.40 +case eval_ist_monom 0 0 (str2term "12 ist_monom") 0 of
121.41 + Some ("12 ist_monom = True", _) => ()
121.42 + | _ => raise error "polyminus.sml: 12 ist_monom = True";
121.43 +
121.44 +case eval_ist_monom 0 0 (str2term "a ist_monom") 0 of
121.45 + Some ("a ist_monom = True", _) => ()
121.46 + | _ => raise error "polyminus.sml: a ist_monom = True";
121.47 +
121.48 +case eval_ist_monom 0 0 (str2term "(3*a) ist_monom") 0 of
121.49 + Some ("3 * a ist_monom = True", _) => ()
121.50 + | _ => raise error "polyminus.sml: 3 * a ist_monom = True";
121.51 +
121.52 +case eval_ist_monom 0 0 (str2term "(a^^^2) ist_monom") 0 of
121.53 + Some ("a ^^^ 2 ist_monom = True", _) => ()
121.54 + | _ => raise error "polyminus.sml: a^^^2 ist_monom = True";
121.55 +
121.56 +case eval_ist_monom 0 0 (str2term "(3*a^^^2) ist_monom") 0 of
121.57 + Some ("3 * a ^^^ 2 ist_monom = True", _) => ()
121.58 + | _ => raise error "polyminus.sml: 3*a^^^2 ist_monom = True";
121.59 +
121.60 +case eval_ist_monom 0 0 (str2term "(a*b) ist_monom") 0 of
121.61 + Some ("a * b ist_monom = True", _) => ()
121.62 + | _ => raise error "polyminus.sml: a*b ist_monom = True";
121.63 +
121.64 +case eval_ist_monom 0 0 (str2term "(3*a*b) ist_monom") 0 of
121.65 + Some ("3 * a * b ist_monom = True", _) => ()
121.66 + | _ => raise error "polyminus.sml: 3*a*b ist_monom = True";
121.67 +
121.68 +
121.69 +"----------- watch order_add_mult -------------------------------";
121.70 +"----------- watch order_add_mult -------------------------------";
121.71 +"----------- watch order_add_mult -------------------------------";
121.72 +"----- with these simple variables it works...";
121.73 +trace_rewrite:=true;
121.74 +trace_rewrite:=false;
121.75 +val t = str2term "((a + d) + c) + b";
121.76 +val Some (t,_) = rewrite_set_ thy false order_add_mult t; term2str t;
121.77 +if term2str t = "a + (b + (c + d))" then ()
121.78 +else raise error "polyminus.sml 1 watch order_add_mult";
121.79 +trace_rewrite:=false;
121.80 +
121.81 +"----- the same stepwise...";
121.82 +val od = ord_make_polynomial true Poly.thy;
121.83 +val t = str2term "((a + d) + c) + b";
121.84 +"((a + d) + c) + b";
121.85 +val Some (t,_) = rewrite_ thy od e_rls true real_add_commute t; term2str t;
121.86 +"b + ((a + d) + c)";
121.87 +val Some (t,_) = rewrite_ thy od e_rls true real_add_commute t; term2str t;
121.88 +"b + (c + (a + d))";
121.89 +val Some (t,_) = rewrite_ thy od e_rls true real_add_left_commute t;term2str t;
121.90 +"b + (a + (c + d))";
121.91 +val Some (t,_) = rewrite_ thy od e_rls true real_add_left_commute t;term2str t;
121.92 +"a + (b + (c + d))";
121.93 +if term2str t = "a + (b + (c + d))" then ()
121.94 +else raise error "polyminus.sml 2 watch order_add_mult";
121.95 +
121.96 +"----- if parentheses are right, left_commute is (almost) sufficient...";
121.97 +val t = str2term "a + (d + (c + b))";
121.98 +"a + (d + (c + b))";
121.99 +val Some (t,_) = rewrite_ thy od e_rls true real_add_left_commute t;term2str t;
121.100 +"a + (c + (d + b))";
121.101 +val Some (t,_) = rewrite_ thy od e_rls true real_add_commute t;term2str t;
121.102 +"a + (c + (b + d))";
121.103 +val Some (t,_) = rewrite_ thy od e_rls true real_add_left_commute t;term2str t;
121.104 +"a + (b + (c + d))";
121.105 +
121.106 +"----- but we do not want the parentheses at right; thus: cond.rew.";
121.107 +"WN0712707 complicated monomials do not yet work ...";
121.108 +val t = str2term "((5*a + 4*d) + 3*c) + 2*b";
121.109 +val Some (t,_) = rewrite_set_ thy false order_add_mult t; term2str t;
121.110 +if term2str t = "2 * b + (3 * c + (4 * d + 5 * a))" then ()
121.111 +else raise error "polyminus.sml: order_add_mult changed";
121.112 +
121.113 +"----- here we see rew_sub going into subterm with ord.rew....";
121.114 +val od = ord_make_polynomial false Poly.thy;
121.115 +val t = str2term "b + a + c + d";
121.116 +val Some (t,_) = rewrite_ thy od e_rls false real_add_commute t; term2str t;
121.117 +val Some (t,_) = rewrite_ thy od e_rls false real_add_commute t; term2str t;
121.118 +(*@@@ rew_sub gosub: t = d + (b + a + c)
121.119 + @@@ rew_sub begin: t = b + a + c*)
121.120 +
121.121 +
121.122 +"----------- build predicate for +- ordering ---------------------";
121.123 +"----------- build predicate for +- ordering ---------------------";
121.124 +"----------- build predicate for +- ordering ---------------------";
121.125 +"a" < "b";
121.126 +"ba" < "ab";
121.127 +"123" < "a"; (*unused due to ---vvv*)
121.128 +"12" < "3"; (*true !!!*)
121.129 +
121.130 +" a kleiner b ==> (b + a) = (a + b)";
121.131 +str2term "aaa";
121.132 +str2term "222 * aaa";
121.133 +(*
121.134 +case eval_kleiner 0 0 (str2term "123 kleiner 32") 0 of
121.135 + Some ("12 kleiner 9 = False", _) => ()
121.136 + | _ => raise error "polyminus.sml: 12 kleiner 9 = False";
121.137 +*)
121.138 +case eval_kleiner 0 0 (str2term "a kleiner b") 0 of
121.139 + Some ("a kleiner b = True", _) => ()
121.140 + | _ => raise error "polyminus.sml: a kleiner b = True";
121.141 +
121.142 +case eval_kleiner 0 0 (str2term "(10*g) kleiner f") 0 of
121.143 + Some ("10 * g kleiner f = False", _) => ()
121.144 + | _ => raise error "polyminus.sml: 10 * g kleiner f = False";
121.145 +
121.146 +case eval_kleiner 0 0 (str2term "(a^^^2) kleiner b") 0 of
121.147 + Some ("a ^^^ 2 kleiner b = True", _) => ()
121.148 + | _ => raise error "polyminus.sml: a ^^^ 2 kleiner b = True";
121.149 +
121.150 +case eval_kleiner 0 0 (str2term "(3*a^^^2) kleiner b") 0 of
121.151 + Some ("3 * a ^^^ 2 kleiner b = True", _) => ()
121.152 + | _ => raise error "polyminus.sml: 3 * a ^^^ 2 kleiner b = True";
121.153 +
121.154 +case eval_kleiner 0 0 (str2term "(a*b) kleiner c") 0 of
121.155 + Some ("a * b kleiner c = True", _) => ()
121.156 + | _ => raise error "polyminus.sml: a * b kleiner b = True";
121.157 +
121.158 +case eval_kleiner 0 0 (str2term "(3*a*b) kleiner c") 0 of
121.159 + Some ("3 * a * b kleiner c = True", _) => ()
121.160 + | _ => raise error "polyminus.sml: 3 * a * b kleiner b = True";
121.161 +
121.162 +
121.163 +
121.164 +"----- compare tausche_plus with real_num_collect";
121.165 +val od = dummy_ord;
121.166 +
121.167 +val erls = erls_ordne_alphabetisch;
121.168 +val t = str2term "b + a";
121.169 +val Some (t,_) = rewrite_ thy od erls false tausche_plus t; term2str t;
121.170 +if term2str t = "a + b" then ()
121.171 +else raise error "polyminus.sml: ordne_alphabetisch1 b + a";
121.172 +
121.173 +val erls = Atools_erls;
121.174 +val t = str2term "2*a + 3*a";
121.175 +val Some (t,_) = rewrite_ thy od erls false real_num_collect t; term2str t;
121.176 +
121.177 +"----- test rewrite_, rewrite_set_";
121.178 +trace_rewrite:=true;
121.179 +val erls = erls_ordne_alphabetisch;
121.180 +val t = str2term "b + a";
121.181 +val Some (t,_) = rewrite_set_ thy false ordne_alphabetisch t; term2str t;
121.182 +if term2str t = "a + b" then ()
121.183 +else raise error "polyminus.sml: ordne_alphabetisch a + b";
121.184 +
121.185 +val t = str2term "2*b + a";
121.186 +val Some (t,_) = rewrite_set_ thy false ordne_alphabetisch t; term2str t;
121.187 +if term2str t = "a + 2 * b" then ()
121.188 +else raise error "polyminus.sml: ordne_alphabetisch a + 2 * b";
121.189 +
121.190 +val t = str2term "a + c + b";
121.191 +val Some (t,_) = rewrite_set_ thy false ordne_alphabetisch t; term2str t;
121.192 +if term2str t = "a + b + c" then ()
121.193 +else raise error "polyminus.sml: ordne_alphabetisch a + b + c";
121.194 +
121.195 +"----- rewrite goes into subterms";
121.196 +val t = str2term "a + c + b + d";
121.197 +val Some (t,_) = rewrite_ thy od erls false tausche_plus_plus t; term2str t;
121.198 +if term2str t = "a + b + c + d" then ()
121.199 +else raise error "polyminus.sml: ordne_alphabetisch1 a + b + c + d";
121.200 +
121.201 +val t = str2term "a + c + d + b";
121.202 +val Some (t,_) = rewrite_set_ thy false ordne_alphabetisch t; term2str t;
121.203 +if term2str t = "a + b + c + d" then ()
121.204 +else raise error "polyminus.sml: ordne_alphabetisch2 a + b + c + d";
121.205 +
121.206 +"----- here we see rew_sub going into subterm with cond.rew....";
121.207 +val t = str2term "b + a + c + d";
121.208 +val Some (t,_) = rewrite_ thy od erls false tausche_plus t; term2str t;
121.209 +if term2str t = "a + b + c + d" then ()
121.210 +else raise error "polyminus.sml: ordne_alphabetisch3 a + b + c + d";
121.211 +
121.212 +"----- compile rls for the most complicated terms";
121.213 +val t = str2term "5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12";
121.214 +"5 * e + 6 * f - 8 * g - 9 - 7 * e - 4 * f + 10 * g + 12";
121.215 +val Some (t,_) = rewrite_set_ thy false ordne_alphabetisch t;
121.216 +if term2str t = "- 9 + 12 + 5 * e - 7 * e + 6 * f - 4 * f - 8 * g + 10 * g"
121.217 +then () else raise error "polyminus.sml: ordne_alphabetisch finished";
121.218 +
121.219 +
121.220 +"----------- build fasse_zusammen --------------------------------";
121.221 +"----------- build fasse_zusammen --------------------------------";
121.222 +"----------- build fasse_zusammen --------------------------------";
121.223 +val t = str2term "- 9 + 12 + 5 * e - 7 * e + 6 * f - 4 * f - 8 * g + 10 * g";
121.224 +val Some (t,_) = rewrite_set_ thy false fasse_zusammen t;
121.225 +if term2str t = "3 + -2 * e + 2 * f + 2 * g" then ()
121.226 +else raise error "polyminus.sml: fasse_zusammen finished";
121.227 +
121.228 +"----------- build verschoenere ----------------------------------";
121.229 +"----------- build verschoenere ----------------------------------";
121.230 +"----------- build verschoenere ----------------------------------";
121.231 +val t = str2term "3 + -2 * e + 2 * f + 2 * g";
121.232 +val Some (t,_) = rewrite_set_ thy false verschoenere t;
121.233 +if term2str t = "3 - 2 * e + 2 * f + 2 * g" then ()
121.234 +else raise error "polyminus.sml: verschoenere 3 + -2 * e ...";
121.235 +
121.236 +trace_rewrite:=true;
121.237 +trace_rewrite:=false;
121.238 +
121.239 +"----------- met simplification for_polynomials with_minus -------";
121.240 +"----------- met simplification for_polynomials with_minus -------";
121.241 +"----------- met simplification for_polynomials with_minus -------";
121.242 +val str =
121.243 +"Script SimplifyScript (t_::real) = \
121.244 +\ (((Try (Rewrite_Set ordne_alphabetisch False)) @@ \
121.245 +\ (Try (Rewrite_Set fasse_zusammen False)) @@ \
121.246 +\ (Try (Rewrite_Set verschoenere False))) t_)"
121.247 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
121.248 +atomty sc;
121.249 +
121.250 +
121.251 +"----------- pbl polynom vereinfachen p.33 -----------------------";
121.252 +"----------- pbl polynom vereinfachen p.33 -----------------------";
121.253 +"----------- pbl polynom vereinfachen p.33 -----------------------";
121.254 +"----------- 140 c ---";
121.255 +states:=[];
121.256 +CalcTree [(["term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
121.257 + "normalform N"],
121.258 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.259 + ["simplification","for_polynomials","with_minus"]))];
121.260 +moveActiveRoot 1;
121.261 +autoCalculate 1 CompleteCalc;
121.262 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.263 +if p = ([], Res) andalso
121.264 + term2str (get_obj g_res pt (fst p)) = "3 - 2 * e + 2 * f + 2 * g"
121.265 +then () else raise error "polyminus.sml: Vereinfache (3 - 2 * e + 2 * f...";
121.266 +
121.267 +"----------- 140 d ---";
121.268 +states:=[];
121.269 +CalcTree [(["term (-r - 2*s - 3*t + 5 + 4*r + 8*s - 5*t - 2)",
121.270 + "normalform N"],
121.271 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.272 + ["simplification","for_polynomials","with_minus"]))];
121.273 +moveActiveRoot 1;
121.274 +autoCalculate 1 CompleteCalc;
121.275 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.276 +if p = ([], Res) andalso
121.277 + term2str (get_obj g_res pt (fst p)) = "3 + 3 * r + 6 * s - 8 * t"
121.278 +then () else raise error "polyminus.sml: Vereinfache 140 d)";
121.279 +
121.280 +
121.281 +"----------- 139 c ---";
121.282 +states:=[];
121.283 +CalcTree [(["term (3*e - 6*f - 8*e - 4*f + 5*e + 7*f)",
121.284 + "normalform N"],
121.285 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.286 + ["simplification","for_polynomials","with_minus"]))];
121.287 +moveActiveRoot 1;
121.288 +autoCalculate 1 CompleteCalc;
121.289 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.290 +if p = ([], Res) andalso
121.291 + term2str (get_obj g_res pt (fst p)) = "- (3 * f)"
121.292 +then () else raise error "polyminus.sml: Vereinfache 139 c)";
121.293 +
121.294 +"----------- 139 b ---";
121.295 +states:=[];
121.296 +CalcTree [(["term (8*u - 5*v - 5*u + 7*v - 6*u - 3*v)",
121.297 + "normalform N"],
121.298 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.299 + ["simplification","for_polynomials","with_minus"]))];
121.300 +moveActiveRoot 1;
121.301 +autoCalculate 1 CompleteCalc;
121.302 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.303 +if p = ([], Res) andalso
121.304 + term2str (get_obj g_res pt (fst p)) = "-3 * u - v"
121.305 +then () else raise error "polyminus.sml: Vereinfache 139 b)";
121.306 +
121.307 +"----------- 138 a ---";
121.308 +states:=[];
121.309 +CalcTree [(["term (2*u - 3*v - 6*u + 5*v)",
121.310 + "normalform N"],
121.311 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.312 + ["simplification","for_polynomials","with_minus"]))];
121.313 +moveActiveRoot 1;
121.314 +autoCalculate 1 CompleteCalc;
121.315 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.316 +if p = ([], Res) andalso
121.317 + term2str (get_obj g_res pt (fst p)) = "-4 * u + 2 * v"
121.318 +then () else raise error "polyminus.sml: Vereinfache 138 a)";
121.319 +
121.320 +
121.321 +"----------- met probe fuer_polynom ------------------------------";
121.322 +"----------- met probe fuer_polynom ------------------------------";
121.323 +"----------- met probe fuer_polynom ------------------------------";
121.324 +val str =
121.325 +"Script ProbeScript (e_::bool) (ws_::bool list) =\
121.326 +\ (let e_ = Take e_; \
121.327 +\ e_ = Substitute ws_ e_ \
121.328 +\ in (Repeat((Try (Repeat (Calculate times))) @@ \
121.329 +\ (Try (Repeat (Calculate plus ))) @@ \
121.330 +\ (Try (Repeat (Calculate minus))))) e_)"
121.331 +val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
121.332 +atomty sc;
121.333 +
121.334 +
121.335 +"----------- pbl polynom probe -----------------------------------";
121.336 +"----------- pbl polynom probe -----------------------------------";
121.337 +"----------- pbl polynom probe -----------------------------------";
121.338 +states:=[];
121.339 +CalcTree [(["Pruefe (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12 =\
121.340 + \3 - 2 * e + 2 * f + 2 * g)",
121.341 + "mitWert [e = 1, f = 2, g = 3]",
121.342 + "Geprueft b"],
121.343 + ("PolyMinus.thy",["polynom","probe"],
121.344 + ["probe","fuer_polynom"]))];
121.345 +moveActiveRoot 1;
121.346 +autoCalculate 1 CompleteCalc;
121.347 +(* autoCalculate 1 CompleteCalcHead;
121.348 + autoCalculate 1 (Step 1);
121.349 + autoCalculate 1 (Step 1);
121.350 + val ((pt,p),_) = get_calc 1; term2str (get_obj g_res pt (fst p));
121.351 +@@@@@WN081114 gives "??.empty", all "Pruefe" are the same,
121.352 +although analogies work in interface.sml: FIXME.WN081114 in "Pruefe"*)
121.353 +val ((pt,p),_) = get_calc 1;
121.354 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "11 = 11"
121.355 +then () else raise error "polyminus.sml: Probe 11 = 11";
121.356 +show_pt pt;
121.357 +
121.358 +
121.359 +"----------- pbl klammer polynom vereinfachen p.34 ---------------";
121.360 +"----------- pbl klammer polynom vereinfachen p.34 ---------------";
121.361 +"----------- pbl klammer polynom vereinfachen p.34 ---------------";
121.362 +states:=[];
121.363 +CalcTree [(["term (2*u - 5 - (3 - 4*u) + (8*u + 9))",
121.364 + "normalform N"],
121.365 + ("PolyMinus.thy",["klammer","polynom","vereinfachen"],
121.366 + ["simplification","for_polynomials","with_parentheses"]))];
121.367 +moveActiveRoot 1;
121.368 +autoCalculate 1 CompleteCalc;
121.369 +val ((pt,p),_) = get_calc 1;
121.370 +if p = ([], Res) andalso
121.371 + term2str (get_obj g_res pt (fst p)) = "1 + 14 * u"
121.372 +then () else raise error "polyminus.sml: Vereinfache (2*u - 5 - (3 - ...";
121.373 +show_pt pt;
121.374 +
121.375 +"----- probe p.34 -----";
121.376 +states:=[];
121.377 +CalcTree [(["Pruefe (2*u - 5 - (3 - 4*u) + (8*u + 9) = 1 + 14 * u)",
121.378 + "mitWert [u = 2]",
121.379 + "Geprueft b"],
121.380 + ("PolyMinus.thy",["polynom","probe"],
121.381 + ["probe","fuer_polynom"]))];
121.382 +moveActiveRoot 1;
121.383 +autoCalculate 1 CompleteCalc;
121.384 +val ((pt,p),_) = get_calc 1;
121.385 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "29 = 29"
121.386 +then () else raise error "polyminus.sml: Probe 29 = 29";
121.387 +show_pt pt;
121.388 +
121.389 +
121.390 +"----------- try fun applyTactics --------------------------------";
121.391 +"----------- try fun applyTactics --------------------------------";
121.392 +"----------- try fun applyTactics --------------------------------";
121.393 +states:=[];
121.394 +CalcTree [(["term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
121.395 + "normalform N"],
121.396 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.397 + ["simplification","for_polynomials","with_minus"]))];
121.398 +moveActiveRoot 1;
121.399 +autoCalculate 1 CompleteCalcHead;
121.400 +autoCalculate 1 (Step 1);
121.401 +autoCalculate 1 (Step 1);
121.402 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.403 +"----- 1 ^^^";
121.404 +fetchApplicableTactics 1 0 p;
121.405 +val appltacs = sel_appl_atomic_tacs pt p;
121.406 +applyTactic 1 p (hd appltacs) (*addiere_x_plus_minus*);
121.407 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.408 +"----- 2 ^^^";
121.409 +trace_rewrite := true;
121.410 +val erls = erls_ordne_alphabetisch;
121.411 +val t = str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
121.412 +val Some (t',_) =
121.413 + rewrite_ Isac.thy e_rew_ord erls false tausche_minus t;
121.414 +term2str t'; "- 9 + 12 + 5 * e - 7 * e + (- 4 + 6) * f - 8 * g + 10 * g";
121.415 +
121.416 +val t = str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
121.417 +val None =
121.418 + rewrite_ Isac.thy e_rew_ord erls false tausche_minus_plus t;
121.419 +
121.420 +val t = str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
121.421 +val Some (t',_) =
121.422 + rewrite_set_ Isac.thy false ordne_alphabetisch t;
121.423 +term2str t'; "- 9 + 12 + 5 * e - 7 * e - 8 * g + 10 * g + (- 4 + 6) * f";
121.424 +trace_rewrite := false;
121.425 +
121.426 +
121.427 +applyTactic 1 p (hd (sel_appl_atomic_tacs pt p)) (*tausche_minus*);
121.428 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.429 +"----- 3 ^^^";
121.430 +applyTactic 1 p (hd (sel_appl_atomic_tacs pt p)) (**);
121.431 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.432 +"----- 4 ^^^";
121.433 +applyTactic 1 p (hd (sel_appl_atomic_tacs pt p)) (**);
121.434 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.435 +"----- 5 ^^^";
121.436 +applyTactic 1 p (hd (sel_appl_atomic_tacs pt p)) (**);
121.437 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.438 +"----- 6 ^^^";
121.439 +
121.440 +(*<CALCMESSAGE> failure </CALCMESSAGE>
121.441 +applyTactic 1 p (hd (sel_appl_atomic_tacs pt p)) (**);
121.442 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.443 +"----- 7 ^^^";
121.444 +*)
121.445 +
121.446 +autoCalculate 1 CompleteCalc;
121.447 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.448 +(*independent from failure above: met_simp_poly_minus not confluent:
121.449 +(([9], Res), - (8 * g) + 10 * g + (3 - 2 * e + 2 * f)),
121.450 +(([], Res), - (8 * g) + 10 * g + (3 - 2 * e + 2 * f))]
121.451 +~~~~~~~~~~~###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
121.452 +
121.453 +states:=[];
121.454 +CalcTree [(["term (- (8 * g) + 10 * g + h)",
121.455 + "normalform N"],
121.456 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.457 + ["simplification","for_polynomials","with_minus"]))];
121.458 +moveActiveRoot 1;
121.459 +autoCalculate 1 CompleteCalc;
121.460 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.461 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "2 * g + h"
121.462 +then () else raise error "polyminus.sml: addiere_vor_minus";
121.463 +
121.464 +
121.465 +states:=[];
121.466 +CalcTree [(["term (- (8 * g) + 10 * g + f)",
121.467 + "normalform N"],
121.468 + ("PolyMinus.thy",["plus_minus","polynom","vereinfachen"],
121.469 + ["simplification","for_polynomials","with_minus"]))];
121.470 +moveActiveRoot 1;
121.471 +autoCalculate 1 CompleteCalc;
121.472 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.473 +if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "f + 2 * g"
121.474 +then () else raise error "polyminus.sml: tausche_vor_plus";
121.475 +
121.476 +
121.477 +"----------- pbl binom polynom vereinfachen p.39 -----------------";
121.478 +"----------- pbl binom polynom vereinfachen p.39 -----------------";
121.479 +"----------- pbl binom polynom vereinfachen p.39 -----------------";
121.480 +val rls = klammern_ausmultiplizieren;
121.481 +val t = str2term "(3 * a + 2) * (4 * a - 1)";
121.482 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.483 +"3 * a * (4 * a) - 3 * a * 1 + (2 * (4 * a) - 2 * 1)";
121.484 +val rls = discard_parentheses;
121.485 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.486 +"3 * a * 4 * a - 3 * a * 1 + (2 * 4 * a - 2 * 1)";
121.487 +val rls = ordne_monome;
121.488 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.489 +"3 * 4 * a * a - 1 * 3 * a + (2 * 4 * a - 1 * 2)";
121.490 +(*
121.491 +val t = str2term "3 * a * 4 * a";
121.492 +val rls = ordne_monome;
121.493 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.494 +*)
121.495 +val rls = klammern_aufloesen;
121.496 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.497 +"3 * 4 * a * a - 1 * 3 * a + 2 * 4 * a - 1 * 2";
121.498 +val rls = ordne_alphabetisch;
121.499 +(*TODO: make is_monom more general, a*a=a^2, ...*)
121.500 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.501 +"3 * 4 * a * a - 1 * 2 - 1 * 3 * a + 2 * 4 * a";
121.502 +(*GOON.WN080104
121.503 +val rls = fasse_zusammen;
121.504 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.505 +val rls = verschoenere;
121.506 +val Some (t,_) = rewrite_set_ thy false rls t; term2str t;
121.507 +*)
121.508 +
121.509 +
121.510 +trace_rewrite := true;
121.511 +trace_rewrite := false;
121.512 +
121.513 +(*@@@@@@@*)
121.514 +states:=[];
121.515 +CalcTree [(["term ((3*a + 2) * (4*a - 1))",
121.516 + "normalform N"],
121.517 + ("PolyMinus.thy",["binom_klammer","polynom","vereinfachen"],
121.518 + ["simplification","for_polynomials","with_parentheses_mult"]))];
121.519 +moveActiveRoot 1;
121.520 +autoCalculate 1 CompleteCalc;
121.521 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.522 +
121.523 +(*
121.524 +if p = ([], Res) andalso
121.525 + term2str (get_obj g_res pt (fst p)) = "1 + 14 * u"
121.526 +then () else raise error "polyminus.sml: Vereinfache (2*u - 5 - (3 - ...";
121.527 +*)
121.528 +
121.529 +
121.530 +"----------- pbl binom polynom vereinfachen: cube ----------------";
121.531 +"----------- pbl binom polynom vereinfachen: cube ----------------";
121.532 +"----------- pbl binom polynom vereinfachen: cube ----------------";
121.533 +states:=[];
121.534 +CalcTree [(["term (8*(a - q) + a - 2*q + 3*(a - 2*q))",
121.535 + "normalform N"],
121.536 + ("PolyMinus.thy",["binom_klammer","polynom","vereinfachen"],
121.537 + ["simplification","for_polynomials","with_parentheses_mult"]))];
121.538 +moveActiveRoot 1;
121.539 +autoCalculate 1 CompleteCalc;
121.540 +val ((pt,p),_) = get_calc 1; show_pt pt;
121.541 +
121.542 +
121.543 +"----------- refine Vereinfache ----------------------------------";
121.544 +"----------- refine Vereinfache ----------------------------------";
121.545 +"----------- refine Vereinfache ----------------------------------";
121.546 +val fmz = ["term (8*(a - q) + a - 2*q + 3*(a - 2*q))",
121.547 + "normalform N"];
121.548 +print_depth 11;
121.549 +val matches = refine fmz ["vereinfachen"];
121.550 +print_depth 3;
121.551 +
121.552 +"----- go into details, if it seems not to work -----";
121.553 +"--- does the predicate evaluate correctly ?";
121.554 +val t = str2term
121.555 + "matchsub (?a * (?b - ?c)) (8 * (a - q) + a - 2 * q + \
121.556 + \3 * (a - 2 * q))";
121.557 +val ma = eval_matchsub "" "Tools.matchsub" t thy;
121.558 +case ma of
121.559 + Some ("matchsub (?a * (?b - ?c)) (8 * (a - q) + \
121.560 + \a - 2 * q + 3 * (a - 2 * q)) = True", _) => ()
121.561 + | _ => raise error "polyminus.sml matchsub (?a * (?b - ?c)...A";
121.562 +
121.563 +"--- does the respective prls rewrite ?";
121.564 +val prls = append_rls "prls_pbl_vereinf_poly" e_rls
121.565 + [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
121.566 + Calc ("Tools.matchsub", eval_matchsub ""),
121.567 + Thm ("or_true",or_true),
121.568 + (*"(?a | True) = True"*)
121.569 + Thm ("or_false",or_false),
121.570 + (*"(?a | False) = ?a"*)
121.571 + Thm ("not_true",num_str not_true),
121.572 + (*"(~ True) = False"*)
121.573 + Thm ("not_false",num_str not_false)
121.574 + (*"(~ False) = True"*)];
121.575 +trace_rewrite := true;
121.576 +val Some (t', _) = rewrite_set_ thy false prls t;
121.577 +trace_rewrite := false;
121.578 +
121.579 +"--- does the respective prls rewrite the whole predicate ?";
121.580 +val t = str2term
121.581 + "Not (matchsub (?a * (?b + ?c)) (8 * (a - q) + a - 2 * q) | \
121.582 + \ matchsub (?a * (?b - ?c)) (8 * (a - q) + a - 2 * q) | \
121.583 + \ matchsub ((?b + ?c) * ?a) (8 * (a - q) + a - 2 * q) | \
121.584 + \ matchsub ((?b - ?c) * ?a) (8 * (a - q) + a - 2 * q) )";
121.585 +trace_rewrite := true;
121.586 +val Some (t', _) = rewrite_set_ thy false prls t;
121.587 +trace_rewrite := false;
121.588 +if term2str t' = "False" then ()
121.589 +else raise error "polyminus.sml Not (matchsub (?a * (?b + ?c)) (8 ...";
121.590 +
121.591 +
121.592 +
121.593 +
121.594 +
121.595 +
121.596 +
121.597 +
121.598 +(*
121.599 +use"../smltest/IsacKnowledge/polyminus.sml";
121.600 +use"polyminus.sml";
121.601 + *)
122.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
122.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/rateq.sml Wed Jul 21 13:53:39 2010 +0200
122.3 @@ -0,0 +1,145 @@
122.4 +(* RL 09.02
122.5 + testexamples for RatEq, equations with fractions
122.6 +
122.7 + Compiler.Control.Print.printDepth:=10; (*4 default*)
122.8 + Compiler.Control.Print.printDepth:=5; (*4 default*)
122.9 + trace_rewrite:=true;
122.10 +
122.11 + use"kbtest/rateq.sml";
122.12 + *)
122.13 +"----------- rateq.sml begin--------";
122.14 +"---------(1/x=5) ---------------------";
122.15 +"--------- S.68, Bsp.: 40, ((x)/(x - 8) + (x - 8)/(x) = 26/5)---------------------";
122.16 +
122.17 +val t = (term_of o the o (parse RatEq.thy)) "(1/b+1/x=1) is_ratequation_in x";
122.18 +val Some(t_, _) = rewrite_set_ RatEq.thy false RatEq_prls t;
122.19 +val result = term2str t_;
122.20 +if result <> "True" then raise error "rateq.sml: new behaviour 1:" else ();
122.21 +
122.22 +val t = (term_of o the o (parse RatEq.thy)) "(sqrt(x)=1) is_ratequation_in x";
122.23 +val Some(t_, _) = rewrite_set_ RatEq.thy false RatEq_prls t;
122.24 +val result = term2str t_;
122.25 +if result <> "False" then raise error "rateq.sml: new behaviour 2:" else ();
122.26 +
122.27 +val t = (term_of o the o (parse RatEq.thy)) "(x=-1) is_ratequation_in x";
122.28 +val Some(t_,_) = rewrite_set_ RatEq.thy false RatEq_prls t;
122.29 +val result = term2str t_;
122.30 +if result <> "False" then raise error "rateq.sml: new behaviour 3:" else ();
122.31 +
122.32 +val t = (term_of o the o (parse RatEq.thy)) "(3 + x^^^2 + 1/(x^^^2+3)=1) is_ratequation_in x";
122.33 +val Some(t_,_) = rewrite_set_ RatEq.thy false RatEq_prls t;
122.34 +val result = term2str t_;
122.35 +if result <> "True" then raise error "rateq.sml: new behaviour 4:" else ();
122.36 +
122.37 +val result = match_pbl ["equality (x=1)","solveFor x","solutions L"]
122.38 + (get_pbt ["rational","univariate","equation"]);
122.39 +case result of NoMatch' _ => () | _ => raise error "rateq.sml: new behaviour: 5";
122.40 +
122.41 +val result = match_pbl ["equality (3 + x^^^2 + 1/(x^^^2+3)=1)","solveFor x","solutions L"]
122.42 + (get_pbt ["rational","univariate","equation"]);
122.43 +case result of Matches' _ => () | _ => raise error "rateq.sml: new behaviour: 6";
122.44 +
122.45 +
122.46 +(*---------rateq---- 23.8.02 ---------------------*)
122.47 +"---------(1/x=5) ---------------------";
122.48 +val fmz = ["equality (1/x=5)","solveFor x","solutions L"];
122.49 +(* refine fmz ["univariate","equation"];
122.50 + *)
122.51 +
122.52 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
122.53 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
122.54 +(* val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.55 + --------------------------------------- Refine_Tacitly*)
122.56 +(* nxt = ("Model_Problem",Model_Problem ["rational","univariate","equation"]) *)
122.57 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.58 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.59 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.60 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.61 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.62 +(* val nxt = ("Subproblem",Subproblem ("RatEq.thy",["univariate","equation"])*)
122.63 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.64 +(* val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.65 + --------------------------------------- Refine_Tacitly*)
122.66 +(*val nxt = ("Model_Problem", Model_Problem ["normalize","polynomial","univariate","equation"])*)
122.67 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.68 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.69 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.70 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.71 +(*val nxt = Apply_Method ["PolyEq", "normalize_poly"])*)
122.72 +
122.73 +(* get_obj g_fmz pt [2];
122.74 + *)
122.75 +
122.76 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.77 +(**** assoc_thm': 'all_left' not in 'RatEq.thy' (and parents)*)
122.78 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.79 +(* val nxt = ("Subproblem", Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
122.80 +
122.81 +
122.82 +
122.83 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.84 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.85 +(* ("Model_Problem", Model_Problem ["degree_1","polynomial","univariate","equation"])*)
122.86 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.87 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.88 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.89 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.90 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.91 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.92 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.93 +(* "x = 1 / 5" *)
122.94 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.95 +if mout2str(f) = "Form' FormKF (~1,EdUndef,0,Nundef,([x = 1 / 5])" then ()
122.96 +else raise error "rateq.sml: new behaviour: [x = 1 / 5]";
122.97 +
122.98 +
122.99 +
122.100 +(*---------((x)/(x - 8) + (x - 8)/(x) = 26/5)---------------------*)
122.101 +"--------- S.68, Bsp.: 40, ((x)/(x - 8) + (x - 8)/(x) = 26/5)---------------------";
122.102 +(*EP Schalk_II_p68_n40*)
122.103 +val fmz = ["equality ((x)/(x - 8) + (x - 8)/(x) = 26/5)","solveFor x","solutions L"];
122.104 +(* val fmz = ["equality (3+x= 9*x^^^4+((1+2*x)/x^^^2)^^^2 + 6*(x^^^2*((1+2*x)/x^^^2)))",
122.105 + "solveFor x","solutions L"];*)
122.106 +
122.107 +(* refine fmz ["univariate","equation"];
122.108 +*)
122.109 +
122.110 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
122.111 +(*val p = e_pos';
122.112 +val c = [];
122.113 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
122.114 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
122.115 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
122.116 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.117 +(* nxt = ("Model_Problem",Model_Problem ["rational","univariate","equation"])*)
122.118 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.120 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.122 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.124 +(* nxt = ("Subproblem",Subproblem ("RatEq.thy",["univariate","equation"]))*)
122.125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.126 +(* nxt = ("Model_Problem", Model_Problem ["normalize","polynomial","univariate","equation"])*)
122.127 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.128 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.129 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.130 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.131 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.132 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.133 +(* ("Subproblem", Subproblem ("PolyEq.thy",["polynomial","univariate","equation"])) *)
122.134 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.135 +(* nxt = ("Model_Problem", Model_Problem
122.136 + ["abcFormula","degree_2","polynomial","univariate","equation"])*)
122.137 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.138 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.139 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.140 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.141 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.142 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.143 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
122.144 +(* "x = -2, x = 10" *)
122.145 +if mout2str(f) = "Form' FormKF (~1,EdUndef,0,Nundef,([x = -2, x = 10])" then()
122.146 +else raise error "rateq.sml: new behaviour: [x = -2, x = 10]";
122.147 +
122.148 +"----------- rateq.sml end--------";
123.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
123.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/rational-old.sml Wed Jul 21 13:53:39 2010 +0200
123.3 @@ -0,0 +1,902 @@
123.4 +(* tests for rationals
123.5 + Stefan Karnel
123.6 + 2002
123.7 + use"../kbtest/rational.sml";
123.8 + use"kbtest/rational.sml";
123.9 + use"rational.sml";
123.10 +*)
123.11 +
123.12 +(*--------------------------------15.10.02---
123.13 +(* tests*)
123.14 +print("\n\n********************* tests *************************\n\n");
123.15 +print("\n\n***** divide tests *****\n");
123.16 +val mv_pquot1 = (#1(mv_division([(1,[1,1,1]),(1,[1,1,0]),(1,[1,0,1]),(1,[0,0,0])],[(1,[1,1,0]),(1,[0,0,0])],LEX_)));
123.17 +(* result: [(1,[0,0,1]),(1,[0,0,0])] *)
123.18 +if mv_pquot1=[(1,[0,0,1]),(1,[0,0,0])] then () else raise error ("Test failed");
123.19 +
123.20 +val mv_prest1 = (#2(mv_division([(1,[1,1,1]),(1,[1,1,0]),(1,[1,0,1]),(1,[0,0,0])],[(1,[1,1,0]),(1,[0,0,0])],LEX_)));
123.21 +(* result: [(1,[1,0,1]),(~1,[0,0,1])] *)
123.22 +if mv_prest1=[(1,[1,0,1]),(~1,[0,0,1])] then () else raise error ("Test failed");
123.23 +
123.24 +val mv_pquot2 = (#1(mv_division([(4,[2]),(8,[1]),(16,[0])],[(1,[1]),(1,[0])],LEX_)));
123.25 +(* result: [(4,[1]),(4,[0])] *)
123.26 +if mv_pquot2=[(4,[1]),(4,[0])] then () else raise error ("Test failed");
123.27 +
123.28 +val mv_prest2 = (#2(mv_division([(4,[2]),(8,[1]),(16,[0])],[(1,[1]),(1,[0])],LEX_)));
123.29 +(* result: [(12,[0]] *)
123.30 +if mv_prest2=[(12,[0])] then () else raise error ("Test failed");
123.31 +
123.32 +val mv_pquot3 = (#1(mv_division([(4,[2]),(~4,[0])],[(2,[1]),(2,[0])],LEX_)));
123.33 +(* [(2,[1]),(~2,[0])] *)
123.34 +if mv_pquot3=[(2,[1]),(~2,[0])] then () else raise error ("Test failed");
123.35 +
123.36 +val mv_prest3 = (#2(mv_division([(1,[2]),(~1,[0])],[(2,[1]),(2,[0])],LEX_)));
123.37 +(* [(1,[2]),(~1,[0])] *)
123.38 +if mv_prest3=[(1,[2]),(~1,[0])] then () else raise error ("Test failed");
123.39 +
123.40 +val mv_pquot4 = (#1(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1])],[(2,[1,0,0]),(4,[0,0,1])],LEX_)));
123.41 +(* [(1,[0,1,1])] *)
123.42 +if mv_pquot4=[(1,[0,1,1])] then () else raise error ("Test failed");
123.43 +
123.44 +val mv_prest4 = (#2(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1])],[(2,[1,0,0]),(4,[0,0,1])],GGO_)));
123.45 +(* [(1,[1,1,1]),(~4,[0,1,2]),(4,[1,0,1]),(3,[0,0,1])] *)
123.46 +if mv_prest4 =[(1,[1,1,1]),(~4,[0,1,2]),(4,[1,0,1]),(3,[0,0,1])] then () else raise error ("Test failed");
123.47 +
123.48 +val mv_pquot5 = (#1(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1]),(6,[2,1,3]),(4,[0,4,1]),(1,[2,2,1])],[(1,[0,0,1])],LEX_)));
123.49 +(* [(1,[2,2,0]),(6,[2,1,2]),(3,[1,1,0]),(4,[1,0,0]),(4,[0,4,0]),(3,[0,0,0])]*)
123.50 +if mv_pquot5=[(1,[2,2,0]),(6,[2,1,2]),(3,[1,1,0]),(4,[1,0,0]),(4,[0,4,0]),(3,[0,0,0])] then () else raise error ("Test failed");
123.51 +
123.52 +val mv_prest5 = (#2(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1]),(6,[2,1,3]),(4,[0,4,1]),(1,[2,2,1])],[(1,[0,0,1])],LEX_)));
123.53 +(* [] *)
123.54 +if mv_prest5=[] then () else raise error ("Test failed");
123.55 +
123.56 +(* (x^2 + 2(a+1)x + (a^2+2a+1)) / (x+a+1) = x+a+1 *)
123.57 +val mv_pquot6 = (#1(mv_division([(1,[2,0,0]),(2,[1,1,0]),(2,[1,0,0]),(1,[0,2,0]),(2,[0,1,0]),(1,[0,0,0])],[(1,[1,0,0]),(1,[0,1,0]),(1,[0,0,0])],LEX_)));
123.58 +if mv_pquot6=[(1,[1,0,0]),(1,[0,1,0]),(1,[0,0,0])] then () else raise error ("Test failed");
123.59 +
123.60 +val mv_prest6 = (#2(mv_division([(1,[2,0,0]),(2,[1,1,0]),(2,[1,0,0]),(1,[0,2,0]),(2,[0,1,0]),(1,[0,0,0])],[(1,[1,0,0]),(1,[0,1,0]),(1,[0,0,0])],LEX_)));
123.61 +if mv_prest6=[] then () else raise error ("Test failed");
123.62 +
123.63 +(* Exception tests *)
123.64 +(* mv_division ([(1,[0,0,0])],[(0,[1,2,3])],LEX_); *)
123.65 +
123.66 +print("\n\n***** MV_CONTENT-TESTS *****\n");
123.67 +val mv_cont1=mv_content([(1,[2,1]),(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,1]),(1,[0,0])]);
123.68 +(* [(1,[0,1]),(1,[0,0])] *)
123.69 +if mv_cont1=[(1,[0,1]),(1,[0,0])] then () else raise error ("Test failed");
123.70 +
123.71 +val mv_pp1=mv_pp([(1,[1,1]),(1,[1,0]),(1,[0,1]),(1,[0,0])]);
123.72 +(*[(1,[1,0]),(1,[0,0])]*)
123.73 +if mv_pp1=[(1,[1,0]),(1,[0,0])] then () else raise error ("Test failed");
123.74 +
123.75 +val mv_cont2=mv_content([(2,[1]),(4,[0])]);
123.76 +(* [(2,[0])] *)
123.77 +if mv_cont2=[(2,[0])] then () else raise error ("Test failed");
123.78 +
123.79 +val mv_pp2=mv_pp([(2,[1]),(4,[0])]);
123.80 +(* [(1,[1]),(2,[0])] *)
123.81 +if mv_pp2=[(1,[1]),(2,[0])] then () else raise error ("Test failed");
123.82 +
123.83 +val mv_cont3=mv_content[(8,[2,1,1]),(12,[1,0,2]),(10,[2,2,0]),(16,[1,1,1])];
123.84 +(* [(2,[0,0,0])] *)
123.85 +if mv_cont3=[(2,[0,0,0])] then () else raise error ("Test failed");
123.86 +
123.87 +val mv_pp3=mv_pp[(8,[2,1,1]),(12,[1,0,2]),(10,[2,2,0]),(16,[1,1,1])];
123.88 +(* [(5,[2,2,0]),(4,[2,1,1]),(8,[1,1,1]),(6,[1,0,2])] *)
123.89 +if mv_pp3=[(5,[2,2,0]),(4,[2,1,1]),(8,[1,1,1]),(6,[1,0,2])] then () else raise error ("Test failed");
123.90 +
123.91 +val mv_cont4=mv_content[(2,[2,1,0]),(3,[1,0,1]),(2,[1,1,0]),(3,[0,0,1])];
123.92 +(* [(1,[0,0,0])] *)
123.93 +if mv_cont4=[(1,[0,0,0])] then () else raise error ("Test failed");
123.94 +
123.95 +val mv_pp4=mv_pp [(2,[2,1,0]),(3,[1,0,1]),(2,[1,1,0]),(3,[0,0,1])];
123.96 +(* [(2,[2,1,0]),(2,[1,1,0]),(3,[1,0,1]),(3,[0,0,1])] *)
123.97 +if mv_pp4=[(2,[2,1,0]),(2,[1,1,0]),(3,[1,0,1]),(3,[0,0,1])] then () else raise error ("Test failed");
123.98 +
123.99 +val con1=mv_content([(9,[2,0]),(15,[1,1]),(12,[1,0]),(6,[0,2]),(12,[0,1])]);
123.100 +(* [(3,[0,0])] *)
123.101 +if con1=[(3,[0,0])] then () else raise error ("Test failed");
123.102 +
123.103 +val pp1=mv_pp([(9,[2,0]),(15,[1,1]),(12,[1,0]),(6,[0,2]),(12,[0,1])]);
123.104 +(* [(3,[2,0]),(5,[1,1]),(4,[1,0]),(2,[0,2]),(4,[0,1])] *)
123.105 +if pp1=[(3,[2,0]),(5,[1,1]),(4,[1,0]),(2,[0,2]),(4,[0,1])] then () else raise error ("Test failed");
123.106 +
123.107 +val con2=mv_content([(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])]);
123.108 +(* [(1,[0,0])] *)
123.109 +if con2=[(1,[0,0])] then () else raise error ("Test failed");
123.110 +
123.111 +val pp2 =mv_pp([(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])]);
123.112 +(* [(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])] *)
123.113 +if pp2=[(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])] then () else raise error ("Test failed");
123.114 +
123.115 +val cont1 = mv_content [(1,[2,1,0]),(2,[2,1,0])];
123.116 +(* [(3,[0,1,0])] *)
123.117 +if cont1=[(3,[0,1,0])] then () else raise error ("Test failed");
123.118 +
123.119 +val pp1 = mv_pp [(1,[2,1,0]),(2,[2,1,0])];
123.120 +(* [(1,[2,0,0])] *)
123.121 +if pp1=[(1,[2,0,0])] then () else raise error ("Test failed");
123.122 +
123.123 +val cont2 = mv_content [(4,[1,2,0]),(2,[2,1,0])];
123.124 +(* [(2,[0,1,0])] *)
123.125 +if cont2=[(2,[0,1,0])] then () else raise error ("Test failed");
123.126 +
123.127 +val pp2 = mv_pp [(4,[1,2,0]),(2,[2,1,0])];
123.128 +(* [(1,[2,0,0]),(2,[1,1,0])] *)
123.129 +if pp2=[(1,[2,0,0]),(2,[1,1,0])] then () else raise error ("Test failed");
123.130 +
123.131 +print("\n\n\n\n********************************************************\n\n");
123.132 +val cont3=mv_content [(65,[3,2,2]),(52,[3,2,1]),(26,[3,1,2]),(~95,[2,2,3]),(~76,[2,2,2]),(35,[2,2,1]),(28,[2,2,0]),(~38,[2,1,3]),(14,[2,1,1])];
123.133 +(*if cont3=[(1,[0,1,0])] then () else raise error ("Test failed"); *)
123.134 +val pp3=mv_pp [(65,[3,2,2]),(52,[3,2,1]),(26,[3,1,2]),(~95,[2,2,3]),(~76,[2,2,2]),(35,[2,2,1]),(28,[2,2,0]),(~38,[2,1,3]),(14,[2,1,1])];
123.135 +
123.136 +
123.137 +print("\n\n***** gcd-tests *****\n");
123.138 +val ggt1 = gcd_poly [(4,[2,2]),(8,[1,1]),(4,[0,0])] [(2,[1,1]),(2,[0,0])];
123.139 +(* [(2,[1,1]),(2,[0,0])] *)
123.140 +if ggt1=[(2,[1,1]),(2,[0,0])] then () else raise error ("Test failed");
123.141 +
123.142 +val ggt2 = gcd_poly [(8,[2,1,1]),(12,[1,0,2]),(10,[2,2,0]),(15,[1,1,1])] [(2,[2,1,0]),(3,[1,0,1]),(2,[1,1,0]),(3,[0,0,1])];
123.143 +(* [(2,[1,1,0]),(3,[0,0,1])] *)
123.144 +if ggt2=[(2,[1,1,0]),(3,[0,0,1])] then () else raise error ("Test failed");
123.145 +
123.146 +val ggt3 = gcd_poly [(1,[2,0,0]),(~2,[1,0,1]),(1,[0,0,2])] [(1,[1,0,0]),(~1,[0,0,1])];
123.147 +(* [(1,[1,0,0]),(~1,[0,0,1])] *)
123.148 +if ggt3=[(1,[1,0,0]),(~1,[0,0,1])] then () else raise error ("Test failed");
123.149 +
123.150 +val ggt4 = gcd_poly [(1,[2,1,0]),(2,[2,1,0])] [(5,[1,0,0])];
123.151 +(* [(1,[1,0,0])] *)
123.152 +if ggt4=[(1,[1,0,0])] then () else raise error ("Test failed");
123.153 +
123.154 +val ggt5 = gcd_poly [(4,[2,0,0]),(~8,[1,0,1]),(4,[0,0,2])] [(1,[2,0,0]),(~1,[0,0,2])];
123.155 +(* [(1,[1,0,0]),(~1,[0,0,1])] *)
123.156 +if ggt5=[(1,[1,0,0]),(~1,[0,0,1])] then () else raise error ("Test failed");
123.157 +
123.158 +val ggt6 = gcd_poly [(10,[2,1,1]),(14,[1,1,0]),(3,[1,0,1]),(20,[1,2,1])] [(5,[1,1,1]),(7,[2,1,1])];
123.159 +(* [(1,[0,0,0])] *)
123.160 +if ggt6=[(1,[1,0,0])] then () else raise error ("Test failed");
123.161 +
123.162 +val ggt7 = gcd_poly [(~169,[4,3,3]),(273,[4,2,2]),(247,[3,3,4]),(~91,[3,3,2]),(78,[3,3,1]),(~399,[3,2,3]),(147,[3,2,1]),(~114,[2,3,2]),(42,[2,3,0])] [(65,[3,2,2]),(52,[3,2,1]),(26,[3,1,2]),(~95,[2,2,3]),(~76,[2,2,2]),(35,[2,2,1]),(28,[2,2,0]),(~38,[2,1,3]),(14,[2,1,1])];
123.163 +(* [(13,[3,1,1]),(~19,[2,1,2]),(7,[2,1,0])] *)
123.164 +if ggt7=[(13,[3,1,1]),(~19,[2,1,2]),(7,[2,1,0])] then () else raise error ("Test failed");
123.165 +
123.166 +print("\n\n***** kgv-tests *****\n");
123.167 +val kgv1=lcm_poly [(10,[])] [(15,[])];
123.168 +(* [(30,[])] *)
123.169 +if kgv1=[(30,[])] then () else raise error ("Test failed");
123.170 +
123.171 +val kgv2=lcm_poly [(1,[2,0,0]),(~2,[1,0,1]),(1,[0,0,2])] [(1,[1,0,0]),(~1,[0,0,1])];
123.172 +(* [(1,[2,0,0]),(~2,[1,0,1]),(1,[0,0,2])] *)
123.173 +if kgv2=[(1,[2,0,0]),(~2,[1,0,1]),(1,[0,0,2])] then () else raise error ("Test failed");
123.174 +
123.175 +val kgv3=lcm_poly [(4,[2,0,0]),(~8,[1,0,1]),(4,[0,0,2])] [(1,[2,0,0]),(~1,[0,0,2])];
123.176 +(* [(4,[3,0,0]),(~4,[2,0,1]),(~4,[1,0,2]),(4,[0,0,3])] *)
123.177 +if kgv3=[(4,[3,0,0]),(~4,[2,0,1]),(~4,[1,0,2]),(4,[0,0,3])] then () else raise error ("Test failed");
123.178 +
123.179 +(*
123.180 +print("***** TERM2POLY-TESTS *****\n");
123.181 +val t0 = (term_of o the o (parse thy)) "3 * 4";
123.182 +val t1 = (term_of o the o (parse thy)) "27";
123.183 +val t11= (term_of o the o (parse thy)) "27 * c";
123.184 +val t2 = (term_of o the o (parse thy)) "b";
123.185 +val t23= (term_of o the o (parse thy)) "c^^^7";
123.186 +val t24= (term_of o the o (parse thy)) "5 * c^^^7";
123.187 +val t26= (term_of o the o (parse thy)) "a * b";
123.188 +val t3 = (term_of o the o (parse thy)) "2 + a";
123.189 +val t4 = (term_of o the o (parse thy)) "b + a";
123.190 +val t5 = (term_of o the o (parse thy)) "2 + a^^^3";*)
123.191 +val t6 = (term_of o the o (parse thy)) "5*a^^^2*b^^^3*c+4*a^^^4*b+2*a*c";
123.192 +val t7 = (term_of o the o (parse thy)) "a-b";
123.193 +(*
123.194 +(the o term2poly) t0;
123.195 +(the o term2poly) t1;
123.196 +(the o term2poly) t11;
123.197 +(the o term2poly) t2;
123.198 +(the o term2poly) t23;
123.199 +(the o term2poly) t24;
123.200 +(the o term2poly) t26;
123.201 +(the o term2poly) t3;
123.202 +(the o term2poly) t4;
123.203 +(the o term2poly) t5;
123.204 +(the o term2poly) t6;
123.205 +(the o term2poly) t7;*)
123.206 +
123.207 +
123.208 +print("\n\n***** STEP_CANCEL_TESTS: *****\n");
123.209 +(*
123.210 +val term2 = (term_of o the o (parse thy)) " (9 * a^^^2 * b) /// (6 * a * c)";
123.211 +val div2 = step_cancel term2;
123.212 +atomt div2;
123.213 +*)
123.214 +
123.215 +val term1 = (term_of o the o (parse thy)) "(10 * a^^^2 * b * c + 14 * a * b + 3 * a * c + 20 * a * b^^^2 * c) /// a";
123.216 +val div1 = step_cancel term1;
123.217 +(*if div1 = (term_of o the o (parse thy)) "((10 * a * b * c + 14 * b + 3 * c + 20 * b^^^2 * c) * a) /// (1 * a)" then () else raise raise error ("Test failed");*)
123.218 +
123.219 +val term2 = (term_of o the o (parse thy)) "(10 * a^^^2 * b * c + 14 * a * b + 3 * a * c + 20 * a * b^^^2 * c) /// (5 * a * b * c + 7 * a^^^2 * b * c) ";
123.220 +val div2 = step_cancel term2;
123.221 +(*if div2 = ([(10,[1,1,1]),(20,[0,2,1]),(14,[0,1,0]),(3,[0,0,1])],[(1,[1,0,0])],[(7,[1,1,1]),(5,[0,1,1])]) then () else raise raise error ("Test failed");*)
123.222 +
123.223 +
123.224 +val term3 = (term_of o the o (parse thy)) "(10 * a^^^2 * b * c) /// (1 * x * y * z) ";
123.225 +val div3 = step_cancel term3;
123.226 +
123.227 +
123.228 +
123.229 +(*val mul1=(term_of o the o (parse thy)) "(5*a*b*c+4*a*b+2*a*c)";
123.230 +val mul2=(the (term2poly((term_of o the o (parse thy)) "13*a^^^2*b*c+7*a*b-19*a*b*c^^^2")));
123.231 +val mul3=(the (term2poly((term_of o the o (parse thy)) "6*a*b^^^2-13*a^^^2*b^^^2*c^^^2+21*a^^^2*b*c")));
123.232 +val t1=mv_mul(mul1,mul2,LEX_);
123.233 +val t2=mv_mul(mul3,mul2,LEX_);
123.234 +val div3=step_cancel t1 t2;
123.235 +if div3=([(5,[0,1,1]),(4,[0,1,0]),(2,[0,0,1])],[(13,[3,1,1]),(~19,[2,1,2]),(7,[2,1,0])],[(~13,[1,2,2]),(21,[1,1,1]),(6,[0,2,0])]) then () else raise error ("Test failed");*)
123.236 +
123.237 +print("\n\n***** all tests successfull ;-) ******\n\n");
123.238 +
123.239 +
123.240 +
123.241 +val thy = Rational.thy;
123.242 +val rls = Prls {func=cancel};
123.243 +val t = (term_of o the o (parse thy))
123.244 + "(1 + 1 * a ^^^ 1)///(-2 + 2 * a ^^^ 2)";
123.245 +val (t,asm) = the (rewrite_set_ thy eval_rls false rls t);
123.246 +
123.247 +
123.248 +val thy' = "Rational.thy";
123.249 +val rls' = "cancel";
123.250 +val t' = "(1 + 1 * a ^^^ 1)///(-2 + 2 * a ^^^ 2)";
123.251 +val (t',asm') = the (rewrite_set thy' "eval_rls" false rls' t');
123.252 +(*if t' = "1 /// (-2 + 2 * a)" then ()
123.253 +else raise error "tests/rationals.sml(1): new behaviour";*)
123.254 +
123.255 +
123.256 +val thy' = "Rational.thy";
123.257 +val rls' = "cancel";
123.258 +val t' = "(10 * a^^^2 * b * c + 14 * a * b + 3 * a * c + 20 * a * b^^^2 * c) /// (5 * a * b * c + 7 * a^^^2 * b * c) ";
123.259 +val (t',asm') = the (rewrite_set thy' "eval_rls" false rls' t');
123.260 +
123.261 +val thy' = "Rational.thy";
123.262 +val rls' = "cancel";
123.263 +val t' = "(a^^^2 * b + 2 * a * b + b ) /// ( a^^^2 - 1 )";
123.264 +val (t',asm') = the (rewrite_set thy' "eval_rls" false rls' t');
123.265 +
123.266 +(*
123.267 +val term2 = (term_of o the o (parse thy)) "(a^^^2 * b + 2 * a * b + b ) /// ( a^^^2 - 1 )";
123.268 +val div2 = direct_cancel term2;
123.269 +val t = (term_of o the o (parse thy)) "(1 + 1 * a ^^^ 1)///(-2 + 2 * a ^^^ 2) = 0";*)
123.270 +
123.271 +
123.272 +
123.273 +(*WN folgendes aus examples he"uberkopiert ...*)
123.274 +
123.275 +(* examples from:
123.276 + Mathematik 1
123.277 + Schalk
123.278 + Reniets Verlag *)
123.279 +
123.280 +val thy' = "Rational.thy";
123.281 +val rls' = "cancel";
123.282 +val mp = "make_polynomial";
123.283 +
123.284 +(* page 63 *)
123.285 +
123.286 +print("\n\nexample 186:\n");
123.287 +print("a)\n");
123.288 +val e186a'="(14 * x * y) / ( x * y )";
123.289 +val e186a = the (rewrite_set thy' "rational_erls" false rls' e186a');
123.290 +print("b)\n");
123.291 +val e186b'="(60 * a * b) / ( 15 * a * b )";
123.292 +val e186b = the (rewrite_set thy' "rational_erls" false rls' e186b');
123.293 +print("c)\n");
123.294 +val e186c'="(144 * a^^^2 * b * c) / (12 * a * b * c )";
123.295 +val e186c = (the (rewrite_set thy' "rational_erls" false rls' e186c'))
123.296 + handle e => print_exn e;
123.297 +val t = (term_of o the o (parse thy)) e186c';
123.298 +atomt t;
123.299 +
123.300 +print("\n\nexample 187:\n");
123.301 +print("a)\n");
123.302 +val e187a'="(12 * x * y) / (8 * y^^^2 )";
123.303 +val e187a = the (rewrite_set thy' "rational_erls" false rls' e187a');
123.304 +print("b)\n");
123.305 +val e187b'="(8 * x^^^2 * y * z ) / (18 * x * y^^^2 * z )";
123.306 +val e187b = the (rewrite_set thy' "rational_erls" false rls' e187b');
123.307 +print("c)\n");
123.308 +val e187c'="(9 * x^^^5 * y^^^2 * z^^^4) / (15 * x^^^6 * y^^^3 * z )";
123.309 +val e187c = the (rewrite_set thy' "rational_erls" false rls' e187c');
123.310 +
123.311 +print("\n\nexample 188:\n");
123.312 +print("a)\n");
123.313 +val e188a'="(8 * x + -8) / (9 * x + -9 )";
123.314 +val e188a = the (rewrite_set thy' "rational_erls" false rls' e188a');
123.315 +val Some (t,_) = rewrite_set thy' "rational_erls" false mp "(8*((-1) + x))/(9*((-1) + x))";
123.316 +if t="((-8) + 8 * x) / ((-9) + 9 * x)"then()
123.317 +else raise error "rationals.sml: e188a new behaviour";
123.318 +print("b)\n");
123.319 +val e188b'="(5 * x + -15) / (6 * x + -18 )";
123.320 +val e188b = the (rewrite_set thy' "rational_erls" false rls' e188b');
123.321 +print("c)\n");
123.322 +val e188c'="( a + -1 * b ) / ( b + -1 * a )";
123.323 +val e188c = the (rewrite_set thy' "rational_erls" false rls' e188c');
123.324 +val Some (t,_) = rewrite_set thy' "rational_erls" false mp "((-1)*(b + (-1) * a))/(1*(b + (-1) * a))";
123.325 +if t="(a + -1 * b) / (b + -1 * a)"then()
123.326 +else raise error "rationals.sml: e188c new behaviour";
123.327 +
123.328 +print("\n\nexample 190:\n");
123.329 +print("c)\n");
123.330 +val e190c'="( 27 * a^^^3 + 9 * a^^^2 + 3 * a + 1 ) / ( 27 * a^^^3 + 18 * a^^^2 + 3 * a )";
123.331 +val e190c = the (rewrite_set thy' "rational_erls" false rls' e190c');
123.332 +val Some (t,_) = rewrite_set thy' "rational_erls" false mp "((1 + 9 * a ^^^ 2)*(1 + 3 * a))/((3 * a + 9 * a ^^^ 2)*(1 + 3 * a))";
123.333 +if t="(1 + (3 * a + (27 * a ^^^ 3 + 9 * a ^^^ 2))) /\n(3 * a + (18 * a ^^^ 2 + 27 * a ^^^ 3))"then()
123.334 +(*TERMORDER ~~~~~~~ ~~~~~~~*)
123.335 +else raise error "rationals.sml: e190c new behaviour";
123.336 +
123.337 +print("\n\nexample 191:\n");
123.338 +print("a)\n");
123.339 +val e191a'="( x^^^2 + -1 * y^^^2 ) / ( x + y )";
123.340 +val e191a = the (rewrite_set thy' "rational_erls" false rls' e191a');
123.341 +val Some (t,_) = rewrite_set thy' "rational_erls" false mp "((x + (-1) * y)*(x + y))/((1)*(x + y))";
123.342 +if t="(x ^^^ 2 + -1 * y ^^^ 2) / (x + y)"then()
123.343 +else raise error "rationals.sml: e191a new behaviour";
123.344 +print("c)\n");
123.345 +val e191c'="( 9 * x^^^2 + -30 * x + 25 ) / ( 9 * x^^^2 + -25 )";
123.346 +val e191c = the (rewrite_set thy' "rational_erls" false rls' e191c');
123.347 +val Some (t,_) = rewrite_set thy' "rational_erls" false mp "(((-5) + 3 * x)*((-5) + 3 * x))/((5 + 3 * x)*((-5) + 3 * x))";
123.348 +if t="(25 + ((-30) * x + 9 * x ^^^ 2)) / ((-25) + 9 * x ^^^ 2)"then()
123.349 +else raise error "rationals.sml: 'e191c' new behaviour";
123.350 +
123.351 +print("\n\nexample 192:\n");
123.352 +print("b)\n");
123.353 +val e192b'="( 7 * x^^^3 + -1 * x^^^2 * y ) / ( 7 * x * y^^^2 + -1 * y^^^3 )";
123.354 +val e192b = the (rewrite_set thy' "rational_erls" false rls' e192b');
123.355 +val Some (t,_) = rewrite_set thy' "rational_erls" false mp "((x ^^^ 2)*(7 * x + (-1) * y))/((y ^^^ 2)*(7 * x + (-1) * y))";
123.356 +if t="(7 * x ^^^ 3 + -1 * (y * x ^^^ 2)) / (-1 * y ^^^ 3 + 7 * (x * y ^^^ 2))"then()
123.357 +(*TERMORDER ~~~~~*)
123.358 +else raise error "rationals.sml: 'e192b' new behaviour";
123.359 +
123.360 +print("\n\nexample 193:\n");
123.361 +print("a)\n");
123.362 +val e193a'="( x^^^2 + -6 * x + 9 ) / ( x^^^2 + -9 )";
123.363 +val e193a = the (rewrite_set thy' "rational_erls" false rls' e193a');
123.364 +print("b)\n");
123.365 +val e193b'="( x^^^2 + -8 * x + 16 ) / ( 2 * x^^^2 + -32 )";
123.366 +val e193b = the (rewrite_set thy' "rational_erls" false rls' e193b');
123.367 +print("c)\n");
123.368 +val e193c'="( 2 * x + -50 * x^^^3 ) / ( 25 * x^^^2 + -10 * x + 1 )";
123.369 +val Some(t,_) = rewrite_set thy' "rational_erls" false rls' e193c';
123.370 +--------------------------------15.10.02---*)
123.371 +
123.372 +
123.373 +(*---------- WN: 10.9.02:
123.374 +ML> val e204a = the (rewrite_set thy' "rational_erls" false rls' e204a');
123.375 +*** RATIONALS_STEP_CANCEL_EXCEPTION: Invalid fraction
123.376 +print("\n\nexample 204:\n");
123.377 +print("a)\n");
123.378 +val e204a'="((5 * x) / 9) + ((3 * x) / 9) + (x / 9)";
123.379 +val e204a = the (rewrite_set thy' "rational_erls" false rls' e204a');
123.380 +print("b)\n");
123.381 +val e204b'="5 / x + -3 / x + -1 / x";
123.382 +val e204b = the (rewrite_set thy' "rational_erls" false rls' e204b');
123.383 +
123.384 +print("\n\nexample 205:\n");
123.385 +print("a)\n");
123.386 +val e205a'="((4 * x + 7) / 8) + ((4 * x + 3) / 8)";
123.387 +val e205a = the (rewrite_set thy' "rational_erls" false rls' e205a');
123.388 +print("b)\n");
123.389 +val e205b'="((5 * x + 2) / 3) + ((-2 * x + 1) / 3)";
123.390 +val e205b = the (rewrite_set thy' "rational_erls" false rls' e205b');
123.391 +
123.392 +print("\n\nexample 206:\n");
123.393 +print("a)\n");
123.394 +val e206a'="((5 * x + 4) / (2 * x + -1)) + ((9 * x + 5) / (2 * x + -1))";
123.395 +val e206a = the (rewrite_set thy' "rational_erls" false rls' e206a');
123.396 +print("b)\n");
123.397 +val e206b'="((17 * x + -23) / (5 * x + 4)) + ((-25 + -17 * x) / (5 * x + 4))";
123.398 +val e206b = the (rewrite_set thy' "rational_erls" false rls' e206b');
123.399 +
123.400 +print("\n\nexample 207:\n");
123.401 +val e207'="((3 * x * y + 3 * y) / (x * y)) + ((5 * x * y + 7 * y) / (x * y)) + ((9 * x * y + -2 * y) / (x * y)) + ((x * y + 4 * y) / (x * y)) ";
123.402 +val e207 = the (rewrite_set thy' "rational_erls" false rls' e207');
123.403 +
123.404 +print("\n\nexample 208:\n");
123.405 +val e208'="((3 * x + 2) / (x + 2)) + ((5 * x + -1) / (x + 2)) + ((-7 * x + -3) / (x + 2)) + ((-1 * x + -3) / (x + 2)) ";
123.406 +val e208 = the (rewrite_set thy' "rational_erls" false rls' e208');
123.407 +
123.408 +print("\n\nexample 209:\n");
123.409 +val e209'="((3 * x + -7 * y + 3 * z) / (4)) + ((2 * x + 17 * y + 10 * z) / (4)) + ((-1 * x + 2 * y + z) / (4)) ";
123.410 +val e209 = the (rewrite_set thy' "rational_erls" false rls' e209');
123.411 +
123.412 +print("\n\nexample 210:\n");
123.413 +val e210'="((2 * x + 3 + -1 * x^^^2) / (5 * x)) + ((5 * x^^^2 + -2 * x + 1) / (5 * x)) + ((-3 * x^^^2 + -2 * x + 1) / (5 * x)) + ((-1 * x^^^2 + -3 * x + -5) / (5 * x)) ";
123.414 +val e210 = the (rewrite_set thy' "rational_erls" false rls' e210');
123.415 +
123.416 +print("\n\nexample 211:\n");
123.417 +print("a)\n");
123.418 +val e211a'="((b) / (a + -1 * b)) + ((-1 * a) / (a + -1 * b))";
123.419 +val e211a = the (rewrite_set thy' "rational_erls" false rls' e211a');
123.420 +print("b)\n");
123.421 +val e211b'="((b) / (b^^^2 + -1 * a^^^2)) + ((-1 * a) / (b^^^2 + -1 * a^^^2))";
123.422 +val e211b = the (rewrite_set thy' "rational_erls" false rls' e211b');
123.423 +
123.424 +print("\n\nexample 212:\n");
123.425 +print("a)\n");
123.426 +val e212a'="((4) / (x)) + ((-3) / (y)) + -1";
123.427 +val e212a = the (rewrite_set thy' "rational_erls" false rls' e212a');
123.428 +print("b)\n");
123.429 +val e212b'="((4) / (x)) + ((-5) / (y)) + ((6) / (x*y))";
123.430 +val e212b = the (rewrite_set thy' "rational_erls" false rls' e212b');
123.431 +
123.432 +print("\n\nexample 213:\n");
123.433 +print("a)\n");
123.434 +val e213a'="((5 * x) / (3 * y^^^2)) + ((19 * z) / (6 * x * y)) + ((-2 * x) / (3 * y^^^2)) + ((7 * y^^^2) / (6 * x^^^2)) ";
123.435 +val e213a = the (rewrite_set thy' "rational_erls" false rls' e213a');
123.436 +print("b)\n");
123.437 +val e213b'="((2 * b) / (3 * a^^^2)) + ((3 * c) / (7 * a * b)) + ((4 * b) / (3 * a^^^2)) + ((3 * a) / (7 * b^^^2))";
123.438 +val e213b = the (rewrite_set thy' "rational_erls" false rls' e213b');
123.439 +
123.440 +print("\n\nexample 214:\n");
123.441 +print("a)\n");
123.442 +val e214a'="((3 * x + 2 * y + 2 * z) / (4)) + ((-5 * x + -3 * y) / (3)) + ((x + y + -2 * z) / (2))";
123.443 +val e214a = the (rewrite_set thy' "rational_erls" false rls' e214a');
123.444 +print("b)\n");
123.445 +val e214b'="((5 * x + 2 * y + z) / (2)) + ((-7 * x + -3 * y) / (3)) + ((3 * x + 6 * y + -1 * z) / (12))";
123.446 +val e214b = the (rewrite_set thy' "rational_erls" false rls' e214b');
123.447 +
123.448 +print("\n\nexample 216:\n");
123.449 +print("a)\n");
123.450 +val e216a'="((2 * b + 3 * c) / (a * c)) + ((3 * a + b) / (a * b)) + ((-2 * b^^^2 + -3 * a * c) / (a * b * c))";
123.451 +val e216a = the (rewrite_set thy' "rational_erls" false rls' e216a');
123.452 +print("b)\n");
123.453 +val e216b'="((2 * a + 3 * b) / (b * c)) + ((3 * c + a) / (a * c)) + ((-2 * a^^^2 + -3 * b * c) / (a * b * c))";
123.454 +val e216b = the (rewrite_set thy' "rational_erls" false rls' e216b');
123.455 +
123.456 +print("\n\nexample 217:\n");
123.457 +val e217'="((z + -1) / (z)) + ((3 * z ^^^2 + -6 * z + 5) / (z^^^2)) + ((-4 * z^^^3 + 7 * z^^^2 + -5 * z + 5) / (z^^^3))";
123.458 +val e217 = the (rewrite_set thy' "rational_erls" false rls' e217');
123.459 +
123.460 +print("\n\nexample 218:\n");
123.461 +val e218'="((9 * a^^^3 - 5 * a^^^2 + 2 * a + 8) / (108 * a^^^4)) + ((-5 * a + 3 * a^^^2 + 4) / (8 * a^^^3)) + ((-261 * a^^^3 + 19 * a^^^2 + -112 * a + 16) / (216 * a^^^4))";
123.462 +val e218 = the (rewrite_set thy' "rational_erls" false rls' e218');
123.463 +
123.464 +print("\n\nexample 219:\n");
123.465 +print("a)\n");
123.466 +val e219a'="((1) / (y + 1)) + ((1) / (y + 2)) + ((1) / (y + 3))";
123.467 +val e219a = the (rewrite_set thy' "rational_erls" false rls' e219a');
123.468 +print("b)\n");
123.469 +val e219b'="((1) / (x + 1)) + ((1) / (x + 2)) + ((-2) / (x + 3))";
123.470 +val e219b = the (rewrite_set thy' "rational_erls" false rls' e219b');
123.471 +
123.472 +print("\n\nexample 220:\n");
123.473 +print("a)\n");
123.474 +val e220a'="((17) / (5 * r + -2)) + ((-13) / (2 * r + 3)) + ((4) / (3 * r + -5))";
123.475 +val e220a = the (rewrite_set thy' "rational_erls" false rls' e220a');
123.476 +print("b)\n");
123.477 +val e220b'="((20 * a) / (a + -3)) + ((-19 * a) / (a + -4)) + ((a) / (a + -5))";
123.478 +val e220b = the (rewrite_set thy' "rational_erls" false rls' e220b');
123.479 +
123.480 +print("\n\nexample 221:\n");
123.481 +print("a)\n");
123.482 +val e221a'="((a + b) / (a + -1 * b)) + ((a + -1 * b) / (a + b))";
123.483 +val e221a = the (rewrite_set thy' "rational_erls" false rls' e221a');
123.484 +print("b)\n");
123.485 +val e221b'="((x + -1 * y) / (x + y)) + ((x + y) / (x + -1 * y)) ";
123.486 +val e221b = the (rewrite_set thy' "rational_erls" false rls' e221b');
123.487 +
123.488 +print("\n\nexample 222:\n");
123.489 +print("a)\n");
123.490 +val e222a'="((1 + -1 * x) / (1 + x)) + ((-1 + -1 * x) / (1 + -1 * x)) + ((4 * x) / (1 + -1 * x^^^2))";
123.491 +val e222a = the (rewrite_set thy' "rational_erls" false rls' e222a');
123.492 +print("b)\n");
123.493 +val e222b'="((1 + x ) / (1 + -1 * x)) + ((-1 + x) / (1 + x)) + ((2 * x) / (1 + -1 * x^^^2))";
123.494 +val e222b = the (rewrite_set thy' "rational_erls" false rls' e222b');
123.495 +
123.496 +print("\n\nexample 225:\n");
123.497 +print("a)\n");
123.498 +val e225a'="((6 * a) / (a^^^2 + -64)) + ((a + 2) / (2 * a + 16)) + ((-1) / (2))";
123.499 +val e225a = the (rewrite_set thy' "rational_erls" false rls' e225a');
123.500 +print("b)\n");
123.501 +val e225b'="((a + 2 ) / (2 * a + 12)) + ((4 * a) / (a^^^2 + -36)) + ((-1) / (2))";
123.502 +val e225b = the (rewrite_set thy' "rational_erls" false rls' e225b');
123.503 +
123.504 +print("\n\nexample 226:\n");
123.505 +print("a)\n");
123.506 +val e226a'="((35 * z) / (49 * z^^^2 + -4)) + -1 + ((14 * z + -1) / (14 * z + 4)) ";
123.507 +val e226a = the (rewrite_set thy' "rational_erls" false rls' e226a');
123.508 +print("b)\n");
123.509 +val e226b'="((45 * a * b) / (25 * a^^^2 + -9 * b^^^2)) + ((20 * a + 3 * b) / (10 * a + 6 * b)) + -2";
123.510 +val e226b = the (rewrite_set thy' "rational_erls" false rls' e226b');
123.511 +
123.512 +print("\n\nexample 227:\n");
123.513 +print("a)\n");
123.514 +val e227a'="((6 * z + 11) / (6 * z + 14)) + ((9 * z ) / (9 * z^^^2 + -49)) + -1 ";
123.515 +val e227a = the (rewrite_set thy' "rational_erls" false rls' e227a');
123.516 +print("b)\n");
123.517 +val e227b'="((16 * a + 37 * b) / (4 * a + 10 * b)) + ((6 * a * b) / (4 * a^^^2 + -25 * b^^^2)) + -4 ";
123.518 +val e227b = the (rewrite_set thy' "rational_erls" false rls' e227b');
123.519 +
123.520 +print("\n\nexample 228:\n");
123.521 +print("a)\n");
123.522 +val e228a'="((7 * a + 11) / (3 * a^^^2 + -3)) + ((-2 * a + -1) / (a^^^2 + -1 * a)) + ((-1) / (3 * a + 3))";
123.523 +val e228a = the (rewrite_set thy' "rational_erls" false rls' e228a');
123.524 +print("b)\n");
123.525 +val e228b'="((11 * z + 2 * b) / (4 * b * z + -8 * b^^^2)) + ((-8 * z) / (z^^^2 + -4 * b^^^2)) + ((-9 * z + -2 * b) / (4 * b * z + 8 * b^^^2))";
123.526 +val e228b = the (rewrite_set thy' "rational_erls" false rls' e228b');
123.527 +
123.528 +
123.529 +print("\n\nexample 229:\n");
123.530 +print("a)\n");
123.531 +val e229a'="((5 * x^^^2 + y) / (x + 2 * y)) + ((-8 * x^^^3 + 4 * x^^^2 * y + 3 * x * y) / (x^^^2 + -4 * y^^^2)) + ((3 * x^^^2 + -4 * y) / (x + -2 * y))";
123.532 +val e229a = the (rewrite_set thy' "rational_erls" false rls' e229a');
123.533 +print("b)\n");
123.534 +val e229b'="((7 * x^^^2 + y) / (x + 3 * y)) + ((-24 * x^^^2 * y + 5 * x * y + 21 * y^^^2) / (x^^^2 + -9 * y^^^2)) + ((4 * x^^^2 + -6 * y) / (x + -3 * y))";
123.535 +val e229b = the (rewrite_set thy' "rational_erls" false rls' e229b');
123.536 +
123.537 +print("\n\nexample 230:\n");
123.538 +print("a)\n");
123.539 +val e230a'="((5 * x^^^2 + y) / (2 * x + y)) + ((-16 * x^^^3 + 2 * x^^^2 * y + 6 * x * y) / (4 * x^^^2 + -1 * y^^^2)) + ((3 * x^^^2 + -4 * y) / (2 * x + -1 * y))";
123.540 +val e230a = the (rewrite_set thy' "rational_erls" false rls' e230a');
123.541 +print("b)\n");
123.542 +val e230b'="((7 * x^^^2 + y) / (3 * x + y)) + ((-3 * x^^^3 + 15 * x * y + -7 * x^^^2 * y + 7 * y^^^2) / (9 * x^^^2 + -1 * y^^^2)) + ((4 * x^^^2 + -6 * y) / (3 * x + -1 * y))";
123.543 +val e230b = the (rewrite_set thy' "rational_erls" false rls' e230b');
123.544 +
123.545 +print("\n\nexample 231:\n");
123.546 +print("a)\n");
123.547 +val e231a'="((2 * x + 5 * y) / (x)) + ((2 * x^^^3 + -5 * y^^^3 + 3 * x * y^^^2) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-3 * x + -6 * y) / (x + -1 * y))";
123.548 +val e231a = the (rewrite_set thy' "rational_erls" false rls' e231a');
123.549 +print("b)\n");
123.550 +val e231b'="((6 * x + 2 * y) / (x)) + ((6 * x^^^2 * y + -4 * x * y^^^2 + -2 * y^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-5 * x + -3 * y) / (x + -1 * y))";
123.551 +val e231b = the (rewrite_set thy' "rational_erls" false rls' e231b');
123.552 +
123.553 +print("\n\nexample 232:\n");
123.554 +print("a)\n");
123.555 +val e232a'="((2 * x + 3 * y) / (x)) + ((4 * x^^^3 + -1 * x * y^^^2 + -3 * y^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-5 * x + -6 * y) / (x + -1 * y))";
123.556 +val e232a = the (rewrite_set thy' "rational_erls" false rls' e232a');
123.557 +print("b)\n");
123.558 +val e232b'="((5 * x + 2 * y) / (x)) + ((2 * x^^^3 + -3 * x * y^^^2 + 3 * x^^^2 * y + -2 * y^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-6 * x + -3 * y) / (x + -1 * y))";
123.559 +val e232b = the (rewrite_set thy' "rational_erls" false rls' e232b');
123.560 +
123.561 +print("\n\nexample 233:\n");
123.562 +print("a)\n");
123.563 +val e233a'="((5 * x + 6 * y) / (x)) + ((5 * x * y^^^2 + -6 * y^^^3 + -2 * x^^^3 + 3 * x^^^2 * y) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-2 * x + -3 * y) / (x + -1 * y))";
123.564 +val e233a = the (rewrite_set thy' "rational_erls" false rls' e233a');
123.565 +print("b)\n");
123.566 +val e233b'="((6 * x + 5 * y) / (x)) + ((4 * x^^^2 * y + 3 * x * y^^^2 + -5 * y^^^3 + -2 * x^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-3 * x + -2 * y) / (x + -1 * y))";
123.567 +val e233b = the (rewrite_set thy' "rational_erls" false rls' e233b');
123.568 +
123.569 +print("\n\nexample 234:\n");
123.570 +print("a)\n");
123.571 +val e234a'="((5 * a + b) / (2 * a * b + -2 * b^^^2)) + ((-3 * a + -1 * b) / (2 * a * b + 2 * b^^^2)) + ((-2 * a) / (a^^^2 + -1 * b^^^2))";
123.572 +val e234a = the (rewrite_set thy' "rational_erls" false rls' e234a');
123.573 +print("b)\n");
123.574 +val e234b'="((5 * a + 3 * b) / (6 * a * b + -18 * b^^^2)) + ((-3 * a + -3 * b) / (6 * a * b + 18 * b^^^2)) + ((-2 * a) / (a^^^2 + -9 * b^^^2)) ";
123.575 +val e234b = the (rewrite_set thy' "rational_erls" false rls' e234b');
123.576 +
123.577 +print("\n\nexample 235:\n");
123.578 +print("a)\n");
123.579 +val e235a'="((10 * x + 3 * y) / (12 * x * y + -18 * y^^^2)) + ((-6 * x + -3 * y) / (12 * x * y + 18 * y^^^2)) + ((-4 * x) / (4 * x^^^2 + -9 * y^^^2))";
123.580 +val e235a = the (rewrite_set thy' "rational_erls" false rls' e235a');
123.581 +print("b)\n");
123.582 +val e235b'="((8 * a + b) / (4 * a * b + -2 * b^^^2)) + ((-4 * a + -1 * b) / (4 * a * b + 2 * b^^^2)) + ((-2 * a) / (4 * a^^^2 + -1 * b^^^2)) ";
123.583 +val e235b = the (rewrite_set thy' "rational_erls" false rls' e235b');
123.584 +
123.585 +print("\n\nexample 236:\n");
123.586 +print("a)\n");
123.587 +val e236a'="((8 * a + 5 * b) / (20 * a * b + -50 * b^^^2)) + ((-4 * a + -5 * b) / (20 * a * b + 50 * b^^^2)) + ((-2 * a) / (4 * a^^^2 + -25 * b^^^2))";
123.588 +val e236a = the (rewrite_set thy' "rational_erls" false rls' e236a');
123.589 +print("b)\n");
123.590 +val e236b'="((24 * x + y) / (6 * x * y + -2 * y^^^2)) + ((-18 * x + -1 * y) / (6 * x * y + 2 * y^^^2)) + ((-15 * x) / (9 * x^^^2 + -1 * y^^^2)) ";
123.591 +val e236b = the (rewrite_set thy' "rational_erls" false rls' e236b');
123.592 +
123.593 +print("\n\nexample heuberger:\n");
123.594 +val eheu'="(x^^^4 + x * y + x^^^3 * y + y^^^2) / (x + 5 * x^^^2 + y + 5 * x * y + x^^^2 * y^^^3 + x * y^^^4)";
123.595 +val eheu = the (rewrite_set thy' "rational_erls" false rls' eheu');
123.596 +
123.597 +print("\n\nexample stiefel:\n");
123.598 +val est1'="(7) / (-14) + (-2) / (4)";
123.599 +val est1 = the (rewrite_set thy' "rational_erls" false rls' est1');
123.600 +if est1 = ("(-1) / 1",[]) then ()
123.601 +else raise error "new behaviour in rationals.sml: est1'";
123.602 +-------------------------------------------------------------------------*)
123.603 +
123.604 +
123.605 +(*
123.606 + val t = (term_of o the o (parse thy))
123.607 + "(9 - x ^^^ 2) / (9 - 6 * x + x ^^^ 2)";
123.608 + val Some (t',_) = factor_expanded_ thy t;
123.609 + term2str t';
123.610 +
123.611 + "((-3) - x) * ((-3) + x) / (((-3) + x) * ((-3) + x))"
123.612 + "(3 + x) * (3 - x) / ((3 - x) * (3 - x))"
123.613 +*)
123.614 +
123.615 +
123.616 +
123.617 +(*WN.28.8.02: tests for the 'reverse-rewrite' functions:
123.618 + these are defined in Rationals.ML and stored in
123.619 + the 'reverse-ruleset' cancel*)
123.620 +
123.621 +(*the term for which reverse rewriting is demonstrated*)
123.622 + val t = (term_of o the o (parse thy))
123.623 + "(9 - x ^^^ 2) / (9 + 6 * x + x ^^^ 2)";
123.624 + val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
123.625 + next_rule=nex,normal_form=nor,...},...} = cancel;
123.626 +
123.627 +(*normal_form produces the result in ONE step*)
123.628 + val Some (t',_) = nor t;
123.629 + term2str t';
123.630 +
123.631 +(*initialize the interpreter state used by the 'me'*)
123.632 + val (t,_,revsets,_) = ini t;
123.633 +
123.634 +(*find the rule 'r' to apply to term 't'*)
123.635 + val Some r = nex revsets t;
123.636 + (*val r = Thm ("sym_#mult_2_3","6 = 2 * 3") : rule*)
123.637 +
123.638 +(*check, if the rule 'r' applied by the user to 't' belongs to the ruleset;
123.639 + if the rule is OK, the term resulting from applying the rule is returned,too;
123.640 + there might be several rule applications inbetween,
123.641 + which are listed after the thead in reverse order*)
123.642 + val (r,(t,asm))::_ = loc revsets t r;
123.643 + term2str t;
123.644 + "(9 - x ^^^ 2) / (3 ^^^ 2 + 6 * x + x ^^^ 2)";
123.645 +
123.646 +(*find the next rule to apply*)
123.647 + val Some r = nex revsets t;
123.648 + (*val r = Thm ("sym_#power_3_2","9 = 3 ^^^ 2") : rule*)
123.649 +
123.650 +(*check the next rule*)
123.651 + val (r,(t,asm))::_ = loc revsets t r;
123.652 + term2str t;
123.653 + "(3 ^^^ 2 - x ^^^ 2) / (3 ^^^ 2 + 6 * x + x ^^^ 2)";
123.654 +
123.655 +(*find and check the next rules, rewrite*)
123.656 + val Some r = nex revsets t;
123.657 + val (r,(t,asm))::_ = loc revsets t r;
123.658 + term2str t;
123.659 + "(3 ^^^ 2 - x ^^^ 2) / (3 ^^^ 2 + 2 * 3 * x + x ^^^ 2)";
123.660 +
123.661 + val Some r = nex revsets t;
123.662 + val (r,(t,asm))::_ = loc revsets t r;
123.663 + term2str t;
123.664 + "(3 - x) * (3 + x) / (3 ^^^ 2 + 2 * 3 * x + x ^^^ 2)";
123.665 +
123.666 + val Some r = nex revsets t;
123.667 + val (r,(t,asm))::_ = loc revsets t r;
123.668 + term2str t;
123.669 + "(3 - x) * (3 + x) / ((3 + x) * (3 + x))";
123.670 +
123.671 + val Some r = nex revsets t;
123.672 + val (r,(t,asm))::_ = loc revsets t r;
123.673 + val ss = term2str t;
123.674 + if ss = "(3 - x) / (3 + x)" then ()
123.675 + else raise error "rational.sml: new behav. in rev-set cancel";
123.676 + terms2str asm;
123.677 +
123.678 +
123.679 +
123.680 +(*WN.11.9.02: the 'reverse-ruleset' cancel*)
123.681 +
123.682 + (*the term for which reverse rewriting is demonstrated*)
123.683 + val t = (term_of o the o (parse thy))
123.684 + "(9 + (-1)*x^^^2) / (9 + ((-6)*x + x^^^2))";
123.685 + val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
123.686 + next_rule=nex,normal_form=nor,...},...} = cancel;
123.687 + (*normal_form produces the result in ONE step*)
123.688 + val Some (t',_) = nor t;
123.689 + term2str t';
123.690 + (*initialize the interpreter state used by the 'me'*)
123.691 + val (t,_,revsets,_) = ini t;
123.692 +(*
123.693 + val [rs] = revsets;
123.694 + filter_out (eq_Thms ["sym_real_add_zero_left",
123.695 + "sym_real_mult_0",
123.696 + "sym_real_mult_1"]) rs;
123.697 +
123.698 + 10.10.02: dieser Fall terminiert nicht (make_poly enth"alt zu viele rules)
123.699 + val Some r = nex revsets t;
123.700 + val (r,(t,asm))::_ = loc revsets t r;
123.701 + term2str t;
123.702 +
123.703 + val Some r = nex revsets t;
123.704 + val (r,(t,asm))::_ = loc revsets t r;
123.705 + term2str t;
123.706 +
123.707 + ------ revset ----------------------------------------------------
123.708 +/// [Thm ("sym_real_add_zero_left","?z = 0 + ?z"),
123.709 +/// Thm ("sym_real_mult_0","0 = 0 * ?z"),
123.710 +! Thm ("sym_#mult_2_(-3)","(-6) * x = 2 * ((-3) * x)"),
123.711 +! Thm ("sym_#add_(-3)_3","0 = (-3) + 3"),
123.712 +
123.713 +? Thm ("sym_real_num_collect_assoc",
123.714 + "[| ?l is_const; ?m is_const |]
123.715 + ==> (?l + ?m) * ?n + ?k = ?l * ?n + (?m * ?n + ?k)"),
123.716 +OK Thm ("sym_real_mult_2_assoc","2 * ?z1.0 + ?k = ?z1.0 + (?z1.0 + ?k)"),
123.717 +OK Thm ("sym_real_add_left_commute","?y + (?x + ?z) = ?x + (?y + ?z)"),
123.718 +/// Thm ("sym_real_mult_1","?z = 1 * ?z"),
123.719 +! Thm ("sym_#power_3_2","9 = 3 ^^^ 2"),
123.720 +! Thm ("sym_#mult_-1_-1","1 * x ^^^ 2 = -1 * (-1 * x ^^^ 2)"),
123.721 +! Thm ("sym_#mult_-1_3","(-3) * x = -1 * (3 * x)"),
123.722 +OK Thm ("realpow_twoI","?r1 ^^^ 2 = ?r1 * ?r1" [.]),
123.723 +OK Thm ("sym_real_add_assoc",
123.724 + "?z1.0 + (?z2.0 + ?z3.0) = ?z1.0 + ?z2.0 + ?z3.0"),
123.725 +OK Thm
123.726 + ("sym_real_mult_assoc","?z1.0 * (?z2.0 * ?z3.0) = ?z1.0 * ?z2.0 * ?z3.0"),
123.727 +OK Thm ("sym_real_mult_left_commute",
123.728 + "?z2.0 * (?z1.0 * ?z3.0) = ?z1.0 * (?z2.0 * ?z3.0)"),
123.729 +OK Thm ("sym_real_mult_commute","?w * ?z = ?z * ?w"),
123.730 +? Thm ("sym_real_add_mult_distrib2",
123.731 + "?w * ?z1.0 + ?w * ?z2.0 = ?w * (?z1.0 + ?z2.0)"),
123.732 +? Thm ("sym_real_add_mult_distrib",
123.733 + "?z1.0 * ?w + ?z2.0 * ?w = (?z1.0 + ?z2.0) * ?w"),
123.734 +OK Thm ("real_mult_div_cancel2","?k ~= 0 ==> ?m * ?k / (?n * ?k) = ?m / ?n")]
123.735 + -------- revset ----------------------------------------------------
123.736 +
123.737 + val t = (term_of o the o (parse thy)) "(-6) * x";
123.738 + val t = (term_of o the o (parse thy))
123.739 + "(9 + (-1)*x^^^2) / (9 + ((-6)*x + x^^^2))";
123.740 + val thm = (mk_thm thy "(-6) * x = 2 * ((-3) * x)")
123.741 + handle e => print_exn e;
123.742 + val Some (t',_) = rewrite_ thy e_rew_ord e_rls false thm t;
123.743 + term2str t';
123.744 +----------------------------------------------------------------------*)
123.745 +
123.746 +
123.747 +
123.748 +(* SK: Testbeispiele --- WN kopiert Rational.ML -> rational.sml-----
123.749 +
123.750 +val t1 = (term_of o the o (parse thy)) "((3 * x^^^2 + 6 *x + 3) / (2*x + 2))";
123.751 +val Some (t1',rest)= cancel_ thy t1;
123.752 +val Some (t1'',_)= factor_out_gcd_ thy t1;
123.753 +print(term2str t1'^" + Einschr\"ankung: "^term2str (hd(rest)));
123.754 +term2str t1'';
123.755 +
123.756 +val t1 = (term_of o the o (parse thy)) "((-3 * x^^^2 + 6 *x - 3) / (2*x - 2))";
123.757 +val Some (t1',_)= cancel_ thy t1;
123.758 +val Some (t1'',_)= factor_expanded_ thy t1;
123.759 +term2str t1';
123.760 +term2str t1'';
123.761 +
123.762 +val t2 = (term_of o the o (parse thy)) "((x+ (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
123.763 +val Some (t2',_) = add_fractions_ thy t2;
123.764 +val Some (t2'',_) = common_nominators_ thy t2;
123.765 +term2str t2';
123.766 +term2str t2'';
123.767 +
123.768 +val t2 = (term_of o the o (parse thy)) "((x - 1) / (x + 1)) + ((x + 1) / (x - 1))";
123.769 +val Some (t2',_) = add_expanded_frac_ thy t2;
123.770 +val Some (t2'',_) = common_expanded_nom_ thy t2;
123.771 +term2str t2';
123.772 +term2str t2'';
123.773 +
123.774 +
123.775 +val t3 = (term_of o the o (parse thy)) "((1) / (2*x + 2)) + ((1) / (2*x + (-2))) + ((1) / ( x^^^2 + (-1)))+((1) / (x^^^2 + (-2)*x + 1))";
123.776 +val Some (t3',_) = common_nominators_ thy t3;
123.777 +val Some (t3'',_) = add_fractions_ thy t3;
123.778 +(term2str t3');
123.779 +(term2str t3'');
123.780 +
123.781 +val t3 = (term_of o the o (parse thy)) "((1) / (2*x + 2)) + ((1) / (2*x - 2)) + ((1) / ( x^^^2 - 1))+((1) / (x^^^2 - 2 * x + 1))";
123.782 +val Some (t3',_) = common_expanded_nom_ thy t3;
123.783 +val Some (t3'',_) = add_expanded_frac_ thy t3;
123.784 +(term2str t3');
123.785 +(term2str t3'');
123.786 +-------------------------------*)
123.787 +
123.788 +(*
123.789 +val Some(t4,t5) = norm_rational_ thy t3;
123.790 +term2str t4;
123.791 +term2str (hd(t5));*)
123.792 +
123.793 +(*val test1 = (term_of o the o (parse thy)) "1 - x^^^2 - 5 * x^^^5";
123.794 +val test2 = (term_of o the o (parse thy)) "1 + (-1) * x ^^^ 2 + (-5) * x ^^^ 5";
123.795 +val test2 = (term_of o the o (parse thy)) "1 - x";
123.796 +val test2 = (term_of o the o (parse thy)) "1 + (-1) * x";
123.797 +term2str(expanded2term(test1));
123.798 +term2str(term2expanded(test2)); *)
123.799 +
123.800 +
123.801 +
123.802 +(* WN kopiert 16.10.02 Rational.ML -> rational.sml-----vvv---*)
123.803 +
123.804 + val t=(term_of o the o (parse thy)) "(9 - x^^^2)/(9 - 6*x + x^^^2)";
123.805 + val Some (t',_) = factout_ thy t;
123.806 + val Some (t'',_) = cancel_ thy t;
123.807 + term2str t';
123.808 + term2str t'';
123.809 + "(3 + x) * (3 - x) / ((3 - x) * (3 - x))";
123.810 + "(3 + x) / (3 - x)";
123.811 +
123.812 + val t=(term_of o the o(parse thy))
123.813 + "(9 - x^^^2) / (9 - 6*x + x^^^2) + 1 / (3 - x)";
123.814 + val Some (t',_) = common_nominator_ thy t;
123.815 + val Some (t'',_) = add_fraction_ thy t;
123.816 + term2str t';
123.817 + term2str t'';
123.818 + "(9 - x ^^^ 2) / ((3 - x) * (3 - x)) + 1 * (3 - x) / ((3 - x) * (3 - x))";
123.819 + "(4 + x) / (3 - x)";
123.820 +
123.821 + (*WN.16.10.02 hinzugef"ugt -----vv---*)
123.822 + val t=(term_of o the o(parse thy))
123.823 + "(9 - x^^^2) / (9 - 6*x + x^^^2) + 1";
123.824 + val Some (t',_) = common_nominator_ thy t;
123.825 + val Some (t'',_) = add_fraction_ thy t;
123.826 + term2str t';
123.827 + term2str t'';
123.828 + "(9 - x ^^^ 2) / (9 - 6 * x + x ^^^ 2) +\
123.829 + \1 * (9 - 6 * x + x ^^^ 2) / (9 - 6 * x + x ^^^ 2)";
123.830 + "6 / (3 - x)";
123.831 +
123.832 + val t=(term_of o the o(parse thy))
123.833 + "1 + (9 - x^^^2) / (9 - 6*x + x^^^2)";
123.834 + val Some (t',_) = common_nominator_ thy t;
123.835 + val Some (t'',_) = add_fraction_ thy t;
123.836 + term2str t';
123.837 + term2str t'';
123.838 + "1 * (9 - 6 * x + x ^^^ 2) / (9 - 6 * x + x ^^^ 2) +\
123.839 + \(9 - x ^^^ 2) / (9 - 6 * x + x ^^^ 2)";
123.840 + "6 / (3 - x)";
123.841 + (*WN.16.10.02 hinzugef"ugt -----^^---*)
123.842 +
123.843 + val t=(term_of o the o (parse thy))
123.844 + "(y^^^2 - x^^^2)/(y^^^2 - 2*y*x + x^^^2)";
123.845 + val Some (t',_) = factout_ thy t;
123.846 + val Some (t'',_) = cancel_ thy t;
123.847 + term2str t';
123.848 + term2str t'';
123.849 + "(y + x) * (y - x) / ((y - x) * (y - x))";
123.850 + "(y + x) / (y - x)";
123.851 +
123.852 + val t=(term_of o the o (parse thy))
123.853 + "(y^^^2 - x^^^2)/(y^^^2 - 2*y*x + x^^^2) + 1 / (y - x)";
123.854 + val Some (t',_) = common_nominator_ thy t;
123.855 + val Some (t'',_) = add_fraction_ thy t;
123.856 + term2str t';
123.857 + term2str t'';
123.858 + "((-1) * x ^^^ 2 + y ^^^ 2) / (((-1) * x + y) * ((-1) * x + y)) +\
123.859 + \1 * ((-1) * x + y) / (((-1) * x + y) * ((-1) * x + y))";
123.860 + "((-1) - x - y) / (x - y)";
123.861 + (*WN.16.10.02 ^^^^^^^ Reihenfolge aus Angabe umgekehrt ?!*)
123.862 +
123.863 + val t=(term_of o the o (parse thy))
123.864 + "(x^^^2 - y^^^2)/(x^^^2 - 2*x*y + y^^^2) + 1 / (x - y)";
123.865 + val Some (t',_) = common_nominator_ thy t;
123.866 + val Some (t'',_) = add_fraction_ thy t;
123.867 + term2str t';
123.868 + term2str t'';
123.869 + "((-1) * y ^^^ 2 + x ^^^ 2) / (((-1) * y + x) * ((-1) * y + x)) +\
123.870 + \1 * ((-1) * y + x) / (((-1) * y + x) * ((-1) * y + x))";
123.871 + "((-1) - y - x) / (y - x)";
123.872 + (*WN.16.10.02 ^^^^^^^ lexicographische Ordnung ?!*)
123.873 +
123.874 + val t=(term_of o the o (parse thy))
123.875 + "(y^^^2 - x^^^2)/(y^^^2 - 2*y*x + x^^^2)";
123.876 + val Some (t',_) = norm_expanded_rat_ thy t;
123.877 + term2str t';
123.878 + "(y + x) / (y - x)";
123.879 +(*val Some (t'',_) = norm_rational_ thy t;
123.880 + term2str t'';
123.881 + *** RATIONALS_TERM2POLY_EXCEPTION: Invalid Polynomial
123.882 + WN.16.10.02 ?!*)
123.883 +
123.884 + val t=(term_of o the o (parse thy))
123.885 + "(9 - x^^^2)/(9 - 6*x + x^^^2) + (1)/(3 + x)";
123.886 + val Some (t',_) = norm_expanded_rat_ thy t;
123.887 + term2str t';
123.888 + "(12 + 5 * x + x ^^^ 2) / (9 - x ^^^ 2)";
123.889 +(*val Some (t'',_) = norm_rational_ thy t;
123.890 + term2str t'';
123.891 + *** RATIONALS_TERM2POLY_EXCEPTION: Invalid Polynomial
123.892 + WN.16.10.02 ?!*)
123.893 +
123.894 + val t=(term_of o the o (parse thy))
123.895 + "(9 + (-1)* x^^^2)/(9 + (-1)* 6*x + x^^^2) + (1)/(3 + x)";
123.896 + val Some (t',_) = norm_expanded_rat_ thy t;
123.897 + val Some (t'',_) = norm_rational_ thy t;
123.898 + term2str t';
123.899 + term2str t'';
123.900 + "(12 + 5 * x + x ^^^ 2) / (9 - x ^^^ 2)";
123.901 + "(12 + 5 * x + x ^^^ 2) / (9 + (-1) * x ^^^ 2)";
123.902 +(* WN kopiert 16.10.02 Rational.ML -> rational.sml-----^^^---*)
123.903 +
123.904 +
123.905 +
124.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
124.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/rational.sml Wed Jul 21 13:53:39 2010 +0200
124.3 @@ -0,0 +1,2023 @@
124.4 +(*.tests for rationals
124.5 + author: Stefan Karnel
124.6 + Copyright (c) Stefan Karnel 2002
124.7 + Use is subject to license terms.
124.8 +
124.9 +use"../smltest/IsacKnowledge/rational.sml";
124.10 +use"rational.sml";
124.11 +
124.12 +LEGEND WN070906
124.13 + nonterm.SK marks non-terminating examples
124.14 + ord.SK PARTIALLY marks crucial ordering examples
124.15 + *SK* of some (secondary) interest (on 070906)
124.16 +****************************************************************.*)
124.17 +
124.18 +(******************************************************************
124.19 +WN060104 transfer marked (*SR..*)examples to the exp-collection
124.20 + # exp_IsacCore_Simp_Rat_Cancel.xml from rational.sml (*SRC*) 10 exp
124.21 + # exp_IsacCore_Simp_Rat_Add.xml from rational.sml (*SRA*) 11 exp
124.22 + # exp_IsacCore_Simp_Rat_Mult.xml from rational.sml (*SRM*) 5 exp
124.23 + # exp_IsacCore_Simp_Rat_AddMult.xml from rational.sml (*SRAM*) 11 exp
124.24 + # exp_IsacCore_Simp_Rat_Double.xml from rational.sml (*SRD*) 12 exp
124.25 +*******************************************************************)
124.26 +"-----------------------------------------------------------------";
124.27 +"table of contents -----------------------------------------------";
124.28 +"-----------------------------------------------------------------";
124.29 +"~~~~~BEGIN: decomment structure RationalI : RATIONALI ~~~~~~~~~~~";
124.30 +"-------- ... missing WN060103 -----------------------------------";
124.31 +"-------- fun monom2term, fun poly2term' ------------------------";
124.32 +"~~~~~END: decomment structure RationalI : RATIONALI ~~~~~~~~~~~~~";
124.33 +"-------- cancel from: Mathematik 1 Schalk Reniets Verlag --------";
124.34 +"-------- common_nominator_p ---------------------------- --------";
124.35 +"-------- reverse rewrite ----------------------------------------";
124.36 +"-------- 'reverse-ruleset' cancel_p -----------------------------";
124.37 +"-------- norm_Rational ------------------------------------------";
124.38 +"-------- numeral rationals --------------------------------------";
124.39 +"-------- cancellation -------------------------------------------";
124.40 +"-------- common denominator -------------------------------------";
124.41 +"-------- multiply and cancel ------------------------------------";
124.42 +"-------- common denominator and multiplication ------------------";
124.43 +"-------- double fractions ---------------------------------------";
124.44 +"-------- me Schalk I No.186 -------------------------------------";
124.45 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------";
124.46 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------";
124.47 +"-------- investigate rulesets for cancel_p ----------------------";
124.48 +"-------- investigate format of factout_ and factout_p_ ----------";
124.49 +"-----------------------------------------------------------------";
124.50 +"-----------------------------------------------------------------";
124.51 +"-----------------------------------------------------------------";
124.52 +
124.53 +
124.54 +"~~~~~BEGIN: decomment structure RationalI : RATIONALI ~~~~~~~~~~~";
124.55 +(*.~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
124.56 + tests of internal functions: to make them work,
124.57 + out-comment (*!!!*) in knowledge/Rational.ML:
124.58 +(*##!!!
124.59 +structure RationalI : RATIONALI =
124.60 +struct
124.61 +!!!##*)
124.62 +
124.63 +(*##!!!
124.64 +end;(*struct*)
124.65 +open RationalI;
124.66 +!!!##*)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~.*)
124.67 +
124.68 +(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
124.69 +print("\n\n********************* rational.sml - TESTS *************************\n\n");
124.70 +print("\n\n***** divide tests *****\n");
124.71 +val mv_pquot1 = (#1(mv_division([(1,[1,1,1]),(1,[1,1,0]),(1,[1,0,1]),(1,[0,0,0])],[(1,[1,1,0]),(1,[0,0,0])],LEX_)));
124.72 +(* result: [(1,[0,0,1]),(1,[0,0,0])] *)
124.73 +if mv_pquot1=[(1,[0,0,1]),(1,[0,0,0])] then () else raise error ("rational.sml: example failed");
124.74 +
124.75 +val mv_prest1 = (#2(mv_division([(1,[1,1,1]),(1,[1,1,0]),(1,[1,0,1]),(1,[0,0,0])],[(1,[1,1,0]),(1,[0,0,0])],LEX_)));
124.76 +(* result: [(1,[1,0,1]),(~1,[0,0,1])] *)
124.77 +if mv_prest1=[(1,[1,0,1]),(~1,[0,0,1])] then () else raise error ("rational.sml: example failed");
124.78 +
124.79 +val mv_pquot2 = (#1(mv_division([(4,[2]),(8,[1]),(16,[0])],[(1,[1]),(1,[0])],LEX_)));
124.80 +(* result: [(4,[1]),(4,[0])] *)
124.81 +if mv_pquot2=[(4,[1]),(4,[0])] then () else raise error ("rational.sml: example failed");
124.82 +
124.83 +val mv_prest2 = (#2(mv_division([(4,[2]),(8,[1]),(16,[0])],[(1,[1]),(1,[0])],LEX_)));
124.84 +(* result: [(12,[0]] *)
124.85 +if mv_prest2=[(12,[0])] then () else raise error ("rational.sml: example failed");
124.86 +
124.87 +val mv_pquot3 = (#1(mv_division([(4,[2]),(~4,[0])],[(2,[1]),(2,[0])],LEX_)));
124.88 +(* [(2,[1]),(~2,[0])] *)
124.89 +if mv_pquot3=[(2,[1]),(~2,[0])] then () else raise error ("rational.sml: example failed");
124.90 +
124.91 +val mv_prest3 = (#2(mv_division([(1,[2]),(~1,[0])],[(2,[1]),(2,[0])],LEX_)));
124.92 +(* [(1,[2]),(~1,[0])] *)
124.93 +if mv_prest3=[(1,[2]),(~1,[0])] then () else raise error ("rational.sml: example failed");
124.94 +
124.95 +val mv_pquot4 = (#1(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1])],[(2,[1,0,0]),(4,[0,0,1])],LEX_)));
124.96 +(* [(1,[0,1,1])] *)
124.97 +if mv_pquot4=[(1,[0,1,1])] then () else raise error ("rational.sml: example failed");
124.98 +
124.99 +val mv_prest4 = (#2(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1])],[(2,[1,0,0]),(4,[0,0,1])],GGO_)));
124.100 +(* [(1,[1,1,1]),(~4,[0,1,2]),(4,[1,0,1]),(3,[0,0,1])] *)
124.101 +if mv_prest4 =[(1,[1,1,1]),(~4,[0,1,2]),(4,[1,0,1]),(3,[0,0,1])] then () else raise error ("rational.sml: example failed");
124.102 +
124.103 +val mv_pquot5 = (#1(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1]),(6,[2,1,3]),(4,[0,4,1]),(1,[2,2,1])],[(1,[0,0,1])],LEX_)));
124.104 +(* [(1,[2,2,0]),(6,[2,1,2]),(3,[1,1,0]),(4,[1,0,0]),(4,[0,4,0]),(3,[0,0,0])]*)
124.105 +if mv_pquot5=[(1,[2,2,0]),(6,[2,1,2]),(3,[1,1,0]),(4,[1,0,0]),(4,[0,4,0]),(3,[0,0,0])] then () else raise error ("rational.sml: example failed");
124.106 +
124.107 +val mv_prest5 = (#2(mv_division([(3,[1,1,1]),(4,[1,0,1]),(3,[0,0,1]),(6,[2,1,3]),(4,[0,4,1]),(1,[2,2,1])],[(1,[0,0,1])],LEX_)));
124.108 +(* [] *)
124.109 +if mv_prest5=[] then () else raise error ("rational.sml: example failed");
124.110 +
124.111 +(* (x^2 + 2(a+1)x + (a^2+2a+1)) / (x+a+1) = x+a+1 *)
124.112 +val mv_pquot6 = (#1(mv_division([(1,[2,0,0]),(2,[1,1,0]),(2,[1,0,0]),(1,[0,2,0]),(2,[0,1,0]),(1,[0,0,0])],[(1,[1,0,0]),(1,[0,1,0]),(1,[0,0,0])],LEX_)));
124.113 +if mv_pquot6=[(1,[1,0,0]),(1,[0,1,0]),(1,[0,0,0])] then () else raise error ("rational.sml: example failed");
124.114 +
124.115 +val mv_prest6 = (#2(mv_division([(1,[2,0,0]),(2,[1,1,0]),(2,[1,0,0]),(1,[0,2,0]),(2,[0,1,0]),(1,[0,0,0])],[(1,[1,0,0]),(1,[0,1,0]),(1,[0,0,0])],LEX_)));
124.116 +if mv_prest6=[] then () else raise error ("rational.sml: example failed");
124.117 +
124.118 +
124.119 +print("\n\n***** MV_CONTENT-TESTS *****\n");
124.120 +val mv_cont1=mv_content([(1,[2,1]),(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,1]),(1,[0,0])]);
124.121 +(* [(1,[0,1]),(1,[0,0])] *)
124.122 +if mv_cont1=[(1,[0,1]),(1,[0,0])] then () else raise error ("rational.sml: example failed");
124.123 +
124.124 +val mv_pp1=mv_pp([(1,[1,1]),(1,[1,0]),(1,[0,1]),(1,[0,0])]);
124.125 +(*[(1,[1,0]),(1,[0,0])]*)
124.126 +if mv_pp1=[(1,[1,0]),(1,[0,0])] then () else raise error ("rational.sml: example failed");
124.127 +
124.128 +val mv_cont2=mv_content([(2,[1]),(4,[0])]);
124.129 +(* [(2,[0])] *)
124.130 +if mv_cont2=[(2,[0])] then () else raise error ("rational.sml: example failed");
124.131 +
124.132 +val mv_pp2=mv_pp([(2,[1]),(4,[0])]);
124.133 +(* [(1,[1]),(2,[0])] *)
124.134 +if mv_pp2=[(1,[1]),(2,[0])] then () else raise error ("rational.sml: example failed");
124.135 +
124.136 +val mv_cont3=mv_content[(8,[2,1,1]),(12,[1,0,2]),(10,[2,2,0]),(16,[1,1,1])];
124.137 +(* [(2,[0,0,0])] *)
124.138 +if mv_cont3=[(2,[0,0,0])] then () else raise error ("rational.sml: example failed");
124.139 +
124.140 +val mv_pp3=mv_pp[(8,[2,1,1]),(12,[1,0,2]),(10,[2,2,0]),(16,[1,1,1])];
124.141 +(* [(5,[2,2,0]),(4,[2,1,1]),(8,[1,1,1]),(6,[1,0,2])] *)
124.142 +if mv_pp3=[(5,[2,2,0]),(4,[2,1,1]),(8,[1,1,1]),(6,[1,0,2])] then () else raise error ("rational.sml: example failed");
124.143 +
124.144 +val mv_cont4=mv_content[(2,[2,1,0]),(3,[1,0,1]),(2,[1,1,0]),(3,[0,0,1])];
124.145 +(* [(1,[0,0,0])] *)
124.146 +if mv_cont4=[(1,[0,0,0])] then () else raise error ("rational.sml: example failed");
124.147 +
124.148 +val mv_pp4=mv_pp [(2,[2,1,0]),(3,[1,0,1]),(2,[1,1,0]),(3,[0,0,1])];
124.149 +(* [(2,[2,1,0]),(2,[1,1,0]),(3,[1,0,1]),(3,[0,0,1])] *)
124.150 +if mv_pp4=[(2,[2,1,0]),(2,[1,1,0]),(3,[1,0,1]),(3,[0,0,1])] then () else raise error ("rational.sml: example failed");
124.151 +
124.152 +val con1=mv_content([(9,[2,0]),(15,[1,1]),(12,[1,0]),(6,[0,2]),(12,[0,1])]);
124.153 +(* [(3,[0,0])] *)
124.154 +if con1=[(3,[0,0])] then () else raise error ("rational.sml: example failed");
124.155 +
124.156 +val pp1=mv_pp([(9,[2,0]),(15,[1,1]),(12,[1,0]),(6,[0,2]),(12,[0,1])]);
124.157 +(* [(3,[2,0]),(5,[1,1]),(4,[1,0]),(2,[0,2]),(4,[0,1])] *)
124.158 +if pp1=[(3,[2,0]),(5,[1,1]),(4,[1,0]),(2,[0,2]),(4,[0,1])] then () else raise error ("rational.sml: example failed");
124.159 +
124.160 +val con2=mv_content([(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])]);
124.161 +(* [(1,[0,0])] *)
124.162 +if con2=[(1,[0,0])] then () else raise error ("rational.sml: example failed");
124.163 +
124.164 +val pp2 =mv_pp([(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])]);
124.165 +(* [(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])] *)
124.166 +if pp2=[(1,[2,0]),(1,[1,1]),(1,[1,0]),(1,[0,2]),(1,[0,1])] then () else raise error ("rational.sml: example failed");
124.167 +
124.168 +val cont1 = mv_content [(1,[2,1,0]),(2,[2,1,0])];
124.169 +(* [(3,[0,1,0])] *)
124.170 +if cont1=[(3,[0,1,0])] then () else raise error ("rational.sml: example failed");
124.171 +
124.172 +val pp1 = mv_pp [(1,[2,1,0]),(2,[2,1,0])];
124.173 +(* [(1,[2,0,0])] *)
124.174 +if pp1=[(1,[2,0,0])] then () else raise error ("rational.sml: example failed");
124.175 +
124.176 +val cont2 = mv_content [(4,[1,2,0]),(2,[2,1,0])];
124.177 +(* [(2,[0,1,0])] *)
124.178 +if cont2=[(2,[0,1,0])] then () else raise error ("rational.sml: example failed");
124.179 +
124.180 +val pp2 = mv_pp [(4,[1,2,0]),(2,[2,1,0])];
124.181 +(* [(1,[2,0,0]),(2,[1,1,0])] *)
124.182 +if pp2=[(1,[2,0,0]),(2,[1,1,0])] then () else raise error ("rational.sml: example failed");
124.183 +
124.184 +print("\n\n\n\n********************************************************\n\n");
124.185 +val cont3=mv_content [(65,[3,2,2]),(52,[3,2,1]),(26,[3,1,2]),(~95,[2,2,3]),(~76,[2,2,2]),(35,[2,2,1]),(28,[2,2,0]),(~38,[2,1,3]),(14,[2,1,1])];
124.186 +if cont3=[(5,[0,2,1]),(4,[0,2,0]),(2,[0,1,1])] then () else raise error ("rational.sml: example failed");
124.187 +val pp3=mv_pp [(65,[3,2,2]),(52,[3,2,1]),(26,[3,1,2]),(~95,[2,2,3]),(~76,[2,2,2]),(35,[2,2,1]),(28,[2,2,0]),(~38,[2,1,3]),(14,[2,1,1])];
124.188 +
124.189 +
124.190 +"-------- fun monom2term, fun poly2term' ------------------------";
124.191 +"-------- fun monom2term, fun poly2term' ------------------------";
124.192 +"-------- fun monom2term, fun poly2term' ------------------------";
124.193 +val t = monom2term ((3,[2,1,0]), ["c","b","a"](*reverse ???SK-*));
124.194 +term2str t = "3 * (c ^^^ 2 * b)" (*true*);
124.195 +
124.196 +val t = monom2term ((1,[1,0]), ["b","a"]);
124.197 +term2str t = "b" (*true*);
124.198 +
124.199 +val t = poly2term ([(1,[0,0,0]),(2,[1,0,0]),(3,[2,1,0]),(4,[3,2,1])],
124.200 + ["c","b","a"]);
124.201 +term2str t = "1 + 2 * c + 3 * (c ^^^ 2 * b) + 4 * (c ^^^ 3 * (b ^^^ 2 * a))";
124.202 +
124.203 +val t = poly2term ([(1,[1,0]),(1,[0,1])], ["b","a"]);
124.204 +term2str t = "a + b" (*true*);
124.205 +
124.206 +
124.207 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
124.208 +"~~~~~END: decomment structure RationalI : RATIONALI ~~~~~~~~~~~~~";
124.209 +"~~~~~END: decomment structure RationalI : RATIONALI ~~~~~~~~~~~~~";
124.210 +"~~~~~END: decomment structure RationalI : RATIONALI ~~~~~~~~~~~~~";
124.211 +
124.212 +
124.213 +fun parse_rat str = (term_of o the o (parse thy)) str;
124.214 +
124.215 +print("\n\n***** mv_gcd-tests *****\n");
124.216 +val ggt1 = mv_gcd [(4,[2,2]),(8,[1,1]),(4,[0,0])] [(2,[1,1]),(2,[0,0])];
124.217 +(* [(2,[1,1]),(2,[0,0])] *)
124.218 +if ggt1=[(2,[1,1]),(2,[0,0])] then () else raise error ("rational.sml: example failed");
124.219 +
124.220 +val ggt2 = mv_gcd [(8,[2,1,1]),(12,[1,0,2]),(10,[2,2,0]),(15,[1,1,1])] [(2,[2,1,0]),(3,[1,0,1]),(2,[1,1,0]),(3,[0,0,1])];
124.221 +(* [(2,[1,1,0]),(3,[0,0,1])] *)
124.222 +if ggt2=[(2,[1,1,0]),(3,[0,0,1])] then () else raise error ("rational.sml: example failed");
124.223 +
124.224 +
124.225 +val ggt3 = mv_gcd [(1,[2,0]),(~2,[1,1]),(1,[0,2])] [(1,[1,0]),(~1,[0,1])];
124.226 +(* [(1,[1,0]),(~1,[0,1])] *)
124.227 +if ggt3=[(1,[1,0]),(~1,[0,1])] then () else raise error ("rational.sml: example failed");
124.228 +
124.229 +
124.230 +val ggt4 = mv_gcd [(1,[2,1,0]),(2,[2,1,0])] [(5,[1,0,0])];
124.231 +(* [(1,[1,0,0])] *)
124.232 +if ggt4=[(1,[1,0,0])] then () else raise error ("rational.sml: example failed");
124.233 +
124.234 +
124.235 +val ggt5 = mv_gcd [(4,[2,0]),(~8,[1,1]),(4,[0,2])] [(1,[2,0]),(~1,[0,2])];
124.236 +(* [(1,[1,0]),(~1,[0,1])] *)
124.237 +if ggt5=[(1,[1,0]),(~1,[0,1])] then () else raise error ("rational.sml: example failed");
124.238 +
124.239 +
124.240 +val ggt6 = mv_gcd [(10,[2,1,1]),(14,[1,1,0]),(3,[1,0,1]),(20,[1,2,1])] [(5,[1,1,1]),(7,[2,1,1])];
124.241 +(* [(1,[0,0,0])] *)
124.242 +if ggt6=[(1,[1,0,0])] then () else raise error ("rational.sml: example failed");
124.243 +
124.244 +print("\n\n***** kgv-tests *****\n");
124.245 +val kgv1=mv_lcm [(10,[])] [(15,[])];
124.246 +(* [(30,[])] *)
124.247 +if kgv1=[(30,[])] then () else raise error ("rational.sml: example failed");
124.248 +
124.249 +val kgv2=mv_lcm [(1,[2,0]),(~2,[1,1]),(1,[0,2])] [(1,[1,0]),(~1,[0,1])];
124.250 +(* [(1,[2,0]),(~2,[1,1]),(1,[0,2])] *)
124.251 +if kgv2=[(1,[2,0]),(~2,[1,1]),(1,[0,2])] then () else raise error ("rational.sml: example failed");
124.252 +
124.253 +val kgv3=mv_lcm [(4,[2,0]),(~8,[1,1]),(4,[0,2])] [(1,[2,0]),(~1,[0,2])];
124.254 +(* [(4,[3,0]),(~4,[2,1]),(~4,[1,2]),(4,[0,3])] *)
124.255 +if kgv3=[(4,[3,0]),(~4,[2,1]),(~4,[1,2]),(4,[0,3])] then () else raise error ("rational.sml: example failed");
124.256 +
124.257 +(*!!!--------
124.258 +print("\n\n***** STEP_CANCEL_TESTS: *****\n");
124.259 +
124.260 +val term2 = (term_of o the o (parse thy)) " (9 * a^^^2 * b) / (6 * a * c)";
124.261 +val div2 = term2str (step_cancel term2);
124.262 +if div2 = "3 * (a * b) * (3 * a) / (2 * c * (3 * a))" then () else raise error ("rational.sml: example failed");
124.263 +
124.264 +
124.265 +val term1 = (term_of o the o (parse thy)) "(10 * a^^^2 * b * c + 14 * a * b + 3 * a * c + 20 * a * b^^^2 * c) / a";
124.266 +val div1 = term2str(step_cancel term1);
124.267 +if div1 = "(3 * c + 14 * b + 20 * (b ^^^ 2 * c) + 10 * (a * (b * c))) * a / (1 * a)" then () else raise error ("rational.sml: example failed");
124.268 +
124.269 +val term3 = (term_of o the o (parse thy)) "(10 * a^^^2 * b * c) / (1 * x * y * z) ";
124.270 +val div3 = term2str(step_cancel term3);
124.271 +if div3="10 * a ^^^ 2 * b * c / (1 * x * y * z)" then () else raise error ("rational.sml: example failed");
124.272 +
124.273 +--------------------------------------------------------------------------!!!*)
124.274 +
124.275 +(*-----versuche 13.3.03-----
124.276 + val t = str2term "1 - x^^^2 - 5 * x^^^5";
124.277 + val vs=(((map free2str) o vars) t);
124.278 + val Some ml = expanded2poly t vs;
124.279 + poly2term (ml, vs);
124.280 + poly2term'(rev(sort (mv_geq LEX_) (ml)),vs);
124.281 + poly2term'([(~5,[5]),(~1,[2]),(1,[0])], vs);
124.282 + monom2term((~5,[5]),vs);
124.283 + monom2term((~1,[2]),vs);
124.284 + val t' = monom2term((1,[0]),vs);(*uncaught exception LIST*)
124.285 +
124.286 + val (i,is) = (~1,[2]);
124.287 + val ttt = Const ("op *", [HOLogic.realT,HOLogic.realT]---> HOLogic.realT) $
124.288 + (Const ("uminus", HOLogic.realT --> HOLogic.realT) $
124.289 + Free ((str_of_int o abs) i, HOLogic.realT)) $
124.290 + powerproduct2term(is, vs);
124.291 + term2str ttt;
124.292 +-------versuche 13.3.03-----*)
124.293 +
124.294 + val t = str2term "1 - x^^^2 - 5 * x^^^5";
124.295 + val Some t' = expanded2polynomial t; term2str t';
124.296 +"1 + - 1 * x ^^^ 2 + - 5 * x ^^^ 5";
124.297 + val t = str2term "1 - x";
124.298 + val Some t' = expanded2polynomial t; term2str t';
124.299 +"1 + - 1 * x";
124.300 + val t = str2term "1 + (-1) * x";
124.301 + val Some t' = expanded2polynomial t; term2str t';
124.302 +"1 + - 1 * x";
124.303 + val t = (term_of o the o (parse thy)) "1 + (-1) * x ^^^ 2 + (-5) * x ^^^5";
124.304 + val Some t' = polynomial2expanded t; term2str t';
124.305 +"1 - x ^^^ 2 - 5 * x ^^^ 5";
124.306 +
124.307 +
124.308 +" external calculating functions test ";
124.309 +" external calculating functions test ";
124.310 +" external calculating functions test ";
124.311 +
124.312 +val t1 = (term_of o the o (parse thy)) "((3 * x^^^2 + 6 *x + 3) / (2*x + 2))";
124.313 +val Some (t1',asm)= factout_p_ thy t1;
124.314 +term2str t1'; terms2str asm;
124.315 +"(3 + 3 * x) * (1 + 1 * x) / (2 * (1 + 1 * x))";
124.316 +"[]";
124.317 +val Some (t1',asm)= cancel_p_ thy t1;
124.318 +term2str t1'; terms2str asm;
124.319 +"(3 + 3 * x) / 2";
124.320 +"[\"1 + 1 * x ~= 0\"]";
124.321 +
124.322 +val t = (term_of o the o (parse thy)) "((-3 * x^^^2 + 6 *x - 3) / (2*x - 2))";
124.323 +val Some (t',asm)= cancel_ thy t;
124.324 +term2str t'; terms2str asm;
124.325 +"(3 - 3 * x) / 2";
124.326 +"[\"-1 + x ~= 0\"]";
124.327 +val Some (t',asm)= factout_ thy t;
124.328 +term2str t'; terms2str asm;
124.329 +"(3 - 3 * x) * (-1 + x) / (2 * (-1 + x))";
124.330 +"[]";
124.331 +
124.332 +val t = str2term "((x+ (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
124.333 +val Some (t',asm) = add_fraction_p_ thy t;
124.334 +term2str t'; terms2str asm;
124.335 +"(2 + 2 * x ^^^ 2) / (-1 + 1 * x ^^^ 2)";
124.336 +"[]";
124.337 +val Some (t',asm) = common_nominator_p_ thy t;
124.338 +term2str t'; terms2str asm;
124.339 +"(-1 + 1 * x) * (-1 + 1 * x) / ((1 + 1 * x) * (-1 + 1 * x)) +\n(1 + 1 * x) * (1 + 1 * x) / ((1 + 1 * x) * (-1 + 1 * x))";
124.340 +"[]";
124.341 +
124.342 +val t = str2term "((x - 1) / (x + 1)) + ((x + 1) / (x - 1))";
124.343 +val Some (t',asm) = add_fraction_ thy t;
124.344 +term2str t'; terms2str asm;
124.345 +"(2 + 2 * x ^^^ 2) / (-1 + x ^^^ 2)";
124.346 +"[]";
124.347 +val Some (t',asm) = common_nominator_ thy t;
124.348 +term2str t'; terms2str asm;
124.349 +"(-1 + x) * (-1 + x) / ((1 + x) * (-1 + x)) +\n(1 + x) * (1 + x) / ((1 + x) * (-1 + x))";
124.350 +"[]";
124.351 +
124.352 +val t = str2term "((1) / (2*x + 2)) + ((1) / (2*x + (-2))) + ((1) / ( x^^^2 + (-1)))+((1) / (x^^^2 + (-2)*x + 1))";
124.353 +val Some (t',asm) = common_nominator_p_ thy t;
124.354 +term2str t'; terms2str asm;
124.355 +"1 * (1 + -2 * x + 1 * x ^^^ 2) /\n((-1 + 1 * x) * (2 * ((-1 + 1 * x) * (1 + 1 * x)))) +\n(1 * (-1 + 1 * x ^^^ 2) /\n ((-1 + 1 * x) * (2 * ((-1 + 1 * x) * (1 + 1 * x)))) +\n (1 * (-2 + 2 * x) / ((-1 + 1 * x) * (2 * ((-1 + 1 * x) * (1 + 1 * x)))) +\n 1 * (#";
124.356 +"[]";
124.357 +val Some (t',asm) = add_fraction_p_ thy t;
124.358 +term2str t'; terms2str asm;
124.359 +"1 * x / (1 + -2 * x + 1 * x ^^^ 2)";
124.360 +"[\"1 + 1 * x ~= 0\"]";
124.361 +val Some(t',asm) = norm_rational_ thy t;
124.362 +term2str t'; terms2str asm;
124.363 +"1 * x / (1 + -2 * x + 1 * x ^^^ 2)";
124.364 +"[\"1 + 1 * x ~= 0\"]";
124.365 +
124.366 +val t3 = (term_of o the o (parse thy)) "((1) / (2*x + 2)) + ((1) / (2*x - 2)) + ((1) / ( x^^^2 - 1))+((1) / (x^^^2 - 2 * x + 1))";
124.367 +val Some (t3',_) = common_nominator_ thy t3;
124.368 +val Some (t3'',_) = add_fraction_ thy t3;
124.369 +(term2str t3');
124.370 +(term2str t3'');
124.371 +
124.372 +val Some(t4,t5) = norm_expanded_rat_ thy t3;
124.373 +term2str t4;
124.374 +term2str (hd(t5));
124.375 +
124.376 +
124.377 +
124.378 + val t=(term_of o the o (parse thy)) "(9 - x^^^2)/(9 - 6*x + x^^^2)";
124.379 + val Some (t',_) = factout_ thy t;
124.380 + val Some (t'',_) = cancel_ thy t;
124.381 + term2str t';
124.382 + term2str t'';
124.383 + "(3 + x) * (3 - x) / ((3 - x) * (3 - x))";
124.384 + "(3 + x) / (3 - x)";
124.385 +
124.386 + val t=(term_of o the o (parse thy))
124.387 + "(9 - x^^^2) / (9 - 6*x + x^^^2) + 1 / (3 - x)";
124.388 + val Some (t',_) = common_nominator_ thy t;
124.389 + val Some (t'',_) = add_fraction_ thy t;
124.390 + term2str t';
124.391 + term2str t'';
124.392 + "(9 - x ^^^ 2) / ((3 - x) * (3 - x)) + 1 * (3 - x) / ((3 - x) * (3 - x))";
124.393 + "(4 + x) / (3 - x)";
124.394 +
124.395 +(*WN021016 added -----vv---*)
124.396 +val t = str2term "(9 - x^^^2) / (9 - 6*x + x^^^2) + 1";
124.397 +val Some (t',_) = common_nominator_ thy t;
124.398 +val Some (t'',_) = add_fraction_ thy t;
124.399 +term2str t' = "(9 - x ^^^ 2) / (9 - 6 * x + x ^^^ 2) +\n1\
124.400 + \ * (9 - 6 * x + x ^^^ 2) / (9 - 6 * x + x ^^^ 2)" (*true*);
124.401 +term2str t'' = "6 / (3 - x)" (*true*);
124.402 +
124.403 +val t = str2term "1 + (9 - x^^^2) / (9 - 6*x + x^^^2)";
124.404 +val Some (t',_) = common_nominator_ thy t;
124.405 +val Some (t'',_) = add_fraction_ thy t;
124.406 +term2str t' = "1 * (9 - 6 * x + x ^^^ 2) / (9 - 6 * x + x ^^^ 2) +\n\
124.407 + \(9 - x ^^^ 2) / (9 - 6 * x + x ^^^ 2)" (*true*);
124.408 +term2str t'' = "6 / (3 - x)" (*true*);
124.409 +(*WN021016 added -----^^---*)
124.410 +(*WN030602 added -----vv--- no rewrite -> None !*)
124.411 +val t = str2term "1 / a";
124.412 +val None = cancel_p_ thy t;
124.413 +val None = rewrite_set_ thy false cancel_p t;
124.414 +(*WN.2.6.03 added -------^^---*)
124.415 +
124.416 +val t = str2term "(y^^^2 - x^^^2)/(y^^^2 - 2*y*x + x^^^2)";
124.417 +val Some (t',_) = factout_ thy t;
124.418 +val Some (t'',_) = cancel_ thy t;
124.419 +term2str t' = "(y + x) * (y - x) / ((y - x) * (y - x))"(*true*);
124.420 +term2str t'' = "(y + x) / (y - x)";
124.421 +
124.422 +val t = str2term "(y^^^2 - x^^^2)/(y^^^2 - 2*y*x + x^^^2) + 1 / (y - x)";
124.423 +val Some (t',_) = common_nominator_ thy t;
124.424 +val Some (t'',_) = add_fraction_ thy t;
124.425 +term2str t' =
124.426 +"(-1 * x ^^^ 2 + y ^^^ 2) / ((-1 * x + y) * (-1 * x + y)) +\n1\
124.427 +\ * (-1 * x + y) / ((-1 * x + y) * (-1 * x + y))" (*true*);
124.428 +term2str t'' = "(-1 - x - y) / (x - y)" (*true*);
124.429 +
124.430 +val t = str2term "(x^^^2 - y^^^2)/(x^^^2 - 2*x*y + y^^^2) + 1 / (x - y)";
124.431 +val Some (t',_) = common_nominator_ thy t;
124.432 +val Some (t'',_) = add_fraction_ thy t;
124.433 +if term2str t' = "(-1 * y ^^^ 2 + x ^^^ 2) / ((-1 * y + x) * (-1 * y + x))\
124.434 +\ +\n1 * (-1 * y + x) / ((-1 * y + x) * (-1 * y + x))" then ()
124.435 +else raise error "rational.sml lex-ord 1";
124.436 +if term2str t'' = "(-1 - y - x) / (y - x)" then ()
124.437 +else raise error "rational.sml lex-ord 2";
124.438 +(*WN.16.10.02 WN070905 lexicographische Ordnung erhalten ! SK.ord*)
124.439 +
124.440 +
124.441 +val t = str2term "(x^^^2 - y^^^2)/(x^^^2 - 2*x*y + y^^^2)";
124.442 +val Some (t',_) = norm_expanded_rat_ thy t;
124.443 +if term2str t' = "(x + y) / (x - y)" then ()
124.444 +else raise error "rational.sml term2poly: invalid x ^^^ 2 - y ^^^ 2 1";
124.445 +(*val Some (t'',_) = norm_rational_ thy t;
124.446 + *** RATIONALS_TERM2POLY_EXCEPTION: Invalid Polynomial
124.447 +WN.16.10.02 ?! + WN060831???SK4
124.448 +WN070905 *** term2poly: invalid = x ^^^ 2 - y ^^^ 2*)
124.449 +
124.450 +
124.451 +val t = str2term "(9 - x^^^2)/(9 - 6*x + x^^^2) + (1)/(3 + x)";
124.452 +val Some (t',_) = norm_expanded_rat_ thy t;
124.453 +if term2str t' = "(12 + 5 * x + x ^^^ 2) / (9 - x ^^^ 2)" then ()
124.454 +else raise error "rational.sml (9 - x^^^2)/(9 - 6*x + x^^^2) +...";
124.455 +(*val Some (t'',_) = norm_rational_ thy t;
124.456 + *** RATIONALS_TERM2POLY_EXCEPTION: Invalid Polynomial WN.16.10.02 ?!
124.457 +WN070906 *** term2poly: invalid = 9 - x ^^^ 2 SK.term2poly*)
124.458 +
124.459 + val t=(term_of o the o (parse thy))
124.460 + "(9 + (-1)* x^^^2)/(9 + (-1)* 6*x + x^^^2) + (1)/(3 + x)";
124.461 + val Some (t',_) = norm_expanded_rat_ thy t;
124.462 + val Some (t'',_) = norm_rational_ thy t;
124.463 + term2str t';
124.464 + term2str t'';
124.465 + "(12 + 5 * x + x ^^^ 2) / (9 - x ^^^ 2)";
124.466 + "(12 + 5 * x + x ^^^ 2) / (9 + (-1) * x ^^^ 2)";
124.467 +
124.468 +
124.469 +" examples from: Mathematik 1 Schalk Reniets Verlag ";
124.470 +" examples from: Mathematik 1 Schalk Reniets Verlag ";
124.471 +" examples from: Mathematik 1 Schalk Reniets Verlag ";
124.472 +
124.473 +
124.474 +"-------- cancel from: Mathematik 1 Schalk Reniets Verlag --------";
124.475 +"-------- cancel from: Mathematik 1 Schalk Reniets Verlag --------";
124.476 +"-------- cancel from: Mathematik 1 Schalk Reniets Verlag --------";
124.477 +val thy' = "Rational.thy";
124.478 +val rls' = "cancel";
124.479 +val mp = "make_polynomial";
124.480 +
124.481 +print("\n\nexample 186:\n");
124.482 +print("a)\n");
124.483 +val e186a'="(14 * x * y) / ( x * y )";(*SRC*)
124.484 +val e186a = the (rewrite_set thy' false "cancel" e186a');
124.485 + is_expanded (parse_rat "14 * x * y");
124.486 + is_expanded (parse_rat "x * y");
124.487 +
124.488 +print("b)\n");
124.489 +val e186b'="(60 * a * b) / ( 15 * a * b )";
124.490 +val e186b = the (rewrite_set thy' false "cancel" e186b');
124.491 +print("c)\n");
124.492 +val e186c'="(144 * a^^^2 * b * c) / (12 * a * b * c )";
124.493 +val e186c = (the (rewrite_set thy' false "cancel" e186c'))
124.494 + handle e => print_exn e;
124.495 +val t = (term_of o the o (parse thy)) e186c';
124.496 +atomt t;
124.497 +
124.498 +print("\n\nexample 187:\n");
124.499 +print("a)\n");
124.500 +val e187a'="(12 * x * y) / (8 * y^^^2 )";(*SRC*)
124.501 +val e187a = the (rewrite_set thy' false "cancel" e187a');
124.502 +print("b)\n");
124.503 +val e187b'="(8 * x^^^2 * y * z ) / (18 * x * y^^^2 * z )";
124.504 +val e187b = the (rewrite_set thy' false "cancel" e187b');
124.505 +print("c)\n");
124.506 +val e187c'="(9 * x^^^5 * y^^^2 * z^^^4) / (15 * x^^^6 * y^^^3 * z )";(*SRC*)
124.507 +val e187c = the (rewrite_set thy' false "cancel" e187c');
124.508 +
124.509 +"example 188:";
124.510 +val e188a'="(-8 + 8 * x) / (-9 + 9 * x)";(*SRC*)
124.511 +val e188a = the (rewrite_set thy' false "cancel" e188a');
124.512 + is_expanded (parse_rat "8 * x + -8");
124.513 +(* e188a = ("8 / 9",["not ((-1) + x = 0)"]) then () 13.3.03*)
124.514 +if e188a = ("8 / 9",["-1 + x ~= 0"]) then ()
124.515 +else raise error "rational.sml: e188a new behaviour";
124.516 +val Some (t,_) = rewrite_set thy' false mp
124.517 + "(8*((-1) + x))/(9*((-1) + x))";
124.518 +print("b)\n");
124.519 +val e188b'="(-15 + 5 * x) / (-18 + 6 * x)";(*SRC*)
124.520 +val Some (t,_) = rewrite_set thy' false "cancel" e188b';
124.521 +t = "5 / 6" (*true*);
124.522 +print("c)\n");
124.523 +
124.524 +val e188c'="( a + -1 * b ) / ( b + -1 * a )";
124.525 +val e188c = the (rewrite_set thy' false "cancel_p" e188c');
124.526 +(*is_expanded (parse_rat "a + -1 * b");*)
124.527 +val Some (t,_) =
124.528 + rewrite_set thy' false mp "((-1)*(b + (-1) * a))/(1*(b + (-1) * a))";
124.529 +if t= "(a + -1 * b) / (-1 * a + b)" then()
124.530 +else raise error "rational.sml: e188c new behaviour";
124.531 +
124.532 +print("\n\nexample 190:\n");
124.533 +print("c)\n");
124.534 +val e190c'="( 27 * a^^^3 + 9 * a^^^2 + 3 * a + 1 ) / ( 27 * a^^^3 + 18 * a^^^2 + 3 * a )";
124.535 +val e190c = the (rewrite_set thy' false "cancel" e190c');
124.536 +val Some (t,_) = rewrite_set thy' false mp "((1 + 9 * a ^^^ 2)*(1 + 3 * a))/((3 * a + 9 * a ^^^ 2)*(1 + 3 * a))";
124.537 +if t = "(1 + 3 * a + 9 * a ^^^ 2 + 27 * a ^^^ 3) /\n(3 * a + 18 * a ^^^ 2 + 27 * a ^^^ 3)" then ()
124.538 +else raise error "rational.sml: e190c new behaviour";
124.539 +
124.540 +print("\n\nexample 191:\n");
124.541 +print("a)\n");
124.542 +val e191a'="( x^^^2 + -1 * y^^^2 ) / ( x + y )";
124.543 +(*WN.23.10.02-------
124.544 +val e191a = the (rewrite_set thy' false "cancel" e191a');
124.545 + is_expanded (parse_rat "x^^^2 + -1 * y^^^2");
124.546 + false;
124.547 + is_expanded (parse_rat "x + y");
124.548 + true; -----------*)
124.549 +val Some (t,_) = rewrite_set thy' false mp "((x + (-1) * y)*(x + y))/((1)*(x + y))";
124.550 +(* t="(x ^^^ 2 + -1 * y ^^^ 2) / (x + y)" then() WN.13.3.03*)
124.551 +if t="(x ^^^ 2 + -1 * y ^^^ 2) / (x + y)" then()
124.552 +else raise error "rational.sml: e191a new behaviour";
124.553 +
124.554 +print("c)\n");
124.555 +val e191c'="( 9 * x^^^2 + -30 * x + 25 ) / ( 9 * x^^^2 + -25 )";
124.556 +(*WN.23.10.02-------
124.557 +val e191c = the (rewrite_set thy' false "cancel" e191c');
124.558 + is_expanded (parse_rat "9 * x^^^2 + -30 * x + 25");
124.559 + false;
124.560 + is_expanded (parse_rat "25 + -30*x + 9*x^^^2");
124.561 + false;
124.562 + is_expanded (parse_rat "-25 + 9*x^^^2");
124.563 + true;------------*)
124.564 +val Some (t,_) = rewrite_set thy' false mp "(((-5) + 3 * x)*((-5) + 3 * x))/((5 + 3 * x)*((-5) + 3 * x))";
124.565 +(* t="(25 + ((-30) * x + 9 * x ^^^ 2)) / ((-25) + 9 * x ^^^ 2)"then() 13.3.03*)
124.566 +if t= "(25 + -30 * x + 9 * x ^^^ 2) / (-25 + 9 * x ^^^ 2)" then()
124.567 +else raise error "rational.sml: 'e191c' new behaviour";
124.568 +
124.569 +
124.570 +print("\n\nexample 192:\n");
124.571 +print("b)\n");
124.572 +val e192b'="( 7 * x^^^3 + -1 * x^^^2 * y ) / ( 7 * x * y^^^2 + -1 * y^^^3 )";
124.573 +(*WN.23.10.02-------
124.574 +val e192b = the (rewrite_set thy' false "cancel" e192b');
124.575 +-------------------*)
124.576 +val Some (t',_) = rewrite_set thy' false mp "((x ^^^ 2)*(7 * x + (-1) * y))/((y ^^^ 2)*(7 * x + (-1) * y))";
124.577 +if t' = "(7 * x ^^^ 3 + -1 * x ^^^ 2 * y) / (7 * x * y ^^^ 2 + -1 * y ^^^ 3)"
124.578 +(*"(-1 * y * x ^^^ 2 + 7 * x ^^^ 3) / (-1 * y ^^^ 3 + 7 * x * y ^^^ 2)"WN050929*)
124.579 +then () else raise error "rational.sml: 'e192b' new behaviour";
124.580 +(*^^^ works with MG's simplifier vvv*)
124.581 +val t =str2term"((x ^^^ 2)*(7 * x + (-1) * y))/((y ^^^ 2)*(7 * x + (-1) * y))";
124.582 +val Some (t',_) = rewrite_set_ Isac.thy false make_polynomial t;
124.583 +if term2str t' = "(7 * x ^^^ 3 + -1 * x ^^^ 2 * y) / (7 * x * y ^^^ 2 + -1 * y ^^^ 3)" then () else raise error "rational.sml: 'e192b'MG new behaviour";
124.584 +
124.585 +
124.586 +print("\n\nexample 193:\n");
124.587 +print("a)\n");
124.588 +val e193a'="( x^^^2 + -6 * x + 9 ) / ( x^^^2 + -9 )";
124.589 +(*WN.23.10.02-------
124.590 +val e193a = the (rewrite_set thy' false "cancel" e193a');
124.591 +-------------------*)
124.592 +print("b)\n");
124.593 +val e193b'="( x^^^2 + -8 * x + 16 ) / ( 2 * x^^^2 + -32 )";
124.594 +(*WN.23.10.02-------
124.595 +val e193b = the (rewrite_set thy' false "cancel" e193b');
124.596 +print("c)\n");
124.597 +val e193c'="( 2 * x + -50 * x^^^3 ) / ( 25 * x^^^2 + -10 * x + 1 )";
124.598 +val Some(t,_) = rewrite_set thy' false "cancel" e193c';
124.599 +-------------------*)
124.600 +
124.601 +val wn01 = "(-25 + 9*x^^^2)/(5 + 3*x)";
124.602 +val Some (t,_) = rewrite_set thy' false "cancel" wn01;
124.603 +(* t = "((-5) + 3 * x) / 1" then () WN.13.3.03*)
124.604 +if t = "(-5 + 3 * x) / 1" then ()
124.605 +else raise error "rational.sml: new behav. in cancel wn01";
124.606 +
124.607 +
124.608 +"-------- common_nominator_p ---------------------------- --------";
124.609 +"-------- common_nominator_p ---------------------------- --------";
124.610 +"-------- common_nominator_p ---------------------------- --------";
124.611 +val rls' = "common_nominator_p";
124.612 +
124.613 +print("\n\nexample 204:\n");
124.614 +print("a)\n");
124.615 +val e204a'="((5 * x) / 9) + ((3 * x) / 9) + (x / 9)";
124.616 +val e204a = the (rewrite_set thy' false "common_nominator_p" e204a');
124.617 +print("b)\n");
124.618 +val e204b'="5 / x + -3 / x + -1 / x";
124.619 +val e204b = the (rewrite_set thy' false "common_nominator_p" e204b');
124.620 +
124.621 +print("\n\nexample 205:\n");
124.622 +print("a)\n");
124.623 +val e205a'="((4 * x + 7) / 8) + ((4 * x + 3) / 8)";
124.624 +val e205a = the (rewrite_set thy' false "common_nominator_p" e205a');
124.625 +print("b)\n");
124.626 +val e205b'="((5 * x + 2) / 3) + ((-2 * x + 1) / 3)";
124.627 +val e205b = the (rewrite_set thy' false "common_nominator_p" e205b');
124.628 +
124.629 +print("\n\nexample 206:\n");
124.630 +print("a)\n");
124.631 +val e206a'="((5 * x + 4) / (2 * x + -1)) + ((9 * x + 5) / (2 * x + -1))";
124.632 +val e206a = the (rewrite_set thy' false "common_nominator_p" e206a');
124.633 +print("b)\n");
124.634 +val e206b'="((17 * x + -23) / (5 * x + 4)) + ((-25 + -17 * x) / (5 * x + 4))";
124.635 +val e206b = the (rewrite_set thy' false "common_nominator_p" e206b');
124.636 +
124.637 +print("\n\nexample 207:\n");
124.638 +val e207'="((3 * x * y + 3 * y) / (x * y)) + ((5 * x * y + 7 * y) / (x * y)) + ((9 * x * y + -2 * y) / (x * y)) + ((x * y + 4 * y) / (x * y)) ";
124.639 +val e207 = the (rewrite_set thy' false "common_nominator_p" e207');
124.640 +
124.641 +print("\n\nexample 208:\n");
124.642 +val e208'="((3 * x + 2) / (x + 2)) + ((5 * x + -1) / (x + 2)) + ((-7 * x + -3) / (x + 2)) + ((-1 * x + -3) / (x + 2)) ";
124.643 +val e208 = the (rewrite_set thy' false "common_nominator_p" e208');
124.644 +
124.645 +print("\n\nexample 209:\n");
124.646 +val e209'="((3 * x + -7 * y + 3 * z) / (4)) + ((2 * x + 17 * y + 10 * z) / (4)) + ((-1 * x + 2 * y + z) / (4)) ";
124.647 +val e209 = the (rewrite_set thy' false "common_nominator_p" e209');
124.648 +
124.649 +print("\n\nexample 210:\n");
124.650 +val e210'="((2 * x + 3 + -1 * x^^^2) / (5 * x)) + ((5 * x^^^2 + -2 * x + 1) / (5 * x)) + ((-3 * x^^^2 + -2 * x + 1) / (5 * x)) + ((-1 * x^^^2 + -3 * x + -5) / (5 * x)) ";
124.651 +val e210 = the (rewrite_set thy' false "common_nominator_p" e210');
124.652 +
124.653 +print("\n\nexample 211:\n");
124.654 +print("a)\n");
124.655 +val e211a'="((b) / (a + -1 * b)) + ((-1 * a) / (a + -1 * b))";
124.656 +val e211a = the (rewrite_set thy' false "common_nominator_p" e211a');
124.657 +print("b)\n");
124.658 +val e211b'="((b) / (b^^^2 + -1 * a^^^2)) + ((-1 * a) / (b^^^2 + -1 * a^^^2))";
124.659 +val e211b = the (rewrite_set thy' false "common_nominator_p" e211b');
124.660 +
124.661 +print("\n\nexample 212:\n");
124.662 +print("a)\n");
124.663 +val e212a'="((4) / (x)) + ((-3) / (y)) + -1";
124.664 +val e212a = the (rewrite_set thy' false "common_nominator_p" e212a');
124.665 +print("b)\n");
124.666 +val e212b'="((4) / (x)) + ((-5) / (y)) + ((6) / (x*y))";
124.667 +val e212b = the (rewrite_set thy' false "common_nominator_p" e212b');
124.668 +
124.669 +print("\n\nexample 213:\n");
124.670 +print("a)\n");
124.671 +val e213a'="((5 * x) / (3 * y^^^2)) + ((19 * z) / (6 * x * y)) + ((-2 * x) / (3 * y^^^2)) + ((7 * y^^^2) / (6 * x^^^2)) ";
124.672 +val e213a = the (rewrite_set thy' false "common_nominator_p" e213a');
124.673 +print("b)\n");
124.674 +val e213b'="((2 * b) / (3 * a^^^2)) + ((3 * c) / (7 * a * b)) + ((4 * b) / (3 * a^^^2)) + ((3 * a) / (7 * b^^^2))";
124.675 +val e213b = the (rewrite_set thy' false "common_nominator_p" e213b');
124.676 +
124.677 +print("\n\nexample 214:\n");
124.678 +print("a)\n");
124.679 +val e214a'="((3 * x + 2 * y + 2 * z) / (4)) + ((-5 * x + -3 * y) / (3)) + ((x + y + -2 * z) / (2))";
124.680 +val e214a = the (rewrite_set thy' false "common_nominator_p" e214a');
124.681 +print("b)\n");
124.682 +val e214b'="((5 * x + 2 * y + z) / (2)) + ((-7 * x + -3 * y) / (3)) + ((3 * x + 6 * y + -1 * z) / (12))";
124.683 +val e214b = the (rewrite_set thy' false "common_nominator_p" e214b');
124.684 +
124.685 +print("\n\nexample 216:\n");
124.686 +print("a)\n");
124.687 +val e216a'="((2 * b + 3 * c) / (a * c)) + ((3 * a + b) / (a * b)) + ((-2 * b^^^2 + -3 * a * c) / (a * b * c))";
124.688 +val e216a = the (rewrite_set thy' false "common_nominator_p" e216a');
124.689 +print("b)\n");
124.690 +val e216b'="((2 * a + 3 * b) / (b * c)) + ((3 * c + a) / (a * c)) + ((-2 * a^^^2 + -3 * b * c) / (a * b * c))";
124.691 +val e216b = the (rewrite_set thy' false "common_nominator_p" e216b');
124.692 +
124.693 +print("\n\nexample 217:\n");
124.694 +val e217'="((z + -1) / (z)) + ((3 * z ^^^2 + -6 * z + 5) / (z^^^2)) + ((-4 * z^^^3 + 7 * z^^^2 + -5 * z + 5) / (z^^^3))";
124.695 +val e217 = the (rewrite_set thy' false "common_nominator_p" e217');
124.696 +
124.697 +
124.698 +val rls' = "common_nominator";
124.699 +print("\n\nexample 218:\n");
124.700 +val e218'="((9 * a^^^3 - 5 * a^^^2 + 2 * a + 8) / (108 * a^^^4)) + ((-5 * a + 3 * a^^^2 + 4) / (8 * a^^^3)) + ((-261 * a^^^3 + 19 * a^^^2 + -112 * a + 16) / (216 * a^^^4))";
124.701 +val e218 = the (rewrite_set thy' false "common_nominator" e218');
124.702 +
124.703 +print("\n\nexample 219:\n");
124.704 +print("a)\n");
124.705 +val e219a'="((1) / (y + 1)) + ((1) / (y + 2)) + ((1) / (y + 3))";
124.706 +val e219a = the (rewrite_set thy' false "common_nominator" e219a');
124.707 +print("b)\n");
124.708 +val e219b'="((1) / (x + 1)) + ((1) / (x + 2)) + ((-2) / (x + 3))";
124.709 +val e219b = the (rewrite_set thy' false "common_nominator" e219b');
124.710 +
124.711 +print("\n\nexample 220:\n");
124.712 +print("a)\n");
124.713 +val e220a'="((17) / (5 * r + -2)) + ((-13) / (2 * r + 3)) + ((4) / (3 * r + -5))";
124.714 +val e220a = the (rewrite_set thy' false "common_nominator" e220a');
124.715 +print("b)\n");
124.716 +val e220b'="((20 * a) / (a + -3)) + ((-19 * a) / (a + -4)) + ((a) / (a + -5))";
124.717 +val e220b = the (rewrite_set thy' false "common_nominator" e220b');
124.718 +
124.719 +print("\n\nexample 221:\n");
124.720 +print("a)\n");
124.721 +val e221a'="((a + b) / (a + -1 * b)) + ((a + -1 * b) / (a + b))";
124.722 +val e221a = the (rewrite_set thy' false "common_nominator" e221a');
124.723 +print("b)\n");
124.724 +val e221b'="((x + -1 * y) / (x + y)) + ((x + y) / (x + -1 * y)) ";
124.725 +val e221b = the (rewrite_set thy' false "common_nominator" e221b');
124.726 +
124.727 +print("\n\nexample 222:\n");
124.728 +print("a)\n");
124.729 +val e222a'="((1 + -1 * x) / (1 + x)) + ((-1 + -1 * x) / (1 + -1 * x)) + ((4 * x) / (1 + -1 * x^^^2))";
124.730 +val e222a = the (rewrite_set thy' false "common_nominator" e222a');
124.731 +print("b)\n");
124.732 +val e222b'="((1 + x ) / (1 + -1 * x)) + ((-1 + x) / (1 + x)) + ((2 * x) / (1 + -1 * x^^^2))";
124.733 +val e222b = the (rewrite_set thy' false "common_nominator" e222b');
124.734 +
124.735 +print("\n\nexample 225:\n");
124.736 +print("a)\n");
124.737 +val e225a'="((6 * a) / (a^^^2 + -64)) + ((a + 2) / (2 * a + 16)) + ((-1) / (2))";
124.738 +val e225a = the (rewrite_set thy' false "common_nominator" e225a');
124.739 +print("b)\n");
124.740 +val e225b'="((a + 2 ) / (2 * a + 12)) + ((4 * a) / (a^^^2 + -36)) + ((-1) / (2))";
124.741 +val e225b = the (rewrite_set thy' false "common_nominator" e225b');
124.742 +
124.743 +print("\n\nexample 226:\n");
124.744 +print("a)\n");
124.745 +val e226a'="((35 * z) / (49 * z^^^2 + -4)) + -1 + ((14 * z + -1) / (14 * z + 4)) ";
124.746 +val e226a = the (rewrite_set thy' false "common_nominator" e226a');
124.747 +print("b)\n");
124.748 +val e226b'="((45 * a * b) / (25 * a^^^2 + -9 * b^^^2)) + ((20 * a + 3 * b) / (10 * a + 6 * b)) + -2";
124.749 +val e226b = the (rewrite_set thy' false "common_nominator" e226b');
124.750 +
124.751 +print("\n\nexample 227:\n");
124.752 +print("a)\n");
124.753 +val e227a'="((6 * z + 11) / (6 * z + 14)) + ((9 * z ) / (9 * z^^^2 + -49)) + -1 ";
124.754 +val e227a = the (rewrite_set thy' false "common_nominator" e227a');
124.755 +print("b)\n");
124.756 +val e227b'="((16 * a + 37 * b) / (4 * a + 10 * b)) + ((6 * a * b) / (4 * a^^^2 + -25 * b^^^2)) + -4 ";
124.757 +val e227b = the (rewrite_set thy' false "common_nominator" e227b');
124.758 +
124.759 +print("\n\nexample 228:\n");
124.760 +print("a)\n");
124.761 +val e228a'="((7 * a + 11) / (3 * a^^^2 + -3)) + ((-2 * a + -1) / (a^^^2 + -1 * a)) + ((-1) / (3 * a + 3))";
124.762 +val e228a = the (rewrite_set thy' false "common_nominator" e228a');
124.763 +print("b)\n");
124.764 +val e228b'="((11 * z + 2 * b) / (4 * b * z + -8 * b^^^2)) + ((-8 * z) / (z^^^2 + -4 * b^^^2)) + ((-9 * z + -2 * b) / (4 * b * z + 8 * b^^^2))";
124.765 +val e228b = the (rewrite_set thy' false "common_nominator" e228b');
124.766 +
124.767 +
124.768 +print("\n\nexample 229:\n");
124.769 +print("a)\n");
124.770 +val e229a'="((5 * x^^^2 + y) / (x + 2 * y)) + ((-8 * x^^^3 + 4 * x^^^2 * y + 3 * x * y) / (x^^^2 + -4 * y^^^2)) + ((3 * x^^^2 + -4 * y) / (x + -2 * y))";
124.771 +val e229a = the (rewrite_set thy' false "common_nominator" e229a');
124.772 +print("b)\n");
124.773 +val e229b'="((7 * x^^^2 + y) / (x + 3 * y)) + ((-24 * x^^^2 * y + 5 * x * y + 21 * y^^^2) / (x^^^2 + -9 * y^^^2)) + ((4 * x^^^2 + -6 * y) / (x + -3 * y))";
124.774 +val e229b = the (rewrite_set thy' false "common_nominator" e229b');
124.775 +
124.776 +print("\n\nexample 230:\n");
124.777 +print("a)\n");
124.778 +val e230a'="((5 * x^^^2 + y) / (2 * x + y)) + ((-16 * x^^^3 + 2 * x^^^2 * y + 6 * x * y) / (4 * x^^^2 + -1 * y^^^2)) + ((3 * x^^^2 + -4 * y) / (2 * x + -1 * y))";
124.779 +val e230a = the (rewrite_set thy' false "common_nominator" e230a');
124.780 +print("b)\n");
124.781 +val e230b'="((7 * x^^^2 + y) / (3 * x + y)) + ((-3 * x^^^3 + 15 * x * y + -7 * x^^^2 * y + 7 * y^^^2) / (9 * x^^^2 + -1 * y^^^2)) + ((4 * x^^^2 + -6 * y) / (3 * x + -1 * y))";
124.782 +val e230b = the (rewrite_set thy' false "common_nominator" e230b');
124.783 +
124.784 +print("\n\nexample 231:\n");
124.785 +print("a)\n");
124.786 +val e231a'="((2 * x + 5 * y) / (x)) + ((2 * x^^^3 + -5 * y^^^3 + 3 * x * y^^^2) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-3 * x + -6 * y) / (x + -1 * y))";
124.787 +val e231a = the (rewrite_set thy' false "common_nominator" e231a');
124.788 +print("b)\n");
124.789 +val e231b'="((6 * x + 2 * y) / (x)) + ((6 * x^^^2 * y + -4 * x * y^^^2 + -2 * y^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-5 * x + -3 * y) / (x + -1 * y))";
124.790 +val e231b = the (rewrite_set thy' false "common_nominator" e231b');
124.791 +
124.792 +print("\n\nexample 232:\n");
124.793 +print("a)\n");
124.794 +val e232a'="((2 * x + 3 * y) / (x)) + ((4 * x^^^3 + -1 * x * y^^^2 + -3 * y^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-5 * x + -6 * y) / (x + -1 * y))";
124.795 +val e232a = the (rewrite_set thy' false "common_nominator" e232a');
124.796 +print("b)\n");
124.797 +val e232b'="((5 * x + 2 * y) / (x)) + ((2 * x^^^3 + -3 * x * y^^^2 + 3 * x^^^2 * y + -2 * y^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-6 * x + -3 * y) / (x + -1 * y))";
124.798 +val e232b = the (rewrite_set thy' false "common_nominator" e232b');
124.799 +
124.800 +print("\n\nexample 233:\n");
124.801 +print("a)\n");
124.802 +val e233a'="((5 * x + 6 * y) / (x)) + ((5 * x * y^^^2 + -6 * y^^^3 + -2 * x^^^3 + 3 * x^^^2 * y) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-2 * x + -3 * y) / (x + -1 * y))";
124.803 +val e233a = the (rewrite_set thy' false "common_nominator" e233a');
124.804 +print("b)\n");
124.805 +val e233b'="((6 * x + 5 * y) / (x)) + ((4 * x^^^2 * y + 3 * x * y^^^2 + -5 * y^^^3 + -2 * x^^^3) / (x^^^3 + -2 * x^^^2 * y + x * y^^^2)) + ((-3 * x + -2 * y) / (x + -1 * y))";
124.806 +val e233b = the (rewrite_set thy' false "common_nominator" e233b');
124.807 +
124.808 +print("\n\nexample 234:\n");
124.809 +print("a)\n");
124.810 +val e234a'="((5 * a + b) / (2 * a * b + -2 * b^^^2)) + ((-3 * a + -1 * b) / (2 * a * b + 2 * b^^^2)) + ((-2 * a) / (a^^^2 + -1 * b^^^2))";
124.811 +val e234a = the (rewrite_set thy' false "common_nominator" e234a');
124.812 +print("b)\n");
124.813 +val e234b'="((5 * a + 3 * b) / (6 * a * b + -18 * b^^^2)) + ((-3 * a + -3 * b) / (6 * a * b + 18 * b^^^2)) + ((-2 * a) / (a^^^2 + -9 * b^^^2)) ";
124.814 +val e234b = the (rewrite_set thy' false "common_nominator" e234b');
124.815 +
124.816 +print("\n\nexample 235:\n");
124.817 +print("a)\n");
124.818 +val e235a'="((10 * x + 3 * y) / (12 * x * y + -18 * y^^^2)) + ((-6 * x + -3 * y) / (12 * x * y + 18 * y^^^2)) + ((-4 * x) / (4 * x^^^2 + -9 * y^^^2))";
124.819 +val e235a = the (rewrite_set thy' false "common_nominator" e235a');
124.820 +print("b)\n");
124.821 +val e235b'="((8 * a + b) / (4 * a * b + -2 * b^^^2)) + ((-4 * a + -1 * b) / (4 * a * b + 2 * b^^^2)) + ((-2 * a) / (4 * a^^^2 + -1 * b^^^2)) ";
124.822 +val e235b = the (rewrite_set thy' false "common_nominator" e235b');
124.823 +
124.824 +print("\n\nexample 236:\n");
124.825 +print("a)\n");
124.826 +val e236a'="((8 * a + 5 * b) / (20 * a * b + -50 * b^^^2)) + ((-4 * a + -5 * b) / (20 * a * b + 50 * b^^^2)) + ((-2 * a) / (4 * a^^^2 + -25 * b^^^2))";
124.827 +val e236a = the (rewrite_set thy' false "common_nominator" e236a');
124.828 +print("b)\n");
124.829 +val e236b'="((24 * x + y) / (6 * x * y + -2 * y^^^2)) + ((-18 * x + -1 * y) / (6 * x * y + 2 * y^^^2)) + ((-15 * x) / (9 * x^^^2 + -1 * y^^^2)) ";
124.830 +val e236b = the (rewrite_set thy' false "common_nominator" e236b');
124.831 +
124.832 +
124.833 +val rls' = "cancel";
124.834 +print("\n\nexample heuberger:\n");
124.835 +val eheu'="(x^^^4 + x * y + x^^^3 * y + y^^^2) / (x + 5 * x^^^2 + y + 5 * x * y + x^^^2 * y^^^3 + x * y^^^4)";
124.836 +val eheu = the (rewrite_set thy' false "cancel" eheu');
124.837 +
124.838 +val rls' = "common_nominator_p";
124.839 +print("\n\nexample stiefel:\n");
124.840 +val est1'="(7) / (-14) + (-2) / (4)";
124.841 +val est1 = the (rewrite_set thy' false "common_nominator_p" est1');
124.842 +if est1 = ("-1 / 1",[]) then ()
124.843 +else raise error "new behaviour in rational.sml: est1'";
124.844 +
124.845 +val t = (term_of o the o (parse thy))
124.846 +"(9 - x ^^^ 2) / (9 - 6 * x + x ^^^ 2)";
124.847 +val Some (t',_) = factout_ thy t;
124.848 +term2str t';
124.849 +"(3 + x) * (3 - x) / ((3 - x) * (3 - x))";
124.850 +
124.851 +
124.852 +"-------- reverse rewrite ----------------------------------------";
124.853 +"-------- reverse rewrite ----------------------------------------";
124.854 +"-------- reverse rewrite ----------------------------------------";
124.855 +
124.856 +(*WN.28.8.02: tests for the 'reverse-rewrite' functions:
124.857 + these are defined in Rationals.ML and stored in
124.858 + the 'reverse-ruleset' cancel*)
124.859 +
124.860 +(*the term for which reverse rewriting is demonstrated*)
124.861 + val t = (term_of o the o (parse thy))
124.862 + "(9 - x ^^^ 2) / (9 + 6 * x + x ^^^ 2)";
124.863 + val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
124.864 + next_rule=nex,normal_form=nor,...},...} = cancel;
124.865 +
124.866 +(*normal_form produces the result in ONE step*)
124.867 + val Some (t',_) = nor t;
124.868 + term2str t';
124.869 +
124.870 +(*initialize the interpreter state used by the 'me'*)
124.871 + val (t,_,revsets,_) = ini t;
124.872 +
124.873 +(*find the rule 'r' to apply to term 't'*)
124.874 + val Some r = nex revsets t;
124.875 + (*val r = Thm ("sym_#mult_2_3","6 = 2 * 3") : rule*)
124.876 +
124.877 +(*check, if the rule 'r' applied by the user to 't' belongs to the ruleset;
124.878 + if the rule is OK, the term resulting from applying the rule is returned,too;
124.879 + there might be several rule applications inbetween,
124.880 + which are listed after the head in reverse order*)
124.881 + val (r,(t,asm))::_ = loc revsets t r;
124.882 + term2str t;
124.883 + "(9 - x ^^^ 2) / (3 ^^^ 2 + 6 * x + x ^^^ 2)";
124.884 +
124.885 +(*find the next rule to apply*)
124.886 + val Some r = nex revsets t;
124.887 + (*val r = Thm ("sym_#power_3_2","9 = 3 ^^^ 2") : rule*)
124.888 +
124.889 +(*check the next rule*)
124.890 + val (r,(t,asm))::_ = loc revsets t r;
124.891 + term2str t;
124.892 + "(3 ^^^ 2 - x ^^^ 2) / (3 ^^^ 2 + 6 * x + x ^^^ 2)";
124.893 +
124.894 +(*find and check the next rules, rewrite*)
124.895 + val Some r = nex revsets t;
124.896 + val (r,(t,asm))::_ = loc revsets t r;
124.897 + term2str t;
124.898 + "(3 ^^^ 2 - x ^^^ 2) / (3 ^^^ 2 + 2 * 3 * x + x ^^^ 2)";
124.899 +
124.900 + val Some r = nex revsets t;
124.901 + val (r,(t,asm))::_ = loc revsets t r;
124.902 + term2str t;
124.903 + "(3 - x) * (3 + x) / (3 ^^^ 2 + 2 * 3 * x + x ^^^ 2)";
124.904 +
124.905 + val Some r = nex revsets t;
124.906 + val (r,(t,asm))::_ = loc revsets t r;
124.907 + term2str t;
124.908 + "(3 - x) * (3 + x) / ((3 + x) * (3 + x))";
124.909 +
124.910 + val Some r = nex revsets t;
124.911 + val (r,(t,asm))::_ = loc revsets t r;
124.912 + val ss = term2str t;
124.913 + if ss = "(3 - x) / (3 + x)" then ()
124.914 + else raise error "rational.sml: new behav. in rev-set cancel";
124.915 + terms2str asm;
124.916 +
124.917 +
124.918 +"-------- 'reverse-ruleset' cancel_p -----------------------------";
124.919 +"-------- 'reverse-ruleset' cancel_p -----------------------------";
124.920 +"-------- 'reverse-ruleset' cancel_p -----------------------------";
124.921 +(*WN.11.9.02: the 'reverse-ruleset' cancel_p*)
124.922 +
124.923 +(*the term for which reverse rewriting is demonstrated*)
124.924 +val t = str2term "(9 + (-1)*x^^^2) / (9 + ((-6)*x + x^^^2))";
124.925 +val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
124.926 + next_rule=nex,normal_form=nor,...},...} = cancel_p;
124.927 +
124.928 +(*normal_form produces the result in ONE step*)
124.929 +val Some (t',_) = nor t;
124.930 +term2str t' = "(3 + 1 * x) / (3 + -1 * x)";
124.931 +
124.932 +(*initialize the interpreter state used by the 'me'*)
124.933 +val Some (t', asm) = cancel_p_ thy t;
124.934 +term2str t' = "(3 + x) / (3 + -1 * x)" (*true*);
124.935 +terms2str asm = "[\"3 + -1 * x ~= 0\"]" (*true*);
124.936 +val (t,_,revsets,_) = ini t;
124.937 +
124.938 +(* WN.10.10.02: dieser Fall terminiert nicht
124.939 + (make_polynomial enth"alt zu viele rules)
124.940 +WN060823 'init_state' requires rewriting on specified location in the term
124.941 +print_depth 99; Rfuns; print_depth 3;
124.942 +WN060831 cycling "sym_order_mult_rls_" "sym_real_mult_assoc"
124.943 + as was with make_polynomial before ?!?*)
124.944 +
124.945 +val Some r = nex revsets t;
124.946 +eq_Thm (r, Thm ("sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))",
124.947 + mk_thm Rational.thy "9 = 3 ^^^ 2"));
124.948 +(*WN060831 *** id_of_thm
124.949 + Exception- ERROR raised ...
124.950 +val (r,(t,asm))::_ = loc revsets t r;
124.951 +term2str t;
124.952 +
124.953 + val Some r = nex revsets t;
124.954 + val (r,(t,asm))::_ = loc revsets t r;
124.955 + term2str t;
124.956 +*)
124.957 +
124.958 +print "\n\n\n****************** all tests successfull *************************\n";
124.959 +
124.960 +
124.961 +
124.962 +(*WN.17.3.03 =========================================================vvv---*)
124.963 +"-------- norm_Rational ------------------------------------------";
124.964 +"-------- norm_Rational ------------------------------------------";
124.965 +"-------- norm_Rational ------------------------------------------";
124.966 +val t = str2term "(3*x+5)/18 - x/2 - -(3*x - 2)/9 = 0";
124.967 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.968 +if term2str t' = "1 / 18 = 0" then () else raise error "rational.sml 1";
124.969 +
124.970 +val t = str2term "(17*x - 51)/9 - (-(13*x - 3)/6) + 11 - (9*x - 7)/4 = 0";
124.971 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.972 +if term2str t' = "(237 + 65 * x) / 36 = 0" then ()
124.973 +else raise error "rational.sml 2";
124.974 +
124.975 +val t = str2term "(1/2 + (5*x)/2)^^^2 - ((13*x)/2 - 5/2)^^^2 - (6*x)^^^2 + 29";
124.976 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.977 +(*before 040209:if term2str t' = "(23 + (35 * x + -72 * x ^^^ 2)) / 1"then()*)
124.978 +if term2str t' = "23 + 35 * x + -72 * x ^^^ 2" then ()
124.979 +else raise error "rational.sml 3";
124.980 +(*trace_rewrite:=true;*)
124.981 +val t = str2term "Not (6*x is_atom)";
124.982 +val Some (t',_) = rewrite_set_ thy false powers_erls t; term2str t';
124.983 +"True";
124.984 +val t = str2term "1 < 2";
124.985 +val Some (t',_) = rewrite_set_ thy false powers_erls t; term2str t';
124.986 +"True";
124.987 +val t = str2term "(6*x)^^^2";
124.988 +val Some (t',_) = rewrite_ thy dummy_ord powers_erls false
124.989 + (num_str realpow_def_atom) t;
124.990 +term2str t';
124.991 +trace_rewrite:=false;
124.992 +
124.993 +val t = str2term "-1 * (-2 * (5 / 2 * (13 * x / 2)))";
124.994 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.995 +if term2str t' = "65 * x / 2" then () else raise error "rational.sml 4";
124.996 +
124.997 +val t = str2term "1 - ((13*x)/2 - 5/2)^^^2";
124.998 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.999 +(*bef.040209: if term2str t' = "(-21 + (130 * x + -169 * x ^^^ 2)) / 4"then()*)
124.1000 +if term2str t' = "(-21 + 130 * x + -169 * x ^^^ 2) / 4" then ()
124.1001 +else raise error "rational.sml 5";
124.1002 +
124.1003 +(*SRAM Schalk I, p.92 Nr. 609a*)
124.1004 +val t = str2term "2*(3 - x/5)/3 - 4*(1 - x/3) - x/3 - 2*(x/2 - 1/4)/27 +5/54";
124.1005 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1006 +if term2str t' = "(-255 + 112 * x) / 135" then ()
124.1007 +else raise error "rational.sml 6";
124.1008 +
124.1009 +(*SRAM Schalk I, p.92 Nr. 610c*)
124.1010 +val t = str2term "((x- 1)/(x+1) + 1) / ((x- 1)/(x+1) - (x+1)/(x- 1)) - 2";
124.1011 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1012 +if term2str t' = "(-3 + -1 * x) / 2" then () else raise error "rational.sml 7";
124.1013 +
124.1014 +(*SRAM Schalk I, p.92 Nr. 476a*)
124.1015 +val t = str2term "(x^^^2/(1 - x^^^2) + 1)/(x/(1 - x) + 1) *\
124.1016 + \ (1 + x)";(*. a/b : c/d translated to a/b * d/c .*)
124.1017 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1018 +(*if term2str t' = "1 / 1" then () else raise error "rational.sml 8";3.6.03*)
124.1019 +if term2str t' = "1" then () else raise error "rational.sml 8";
124.1020 +
124.1021 +(*............................vvv---TODO: sollte gehen mit poly_order *)
124.1022 +(*Schalk I, p.92 Nr. 472a*)
124.1023 +val t = str2term "((8*x^^^2 - 32*y^^^2)/(2*x + 4*y))/((4*x - 8*y)/(x + y))";
124.1024 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1025 +if term2str t' = "x + y" then () else raise error "rational.sml p.92 Nr. 472a";
124.1026 +
124.1027 +(*Schalk I, p.70 Nr. 480b; a/b : c/d translated to a/b * d/c*)
124.1028 +val t = str2term "((12*x*y/(9*x^^^2 - y^^^2))/\
124.1029 + \(1/(3*x - y)^^^2 - 1/(3*x + y)^^^2)) *\
124.1030 + \(1/(x - 5*y)^^^2 - 1/(x + 5*y)^^^2)/\
124.1031 + \(20*x*y/(x^^^2 - 25*y^^^2))";
124.1032 +(*... nicht simpl, zerlegt ...*)
124.1033 +val t = str2term "((12*x*y/(9*x^^^2 - y^^^2))/\
124.1034 + \(1/(3*x - y)^^^2 - 1/(3*x + y)^^^2))";
124.1035 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1036 +"(-12 * (x * y ^^^ 3) + 108 * (x * (y * x ^^^ 2))) / (12 * (x * y))";
124.1037 +(* ~~~~~~~~~~ poly_order notwendig!*)
124.1038 +val t = str2term "(1/(x - 5*y)^^^2 - 1/(x + 5*y)^^^2)/\
124.1039 + \(20*x*y/(x^^^2 - 25*y^^^2))";
124.1040 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1041 +"(-500 * (x * y ^^^ 3) /\n (x ^^^ 4 + (625 * y ^^^ 4 + -50 * (x ^^^ 2 * y ^^^ 2))) +\n 20 * (x * (y * x ^^^ 2)) /\n (x ^^^ 4 + (625 * y ^^^ 4 + -50 * (x ^^^ 2 * y ^^^ 2)))) /\n(20 * (x * y))";
124.1042 +trace_rewrite:=true;
124.1043 +trace_rewrite:=false;
124.1044 +
124.1045 +"nonterm.SK6 ----- SK060904-2a non-termination of add_fraction_p_";
124.1046 +(*WN.2.6.03 from rlang.sml 56a
124.1047 +val t = str2term "(a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x) = 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)";
124.1048 +val None = rewrite_set_ thy false common_nominator_p t;
124.1049 +
124.1050 +WN060831 nonterm.SK7
124.1051 +val t = str2term "(a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x)";
124.1052 +val None = add_fraction_p_ thy t;
124.1053 +*)
124.1054 +
124.1055 +
124.1056 +(* ------------------------------------------------------------------- *)
124.1057 +(*---------vvv------------ MG: ab 1.7.03 ----------------vvv-----------*)
124.1058 +(* Simplifier fuer beliebige Buchterme *)
124.1059 +(* ------------------------------------------------------------------- *)
124.1060 +(*----------------------- norm_Rational_mg ----------------------------*)
124.1061 +(* ------------------------------------------------------------------- *)
124.1062 +
124.1063 +"-------- numeral rationals --------------------------------------";
124.1064 +"-------- numeral rationals --------------------------------------";
124.1065 +"-------- numeral rationals --------------------------------------";
124.1066 +
124.1067 +(*SRA Schalk I, p.40 Nr. 164b *)
124.1068 +val t = str2term "(47/6 - 76/9 + 13/4)/(35/12)";
124.1069 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1070 +term2str t;
124.1071 +if (term2str t) = "19 / 21" then ()
124.1072 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 1";
124.1073 +
124.1074 +(*SRA Schalk I, p.40 Nr. 166a *)
124.1075 +val t = str2term "((5/4)/(4+22/7) + 37/20)*(110/3 - 110/9 * 23/11)";
124.1076 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1077 +term2str t;
124.1078 +if (term2str t) = "45 / 2" then ()
124.1079 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 2";
124.1080 +
124.1081 +
124.1082 +"-------- cancellation -------------------------------------------";
124.1083 +"-------- cancellation -------------------------------------------";
124.1084 +"-------- cancellation -------------------------------------------";
124.1085 +
124.1086 +(* e190c Stefan K.*)
124.1087 +val t = str2term
124.1088 +"((1 + 9 * a ^^^ 2)*(1 + 3 * a))/((3 * a + 9 * a ^^^ 2)*(1 + 3 * a))";
124.1089 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1090 +term2str t;
124.1091 +if (term2str t) =
124.1092 +"(1 + 9 * a ^^^ 2) / (3 * a + 9 * a ^^^ 2)"
124.1093 +then ()
124.1094 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 3";
124.1095 +
124.1096 +(* e192b Stefan K.*)
124.1097 +val t = str2term
124.1098 +"((x ^^^ 2)*(7 * x + (-1) * y))/((y ^^^ 2)*(7 * x + (-1) * y))";
124.1099 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1100 +term2str t;
124.1101 +if (term2str t) =
124.1102 +"x ^^^ 2 / y ^^^ 2"
124.1103 +then ()
124.1104 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 4";
124.1105 +
124.1106 +(*SRC Schalk I, p.66 Nr. 379c *)
124.1107 +val t = str2term
124.1108 +"(a - b)/(b - a)";
124.1109 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1110 +term2str t;
124.1111 +if (term2str t) =
124.1112 +"-1"
124.1113 +then ()
124.1114 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 5";
124.1115 +
124.1116 +(*SRC Schalk I, p.66 Nr. 380b *)
124.1117 +val t = str2term
124.1118 +"15*(3*x+3)*(4*x+9)/(12*(2*x+7)*(5*x+5))";
124.1119 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1120 +term2str t;
124.1121 +if (term2str t) =
124.1122 +"(27 + 12 * x) / (28 + 8 * x)"
124.1123 +then ()
124.1124 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 6";
124.1125 +
124.1126 +(*Schalk I, p.60 Nr. 215c *)
124.1127 +(* Falsches Ergebnis: rechnet lange und cancel_p kann nicht weiter krzen!!!*)
124.1128 +(* WN060831????MG1
124.1129 +val t = str2term "(a+b)^^^4*(x - y)/((x - y)^^^3*(a+b)^^^2)";
124.1130 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1131 +term2str t;
124.1132 +if (term2str t) =
124.1133 +"(a ^^^ 4 * x + -1 * a ^^^ 4 * y + 4 * a ^^^ 3 * b * x + -4 * a ^^^ 3 * b * y + 6 * a ^^^ 2 * b ^^^ 2 * x + -6 * a ^^^ 2 * b ^^^ 2 * y + 4 * a * b ^^^ 3 * x + -4 * a * b ^^^ 3 * y + b ^^^ 4 * x + -1 * b ^^^ 4 * y) /(a ^^^ 2 * x ^^^ 3 + -3 * a ^^^ 2 * x ^^^ 2 * y + 3 * a ^^^ 2 * x * y ^^^ 2 + -1 * a ^^^ 2 * y ^^^ 3 + 2 * a * b * x ^^^ 3 + -6 * a * b * x ^^^ 2 * y + 6 * a * b * x * y ^^^ 2 + -2 * a * b * y ^^^ 3 + b ^^^ 2 * x ^^^ 3 + -3 * b ^^^ 2 * x ^^^ 2 * y + 3 * b ^^^ 2 * x * y ^^^ 2 + -1 * b ^^^ 2 * y ^^^ 3)"
124.1134 +then ()
124.1135 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 7";
124.1136 +*)
124.1137 +(*val t = str2term
124.1138 +"(a ^^^ 4 * x + -1 * a ^^^ 4 * y + 4 * a ^^^ 3 * b * x + -4 * a ^^^ 3 * b * y + 6 * a ^^^ 2 * b ^^^ 2 * x + -6 * a ^^^ 2 * b ^^^ 2 * y + 4 * a * b ^^^ 3 * x + -4 * a * b ^^^ 3 * y + b ^^^ 4 * x + -1 * b ^^^ 4 * y) /(a ^^^ 2 * x ^^^ 3 + -3 * a ^^^ 2 * x ^^^ 2 * y + 3 * a ^^^ 2 * x * y ^^^ 2 + -1 * a ^^^ 2 * y ^^^ 3 + 2 * a * b * x ^^^ 3 + -6 * a * b * x ^^^ 2 * y + 6 * a * b * x * y ^^^ 2 + -2 * a * b * y ^^^ 3 + b ^^^ 2 * x ^^^ 3 + -3 * b ^^^ 2 * x ^^^ 2 * y + 3 * b ^^^ 2 * x * y ^^^ 2 + -1 * b ^^^ 2 * y ^^^ 3)"
124.1139 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1140 +term2str t;*)
124.1141 +(* uncaught exception nonexhaustive binding failure
124.1142 + raised at: stdIn:93.1-93.51 *)
124.1143 +
124.1144 +(*Schalk I, p.66 Nr. 381a *)
124.1145 +(* ACHTUNG: rechnet ca. 2 Minuten !!! *)
124.1146 +(* WN060831???MG2
124.1147 +val t = str2term "18*(a+b)^^^3*(a - b)^^^2/(72*(a - b)^^^3*(a+b)^^^2)";
124.1148 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1149 +term2str t;
124.1150 +if (term2str t) =
124.1151 +"(a + b) / (4 * a + -4 * b)"
124.1152 +then () else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 8";
124.1153 +*)
124.1154 +
124.1155 +(*SRC Schalk I, p.66 Nr. 381b *)
124.1156 +val t = str2term
124.1157 +"(4*x^^^2 - 20*x + 25)/(2*x - 5)^^^3";
124.1158 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1159 +term2str t;
124.1160 +if (term2str t) =
124.1161 +"-1 / (5 + -2 * x)"
124.1162 +then ()
124.1163 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 9";
124.1164 +
124.1165 +(*SRC Schalk I, p.66 Nr. 381c *)
124.1166 +val t = str2term
124.1167 +"(27*a^^^3+9*a^^^2+3*a+1)/(27*a^^^3+18*a^^^2+3*a)";
124.1168 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1169 +term2str t;
124.1170 +if (term2str t) =
124.1171 +"(1 + 9 * a ^^^ 2) / (3 * a + 9 * a ^^^ 2)"
124.1172 +then ()
124.1173 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 10";
124.1174 +
124.1175 +(*SRC Schalk I, p.66 Nr. 383a *)
124.1176 +val t = str2term
124.1177 +"(5*a^^^2 - 5*a*b)/(a - b)^^^2";
124.1178 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1179 +term2str t;
124.1180 +if (term2str t) =
124.1181 +"5 * a / (a + -1 * b)"
124.1182 +then ()
124.1183 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 11";
124.1184 +
124.1185 +"-------- common denominator -------------------------------------";
124.1186 +"-------- common denominator -------------------------------------";
124.1187 +"-------- common denominator -------------------------------------";
124.1188 +
124.1189 +(*SRA Schalk I, p.67 Nr. 403a *)
124.1190 +val t = str2term
124.1191 +"4/x - 3/y - 1";
124.1192 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1193 +term2str t;
124.1194 +if (term2str t) =
124.1195 +"(-3 * x + 4 * y + -1 * x * y) / (x * y)"
124.1196 +then ()
124.1197 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 12";
124.1198 +
124.1199 +(*SRA Schalk I, p.67 Nr. 407b *)
124.1200 +val t = str2term
124.1201 +"(2*a+3*b)/(b*c) + (3*c+a)/(a*c) - (2*a^^^2+3*b*c)/(a*b*c)";
124.1202 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1203 +term2str t;
124.1204 +if (term2str t) =
124.1205 +"4 / c"
124.1206 +then ()
124.1207 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 13";
124.1208 +
124.1209 +(*SRA Schalk I, p.67 Nr. 410b *)
124.1210 +val t = str2term
124.1211 +"1/(x+1) + 1/(x+2) - 2/(x+3)";
124.1212 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1213 +term2str t;
124.1214 +if (term2str t) =
124.1215 +"(5 + 3 * x) / (6 + 11 * x + 6 * x ^^^ 2 + x ^^^ 3)"
124.1216 +then ()
124.1217 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 14";
124.1218 +
124.1219 +(*SRA Schalk I, p.67 Nr. 413b *)
124.1220 +val t = str2term
124.1221 +"(1+x)/(1 - x) - (1 - x)/(1+x) + 2*x/(1 - x^^^2)";
124.1222 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1223 +term2str t;
124.1224 +if (term2str t) =
124.1225 +"6 * x / (1 + -1 * x ^^^ 2)"
124.1226 +then ()
124.1227 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 15";
124.1228 +
124.1229 +(*SRA Schalk I, p.68 Nr. 414a *)
124.1230 +val t = str2term
124.1231 +"(x + 2)/(x - 1) + (x - 3)/(x - 2) - (x + 1)/((x - 1)*(x - 2))";
124.1232 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1233 +term2str t;
124.1234 +if (term2str t) =
124.1235 +"(-2 + -5 * x + 2 * x ^^^ 2) / (2 + -3 * x + x ^^^ 2)"
124.1236 +then ()
124.1237 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 16";
124.1238 +
124.1239 +(*SRA Schalk I, p.68 Nr. 423a *)
124.1240 +val t = str2term
124.1241 +"(2*x+3*y)/x + (4*x^^^3 - x*y^^^2 - 3*y^^^3)/(x^^^3 - 2*x^^^2*y+x*y^^^2) - (5*x+6*y)/(x - y)";
124.1242 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1243 +term2str t;
124.1244 +if (term2str t) =
124.1245 +"1"
124.1246 +then ()
124.1247 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 17";
124.1248 +
124.1249 +(*SRA Schalk I, p.68 Nr. 428b *)
124.1250 +val t = str2term
124.1251 +"1/(a - b)^^^2 + 1/(a+b)^^^2 - 2/(a^^^2 - b^^^2) - 4*(b^^^2 - 1)/(a^^^2 - b^^^2)^^^2";
124.1252 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1253 +term2str t;
124.1254 +if (term2str t) =
124.1255 +"4 / (a ^^^ 4 + -2 * a ^^^ 2 * b ^^^ 2 + b ^^^ 4)"
124.1256 +then ()
124.1257 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 18";
124.1258 +
124.1259 +(*SRA Schalk I, p.68 Nr. 430b *)
124.1260 +val t = str2term
124.1261 +"a^^^2/(a - 3*b) - 108*a*b^^^3/((a+3*b)*(a^^^2 - 9*b^^^2)) - 9*b^^^2*(a - 3*b)/(a+3*b)^^^2";
124.1262 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1263 +term2str t;
124.1264 +if (term2str t) =
124.1265 +"a + 3 * b"
124.1266 +then ()
124.1267 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 19";
124.1268 +
124.1269 +
124.1270 +(*SRA Schalk I, p.68 Nr. 432 *)
124.1271 +val t = str2term
124.1272 +"(a^^^2+a*b)/(a^^^2 - b^^^2) - (b^^^2 - a*b)/(b^^^2 - a^^^2) + a^^^2*(a - b)/(a^^^3 - a^^^2*b) - 2*a*(a^^^2 - b^^^2)/(a^^^3 - a*b^^^2) - 2*b^^^2/(a^^^2 - b^^^2)";
124.1273 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1274 +term2str t;
124.1275 +if (term2str t) =
124.1276 +"0"
124.1277 +then ()
124.1278 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 20";
124.1279 +
124.1280 +(*Eigenes*)
124.1281 +val t = str2term
124.1282 +"3*a/(a*b) + x/y";
124.1283 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1284 +term2str t;
124.1285 +if (term2str t) =
124.1286 +"(3 * y + b * x) / (b * y)"
124.1287 +then ()
124.1288 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 21";
124.1289 +
124.1290 +
124.1291 +"-------- multiply and cancel ------------------------------------";
124.1292 +"-------- multiply and cancel ------------------------------------";
124.1293 +"-------- multiply and cancel ------------------------------------";
124.1294 +
124.1295 +(*SRM Schalk I, p.68 Nr. 436a *)
124.1296 +val t = str2term
124.1297 +"3*(x+y)/(15*(x - y)) * 25*(x - y)^^^2/(18*(x+y)^^^2)";
124.1298 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1299 +term2str t;
124.1300 +if (term2str t) =
124.1301 +"(5 * x + -5 * y) / (18 * x + 18 * y)"
124.1302 +then ()
124.1303 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 22";
124.1304 +
124.1305 +(*SRM.test Schalk I, p.68 Nr. 436b *)
124.1306 +(*WN060420???MG3 crashes with method 'simplify' in
124.1307 + IsacCore > Simplification > Rational Terms > Multiplication > No.2*)
124.1308 +val t = str2term "5*a*(a - b)^^^2*(a + b)^^^3/(7*b*(a - b)^^^3) * 7*b/(a + b)^^^3";
124.1309 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1310 +term2str t;
124.1311 +if (term2str t) =
124.1312 +"5 * a / (a + -1 * b)"
124.1313 +then ()
124.1314 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 23";
124.1315 +
124.1316 +(*Schalk I, p.68 Nr. 437a *)
124.1317 +val t = str2term "(3*a - 4*b)/(4*c+3*e) * (3*a+4*b)/(9*a^^^2 - 16*b^^^2)";
124.1318 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1319 +if (term2str t) = "1 / (4 * c + 3 * e)" then ()
124.1320 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 24";
124.1321 +
124.1322 +"----- S.K. corrected non-termination 060904";
124.1323 +val t = str2term "(3*a - 4*b) * (3*a+4*b)/((4*c+3*e)*(9*a^^^2 - 16*b^^^2))";
124.1324 +val Some (t',_) = rewrite_set_ thy false make_polynomial t;
124.1325 +if term2str t' = "(9 * a ^^^ 2 + -16 * b ^^^ 2) /\n(36 * a ^^^ 2 * c + 27 * a ^^^ 2 * e + -64 * b ^^^ 2 * c +\n -48 * b ^^^ 2 * e)" then ()
124.1326 +else raise error "rational.sml.sml: S.K.8..corrected 060904-6";
124.1327 +
124.1328 +"----- S.K. corrected non-termination of cancel_p_";
124.1329 +val t'' = str2term "(9 * a ^^^ 2 + -16 * b ^^^ 2) /\
124.1330 +\(36 * a^^^2 * c + (27 * a^^^2 * e + (-64 * b^^^2 * c + -48 * b^^^2 * e)))";
124.1331 +val Some (t',_) = rewrite_set_ thy false cancel_p t'';
124.1332 +if term2str t' = "1 / (4 * c + 3 * e)" then ()
124.1333 +else raise error "rational.sml.sml: diff.behav. in cancel_p S.K.8";
124.1334 +
124.1335 +(**)
124.1336 +
124.1337 +(*Schalk I, p.68 Nr. 437b *)
124.1338 +(* nonterm.SK9 loops: cancel_p kann nicht weiter kuerzen!!! *)
124.1339 +val t'' = str2term "(a + b)/(x^^^2 - y^^^2) * ((x - y)^^^2/(a^^^2 - b^^^2))";
124.1340 +(* val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t'';
124.1341 + *)
124.1342 +
124.1343 +(*a casual output from above*)
124.1344 +val t = str2term
124.1345 +"(a * x ^^^ 2 + -2 * a * x * y + a * y ^^^ 2 + b * x ^^^ 2 + -2 * b * x * y + b * y ^^^ 2) /(a ^^^ 2 * x ^^^ 2 + -1 * a ^^^ 2 * y ^^^ 2 + -1 * b ^^^ 2 * x ^^^ 2 + b ^^^ 2 * y ^^^ 2)";
124.1346 +(* WN060831 nonterm.SK10
124.1347 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1348 +term2str t;
124.1349 +*)
124.1350 +
124.1351 +(*SRM Schalk I, p.68 Nr. 438a *)
124.1352 +val t = str2term
124.1353 +"x*y/(x*y - y^^^2)*(x^^^2 - x*y)";
124.1354 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1355 +term2str t;
124.1356 +if (term2str t) =
124.1357 +"x ^^^ 2"
124.1358 +then ()
124.1359 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 24";
124.1360 +
124.1361 +(*SRM Schalk I, p.68 Nr. 439b *)
124.1362 +val t = str2term
124.1363 +"(4*x^^^2+4*x+1)*((x^^^2 - 2*x^^^3)/(4*x^^^2+2*x))";
124.1364 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1365 +term2str t;
124.1366 +if (term2str t) =
124.1367 +"(x + -4 * x ^^^ 3) / 2"
124.1368 +then ()
124.1369 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 25";
124.1370 +
124.1371 +(*SRM Schalk I, p.68 Nr. 440a *)
124.1372 +val t = str2term
124.1373 +"(x^^^2 - 2*x)/(x^^^2 - 3*x) * (x - 3)^^^2/(x^^^2 - 4)";
124.1374 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1375 +term2str t;
124.1376 +if (term2str t) =
124.1377 +"(-3 + x) / (2 + x)"
124.1378 +then ()
124.1379 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 26";
124.1380 +
124.1381 +"----- Schalk I, p.68 Nr. 440b SK11 works since 0707xx";
124.1382 +val t = str2term
124.1383 +"(a^^^3 - 9*a)/(a^^^3*b - a*b^^^3)*(a^^^2*b+a*b^^^2)/(a+3)";
124.1384 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
124.1385 +if term2str t = "(-3 * a + a ^^^ 2) / (a + -1 * b)" then ()
124.1386 +else raise error "rational.sml.sml: diff.behav. in norm_Rational 27";
124.1387 +
124.1388 +"----- SK12 works since 0707xx";
124.1389 +val t = str2term "(a^^^3 - 9*a)*(a^^^2*b+a*b^^^2)/((a^^^3*b - a*b^^^3)*(a+3))";
124.1390 +val Some (t',_) = rewrite_set_ thy false norm_Rational t; term2str t';
124.1391 +if term2str t' = "(-3 * a + a ^^^ 2) / (a + -1 * b)" then ()
124.1392 +else raise error "rational.sml.sml: diff.behav. in norm_Rational 28";
124.1393 +
124.1394 +
124.1395 +"-------- common denominator and multiplication ------------------";
124.1396 +"-------- common denominator and multiplication ------------------";
124.1397 +"-------- common denominator and multiplication ------------------";
124.1398 +
124.1399 +(*----------------------------------------------------------------------*)
124.1400 +(*--------- Gemeinsamer Nenner und Multiplikation von Bruechen ---------*)
124.1401 +(*----------------------------------------------------------------------*)
124.1402 +
124.1403 +
124.1404 +(*SRAM Schalk I, p.69 Nr. 441b *)
124.1405 +val t = str2term "(4*a/3 + 3*b^^^2/a^^^3 + b/(4*a))*(4*b/(3*a))";
124.1406 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1407 +term2str t;
124.1408 +if (term2str t) =
124.1409 +"(36 * b ^^^ 3 + 3 * a ^^^ 2 * b ^^^ 2 + 16 * a ^^^ 4 * b) / (9 * a ^^^ 4)"
124.1410 +then ()
124.1411 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 28";
124.1412 +
124.1413 +(*SRAM Schalk I, p.69 Nr. 442b *)
124.1414 +val t = str2term "(15*a^^^2/x^^^3 - 5*b^^^4/x^^^2 + 25*c^^^2/x)*(x^^^3/(5*a*b^^^3*c^^^3)) + 1/c^^^3 * (b*x/a - 3*a/b^^^3)";
124.1415 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1416 +term2str t;
124.1417 +if (term2str t) =
124.1418 +"5 * x ^^^ 2 / (a * b ^^^ 3 * c)"
124.1419 +then ()
124.1420 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 29";
124.1421 +
124.1422 +(*SRAM Schalk I, p.69 Nr. 443b *)
124.1423 +val t = str2term "(a/2 + b/3)*(b/3 - a/2)";
124.1424 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1425 +term2str t;
124.1426 +if (term2str t) =
124.1427 +"(-9 * a ^^^ 2 + 4 * b ^^^ 2) / 36"
124.1428 +then ()
124.1429 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 30";
124.1430 +
124.1431 +(*SRAM Schalk I, p.69 Nr. 445b *)
124.1432 +val t = str2term "(a^^^2/9 + 2*a/(3*b) + 4/b^^^2)*(a/3 - 2/b) + 8/b^^^3";
124.1433 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1434 +term2str t;
124.1435 +if (term2str t) =
124.1436 +"a ^^^ 3 / 27"
124.1437 +then ()
124.1438 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 31";
124.1439 +
124.1440 +(*SRAM Schalk I, p.69 Nr. 446b *)
124.1441 +val t = str2term "(x/(5*x + 4*y) - y/(5*x - 4*y) + 1)*(25*x^^^2 - 16*y^^^2)";
124.1442 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1443 +term2str t;
124.1444 +if (term2str t) =
124.1445 +"30 * x ^^^ 2 + -9 * x * y + -20 * y ^^^ 2"
124.1446 +then ()
124.1447 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 32";
124.1448 +
124.1449 +(*SRAM Schalk I, p.69 Nr. 449a *)(*Achtung: rechnet ca 8 Sekunden*)
124.1450 +val t = str2term
124.1451 +"(2*x^^^2/(3*y)+x/y^^^2)*(4*x^^^4/(9*y^^^2)+x^^^2/y^^^4)*(2*x^^^2/(3*y) - x/y^^^2)";
124.1452 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1453 +term2str t;
124.1454 +if (term2str t) =
124.1455 +"(-81 * x ^^^ 4 + 16 * x ^^^ 8 * y ^^^ 4) / (81 * y ^^^ 8)"
124.1456 +then ()
124.1457 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 33";
124.1458 +
124.1459 +(*SRAM Schalk I, p.69 Nr. 450a *)
124.1460 +val t = str2term
124.1461 +"(4*x/(3*y)+2*y/(3*x))^^^2 - (2*y/(3*x) - 2*x/y)*(2*y/(3*x)+2*x/y)";
124.1462 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1463 +term2str t;
124.1464 +if (term2str t) =
124.1465 +"(52 * x ^^^ 2 + 16 * y ^^^ 2) / (9 * y ^^^ 2)"
124.1466 +then ()
124.1467 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 34";
124.1468 +
124.1469 +"-------- double fractions ---------------------------------------";
124.1470 +"-------- double fractions ---------------------------------------";
124.1471 +"-------- double fractions ---------------------------------------";
124.1472 +
124.1473 +(*SRD Schalk I, p.69 Nr. 454b *)
124.1474 +val t = str2term
124.1475 +"((2 - x)/(2*a)) / (2*a/(x - 2))";
124.1476 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1477 +term2str t;
124.1478 +if (term2str t) =
124.1479 +"(-4 + 4 * x + -1 * x ^^^ 2) / (4 * a ^^^ 2)"
124.1480 +then ()
124.1481 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 35";
124.1482 +
124.1483 +(*SRD Schalk I, p.69 Nr. 455a *)
124.1484 +val t = str2term
124.1485 +"(a^^^2 + 1)/(a^^^2 - 1) / ((a+1)/(a - 1))";
124.1486 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1487 +term2str t;
124.1488 +if (term2str t) =
124.1489 +"(1 + a ^^^ 2) / (1 + 2 * a + a ^^^ 2)" then ()
124.1490 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 36";
124.1491 +
124.1492 +
124.1493 +"----- Schalk I, p.69 Nr. 455b";
124.1494 +val t = str2term "(x^^^2 - 4)/(y^^^2 - 9)/((2+x)/(3 - y))";
124.1495 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1496 +if term2str t = "(2 + -1 * x) / (3 + y)" then ()
124.1497 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 37";
124.1498 +
124.1499 +"----- SK060904-1a non-termination of cancel_p_ ?: worked before 0707xx";
124.1500 +val t = str2term "(x^^^2 - 4)*(3 - y)/((y^^^2 - 9)*(2+x))";
124.1501 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
124.1502 +if term2str t = "(2 + -1 * x) / (3 + y)" then ()
124.1503 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 37b";
124.1504 +
124.1505 +"----- ?: worked before 0707xx";
124.1506 +val t = str2term "(3 + -1 * y) / (-9 + y ^^^ 2)";
124.1507 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
124.1508 +if term2str t = "-1 / (3 + y)" then ()
124.1509 +else raise error "rational.sml: -1 / (3 + y) norm_Rational";
124.1510 +
124.1511 +(*SRD Schalk I, p.69 Nr. 456b *)
124.1512 +val t = str2term
124.1513 +"(b^^^3 - b^^^2)/(b^^^2+b)/(b^^^2 - 1)";
124.1514 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1515 +term2str t;
124.1516 +if (term2str t) = "b / (1 + 2 * b + b ^^^ 2)" then ()
124.1517 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 38";
124.1518 +
124.1519 +(*SRD Schalk I, p.69 Nr. 457b *)
124.1520 +val t = str2term
124.1521 +"(16*a^^^2 - 9*b^^^2)/(2*a+3*a*b) / ((4*a+3*b)/(4*a^^^2 - 9*a^^^2*b^^^2))";
124.1522 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1523 +term2str t;
124.1524 +if (term2str t) =
124.1525 +"8 * a ^^^ 2 + -6 * a * b + -12 * a ^^^ 2 * b + 9 * a * b ^^^ 2"
124.1526 +then ()
124.1527 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 39";
124.1528 +
124.1529 +"----- Schalk I, p.69 Nr. 458b works since 0707";
124.1530 +val t = str2term
124.1531 +"(2*a^^^2*x - a^^^2)/(a*x - b*x) / (b^^^2*(2*x - 1)/(x*(a - b)))";
124.1532 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
124.1533 +if term2str t = "a ^^^ 2 / b ^^^ 2" then ()
124.1534 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 39b";
124.1535 +
124.1536 +(*SRD Schalk I, p.69 Nr. 459b *)
124.1537 +val t = str2term "(a^^^2 - b^^^2)/(a*b) / (4*(a+b)^^^2/a)";
124.1538 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
124.1539 +if term2str t = "(a + -1 * b) / (4 * a * b + 4 * b ^^^ 2)" then ()
124.1540 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 41";
124.1541 +
124.1542 +
124.1543 +(*Schalk I, p.69 Nr. 460b nonterm.SK
124.1544 +val t = str2term
124.1545 +"(9*(x^^^2 - 8*x+16)/(4*(y^^^2 - 2*y+1)))/((3*x - 12)/(16*y - 16))";
124.1546 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1547 +if term2str t =
124.1548 +then ()
124.1549 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 42";
124.1550 +
124.1551 +val t = str2term
124.1552 +"9*(x^^^2 - 8*x+16)*(16*y - 16)/(4*(y^^^2 - 2*y+1)*(3*x - 12))";
124.1553 +val Some (t',_) = rewrite_set_ thy false norm_Rational t;
124.1554 +... non terminating.
124.1555 +val Some (t',_) = rewrite_set_ thy false make_polynomial t;
124.1556 +"(-2304 + 1152 * x + 2304 * y + -144 * x ^^^ 2 + -1152 * x * y + 144 * x ^^^ 2 * y) /(-48 + 12 * x + 96 * y + -24 * x * y + -48 * y ^^^ 2 + 12 * x * y ^^^ 2)";
124.1557 +val Some (t,_) = rewrite_set_ thy false cancel_p t';
124.1558 +... non terminating.*)
124.1559 +
124.1560 +(*SRD Schalk I, p.70 Nr. 472a *)
124.1561 +val t = str2term "((8*x^^^2 - 32*y^^^2)/(2*x + 4*y))/\
124.1562 + \((4*x - 8*y)/(x + y))";
124.1563 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1564 +term2str t;
124.1565 +if (term2str t) =
124.1566 +"x + y"
124.1567 +then ()
124.1568 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 43";
124.1569 +
124.1570 +
124.1571 +(*----------------------------------------------------------------------*)
124.1572 +(*---------------------- Einfache Dppelbrche --------------------------*)
124.1573 +(*----------------------------------------------------------------------*)
124.1574 +
124.1575 +(*SRD Schalk I, p.69 Nr. 461a *)
124.1576 +val t = str2term
124.1577 +"(2/(x+3) + 2/(x - 3)) / (8*x/(x^^^2 - 9))";
124.1578 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1579 +term2str t;
124.1580 +if (term2str t) =
124.1581 +"1 / 2"
124.1582 +then ()
124.1583 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 44";
124.1584 +
124.1585 +(*SRD Schalk I, p.69 Nr. 464b *)
124.1586 +val t = str2term
124.1587 +"(a - a/(a - 2)) / (a + a/(a - 2))";
124.1588 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1589 +term2str t;
124.1590 +if (term2str t) =
124.1591 +"(3 + -1 * a) / (1 + -1 * a)"
124.1592 +then ()
124.1593 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 45";
124.1594 +
124.1595 +(*SRD Schalk I, p.69 Nr. 465b *)
124.1596 +val t = str2term
124.1597 +"((x+3*y)/9 + (4*y^^^2 - 9*z^^^2)/(16*x)) /(x/9+y/6+z/4)";
124.1598 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1599 +term2str t;
124.1600 +if (term2str t) =
124.1601 +"(4 * x + 6 * y + -9 * z) / (4 * x)"
124.1602 +then ()
124.1603 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 46";
124.1604 +
124.1605 +(*SRD Schalk I, p.69 Nr. 466b *)
124.1606 +val t = str2term
124.1607 +"((1 - 7*(x - 2)/(x^^^2 - 4)) / (6/(x+2))) / (3/(x+5)+30/(x^^^2 - 25))";
124.1608 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1609 +term2str t;
124.1610 +if (term2str t) =
124.1611 +"(25 + -10 * x + x ^^^ 2) / 18"
124.1612 +then ()
124.1613 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 47";
124.1614 +
124.1615 +(*SRD Schalk I, p.70 Nr. 469 *)
124.1616 +val t = str2term
124.1617 +"3*b^^^2/(4*a^^^2 - 8*a*b + 4*b^^^2)/(a/(a^^^2*b - b^^^3) + (a - b)/(4*a*b^^^2+4*b^^^3) - 1/(4*b^^^2))";
124.1618 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1619 +term2str t;
124.1620 +if (term2str t) =
124.1621 +"3 * b ^^^ 3 / (2 * a + -2 * b)"
124.1622 +then ()
124.1623 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 48";
124.1624 +
124.1625 +(*----------------------------------------------------------------------*)
124.1626 +(*---------------------- Mehrfache Dppelbrueche ------------------------*)
124.1627 +(*----------------------------------------------------------------------*)
124.1628 +
124.1629 +(*SRD.test Schalk I, p.70 Nr. 476b *) (* Rechenzeit: 10 sec *)
124.1630 +(*WN060419 crashes with method 'simplify' ????SK*)
124.1631 +val t = str2term
124.1632 +"((a^^^2 - b^^^2)/(2*a*b)+2*a*b/(a^^^2 - b^^^2))/((a^^^2+b^^^2)/(2*a*b)+1) / ((a^^^2+b^^^2)^^^2/(a+b)^^^2)";
124.1633 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
124.1634 +if term2str t = "1 / (a ^^^ 2 + -1 * b ^^^ 2)" then ()
124.1635 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 49";
124.1636 +
124.1637 +"----- Schalk I, p.70 Nr. 477a";
124.1638 +(* MG Achtung: terme explodieren; Bsp zu komplex;
124.1639 + L???ung sollte (ziemlich grosser) Faktorisierter Ausdruck sein
124.1640 +val t = str2term "b*y/(b - 2*y)/((b^^^2 - y^^^2)/(b+2*y)) /\
124.1641 + \(b^^^2*y+b*y^^^2)*(a+x)^^^2/((b^^^2 - 4*y^^^2)*(a+2*x)^^^2)";
124.1642 +val Some (t',_) = rewrite_set_ thy false norm_Rational t;
124.1643 +
124.1644 +
124.1645 +val t = str2term "b*y*(b+2*y)*(b^^^2 - 4*y^^^2)*(a+2*x)^^^2 / \
124.1646 + \((b - 2*y)*(b^^^2 - y^^^2)*(b^^^2*y+b*y^^^2)*(a+x)^^^2)";
124.1647 +val Some (t,_) = rewrite_set_ thy false make_polynomial t;
124.1648 +????SK ???MG*)
124.1649 +
124.1650 +
124.1651 +"----- Schalk I, p.70 Nr. 478b ----- Rechenzeit: 5 sec";
124.1652 +val t = str2term "(a - (a*b+b^^^2)/(a+b))/(b+(a - b)/(1+(a+b)/(a - b))) / \
124.1653 + \((a - a^^^2/(a+b))/(a+(a*b)/(a - b)))";
124.1654 +val Some (t',_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1655 +if term2str t' =
124.1656 +"(2 * a ^^^ 3 + 2 * a ^^^ 2 * b) / (a ^^^ 2 * b + b ^^^ 3)"
124.1657 +then ()
124.1658 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 51";
124.1659 +
124.1660 +(* TODO.new_c:WN050820 STOP_REW_SUB introduced gave ...
124.1661 +if term2str t' = "(a ^^^ 4 + -1 * a ^^^ 2 * b ^^^ 2) /\n(a * b * (b + (a * (a + -1 * b) + -1 * b * (a + -1 * b)) / (2 * a)) *\n (a + -1 * b))" then ()
124.1662 +else raise error "rational.sml: works again";
124.1663 +re-outcommented with TODO.new_c: cvs before 071227, 11:50*)
124.1664 +
124.1665 +
124.1666 +
124.1667 +(*Schalk I, p.70 Nr. 480a *)
124.1668 +(* Achtung: rechnet ewig; cancel_p kann nicht krzen: WN060831 nonterm.SK00
124.1669 +val t = str2term
124.1670 +"(1/x+1/y+1/z)/(1/x - 1/y - 1/z) / (2*x^^^2/(x^^^2 - z^^^2)/(x/(x+z)+x/(x - z)))";
124.1671 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1672 +term2str t;
124.1673 +if (term2str t) =
124.1674 +
124.1675 +then ()
124.1676 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 52";
124.1677 +
124.1678 +(*MG Berechne Zwischenergebnisse: WN060831 nonterm.SK00*)
124.1679 +val t = str2term
124.1680 +"(1/x+1/y+1/z)/(1/x - 1/y - 1/z)";
124.1681 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1682 +term2str t;
124.1683 +"(x ^^^ 2 * y ^^^ 2 * z + x ^^^ 2 * y * z ^^^ 2 + x * y ^^^ 2 * z ^^^ 2) /
124.1684 +(-1 * x ^^^ 2 * y ^^^ 2 * z + -1 * x ^^^ 2 * y * z ^^^ 2 + x * y ^^^ 2 * z ^^^ 2)";
124.1685 +val t = str2term
124.1686 +"2*x^^^2/(x^^^2 - z^^^2)/(x/(x+z)+x/(x - z))";
124.1687 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1688 +term2str t;
124.1689 +"1"
124.1690 +
124.1691 +(* SK 1. Ausdruck kann nicht weiter gekrzt werden; cancel_p !!!*)
124.1692 +### rls: cancel_p on:
124.1693 +(x ^^^ 2 * (y ^^^ 2 * z) + x ^^^ 2 * (y * z ^^^ 2) + x * (y ^^^ 2 * z ^^^ 2)) /
124.1694 +(-1 * (x ^^^ 2 * (y ^^^ 2 * z)) + -1 * (x ^^^ 2 * (y * z ^^^ 2)) + x * (y ^^^ 2 * z ^^^ 2))
124.1695 +GC #3.61.81.101.197.17503: (0 ms)
124.1696 +*** RATIONALS_DIRECT_CANCEL_EXCEPTION: Invalid fraction
124.1697 +
124.1698 +val t = str2term
124.1699 +"(x^^^2 * (y^^^2 * z) + x^^^2 * (y * z^^^2) + x * (y^^^2 * z^^^2)) / (-1 * (x^^^2 * (y^^^2 * z)) + -1 * (x^^^2 * (y * z^^^2)) + x * (y^^^2 * z^^^2))";
124.1700 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1701 +term2str t;
124.1702 +(*uncaught exception nonexhaustive binding failure*)
124.1703 +
124.1704 +(* Das kann er aber krzen !!????: *)
124.1705 +val t = str2term
124.1706 +"(x^^^2 * (y^^^2 * z) + x * (y^^^2 * z^^^2)) / (-1 * (x^^^2 * (y * z^^^2)) + x * (y^^^2 * z^^^2))";
124.1707 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1708 +term2str t;
124.1709 +"(-1 * (y * x) + -1 * (z * y)) / (1 * (z * x) + -1 * (z * y))";
124.1710 +*)
124.1711 +
124.1712 +
124.1713 +
124.1714 +
124.1715 +
124.1716 +
124.1717 +(*--------------------------------------------------------------------*)
124.1718 +(*----------------------- Problem-Beispiele --------------------------*)
124.1719 +(*--------------------------------------------------------------------*)
124.1720 +
124.1721 +(*Schalk I, p.60 Nr. 215d *)
124.1722 +(* Achtung: rechnet ewig ...
124.1723 +val t = str2term "(a-b)^^^3 * (x+y)^^^4 / ((x+y)^^^2 * (a-b)^^^5)";
124.1724 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1725 +term2str t; noterm.SK
124.1726 +*)
124.1727 +
124.1728 +(* Kein Wunder, denn Z???ler und Nenner extra als Polynom dargestellt ergibt:*)
124.1729 +(*
124.1730 +val t = str2term "(a-b)^^^3 * (x+y)^^^4";
124.1731 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1732 +term2str t;
124.1733 +"a^^^3 * x^^^4 + 4 * a^^^3 * x^^^3 * y +\n6 * a^^^3 * x^^^2 * y^^^2 +\n4 * a^^^3 * x * y^^^3 +\na^^^3 * y^^^4 +\n-3 * a^^^2 * b * x^^^4 +\n-12 * a^^^2 * b * x^^^3 * y +\n-18 * a^^^2 * b * x^^^2 * y^^^2 +\n-12 * a^^^2 * b * x * y^^^3 +\n-3 * a^^^2 * b * y^^^4 +\n3 * a * b^^^2 * x^^^4 +\n12 * a * b^^^2 * x^^^3 * y +\n18 * a * b^^^2 * x^^^2 * y^^^2 +\n12 * a * b^^^2 * x * y^^^3 +\n3 * a * b^^^2 * y^^^4 +\n-1 * b^^^3 * x^^^4 +\n-4 * b^^^3 * x^^^3 * y +\n-6 * b^^^3 * x^^^2 * y^^^2 +\n-4 * b^^^3 * x * y^^^3 +\n-1 * b^^^3 * y^^^4";
124.1734 +val t = str2term "((x+y)^^^2 * (a-b)^^^5)";
124.1735 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1736 +term2str t;
124.1737 +"a^^^5 * x^^^2 + 2 * a^^^5 * x * y + a^^^5 * y^^^2 +\n-5 * a^^^4 * b * x^^^2 +\n-10 * a^^^4 * b * x * y +\n-5 * a^^^4 * b * y^^^2 +\n10 * a^^^3 * b^^^2 * x^^^2 +\n20 * a^^^3 * b^^^2 * x * y +\n10 * a^^^3 * b^^^2 * y^^^2 +\n-10 * a^^^2 * b^^^3 * x^^^2 +\n-20 * a^^^2 * b^^^3 * x * y +\n-10 * a^^^2 * b^^^3 * y^^^2 +\n5 * a * b^^^4 * x^^^2 +\n10 * a * b^^^4 * x * y +\n5 * a * b^^^4 * y^^^2 +\n-1 * b^^^5 * x^^^2 +\n-2 * b^^^5 * x * y +\n-1 * b^^^5 * y^^^2";
124.1738 +*)
124.1739 +(*anscheinend macht dem Rechner das Krzen diese Bruches keinen Spass mehr ...*)
124.1740 +
124.1741 +(*--------------------------------------------------------------------*)
124.1742 +(*Schalk I, p.70 Nr. 480b
124.1743 +val t = str2term "((12*x*y/(9*x^^^2 - y^^^2))/\
124.1744 + \(1/(3*x - y)^^^2 - 1/(3*x + y)^^^2)) *\
124.1745 + \(1/(x - 5*y)^^^2 - 1/(x + 5*y)^^^2)/\
124.1746 + \(20*x*y/(x^^^2 - 25*y^^^2))";
124.1747 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1748 +SK.nonterm
124.1749 +Kann nicht weiter vereinfacht werden !!!!?? *)
124.1750 +
124.1751 +(*--------------------------------------------------------------------*)
124.1752 +"---- MGs test set";
124.1753 +val t = str2term " (1 + x^^^5) / (y + x) + x^^^3 / x ";
124.1754 +val Some (t,_) = rewrite_set_ thy false common_nominator_p t;
124.1755 +if term2str t = "(1 + x ^^^ 3 + x ^^^ 5 + y * x ^^^ 2) / (x + y)" then()
124.1756 +else raise error "";
124.1757 +
124.1758 +(*--------------------------------------------------------------------*)
124.1759 +(* cancel_p liefert nicht immer Polynomnormalform (2): WN060831???SK3b
124.1760 + ---> Sortierung FALSCH !! *)
124.1761 +val t = str2term "b^^^3 * a^^^5/a ";
124.1762 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1763 +term2str t;
124.1764 +"1 * (a^^^4 * b^^^3) / 1"; (*OK*)
124.1765 +
124.1766 +val t = str2term "b^^^3 * a^^^5/b ";
124.1767 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1768 +term2str t;
124.1769 +"1 * (b^^^2 * a^^^5) / 1"; (*cancel_p sortiert hier falsch um!*)
124.1770 +
124.1771 +(* Problem liegt NICHT bei ord_make_polynomial! (siehe folgende Bsple) *)
124.1772 +(*
124.1773 +val x = str2term "x"; val bdv = str2term "bdv";
124.1774 +val t1 = str2term "b^^^2 * a^^^5";
124.1775 +val t2 = str2term "a^^^5 * b^^^2 ";
124.1776 +ord_make_polynomial false Rational.thy [(x,bdv)] (t1,t2); (*false*)
124.1777 +*)
124.1778 +(* ==> "b^^^2 * a^^^5" > "a^^^5 * b^^^2 " ... OK!*)
124.1779 +
124.1780 +(*--------------------------------------------------------------------*)
124.1781 +(* cancel_p liefert nicht immer Polynomnormalform (2): WN060831???SK3c
124.1782 + ---> erzeugt berflssige "1 * ..."
124.1783 +
124.1784 +val t = str2term "-1 / (3 + y)";
124.1785 +(*~~ *)
124.1786 +val Some (t,_) = rewrite_set_ thy false cancel_p t;
124.1787 +term2str t;
124.1788 +"-1 / (3 + 1 * y)";
124.1789 +(********* Das ist das PROBLEM !!!!!!!??? *******************)
124.1790 +(* -1 im Z???ler der Angabe verursacht das Problem !*)
124.1791 +*)
124.1792 +
124.1793 +(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
124.1794 +"----- MGs test set";
124.1795 +val t = str2term "(a^^^2 + -1)/(a+1)";
124.1796 +val Some (t',_) = rewrite_set_ thy false cancel_p t;
124.1797 +if term2str t' = "(-1 + a) / 1" then ()
124.1798 +else raise error "rational.sml MG tests 3d";
124.1799 +
124.1800 +"----- NOT TERMINATING ?: worked before 0707xx";
124.1801 +val t = str2term "(a^^^2 - 1)*(b + 1) / ((b^^^2 - 1)*(a+1))";
124.1802 +val Some (t'',_) = rewrite_set_ thy false norm_Rational t;
124.1803 +if term2str t'' = "(1 + -1 * a) / (1 + -1 * b)" then ()
124.1804 +else raise error "rational.sml MG tests 3e";
124.1805 +
124.1806 +"----- corrected SK060905";
124.1807 +val t = str2term "(4*x^^^2 - 20*x + 25)/(2*x - 5)^^^3";
124.1808 +val Some (t',_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1809 +if term2str t' = "-1 / (5 + -2 * x)" then ()
124.1810 +else raise error "rational.sml corrected SK060905";
124.1811 +
124.1812 +
124.1813 +"--------------------------------------------------------------------";
124.1814 +"----------------------- Muster-Beispiele fuer DA -------------------";
124.1815 +"--------------------------------------------------------------------";
124.1816 +
124.1817 +(*SRAM Schalk I, p.69 Nr. 442b --- abgewandelt*)
124.1818 +val t = str2term
124.1819 +"(15*a^^^4/(a*x^^^3) - 5*a*((b^^^4 - 5*c^^^2*x)/x^^^2))*(x^^^3/(5*a*b^^^3*c^^^3)) + a/c^^^3 * (x*(b/a) - 3*b*(a/b^^^4))";
124.1820 +val Some (t,_) = rewrite_set_ thy false norm_Rational(*_mg*) t;
124.1821 +term2str t;
124.1822 +if (term2str t) =
124.1823 +"5 * x ^^^ 2 / (b ^^^ 3 * c)"
124.1824 +then ()
124.1825 +else raise error "rational.sml.sml: diff.behav. in norm_Rational_mg 53";
124.1826 +
124.1827 +"-------- me Schalk I No.186 -------------------------------------";
124.1828 +"-------- me Schalk I No.186 -------------------------------------";
124.1829 +"-------- me Schalk I No.186 -------------------------------------";
124.1830 +val fmz = ["term ((14 * x * y) / ( x * y ))",
124.1831 + "normalform N"];
124.1832 +val (dI',pI',mI') =
124.1833 + ("Rational.thy",["rational","simplification"],
124.1834 + ["simplification","of_rationals"]);
124.1835 +val p = e_pos'; val c = [];
124.1836 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
124.1837 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1838 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1839 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1840 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1841 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1842 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1843 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
124.1844 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
124.1845 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
124.1846 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
124.1847 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
124.1848 +case (f2str f, nxt) of
124.1849 + ("14", ("End_Proof'", _)) => ()
124.1850 + | _ => raise error "rational.sml diff.behav. in me Schalk I No.186";
124.1851 +
124.1852 +
124.1853 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------";
124.1854 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------";
124.1855 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------";
124.1856 +states:=[];
124.1857 +CalcTree
124.1858 +[(["term (((2 - x)/(2*a)) / (2*a/(x - 2)))", "normalform N"],
124.1859 + ("Rational.thy",["rational","simplification"],
124.1860 + ["simplification","of_rationals"]))];
124.1861 +Iterator 1;
124.1862 +moveActiveRoot 1;
124.1863 +autoCalculate 1 CompleteCalc;
124.1864 +val ((pt,p),_) = get_calc 1; show_pt pt;
124.1865 +
124.1866 +interSteps 1 ([1],Res);
124.1867 +val ((pt,p),_) = get_calc 1; show_pt pt;
124.1868 +
124.1869 +
124.1870 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------";
124.1871 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------";
124.1872 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------";
124.1873 +states:=[];
124.1874 +CalcTree
124.1875 +[(["term ((a^2 + -1*b^2) / (a^2 + -2*a*b + b^2))", "normalform N"],
124.1876 + ("Rational.thy",["rational","simplification"],
124.1877 + ["simplification","of_rationals"]))];
124.1878 +Iterator 1;
124.1879 +moveActiveRoot 1;
124.1880 +autoCalculate 1 CompleteCalc;
124.1881 +val ((pt,p),_) = get_calc 1; show_pt pt;
124.1882 +(*with explicit script done already... and removed [1,..] at below...
124.1883 +interSteps 1 ([1],Res);
124.1884 +val ((pt,p),_) = get_calc 1; show_pt pt;
124.1885 +*)
124.1886 +interSteps 1 ([2],Res);
124.1887 +val ((pt,p),_) = get_calc 1; show_pt pt;
124.1888 +
124.1889 +interSteps 1 ([2,1],Res);
124.1890 +val ((pt,p),_) = get_calc 1; show_pt pt;
124.1891 +val newnds = children (get_nd pt [2,1]) (*see "fun detailrls"*);
124.1892 +(*if length newnds = 12 then () WN060905*)
124.1893 +if length newnds = 13 then ()
124.1894 +else raise error "rational.sml: interSteps cancel_p rev_rew_p";
124.1895 +
124.1896 +val p = ([2,1,9],Res);
124.1897 +getTactic 1 p;
124.1898 +val (_, tac, _) = pt_extract (pt, p);
124.1899 +(*case tac of Some (Rewrite ("sym_real_plus_binom_times1", _)) => ()
124.1900 +WN060905*)
124.1901 +case tac of Some (Rewrite ("sym_real_add_mult_distrib2", _)) => ()
124.1902 +| _ => raise error "rational.sml: getTactic, sym_real_plus_binom_times1";
124.1903 +
124.1904 +
124.1905 +"-------- investigate rulesets for cancel_p ----------------------";
124.1906 +"-------- investigate rulesets for cancel_p ----------------------";
124.1907 +"-------- investigate rulesets for cancel_p ----------------------";
124.1908 +val thy = Rational.thy;
124.1909 +"---------------- (a^^^2 + -1*b^^^2) / (a^^^2 + -2*a*b + b^^^2)";
124.1910 +val t = str2term "(a^^^2 + -1*b^^^2) / (a^^^2 + -2*a*b + b^^^2)";
124.1911 +val tt = str2term "(1 * a + 1 * b) * (1 * a + -1 * b)"(*numerator only*);
124.1912 +"----- with rewrite_set_";
124.1913 +val Some (tt',asm) = rewrite_set_ thy false make_polynomial tt;
124.1914 +term2str tt'= "a ^^^ 2 + -1 * b ^^^ 2" (*true*);
124.1915 +val tt = str2term "((1 * a + -1 * b) * (1 * a + -1 * b))"(*denominator only*);
124.1916 +val Some (tt',asm) = rewrite_set_ thy false make_polynomial tt;
124.1917 +term2str tt' = "a ^^^ 2 + -2 * a * b + b ^^^ 2" (*true*);
124.1918 +
124.1919 +"----- with make_deriv";
124.1920 +val Some (tt, _) = factout_p_ Isac.thy t; term2str tt =
124.1921 +"(1 * a + 1 * b) * (1 * a + -1 * b) / ((1 * a + -1 * b) * (1 * a + -1 * b))";
124.1922 +(*
124.1923 +"--- with ruleset as before 060829";
124.1924 +val {rules, rew_ord=(_,ro),...} =
124.1925 + rep_rls (assoc_rls "make_polynomial");
124.1926 +val der = make_deriv thy Atools_erls rules ro None tt;
124.1927 +print_depth 99; map (term2str o #1) der; print_depth 3;
124.1928 +print_depth 99; map (rule2str o #2) der; print_depth 3;
124.1929 +... did not terminate"*)
124.1930 +"--- with simpler ruleset";
124.1931 +val {rules, rew_ord=(_,ro),...} =
124.1932 + rep_rls (assoc_rls "rev_rew_p");
124.1933 +val der = make_deriv thy Atools_erls rules ro None tt;
124.1934 +print_depth 99; writeln (deriv2str der); print_depth 3;
124.1935 +
124.1936 +print_depth 99; map (term2str o #1) der; print_depth 3;
124.1937 +"...,(-1 * b ^^^ 2 + a ^^^ 2) / (-2 * (a * b) + a ^^^ 2 + (-1 * b) ^^^ 2) ]";
124.1938 +print_depth 99; map (rule2str o #2) der; print_depth 3;
124.1939 +print_depth 99; map (term2str o #1 o #3) der; print_depth 3;
124.1940 +
124.1941 +val der = make_deriv thy Atools_erls rules ro None
124.1942 + (str2term "(1 * a + 1 * b) * (1 * a + -1 * b)");
124.1943 +print_depth 99; writeln (deriv2str der); print_depth 3;
124.1944 +
124.1945 +val {rules, rew_ord=(_,ro),...} =
124.1946 + rep_rls (assoc_rls "rev_rew_p");
124.1947 +val der = make_deriv thy Atools_erls rules ro None
124.1948 + (str2term "(1 * a + -1 * b) * (1 * a + -1 * b)");
124.1949 +print_depth 99; writeln (deriv2str der); print_depth 3;
124.1950 +print_depth 99; map (term2str o #1) der; print_depth 3;
124.1951 +(*WN060829 ...postponed*)
124.1952 +
124.1953 +
124.1954 +"-------- investigate format of factout_ and factout_p_ ----------";
124.1955 +"-------- investigate format of factout_ and factout_p_ ----------";
124.1956 +"-------- investigate format of factout_ and factout_p_ ----------";
124.1957 +val {rules, rew_ord = (_,ro),...} = rep_rls (assoc_rls "make_polynomial");
124.1958 +val (thy, eval_rls) = (Rational.thy, Atools_erls)(*see 'fun init_state'*);
124.1959 +val Rrls {scr = Rfuns {init_state,...},...} = assoc_rls "cancel_p";
124.1960 +
124.1961 +"----- see Rational.ML, local cancel_p, fun init_state";
124.1962 +val t = str2term "(a^^^2 + (-1)*b^^^2) / (a^^^2 + (-2)*a*b + b^^^2)";
124.1963 +val Some (t',_) = factout_p_ thy t; term2str t';
124.1964 +(*
124.1965 +val rtas = reverse_deriv thy eval_rls rules ro None t';
124.1966 +writeln(trtas2str rst);
124.1967 +*)
124.1968 +
124.1969 +
124.1970 +"----- see Rational.ML, local cancel_p, fun init_state";
124.1971 +val t = str2term "a^^^2 / a";
124.1972 +val Some (t',_) = factout_p_ thy t;
124.1973 +term2str t' = "a * a / (1 * a)" (*true*);
124.1974 +(*... can be canceled with
124.1975 +real_mult_div_cancel2 ?k ~= 0 ==> ?m * ?k / (?n * ?k) = ?m / ?n"*)
124.1976 +(* sml/ME/rewtools.sml:
124.1977 +val rtas = reverse_deriv thy Atools_erls rules ro None t';
124.1978 +writeln (deri2str rtas);
124.1979 +*)
124.1980 +
124.1981 +
124.1982 +
124.1983 +"-------- SK 060904 ----------------------------------------------";
124.1984 +"-------- SK 060904 ----------------------------------------------";
124.1985 +"-------- SK 060904 ----------------------------------------------";
124.1986 +"----- order on polynomials -- input + output";
124.1987 +val thy = Isac.thy;
124.1988 +val t = str2term "(a + -1 * b) / (-1 * a + b)";
124.1989 +val Some (t', _) = factout_p_ thy t; term2str t';
124.1990 +val Some (t', _) = cancel_p_ thy t; term2str t';
124.1991 +
124.1992 +val t = str2term "a*b*c*d / (d*e*f*g)";
124.1993 +val Some (t', _) = cancel_p_ thy t; term2str t';
124.1994 +
124.1995 +val t = str2term "a*(b*(c*d)) / (b*(e*(f*g)))";
124.1996 +val Some (t', _) = cancel_p_ thy t; term2str t';
124.1997 +(*???order.SK ???*)
124.1998 +
124.1999 +"----- SK060904-1a non-termination of cancel_p_ ? worked before 0707xx";
124.2000 +val t = str2term "(x^^^2 - 4)*(3 - y) / ((y^^^2 - 9)*(2+x))";
124.2001 +val Some (t',_) = rewrite_set_ thy false norm_Rational t;
124.2002 +if term2str t' = "(2 + -1 * x) / (3 + y)" then ()
124.2003 +else raise error "rational.sml SK060904-1a worked since 0707xx";
124.2004 +
124.2005 +"----- SK060904-1b non-termination of cancel_p_ ... worked before 0707xx";
124.2006 +val t = str2term "(9 * a ^^^ 2 + -16 * b ^^^ 2) /\
124.2007 +\(36 * a^^^2 * c + (27 * a^^^2 * e + (-64 * b^^^2 * c + -48 * b^^^2 * e)))";
124.2008 +val Some (t',_) = cancel_p_ thy t;
124.2009 +if term2str t' = "1 / (4 * c + 3 * e)" then ()
124.2010 +else raise error "rational.sml SK060904-1b";
124.2011 +
124.2012 +
124.2013 +"----- SK060904-2a non-termination of add_fraction_p_";
124.2014 +val t = str2term " (a + b * x) / (a + -1 * (b * x)) + \
124.2015 + \ (-1 * a + b * x) / (a + b * x) ";
124.2016 +(* nonterm.SK
124.2017 +val Some (t',_) = rewrite_set_ thy false common_nominator_p t;
124.2018 +
124.2019 +common_nominator_p_ thy t;
124.2020 +" (a + b * x)*(a + b * x) / ((a + -1 * (b * x))*(a + -1 * (b * x))) + \
124.2021 +\ (-1 * a + b * x)*(a + -1 * (b * x)) / ((a + b * x)*(-1 * a + b * x)) ";
124.2022 +
124.2023 +add_fraction_p_ thy t;
124.2024 +" ((a + b * x)*(a + b * x) + (-1 * a + b * x)*(a + -1 * (b * x))) /\
124.2025 +\ ((a + b * x)*(-1 * a + b * x)) ";
124.2026 +*)
124.2027 \ No newline at end of file
125.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
125.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/rlang.sml Wed Jul 21 13:53:39 2010 +0200
125.3 @@ -0,0 +1,1883 @@
125.4 +(* use"../smltest/IsacKnowledge/rlang.sml";
125.5 + use"rlang.sml";
125.6 + *)
125.7 +
125.8 +(******************************************************************
125.9 +WN.060104 transfer marked (*E..*)examples to the exp-collection
125.10 + # exp_IsacCore_Equ_Uni_Poly.xml from rlang.sml (*EP*) exp
125.11 + # exp_IsacCore_Equ_Uni_Rat.xml from rlang.sml (*ER*) exp
125.12 + # exp_IsacCore_Equ_Uni_Root.xml from rlang.sml (*EO*) exp
125.13 +*******************************************************************)
125.14 +
125.15 +
125.16 +
125.17 +(*WN.12.6.03: for TODOs search 'writeln', for simplification search MG*)
125.18 +(* use"kbtest/rlang.sml";
125.19 + use"rlang.sml";
125.20 + (c) Richard Lang 2003
125.21 + tests over all equations implemented in his diploma thesis
125.22 + Elementare Gleichungen der Mittelschulmathematik in der ISAC Wissensbasis,
125.23 + Master's thesis, University of Technology, Graz, Austria, March 2003.
125.24 + created: 030228
125.25 + by: rlang
125.26 + last change: 030603
125.27 +*)
125.28 +(*@Book{bSchalk1,
125.29 + author = {Schalk, Heinz-Christian and Binder, Christian and Fertl, Walter and
125.30 + Firneis, Friedrich and Gems, Werner and Lehner, Dieter and
125.31 + Plihal, Andreas and Würl,Manfred},
125.32 + title = {Mathematik für höhere technische Lehranstalten Band I},
125.33 + publisher = {Reniets Verlag},
125.34 + year = {1986},
125.35 + note = {Schulbuch-Nr. 942},
125.36 +}
125.37 +
125.38 +@Book{bSchalk2,
125.39 + author = {Schalk, Heinz-Christian and Baumgartner, Gerhard and Binder, Christian and
125.40 + Eder, Hans Gerhard and Fertl, Walter and Firneis, Friedrich and
125.41 + Konstantiniuk, Peter and Plihal, Andreas and Rümmele, Goswin and
125.42 + Steinwender, Andreas and Zangerl, Nikolaus},
125.43 + title = {Mathematik für höhere technische Lehranstalten Band II},
125.44 + publisher = {Reniets Verlag},
125.45 + year = {1987},
125.46 + note = {Schulbuch-Nr. 1682},
125.47 +}
125.48 +*)
125.49 +
125.50 +(* Compiler.Control.Print.printDepth:=5; (*4 default*)
125.51 +trace_rewrite:=true;
125.52 + trace_rewrite:=false;
125.53 + refine fmz ["univariate","equation"];
125.54 +*)
125.55 +"---- rlang.sml begin-----------------------------------";
125.56 +(*----------------- Schalk I s.86 Bsp 5 ------------------------*)
125.57 +"Schalk I s.86 Bsp 5 (3*x - 1 - (5*x - (2 - 4*x)) = -11)";
125.58 +"Schalk I s.86 Bsp 5 (3*x - 1 - (5*x - (2 - 4*x)) = -11)";
125.59 +"Schalk I s.86 Bsp 5 (3*x - 1 - (5*x - (2 - 4*x)) = -11)";
125.60 +(*EP*)
125.61 +val fmz = ["equality (3*x - 1 - (5*x - (2 - 4*x)) = -11)",
125.62 + "solveFor x","solutions L"];
125.63 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.64 +(*val p = e_pos';
125.65 +val c = [];
125.66 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.67 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.68 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.69 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.70 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.71 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.72 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.73 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.74 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.75 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.76 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.77 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.78 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.79 +
125.80 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.81 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.82 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.83 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.84 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2]")) => ()
125.85 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 5 [x = 2]";
125.86 +
125.87 +(*----------------- Schalk I s.86 Bsp 19 ------------------------*)
125.88 +"Schalk I s.86 Bsp 19 (x - 5)*(10 - x) = (3 - x)*(2 + x) + 2*(x + 20)";
125.89 +"Schalk I s.86 Bsp 19 (x - 5)*(10 - x) = (3 - x)*(2 + x) + 2*(x + 20)";
125.90 +"Schalk I s.86 Bsp 19 (x - 5)*(10 - x) = (3 - x)*(2 + x) + 2*(x + 20)";
125.91 +(*EP*)
125.92 +val fmz = ["equality ((x - 5)*(10 - x) = (3 - x)*(2 + x) + 2*(x + 20))",
125.93 + "solveFor x","solutions L"];
125.94 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.95 +(*val p = e_pos';
125.96 +val c = [];
125.97 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.98 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.99 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.100 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.101 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.102 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.103 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.104 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.105 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.106 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.107 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.108 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.109 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.110 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.111 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.112 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.113 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.114 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 8]")) => ()
125.115 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 19 [x = 8]";
125.116 +
125.117 +(*----------------- Schalk I s.86 Bsp 23 ------------------------*)
125.118 +"Schalk I s.86 Bsp 19 ((2*x+5)^^^2+(3*x+4)^^^2=(13*x+2)*(x+1)+2*(15+14*x))";
125.119 +"Schalk I s.86 Bsp 19 ((2*x+5)^^^2+(3*x+4)^^^2=(13*x+2)*(x+1)+2*(15+14*x))";
125.120 +"Schalk I s.86 Bsp 19 ((2*x+5)^^^2+(3*x+4)^^^2=(13*x+2)*(x+1)+2*(15+14*x))";
125.121 +(*EP*)
125.122 +val fmz = ["equality ((2*x+5)^^^2+(3*x+4)^^^2=(13*x+2)*(x+1)+2*(15+14*x))",
125.123 + "solveFor x","solutions L"];
125.124 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.125 +(*val p = e_pos';
125.126 +val c = [];
125.127 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.128 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.129 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.130 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.131 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.132 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.133 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.134 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.135 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.136 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.137 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.138 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.139 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.140 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.141 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.142 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.143 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.144 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -9]")) => ()
125.145 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 23 [x = -9]";
125.146 +
125.147 +(*----------------- Schalk I s.86 Bsp 25 ------------------------*)
125.148 +"Schalk I s.86 Bsp 25 ((2*x+1)^^^3+(x+1)^^^3=(2*x+1)^^^2*2*x+(x+2)^^^3+x^^^2)";
125.149 +"Schalk I s.86 Bsp 25 ((2*x+1)^^^3+(x+1)^^^3=(2*x+1)^^^2*2*x+(x+2)^^^3+x^^^2)";
125.150 +"Schalk I s.86 Bsp 25 ((2*x+1)^^^3+(x+1)^^^3=(2*x+1)^^^2*2*x+(x+2)^^^3+x^^^2)";
125.151 +(*EP*)
125.152 +val fmz = ["equality ((2*x+1)^^^3+(x+1)^^^3=(2*x+1)^^^2*2*x+(x+2)^^^3+x^^^2)",
125.153 + "solveFor x","solutions L"];
125.154 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.155 +(*val p = e_pos';
125.156 +val c = [];
125.157 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.158 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.159 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.160 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.161 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.162 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.163 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.164 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.165 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.166 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.167 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.168 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.169 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.170 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.171 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.172 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.173 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.174 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -6 / 5]")) => ()
125.175 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 25 [x = -6 / 5]";
125.176 +
125.177 +(*----------------- Schalk I s.86 Bsp 28b ------------------------*)
125.178 +"Schalk I s.86 Bsp 28b ((3*x+5)/18 - x/2 = -((3*x - 2)/9))";
125.179 +"Schalk I s.86 Bsp 28b ((3*x+5)/18 - x/2 = -((3*x - 2)/9))";
125.180 +"Schalk I s.86 Bsp 28b ((3*x+5)/18 - x/2 = -((3*x - 2)/9))";
125.181 +(*ER-2*)
125.182 +val fmz = ["equality ((3*x+5)/18 - x/2 = -((3*x - 2)/9))",
125.183 + "solveFor x","solutions L"];
125.184 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.185 +(*val p = e_pos'; val c = [];
125.186 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.187 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.188 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.189 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.190 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.191 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.192 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.193 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.194 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.195 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.196 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.197 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.198 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.199 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.200 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.201 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.202 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[]")) => ()
125.203 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 28b []";
125.204 +
125.205 +(*WN---v *)
125.206 +val bdv= (term_of o the o (parse thy)) "bdv";
125.207 +val v = (term_of o the o (parse thy)) "x";
125.208 +val t = (term_of o the o (parse thy)) "3 * x / 5";
125.209 +val Some (t',_) = rewrite_set_inst_ PolyEq.thy true
125.210 + [(bdv, v)] make_ratpoly_in t;
125.211 +if term2str t' = "3 / 5 * x" then () else raise error "rlang.sml: 1";
125.212 +
125.213 +val t = str2term "(3*x+5)/18 - x/2 - -(3*x - 2)/9 = 0";
125.214 +val subst = [(str2term "bdv", str2term "x")];
125.215 +val Some (t',_) = rewrite_set_inst_ thy false subst make_ratpoly_in t;
125.216 +if term2str t' = "1 / 18 = 0" then () else raise error "rlang.sml: 2";
125.217 +(*WN---^ *)
125.218 +
125.219 +(*----------------- Schalk I s.87 Bsp 36b ------------------------*)
125.220 +"Schalk I s.87 Bsp 36b ((17*x - 51)/9 - (-(13*x - 3)/6) + 11 -(9*x- 7)/4 = 0)";
125.221 +"Schalk I s.87 Bsp 36b ((17*x - 51)/9 - (-(13*x - 3)/6) + 11 -(9*x- 7)/4 = 0)";
125.222 +"Schalk I s.87 Bsp 36b ((17*x - 51)/9 - (-(13*x - 3)/6) + 11 -(9*x- 7)/4 = 0)";
125.223 +(*ER-1*)
125.224 +val fmz = ["equality ((17*x - 51)/9 - (-(13*x - 3)/6) + 11 - (9*x - 7)/4 = 0)",
125.225 + "solveFor x","solutions L"];
125.226 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.227 +(*val p = e_pos';
125.228 +val c = [];
125.229 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.230 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.231 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.232 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.233 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.234 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.235 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.236 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.237 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.238 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.239 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.240 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.241 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.242 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.243 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.244 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.245 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -237 / 65]")) => ()
125.246 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 36b [x = -237 / 65]";
125.247 +
125.248 +
125.249 +(*WN---v *)
125.250 +val t = str2term "(17*x - 51)/9 - (-(13*x - 3)/6) + 11 - (9*x - 7)/4 = 0";
125.251 +val subst = [(str2term "bdv", str2term "x")];
125.252 +val Some (t',_) = rewrite_set_inst_ thy false subst make_ratpoly_in t;
125.253 +term2str t';
125.254 +if term2str t' = "79 / 12 + 65 / 36 * x = 0" then ()
125.255 +else raise error "rlang.sml: 3";
125.256 +(*WN---^ *)
125.257 +
125.258 +
125.259 +(*----------------- Schalk I s.87 Bsp 38b ------------------------*)
125.260 +"Schalk I s.87 Bsp 38b (-(2/x) + 3/(2*x) - 4/(3*x) + 5/(4*x) + 6/(5*x) =65/8)";
125.261 +"Schalk I s.87 Bsp 38b (-(2/x) + 3/(2*x) - 4/(3*x) + 5/(4*x) + 6/(5*x) =65/8)";
125.262 +"Schalk I s.87 Bsp 38b (-(2/x) + 3/(2*x) - 4/(3*x) + 5/(4*x) + 6/(5*x) =65/8)";
125.263 +(*ER-3*)
125.264 +val fmz = ["equality (-2/x + 3/(2*x) - 4/(3*x) + 5/(4*x) + 6/(5*x) = 65/8)",
125.265 + "solveFor x","solutions L"];
125.266 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.267 +(*val p = e_pos';
125.268 +val c = [];
125.269 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.270 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.271 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.272 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.273 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.274 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.275 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.276 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.277 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.278 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.279 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.280 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.281 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.282 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.283 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.284 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "296 + -3900 * x = 0")) then ()
125.285 +else raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 38b";
125.286 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.287 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.288 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.289 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.290 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.291 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.292 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.293 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.294 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.295 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.296 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 74 / 975]")) => ()
125.297 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.86 Bsp 38b [x = 74 / 975]";
125.298 +
125.299 +(*----------------- Schalk I s.87 Bsp 40b ------------------------*)
125.300 +"Schalk I s.87 Bsp 40b ((x+3)/(2*x - 4)=3)";
125.301 +"Schalk I s.87 Bsp 40b ((x+3)/(2*x - 4)=3)";
125.302 +"Schalk I s.87 Bsp 40b ((x+3)/(2*x - 4)=3)";
125.303 +(*ER-4*)
125.304 +val fmz = ["equality ((x+3)/(2*x - 4)=3)",
125.305 + "solveFor x","solutions L"];
125.306 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.307 +(*val p = e_pos';
125.308 +val c = [];
125.309 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.310 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.311 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.312 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.313 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.314 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.315 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.316 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.317 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.318 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.319 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.320 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.321 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.322 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.323 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.324 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.325 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;*)
125.326 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "15 + -5 * x = 0")) then ()
125.327 +else raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 40b";
125.328 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.329 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.330 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.331 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.332 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.333 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.334 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.335 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.336 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.337 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 3]")) => ()
125.338 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 40b [x = 3]";
125.339 +
125.340 +
125.341 +(*----------------- Schalk I s.87 Bsp 44a ------------------------*)
125.342 +"Schalk I s.87 Bsp 44a ((1/2+(5*x)/2)^^^2 -((13*x)/2- 5/2)^^^2 -(6*x)^^^2+29)";
125.343 +"Schalk I s.87 Bsp 44a ((1/2+(5*x)/2)^^^2 -((13*x)/2- 5/2)^^^2 -(6*x)^^^2+29)";
125.344 +"Schalk I s.87 Bsp 44a ((1/2+(5*x)/2)^^^2 -((13*x)/2- 5/2)^^^2 -(6*x)^^^2+29)";
125.345 +(*ER-5*)
125.346 +val fmz = ["equality ((1/2 + (5*x)/2)^^^2 - ((13*x)/2 - 5/2)^^^2 = -1*(6*x)^^^2 + 29)",
125.347 + "solveFor x","solutions L"];
125.348 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.349 +(*val p = e_pos';
125.350 +val c = [];
125.351 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.352 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.353 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.354 +(*trace_rewrite:=true;
125.355 +*)
125.356 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.357 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.358 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.359 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.360 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.361 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.362 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.363 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.364 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.365 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.366 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.367 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.368 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.369 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.370 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1]")) => ()
125.371 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 44a [x = 1]";
125.372 +
125.373 +(*WN---v *)
125.374 +val t = str2term "(1/2 + (5*x)/2)^^^2 - ((13*x)/2 - 5/2)^^^2 - (6*x)^^^2 + 29";
125.375 +val subst = [(str2term "bdv", str2term "x")];
125.376 +val Some (t',_) = rewrite_set_inst_ thy false subst make_ratpoly_in t;
125.377 +if term2str t' = "23 + 35 * x + -72 * x ^^^ 2" then ()
125.378 +else raise error "rlang.sml: 4";
125.379 +
125.380 +val t = str2term "(1/2 + (5*x)/2)^^^2 - ((13*x)/2 - 5/2)^^^2 + (6*x)^^^2 - 29";
125.381 +val subst = [(str2term "bdv", str2term "x")];
125.382 +val Some (t',_) = rewrite_set_inst_ thy false subst make_ratpoly_in t;
125.383 +if term2str t' = "-35 + 35 * x" then ()
125.384 +else raise error "rlang.sml: 4.1";
125.385 +(*WN---^ *)
125.386 +
125.387 +(*----------------- Schalk I s.87 Bsp 52a ------------------------*)
125.388 +"Schalk I s.87 Bsp 52a ((5*x)/(x - 2) - x/(x+2)=4)";
125.389 +"Schalk I s.87 Bsp 52a ((5*x)/(x - 2) - x/(x+2)=4)";
125.390 +"Schalk I s.87 Bsp 52a ((5*x)/(x - 2) - x/(x+2)=4)";
125.391 +(*ER-6*)
125.392 +val fmz = ["equality ((5*x)/(x - 2) - x/(x+2)=4)",
125.393 + "solveFor x","solutions L"];
125.394 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.395 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.396 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.397 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.398 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.399 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.400 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.401 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.402 + (*"12 * x + 4 * x ^^^ 2 = 4 * (-4 + x ^^^ 2)",Subproblem["normalize", "poly*)
125.403 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.404 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.405 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.406 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.407 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.408 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.409 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "16 + 12 * x = 0")) then ()
125.410 +else raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 52a";
125.411 + (*Subproblem["degree_1", "polynomial", "univariate", "equation"]*)
125.412 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.413 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.414 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.415 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.416 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.417 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.418 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.419 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.420 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.421 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -4 / 3]")) => ()
125.422 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 52a [x = -4 / 3]";
125.423 +
125.424 +(*----------------- Schalk I s.87 Bsp 55b ------------------------*)
125.425 +"Schalk I s.87 Bsp 55b (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)";
125.426 +"Schalk I s.87 Bsp 55b (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)";
125.427 +"Schalk I s.87 Bsp 55b (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)";
125.428 +(*ER-7*)
125.429 +val fmz = ["equality (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)",
125.430 + "solveFor x","solutions L"];
125.431 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.432 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.433 +(*val nxt = ("Model_Problem",Model_Problem["rational","univariate","equation"*)
125.434 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.435 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.436 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.437 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.438 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.439 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.440 +(*//me's dropped !val it = ["9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3 ~= 0","x ~= 0"]
125.441 +"(3 + -1 * x + 1 * x ^^^ 2) * x = 1 * (9 * x + -6 * x ^^^ 2 + 1 * x ^^^3)"))
125.442 +WN: Grad hoeher ~~~~~~~~~~~~ als notwendig ~~~~~~~~*)
125.443 +(* nxt =Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.444 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.445 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.446 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.447 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.448 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.449 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.450 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; 040209 MGs norm_Rational*)
125.451 +(* val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"])*)
125.452 +if f= Form' (FormKF (~1, EdUndef, 0, Nundef, "-6 * x + 5 * x ^^^ 2 = 0"))then()
125.453 +else raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 55b";
125.454 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.455 +(*nxt=Model_Problem["bdv_only","degree_2","polynomial","univariate","equation*)
125.456 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.457 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.458 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.459 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.460 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.461 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.462 +(*val f = Form' (FormKF (~1,EdUndef,3,Nundef,"x = 0 | x = 6 / 5")) : mout
125.463 +val nxt = ("Or_to_List",Or_to_List) *)
125.464 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.465 +(*val f = Form' (FormKF (~1,EdUndef,3,Nundef,"[x = 0, x = 6 / 5]")) : mout
125.466 +val nxt = ("Check_elementwise",Check_elementwise "Assumptions")
125.467 +get_assumptions pt (fst p);
125.468 +val it = [] : string list ... correct for this subproblem !*)
125.469 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.470 +(*val p = ([6,5,5],Res) : pos'
125.471 +val f = Form' (FormKF (~1,EdUndef,3,Nundef,"[x = 0, x = 6 / 5]")) : mout
125.472 +nxt=Check_Postcond ["bdv_only","degree_2","polynomial","univariate","equation*)
125.473 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.474 +(*val p = ([6,5],Res) : pos'
125.475 +val f = Form' (FormKF (~1,EdUndef,2,Nundef,"[x = 0, x = 6 / 5]")) : mout
125.476 +val nxt =Check_Postcond ["normalize","polynomial","univariate","equation"])*)
125.477 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.478 +(*val p = ([6],Res) : pos'
125.479 +val f = Form' (FormKF (~1,EdUndef,1,Nundef,"[x = 0, x = 6 / 5]")) : mout
125.480 +val nxt = ("Check_elementwise",Check_elementwise "Assumptions")*)
125.481 +val [(aaa,ppp)] = get_assumptions_ pt p;
125.482 +if term2str aaa = "9 * x + -6 * x ^^^ 2 + x ^^^ 3 ~= 0" then ()
125.483 +else raise error "rlang.sml: diff.behav. in I s.87 Bsp 55b [x = 6 / 5], asms";
125.484 +(*WN060717 unintentionally changed some rls/ord while
125.485 + completing knowl. for thes2file...
125.486 +if term2str aaa = "9 * x + (x ^^^ 3 + -6 * x ^^^ 2) ~= 0" then ()
125.487 +else raise error "rlang.sml: diff.behav. in I s.87 Bsp 55b [x = 6 / 5], asms";
125.488 +.... but it became even better*)
125.489 +
125.490 +(*22.10.03:
125.491 +val it = "9 * x + (x ^^^ 3 + -6 * x ^^^ 2) ~= 0" : string;
125.492 + before 22.10.03:
125.493 +val it = ["9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3 ~= 0","x ~= 0"]
125.494 +> val subs = [(str2term "x", str2term "0")];
125.495 +> val pred = str2term "9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3 ~= 0 & x ~= 0";
125.496 +> eval_true thy [subst_atomic subs pred] rateq_erls;
125.497 +val it = false : bool
125.498 +> val subs = [(str2term "x", str2term "6 / 5")];
125.499 +> val pred = str2term "9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3 ~= 0 & x ~= 0";
125.500 +> eval_true thy [subst_atomic subs pred] rateq_erls;
125.501 +val it = true : bool*)
125.502 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.503 +(*val p = ([7],Res) : pos'
125.504 +val f = Form' (FormKF (~1,EdUndef,1,Nundef,"[x = 6 / 5]")) : mout
125.505 +val nxt =Check_Postcond ["rational","univariate","equation"]) *)
125.506 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.507 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 6 / 5]")) => ()
125.508 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 55b [x = 6 / 5]";
125.509 +
125.510 +(*----------------- Schalk I s.88 Bsp 64c ------------------------*)
125.511 +"Schalk I s.88 Bsp 64c (((x - 1)/(x+1)+1)/((x - 1)/(x+1) - (x+1)/(x - 1))=2)";
125.512 +"Schalk I s.88 Bsp 64c (((x - 1)/(x+1)+1)/((x - 1)/(x+1) - (x+1)/(x - 1))=2)";
125.513 +"Schalk I s.88 Bsp 64c (((x - 1)/(x+1)+1)/((x - 1)/(x+1) - (x+1)/(x - 1))=2)";
125.514 +(*ER-8*)
125.515 +val fmz = ["equality (((x - 1)/(x+1)+1)/((x - 1)/(x+1) - (x+1)/(x - 1))=2)",
125.516 + "solveFor x","solutions L"];
125.517 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.518 +
125.519 +(*val p = e_pos'; val c = [];
125.520 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.521 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.522 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.523 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.524 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.525 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.526 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.527 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.528 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.529 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.530 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.531 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.532 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.533 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.534 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.535 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-3 + -1 * x = 0")) then ()
125.536 +else raise error "rlangsml: diff.behav. in Schalk I s.88 Bsp 64c";
125.537 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.538 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.539 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.540 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.541 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.542 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.543 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.544 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.545 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.546 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.547 +case f of Form' (FormKF (_,_,0,_,"[x = -3]")) => ()
125.548 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.88 Bsp 64c [x = -3]";
125.549 +
125.550 +(*----------------- Schalk I s.88 Bsp 79a (2) ------------------------*)
125.551 +"Schalk I s.88 Bsp 79a (2) (m1*v1+m2*v2=0)";
125.552 +"Schalk I s.88 Bsp 79a (2) (m1*v1+m2*v2=0)";
125.553 +"Schalk I s.88 Bsp 79a (2) (m1*v1+m2*v2=0)";
125.554 +(*ER-10*)
125.555 +val fmz = ["equality (m1*v1+m2*v2=0)",
125.556 + "solveFor m1","solutions L"];
125.557 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.558 +
125.559 +(*val p = e_pos'; val c = [];
125.560 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.561 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.562 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.563 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.564 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.565 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.566 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.567 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.568 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.569 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.570 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.571 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.572 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.573 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.574 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.575 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.576 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[m1 = -1 * m2 * v2 / v1]")) => ()
125.577 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.88 Bsp 79a (2) [m1 = -1 * m2 * v2 / v1]";
125.578 +
125.579 +(*----------------- Schalk I s.89 Bsp 90a(1) ------------------------*)
125.580 +"Schalk I s.89 Bsp 90a (1) (f=((w+u)/(w+v))*v0)";
125.581 +"Schalk I s.89 Bsp 90a (1) (f=((w+u)/(w+v))*v0)";
125.582 +"Schalk I s.89 Bsp 90a (1) (f=((w+u)/(w+v))*v0)";
125.583 +(*ER-11*)
125.584 +val fmz = ["equality (f=((w+u)/(w+v))*v0)",
125.585 + "solveFor v","solutions L"];
125.586 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.587 +
125.588 +(*val p = e_pos'; val c = [];
125.589 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.590 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.591 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.592 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.593 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.594 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.595 +(*val nxt = Specify_Problem ["rational","univariate","equation"]) *)
125.596 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.597 +(*val nxt = Specify_Method ["RatEq","solve_rat_equation"]) *)
125.598 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.599 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.600 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.601 +(*nxt = Subproblem ("RatEq.thy",["univariate","equation"])) *)
125.602 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.603 +(*val nxt =Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.604 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.605 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.606 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.607 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.608 +(*val nxt = ("Apply_Method",Apply_Method ["PolyEq","normalize_poly"])*)
125.609 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.610 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.611 +(*val nxt =Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
125.612 +if f = Form'
125.613 + (FormKF
125.614 + (~1,
125.615 + EdUndef,
125.616 + 0,
125.617 + Nundef,
125.618 + "f * w + -1 * u * v0 + -1 * v0 * w + f * v = 0")) then ()
125.619 +else raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 90a";
125.620 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.621 +(*val nxt = Model_Problem ["degree_1","polynomial","univariate","equation"])*)
125.622 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.623 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.624 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.625 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.626 +(*val nxt = ("Apply_Method",Apply_Method ["PolyEq","solve_d1_poly_equation"])*)
125.627 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.628 +(*val f = "v = -1 * (f * w + -1 * u * v0 + -1 * v0 * w) / f")) : mout
125.629 +val nxt = ("Or_to_List",Or_to_List) : string * tac *)
125.630 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.631 +(*val f = "[v = -1 * (f * w + -1 * u * v0 + -1 * v0 * w) / f]")) : mout
125.632 +val nxt = ("Check_elementwise",Check_elementwise "Assumptions") *)
125.633 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.634 +(*val f = "[v = -1 * (f * w + -1 * u * v0 + -1 * v0 * w) / f]")) : mout
125.635 +val nxt = Check_Postcond ["degree_1","polynomial","univariate","equation"])*)
125.636 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.637 +(*val f = "[v = -1 * (f * w + -1 * u * v0 + -1 * v0 * w) / f]")) : mout
125.638 +val nxt = Check_Postcond ["normalize","polynomial","univariate","equation"])*)
125.639 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.640 +(*val f = "[v = -1 * (f * w + -1 * u * v0 + -1 * v0 * w) / f]")) : mout
125.641 +val nxt = ("Check_elementwise",Check_elementwise "Assumptions")*)
125.642 +
125.643 +get_assumptions_ pt p;
125.644 +(*it = ["v + w ~= 0"] ... goes to the solution as an assumption*)
125.645 +
125.646 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.647 +(*val f = Form' (FormKF (~1,EdUndef,1,Nundef,"[]")) : mout
125.648 +val nxt = Check_Postcond ["rational","univariate","equation"]) *)
125.649 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.650 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,
125.651 + "[v = (u * v0 + v0 * w + -1 * f * w) / f]")) => ()
125.652 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 90a (1) [v=...]";
125.653 +if get_assumptions_ pt p =
125.654 + [(str2term"(u * v0 + v0 * w + -1 * f * w) / f + w ~= 0",[])] then ()
125.655 +else raise error "rlang.sml: diff.behav. in I s.89 Bsp 90a (1) [v=...] asm";
125.656 +
125.657 +
125.658 +(*----------------- Schalk I s.89 Bsp 90a(2) ------------------------*)
125.659 +"Schalk I s.89 Bsp 90a (2) (f=((w+u)/(w+v))*v0)";
125.660 +"Schalk I s.89 Bsp 90a (2) (f=((w+u)/(w+v))*v0)";
125.661 +"Schalk I s.89 Bsp 90a (2) (f=((w+u)/(w+v))*v0)";
125.662 +(*ER-12*)
125.663 +val fmz = ["equality (f=((w+u)/(w+v))*v0)",
125.664 + "solveFor w","solutions L"];
125.665 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.666 +(*val p = e_pos';val c = [];
125.667 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.668 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.669 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.670 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.671 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.672 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.673 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.674 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.675 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.676 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.677 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.678 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.679 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.680 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.681 +if f = Form'
125.682 + (FormKF
125.683 + (~1,
125.684 + EdUndef,
125.685 + 0,
125.686 + Nundef,
125.687 + "f * v + -1 * u * v0 + (f + -1 * v0) * w = 0")) then ()
125.688 +else raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 90a (2)";
125.689 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.690 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.691 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.692 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.693 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.694 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.695 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.696 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.697 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.698 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[w = (u * v0 + -1 * f * v) / (f + -1 * v0)]")) => ()
125.699 + | _ => raise error "rlang.sml: diff.behav. in Schalk I Bsp 90a(2)";
125.700 +if get_assumptions_ pt p =
125.701 +[(str2term"v + (u * v0 + -1 * f * v) / (f + -1 * v0) ~= 0",[]),
125.702 + (str2term"f + -1 * v0 ~= 0",[])]
125.703 +then writeln "asm should be simplified ???"
125.704 +else raise error "rlang.sml: diff.behav. in Schalk I Bsp 90a(2) asm";
125.705 +
125.706 +(*----------------- Schalk I s.89 Bsp 98a(1) ------------------------*)
125.707 +"Schalk I s.89 Bsp 98a (1) (1/R=1/R1+1/R2)";
125.708 +"Schalk I s.89 Bsp 98a (1) (1/R=1/R1+1/R2)";
125.709 +"Schalk I s.89 Bsp 98a (1) (1/R=1/R1+1/R2)";
125.710 +(*ER-9*)
125.711 +val fmz = ["equality (1/R=1/R1+1/R2)",
125.712 + "solveFor R1","solutions L"];
125.713 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.714 +(*val p = e_pos'; val c = [];
125.715 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.716 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.717 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.718 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.719 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.720 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.721 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.722 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.723 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.724 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.725 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.726 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.727 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.728 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.729 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.730 +if f = Form'
125.731 + (FormKF
125.732 + (~1, EdUndef, 0, Nundef, "-1 * R * R2 + (R2 + -1 * R) * R1 = 0"))then()
125.733 +else raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 98a (1)";
125.734 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.735 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.736 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.737 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.738 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.739 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.740 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.741 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.742 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.743 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[R1 = R * R2 / (R2 + -1 * R)]")) => ()
125.744 + | _ => raise error "rlang.sml: diff.behav. in 98a(1) [R1 = ...]";
125.745 +if get_assumptions_ pt p = [(str2term"R * R2 * R2 ~= (R2 + -1 * R) * 0",[]),
125.746 + (str2term"R2 + -1 * R ~= 0",[]),
125.747 + (str2term"R2 + -1 * R ~= 0",[])]
125.748 + then writeln "asm should be simplified"
125.749 +else raise error "rlang.sml: diff.behav. in 98a(1) asm";
125.750 +
125.751 +(*----------------- Schalk I s.89 Bsp 104a(1) ------------------------*)
125.752 +"Schalk I s.89 Bsp 104a (1) (y^^^2=2*p*x)";
125.753 +"Schalk I s.89 Bsp 104a (1) (y^^^2=2*p*x)";
125.754 +"Schalk I s.89 Bsp 104a (1) (y^^^2=2*p*x)";
125.755 +(*ER-13 + EO-11 ?!?*)
125.756 +val fmz = ["equality (y^^^2=2*p*x)",
125.757 + "solveFor p","solutions L"];
125.758 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.759 +(*val p = e_pos'; val c = [];
125.760 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.761 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.762 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.763 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.764 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.765 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.766 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.767 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.768 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.769 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.770 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.771 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.772 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.773 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.774 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.775 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.776 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.777 +case f of Form' (FormKF (_,_,0,_,"[p = y ^^^ 2 / (2 * x)]")) => ()
125.778 + | _ => raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 104a (1) [p = y^2/(2*x)]";
125.779 +if get_assumptions_ pt p = [(str2term"-2 * x ~= 0",[])]
125.780 +then writeln"should be x ~= 0\nshould be x ~= 0\nshould be x ~= 0\n"
125.781 +else raise error "rlang.sml: diff.behav. in I s.89 Bsp 104a(1) asm";
125.782 +
125.783 +
125.784 +(*----------------- Schalk I s.89 Bsp 104a(2) ------------------------*)
125.785 +"Schalk I s.89 Bsp 104a (2) (y^^^2=2*p*x)";
125.786 +"Schalk I s.89 Bsp 104a (2) (y^^^2=2*p*x)";
125.787 +"Schalk I s.89 Bsp 104a (2) (y^^^2=2*p*x)";
125.788 +(*EO ??*)
125.789 +val fmz = ["equality (y^^^2=2*p*x)",
125.790 + "solveFor y","solutions L"];
125.791 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.792 +(*val p = e_pos';
125.793 +val c = [];
125.794 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.795 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.796 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.797 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.798 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.799 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.800 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.801 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.802 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.803 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.804 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.805 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.806 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.807 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.808 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.809 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.810 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.811 +case f of Form' (FormKF (_,_,0,_,"[y = sqrt (2 * p * x), y = -1 * sqrt (2 * p * x)]")) => ()
125.812 +| _ => raise error "rlang.sml: diff.behav. Schalk I s.89 Bsp 104a(2) [x = ]";
125.813 +if get_assumptions_ pt p = [(str2term"0 <= -1 * (-2 * p * x)",[]),(str2term"0 <= -1 * (-2 * p * x)",[])] then writeln "asm should be simplified\nshould be simplified"
125.814 +else raise error "rlang.sml: diff.behav. in I s.89 Bsp 104a(2) asm";
125.815 +
125.816 +
125.817 +(*----------------- Schalk I s.90 Bsp 118a (1) ------------------------*)
125.818 +"Schalk I s.90 Bsp 118a (1) (b^^^2*x^^^2 + a^^^2*y^^^2 = a^^^2*b^^^2)";
125.819 +"Schalk I s.90 Bsp 118a (1) (b^^^2*x^^^2 + a^^^2*y^^^2 = a^^^2*b^^^2)";
125.820 +"Schalk I s.90 Bsp 118a (1) (b^^^2*x^^^2 + a^^^2*y^^^2 = a^^^2*b^^^2)";
125.821 +(*EO-8*)
125.822 +val fmz = ["equality (b^^^2*x^^^2 + a^^^2*y^^^2 = a^^^2*b^^^2)",
125.823 + "solveFor x","solutions L"];
125.824 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.825 +(*val p = e_pos';
125.826 +val c = [];
125.827 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.828 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.829 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.830 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.831 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.832 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.833 +
125.834 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.835 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;
125.836 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;
125.837 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;
125.838 +
125.839 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.840 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.841 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.842 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.843 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.844 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.845 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.846 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.847 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;
125.848 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;get_asm (fst p, fst p) pt;
125.849 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;get_asm (fst p, fst p) pt;
125.850 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;get_asm (fst p, fst p) pt;
125.851 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;get_asm (fst p, fst p) pt;
125.852 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;asms2str (get_asm (fst p, fst p) pt);
125.853 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;asms2str (get_asm (fst p, fst p) pt);
125.854 +
125.855 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;get_asm (fst p, fst p) pt;
125.856 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;f2str f;get_asm (fst p, fst p) pt;
125.857 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = sqrt ((a ^^^ 2 * b ^^^ 2 + -1 * a ^^^ 2 * y ^^^ 2) / b ^^^ 2),\n x = -1 * sqrt ((a ^^^ 2 * b ^^^ 2 + -1 * a ^^^ 2 * y ^^^ 2) / b ^^^ 2)]")) => writeln"should be simplified MG"
125.858 +| _ => raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 118a(2) [x = ]";
125.859 +val asms = get_assumptions_ pt p;
125.860 +if asms = [(str2term"0 * b ^^^ 2 <= -1 * (a ^^^ 2 * y ^^^ 2 + -1 * a ^^^ 2 * b ^^^ 2)", []),
125.861 + (str2term"b ^^^ 2 ~= 0", []),
125.862 + (str2term"0 * b ^^^ 2 <= -1 * (a ^^^ 2 * y ^^^ 2 + -1 * a ^^^ 2 * b ^^^ 2)", []),
125.863 + (str2term"b ^^^ 2 ~= 0", [])
125.864 + ] then writeln"should be simplified MG"
125.865 +else raise error "rlang.sml: diff.behav. in Schalk I s.89 Bsp 118a(2) asms";
125.866 +
125.867 +(*----------------- Schalk I s.102 Bsp 268(1) ------------------------*)
125.868 +"Schalk I s.102 Bsp 268(1) (A = (1/2)*(x1*(y2-y3)+x2*(y3 - y1)+x3*(y1 - y2)))";
125.869 +"Schalk I s.102 Bsp 268(1) (A = (1/2)*(x1*(y2-y3)+x2*(y3 - y1)+x3*(y1 - y2)))";
125.870 +"Schalk I s.102 Bsp 268(1) (A = (1/2)*(x1*(y2-y3)+x2*(y3 - y1)+x3*(y1 - y2)))";
125.871 +(*ER-14*)
125.872 +val fmz = ["equality (A = (1/2)*(x1*(y2 - y3)+x2*(y3 - y1)+x3*(y1 - y2)))",
125.873 + "solveFor x2","solutions L"];
125.874 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.875 +(*val p = e_pos';
125.876 +val c = [];
125.877 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.878 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.879 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.880 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.881 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.882 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.883 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.884 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.885 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.886 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.887 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.888 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.889 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.890 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.891 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.892 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.893 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.894 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x2 =\n (-2 * A + x1 * y2 + x3 * y1 + -1 * x1 * y3 + -1 * x3 * y2) /\n (y1 + -1 * y3)]")) => ()
125.895 +| _ => raise error "rlang.sml: diff.behav. Schalk I s.102 Bsp 268(1) [x2=...]";
125.896 +if get_assumptions_ pt p = [(str2term"y1 / 2 + -1 * y3 / 2 ~= 0",[])] then ()
125.897 +else raise error "rlang.sml: diff.behav. in I s.102 Bsp 268(1) asm";
125.898 +
125.899 +(*-------------------- Schalk II ----------------------------*)
125.900 +(*-------------------- Schalk II ----------------------------*)
125.901 +(*-------------------- Schalk II ----------------------------*)
125.902 +(*-------------------- Schalk II ----------------------------*)
125.903 +(*-------------------- Schalk II ----------------------------*)
125.904 +
125.905 +
125.906 +(*----------------- Schalk II s.56 Bsp 67b ------------------------*)
125.907 +"Schalk II s.56 Bsp 67b (4*sqrt(4*x+1)=3*sqrt(7*x+2))";
125.908 +"Schalk II s.56 Bsp 67b (4*sqrt(4*x+1)=3*sqrt(7*x+2))";
125.909 +"Schalk II s.56 Bsp 67b (4*sqrt(4*x+1)=3*sqrt(7*x+2))";
125.910 +(*EO*)
125.911 +val fmz = ["equality (4*sqrt(4*x+1)=3*sqrt(7*x+2))",
125.912 + "solveFor x","solutions L"];
125.913 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.914 +(*val p = e_pos';
125.915 +val c = [];
125.916 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.917 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.918 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.919 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.920 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.921 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.922 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.923 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.924 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.925 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.926 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.927 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.928 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.929 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.930 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.931 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-2 + x = 0")) then ()
125.932 +else raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 67b";
125.933 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.934 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.935 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.936 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.937 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.938 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.939 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.940 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.941 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.942 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2]")) => ()
125.943 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 67b [x=2]";
125.944 +
125.945 +(*----------------- Schalk II s.56 Bsp 68a ------------------------*)
125.946 +"Schalk II s.56 Bsp 68a (5*sqrt(x) - 1 = 7*sqrt(x) - 5)";
125.947 +"Schalk II s.56 Bsp 68a (5*sqrt(x) - 1 = 7*sqrt(x) - 5)";
125.948 +"Schalk II s.56 Bsp 68a (5*sqrt(x) - 1 = 7*sqrt(x) - 5)";
125.949 +val fmz = ["equality (5*sqrt(x) - 1 = 7*sqrt(x) - 5)",
125.950 + "solveFor x","solutions L"];
125.951 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.952 +(*val p = e_pos';
125.953 +val c = [];
125.954 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.955 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.956 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.957 +(* val nxt = ("Model_Problem",Model_Problem ["normalize","root","univariate","equation"])*)
125.958 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.959 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.960 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.961 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.962 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.963 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"]) *)
125.964 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.965 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.966 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.967 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.968 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.969 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.970 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.971 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"]) *)
125.972 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.973 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.974 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.975 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.976 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.977 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.978 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.979 +get_assumptions_ pt p;
125.980 +(* val nxt = ("Model_Problem", Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.981 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.982 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.983 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.984 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.985 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.986 +if f = Form'
125.987 + (FormKF
125.988 + (~1, EdUndef, 0, Nundef, "256 + -2368 * x + 576 * x ^^^ 2 = 0"))then()
125.989 +else raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 68a";
125.990 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.991 +get_assumptions_ pt p;
125.992 +(* val nxt = ("Model_Problem", Model_Problem
125.993 + ["abcFormula","degree_2","polynomial","univariate","equation"])*)
125.994 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.995 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.996 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.997 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.998 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.999 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1000 +get_assumptions_ pt p;
125.1001 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1002 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1003 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1004 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1005 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4, x = 1 / 9]"))
125.1006 +then writeln "only [x = 4] !\nonly [x = 4] !\nonly [x = 4] !\n"
125.1007 +else raise error "rlang.sml: diff.behav. in II 68a";
125.1008 +val asms = get_assumptions_ pt p;
125.1009 +if asms2str asms =
125.1010 +"[(0 <= (25 * (1 / 9) + -1 * (16 + 49 * (1 / 9))) * -56, []),\
125.1011 + \(0 <= 1 / 9, []),\
125.1012 + \(0 <= 1 / 9, []),\
125.1013 + \(0 <= (-5 + 7 * sqrt (1 / 9) + 1) * 5, []),\
125.1014 + \(0 <= 1 / 9, []),\
125.1015 + \(0 <= (25 * (1 / 9) + -1 * (16 + 49 * (1 / 9))) * -56, []),\
125.1016 + \(0 <= 1 / 9, [])]"
125.1017 +(*WN050916 before correction 'rewrite__set_ called with 'Erls' for ..'
125.1018 + thus: maybe the rls for the asms is Erls ??:
125.1019 + [(str2term"0 <= (25 * (1 / 9) + -1 * (16 + 49 * (1 / 9))) * -56", []),
125.1020 + (str2term"9 ~= 0", []),
125.1021 + (str2term"0 <= (-5 + 7 * sqrt (1 / 9) + 1) * 5", []),
125.1022 + (str2term"9 ~= 0", []),
125.1023 + (str2term"0 <= (25 * (1 / 9) + -1 * (16 + 49 * (1 / 9))) * -56", [])]*)
125.1024 + then "should get True * False!!!"
125.1025 +else raise error "rlang.sml: diff.behav. in II 68a asms";
125.1026 +
125.1027 +(*----------------- Schalk II s.56 Bsp 73b ------------------------*)
125.1028 +"Schalk II s.56 Bsp 73b (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))";
125.1029 +"Schalk II s.56 Bsp 73b (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))";
125.1030 +"Schalk II s.56 Bsp 73b (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))";
125.1031 +(*EO-2*)
125.1032 +val fmz = ["equality (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))",
125.1033 + "solveFor x","solutions L"];
125.1034 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1035 +
125.1036 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1037 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1038 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1039 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1040 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1041 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1042 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1043 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1044 +(*"13 + 13 * x + -2 * sqrt ((4 + 4 * x) * (9 + 9 * x)) = 1 + x"
125.1045 +-> Subproblem ("RootEq.thy", ["univariate", ...])*)
125.1046 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1047 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1048 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1049 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1050 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1051 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1052 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1053 +(*"144 + 288 * x + 144 * x ^^^ 2 = 144 + x ^^^ 2 + 288 * x + 143 * x ^^^ 2"
125.1054 +-> Subproblem ("RootEq.thy", ["univariate", ...])*)
125.1055 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1056 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1057 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1058 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1059 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1060 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1061 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "0 = 0")) then ()
125.1062 +else raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 73b";
125.1063 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1064 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1065 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1066 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1067 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1068 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1069 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1070 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1071 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1072 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1073 +val asm = get_assumptions_ pt p;
125.1074 +if asm=[] andalso f = Form' (FormKF (~1,EdUndef,0,Nundef,"UniversalList")) andalso nxt = ("End_Proof'",End_Proof') then ()
125.1075 +else raise error "rlang.sml: diff.behav. in UniversalList 2";
125.1076 +
125.1077 +(*----------------- Schalk II s.56 Bsp 74a ------------------------*)
125.1078 +"Schalk II s.56 Bsp 74a (sqrt(4*x+1) - sqrt(x+3) = sqrt(x - 2))";
125.1079 +"Schalk II s.56 Bsp 74a (sqrt(4*x+1) - sqrt(x+3) = sqrt(x - 2))";
125.1080 +"Schalk II s.56 Bsp 74a (sqrt(4*x+1) - sqrt(x+3) = sqrt(x - 2))";
125.1081 +(*EO-3*)
125.1082 +val fmz = ["equality (sqrt(4*x+1) - sqrt(x+3) = sqrt(x - 2))",
125.1083 + "solveFor x","solutions L"];
125.1084 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1085 +
125.1086 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1087 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1088 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1089 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1090 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1091 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1092 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1093 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1094 +(*4 + 5 * x + -2 * sqrt (3 + 13 * x + 4 * x ^^^ 2) = -2 + x"
125.1095 +-> Subproblem ("RootEq.thy", ["univariate", ...])*)
125.1096 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1097 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1098 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1099 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1100 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1101 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1102 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1103 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1104 +(*"12 + 52 * x + 16 * x ^^^ 2 = 36 + x ^^^ 2 + 48 * x + 15 * x ^^^ 2"
125.1105 +-> Subproblem ("RootEq.thy", ["univariate", ...])*)
125.1106 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1107 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1108 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1109 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1110 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1111 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1112 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-24 + 4 * x = 0")) then ()
125.1113 +else raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 74a";
125.1114 +(*-> ubproblem ("PolyEq.thy", ["degree_1", ...]*)
125.1115 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1116 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1117 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1118 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1120 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1122 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1124 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1125 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 6]")) => ()
125.1126 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 74a [x = 6]";
125.1127 +
125.1128 +
125.1129 +(*----------------- Schalk II s.56 Bsp 77b ------------------------*)
125.1130 +"Schalk II s.56 Bsp 77b (sqrt(x+12)+sqrt(x - 3) = sqrt(x + 32) - sqrt(5+x))";
125.1131 +"Schalk II s.56 Bsp 77b (sqrt(x+12)+sqrt(x - 3) = sqrt(x + 32) - sqrt(5+x))";
125.1132 +"Schalk II s.56 Bsp 77b (sqrt(x+12)+sqrt(x - 3) = sqrt(x + 32) - sqrt(5+x))";
125.1133 +(*EO-4*)
125.1134 +val fmz = ["equality (sqrt(x+12)+sqrt(x - 3) = sqrt(x + 32) - sqrt(5+x))",
125.1135 + "solveFor x","solutions L"];
125.1136 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1137 +
125.1138 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1139 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"]) *)
125.1140 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1141 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1142 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1143 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1144 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1145 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1146 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1147 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"]) *)
125.1148 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1149 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1150 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1151 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1152 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1153 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1154 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.1155 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1156 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"]) *)
125.1157 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1158 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1159 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1160 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1161 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1162 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1163 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1164 +(*val nxt = ("Model_Problem",
125.1165 + Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.1166 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1167 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1168 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1169 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1170 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1171 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; since MGs norm_Rational*)
125.1172 +if f = Form'(FormKF (~1, EdUndef, 0, Nundef, "451584 + -112896 * x = 0"))then()
125.1173 +else raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 77b";
125.1174 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1175 +(* val nxt = ("Model_Problem",
125.1176 + Model_Problem ["degree_1","polynomial","univariate","equation"])*)
125.1177 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1178 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1179 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1180 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1181 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1182 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1183 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1184 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1185 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1186 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[]")) => ()
125.1187 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.56 Bsp 77b []";
125.1188 +(*added 040209 at introducing MGs norm_Rational ?!*)
125.1189 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1190 +
125.1191 +
125.1192 +(*----------------- Schalk II s.66 Bsp 4 ------------------------*)
125.1193 +"Schalk II s.66 Bsp 4 ((6*x - 9)*(5*x+7) - (4*x+7)*(3*x - 6) = 429)";
125.1194 +"Schalk II s.66 Bsp 4 ((6*x - 9)*(5*x+7) - (4*x+7)*(3*x - 6) = 429)";
125.1195 +"Schalk II s.66 Bsp 4 ((6*x - 9)*(5*x+7) - (4*x+7)*(3*x - 6) = 429)";
125.1196 +(*EP*)
125.1197 +val fmz = ["equality ((6*x - 9)*(5*x+7) - (4*x+7)*(3*x - 6) = 429)",
125.1198 + "solveFor x","solutions L"];
125.1199 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.1200 +(*val p = e_pos';
125.1201 +val c = [];
125.1202 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.1203 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.1204 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1205 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1206 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1207 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1208 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1209 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1210 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1211 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1212 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1213 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1214 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1215 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1216 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1217 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1218 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1219 +case f of Form' (FormKF (_,_,0,_,"[x = 5, x = -5]")) => ()
125.1220 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 4 []";
125.1221 +
125.1222 +
125.1223 +(*----------------- Schalk II s.66 Bsp 8a ------------------------*)
125.1224 +"Schalk II s.66 Bsp 8a ((x - 4)/(x+4) = (1 - x)/(1+x))";
125.1225 +(*ER-15*)
125.1226 +val fmz = ["equality ((x - 4)/(x+4) = (1 - x)/(1+x))",
125.1227 + "solveFor x","solutions L"];
125.1228 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.1229 +
125.1230 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1231 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1232 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1233 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1234 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1235 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1236 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1237 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.1238 +(*"(-4 + x) * (1 + x) = (1 + -1 * x) * (4 + x)"
125.1239 +-> Subproblem ("RatEq.thy", ["univariate", ...])*)
125.1240 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1241 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1242 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1243 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1244 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1245 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1246 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1247 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-8 + 2 * x ^^^ 2 = 0")) then ()
125.1248 +else raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 8a";
125.1249 +(*-> Subproblem ("PolyEq.thy", ["polynomial", ...])*)
125.1250 +(*
125.1251 + val Form' (FormKF (~1, EdUndef, 0, Nundef, str)) = f;
125.1252 + *)
125.1253 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1254 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1255 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1256 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1257 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1258 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1259 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1260 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1261 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1262 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 2, x = -2]")) => ()
125.1263 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 8a [x = 2, x = -2]";
125.1264 +
125.1265 +(*----------------- Schalk II s.66 Bsp 10b ------------------------*)
125.1266 +"Schalk II s.66 Bsp 10b (1/(x^^^2 - 9)+(2*x+3)/(x+3)=(3*x+4)/(x - 3))";
125.1267 +"Schalk II s.66 Bsp 10b (1/(x^^^2 - 9)+(2*x+3)/(x+3)=(3*x+4)/(x - 3))";
125.1268 +"Schalk II s.66 Bsp 10b (1/(x^^^2 - 9)+(2*x+3)/(x+3)=(3*x+4)/(x - 3))";
125.1269 +val fmz = ["equality (1/(x^^^2 - 9)+(2*x+3)/(x+3)=(3*x+4)/(x - 3))",
125.1270 + "solveFor x","solutions L"];
125.1271 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.1272 +(*val p = e_pos';
125.1273 +val c = [];
125.1274 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.1275 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.1276 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1277 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1278 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1279 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1280 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1281 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1282 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1283 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1284 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1285 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1286 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1287 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1288 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1289 +if f = Form'
125.1290 + (FormKF
125.1291 + (~1,
125.1292 + EdUndef,
125.1293 + 0,
125.1294 + Nundef,
125.1295 + "60 + 28 * x + -13 * x ^^^ 2 + -1 * x ^^^ 3 = 0")) then ()
125.1296 +else raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 10b";
125.1297 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1298 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1299 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1300 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1301 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1302 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1303 +(*60 + 28 * x + -13 * x ^^^ 2 + -1 * x ^^^ 3 = 0 ... degree 3 not solvable*)
125.1304 +
125.1305 +
125.1306 +(*----------------- Schalk II s.66 Bsp 20a ------------------------*)
125.1307 +(*EO-6*)
125.1308 +"Schalk II s.66 Bsp 20a (sqrt(29 - sqrt (x^^^2 - 9))=5)";
125.1309 +"Schalk II s.66 Bsp 20a (sqrt(29 - sqrt (x^^^2 - 9))=5)";
125.1310 +"Schalk II s.66 Bsp 20a (sqrt(29 - sqrt (x^^^2 - 9))=5)";
125.1311 +val fmz = ["equality (sqrt(29 - sqrt(x^^^2 - 9))=5)",
125.1312 + "solveFor x","solutions L"];
125.1313 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1314 +(*val p = e_pos';
125.1315 +val c = [];
125.1316 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.1317 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.1318 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1319 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1320 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1321 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1322 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1323 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1324 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1325 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1326 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1327 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1328 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1329 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1330 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1331 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1332 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1333 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1334 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1335 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1336 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1337 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-25 + x ^^^ 2 = 0")) then ()
125.1338 +else raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 20a";
125.1339 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1340 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1341 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1342 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1343 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1344 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1345 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1346 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1347 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1348 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1349 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1350 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 5, x = -5]")) => ()
125.1351 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 20a [x = 5, x = -5]";
125.1352 +
125.1353 +(*----------------- Schalk II s.66 Bsp 23b ------------------------*)
125.1354 +"Schalk II s.66 Bsp 23b (2*sqrt(261 - x) - sqrt(2+2*x)=sqrt(2)*sqrt(5 - 3*x))";
125.1355 +"Schalk II s.66 Bsp 23b (2*sqrt(261 - x) - sqrt(2+2*x)=sqrt(2)*sqrt(5 - 3*x))";
125.1356 +"Schalk II s.66 Bsp 23b (2*sqrt(261 - x) - sqrt(2+2*x)=sqrt(2)*sqrt(5 - 3*x))";
125.1357 +(*EO WN060310 something wrong:
125.1358 +([6, 6, 3, 1], Frm) "-1064944 + 32 * x + -48 * x ^^^ 2 = 0"
125.1359 + ### or2list False
125.1360 +([6, 6, 3, 1], Res) "False"
125.1361 +*)
125.1362 +val fmz = ["equality (2*sqrt(261 - x) - sqrt(2+2*x)=sqrt(2)*sqrt(5 - 3*x))",
125.1363 + "solveFor x","solutions L"];
125.1364 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1365 +
125.1366 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1367 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1368 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1369 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1370 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1371 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1372 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1373 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1374 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1375 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1376 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1377 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1378 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1379 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1380 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1381 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1382 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1383 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1384 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1385 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1386 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; f2str f;
125.1387 +if f = Form'
125.1388 + (FormKF
125.1389 + (~1, EdUndef, 0, Nundef, "-1064944 + 32 * x + -48 * x ^^^ 2 = 0"))then()
125.1390 +else raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 23b";
125.1391 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1392 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1393 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1394 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1395 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1396 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1397 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1398 +case f of Form' (FormKF (~1,EdUndef,_,Nundef,"[]")) => ()
125.1399 + | _ => raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 23b []";
125.1400 +
125.1401 +(*----------------- Schalk II s.66 Bsp 28a ------------------------*)
125.1402 +"Schalk II s.66 Bsp 28a (A=(c/d)*sqrt(4*a^^^2 - c^^^2))";
125.1403 +"Schalk II s.66 Bsp 28a (A=(c/d)*sqrt(4*a^^^2 - c^^^2))";
125.1404 +"Schalk II s.66 Bsp 28a (A=(c/d)*sqrt(4*a^^^2 - c^^^2))";
125.1405 +val fmz = ["equality (A=(c/d)*sqrt(4*a^^^2 - c^^^2))",
125.1406 + "solveFor a","solutions L"];
125.1407 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1408 +(*val p = e_pos';
125.1409 +val c = [];
125.1410 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
125.1411 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
125.1412 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1413 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1414 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1415 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1416 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1417 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1418 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1419 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1420 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1421 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1422 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1423 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1424 +(*if f = Form'
125.1425 + (FormKF
125.1426 + (~1,
125.1427 + EdUndef,
125.1428 + 0,
125.1429 + Nundef,
125.1430 + "c ^^^ 4 / d ^^^ 2 + A ^^^ 2 * d ^^^ 2 / d ^^^ 2 +\n-4 * c ^^^ 2 / d ^^^ 2 * a ^^^ 2 =\n0")) then ()*)
125.1431 +if f2str f =
125.1432 + "c ^^^ 4 / d ^^^ 2 + A ^^^ 2 / 1 + -4 * c ^^^ 2 / d ^^^ 2 * a ^^^ 2 = 0"
125.1433 +then () else raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 28a";
125.1434 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1435 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1436 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1437 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1438 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1439 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1440 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1441 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1442 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1443 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[a = sqrt ((c ^^^ 4 + A ^^^ 2 * d ^^^ 2) / (4 * c ^^^ 2)),\n a = -1 * sqrt ((c ^^^ 4 + A ^^^ 2 * d ^^^ 2) / (4 * c ^^^ 2))]")) => ()
125.1444 +| _ => raise error "rlang.sml: diff.behav. in Schalk II s.66 Bsp 28a [a=...]";
125.1445 +
125.1446 +
125.1447 +
125.1448 +(*----------------- Schalk II s.68 Bsp 52b ------------------------*)
125.1449 +"Schalk II s.68 Bsp 52b (1/(x - a+b)=1/x - 1/a + 1/b)";
125.1450 +val fmz = ["equality (1/(x - a+b)=1/x - 1/a + 1/b)",
125.1451 + "solveFor x","solutions L"];
125.1452 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.1453 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1454 +(* val nxt = ("Model_Problem",Model_Problem ["rational","univariate","equation"])*)
125.1455 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1456 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1457 +(*val nxt = ("Specify_Theory",Specify_Theory "RatEq.thy")*)
125.1458 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1459 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1460 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1461 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1462 +(*val p = ([3],Res)
125.1463 +val f="1 * (a * (b * x)) = (a * b + (a * x + -1 * (b * x))) * (b + (x + -1 * a)
125.1464 +val nxt = Subproblem ("RatEq.thy",["univariate","equation"]))*)
125.1465 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1466 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1467 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1468 +(*val nxt = ("Specify_Theory",Specify_Theory "PolyEq.thy")*)
125.1469 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1470 +(* nxt = Specify_Problem ["normalize","polynomial","univariate","equation"])*)
125.1471 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1472 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1473 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1474 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1475 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; at introducing of MGs norm_Rational*)
125.1476 +(*val p = ([4,5],Res) val f ="b * a ^^^ 2 + -1 * a * b ^^^ 2 + (a ^^^ 2 + b ^^^ 2 + -2 * a * b) * x +\n(b + -1 * a) * x ^^^ 2 =\n0"))
125.1477 +val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
125.1478 +if f = Form'
125.1479 + (FormKF
125.1480 + (~1,
125.1481 + EdUndef,
125.1482 + 0,
125.1483 + Nundef,
125.1484 + "b * a ^^^ 2 + -1 * a * b ^^^ 2 + (a ^^^ 2 + b ^^^ 2 + -2 * a * b) * x +\n(b + -1 * a) * x ^^^ 2 =\n0")) then ()
125.1485 +else raise error "rlang.sml: diff.behav. in chalk I s.87 Bsp 38b";
125.1486 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1487 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1488 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1489 +(*val nxt = ("Specify_Theory",Specify_Theory "PolyEq.thy")*)
125.1490 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1491 +(*Specify_Problem["abcFormula","degree_2","polynomial","univariate","equation*)
125.1492 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1493 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1494 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1495 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1496 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1497 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;introducing MGs norm_Rational*)
125.1498 +(*val p = ([4,6,5],Res) val f ="[x =\n (2 * a * b + -1 * a ^^^ 2 + -1 * b ^^^ 2 +\n sqrt\n (a ^^^ 4 + b ^^^ 4 + -4 * a * a * b ^^^ 2 + -4 * a * b * a ^^^ 2 +\n -4 * b * b * a ^^^ 2 +\n 4 * a * a * b ^^^ 2 +\n 4 * a * b * a ^^^ 2 +\n 2 * a ^^^ 2 * b ^^^ 2)) /\n (-2 * a + 2 * #"
125.1499 +nx Check_Postcond["abcFormula","degree_2","polynomial","univariate","equation*)
125.1500 +(*9.9.03: -"- ["normalize","polynomial","univar...*)
125.1501 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1502 +(*val p = ([4,6],Res)
125.1503 +val nxt =Check_Postcond ["normalize","polynomial","univariate","equation"])*)
125.1504 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1505 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(*1 additional for MGs norm_Rational*)
125.1506 +if p = ([],Res) andalso f = Form' (FormKF (~1,EdUndef,0,Nundef,
125.1507 +"[x =\n (2 * a * b + -1 * a ^^^ 2 + -1 * b ^^^ 2 +\n sqrt\n (a ^^^ 4 + b ^^^ 4 + -4 * a * a * b ^^^ 2 + -4 * a * b * a ^^^ 2 +\n -4 * b * b * a ^^^ 2 +\n 4 * a * a * b ^^^ 2 +\n 4 * a * b * a ^^^ 2 +\n 2 * a ^^^ 2 * b ^^^ 2)) /\n (-2 * a + 2 * b),\n x =\n (2 * a * b + -1 * a ^^^ 2 + -1 * b ^^^ 2 +\n -1 *\n sqrt\n (a ^^^ 4 + b ^^^ 4 + -4 * a * a * b ^^^ 2 + -4 * a * b * a ^^^ 2 +\n -4 * b * b * a ^^^ 2 +\n 4 * a * a * b ^^^ 2 +\n 4 * a * b * a ^^^ 2 +\n 2 * a ^^^ 2 * b ^^^ 2)) /\n (-2 * a + 2 * b)]")) andalso nxt = ("End_Proof'",End_Proof') then writeln"simplify MG"
125.1508 +else raise error "rlang.sml: diff.behav. in rational-a-b";
125.1509 +
125.1510 +(*----------------- Schalk II s.68 Bsp 56a ------------------------*)
125.1511 +"Schalk II s.68 Bsp 56a ((a+b*x)/(a-b*x) - (a - b*x)/(a+b*x)= (4*a*b)/(a^^^2 - b^^^2))";
125.1512 +val fmz = ["equality ((a+b*x)/(a-b*x) - (a - b*x)/(a+b*x)= (4*a*b)/(a^^^2 - b^^^2))","solveFor x","solutions L"];
125.1513 +val (dI',pI',mI') = ("RatEq.thy",["univariate","equation"],["no_met"]);
125.1514 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1515 +(* val nxt = ("Model_Problem",Model_Problem ["rational","univariate","equation"]) *)
125.1516 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1517 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1518 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1519 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1520 +(*SK loops with poly:
125.1521 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1522 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1523 +
125.1524 +... with sml-nj:
125.1525 + (a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x) =
125.1526 + 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1527 +common_nominator_p wird nicht angewendet, weil ...
125.1528 +add_fract terminiert nicht: 030603
125.1529 +siehe Rational.ML rational.sml
125.1530 +*)
125.1531 +
125.1532 +(*
125.1533 +"(a + b * x) / (a + -1 * (b * x)) + -1 * (a + -1 * (b * x)) / (a + b * x) =\n4 * a * b / (a ^^^ 2 + -1 * b ^^^ 2)"
125.1534 +
125.1535 +val nxt = ("Rewrite_Set",Rewrite_Set "make_ratpoly") : string * tac
125.1536 +"(a + b * x) / (a + -1 * b * x) + (-1 * a + b * x) / (a + b * x) =\n4 *
125.1537 +a * b / (a ^^^ 2 + -1 * b ^^^ 2)"
125.1538 +
125.1539 +
125.1540 +val t = str2term"(a + b * x) / (a + -1 * (b * x)) + -1 * (a + -1 * (b * x)) / (a + b * x) =\n4 * a * b / (a ^^^ 2 + -1 * b ^^^ 2)";
125.1541 +trace_rewrite:=true;
125.1542 +val Some (t',asm) = rewrite_set_ thy false norm_Rational t;
125.1543 +term2str t';
125.1544 +trace_rewrite:=false;
125.1545 +
125.1546 +# rls: norm_Rational on: (a + b * x) / (a + -1 * (b * x)) + -1 * (a + -1 * (b * x)) / (a + b * x) = 4 * a * b / (a ^^^ 2 + -1 * b ^^^ 2)
125.1547 +
125.1548 +## rls: discard_minus on:
125.1549 +## rls: powers on:
125.1550 +## rls: rat_mult_divide on:
125.1551 +## rls: expand on:
125.1552 +## rls: reduce_0_1_2 on:
125.1553 +## rls: order_add_mult on:
125.1554 +### try thm: real_mult_commute
125.1555 +=== rewrites to: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + -1 * (-1 * (b * x))) / (a + b * x) = b * (4 * a) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1556 +
125.1557 +### try thm: real_mult_left_commute
125.1558 +=== rewrites to: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + -1 * (-1 * (b * x))) / (a + b * x) = 4 * (b * a) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1559 +
125.1560 +### try thm: real_mult_commute
125.1561 +=== rewrites to: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + -1 * (-1 * (b * x))) / (a + b * x) = 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1562 +
125.1563 +### try calc: op *'
125.1564 +=== calc. to: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + 1 * (b * x)) / (a +b * x) = 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1565 +
125.1566 +## rls: common_nominator_p on: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + 1 * (b * x)) / (a + b * x) =
125.1567 + 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1568 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!GC
125.1569 +
125.1570 +## rls: discard_minus on:
125.1571 +## rls: powers on:
125.1572 +## rls: rat_mult_divide on:
125.1573 +## rls: expand on:
125.1574 +## rls: reduce_0_1_2 on:
125.1575 +### try thm: real_mult_1
125.1576 +=== rewrites to: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x) = 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1577 +
125.1578 +## rls: order_add_mult on:
125.1579 +
125.1580 +## rls: common_nominator_p on: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x) =
125.1581 + 4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1582 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!GC
125.1583 +
125.1584 +## rls: discard_minus on:
125.1585 +## rls: powers on:
125.1586 +## rls: rat_mult_divide on:
125.1587 +## rls: expand on:
125.1588 +## rls: reduce_0_1_2 on:
125.1589 +## rls: order_add_mult on:
125.1590 +## rls: collect_numerals on:
125.1591 +## rls: common_nominator_p on: (a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x) =
125.1592 +4 * (a * b) / (a ^^^ 2 + -1 * b ^^^ 2)
125.1593 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!GC
125.1594 +*)
125.1595 +
125.1596 +
125.1597 +(*----------------- Schalk II s.68 Bsp 61b ------------------------*)
125.1598 +"Schalk II s.68 Bsp 61b (sqrt(x+a)+sqrt(b - x)=sqrt(a+b))";
125.1599 +val fmz = ["equality (sqrt(x+a)+sqrt(b - x)=sqrt(a+b))",
125.1600 + "solveFor x","solutions L"];
125.1601 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1602 +
125.1603 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1604 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"])*)
125.1605 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1606 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1607 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1608 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1609 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1610 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1611 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1612 +(* val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"])*)
125.1613 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1614 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1615 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1616 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1617 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1618 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1619 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1620 +(*val nxt = ("Model_Problem",
125.1621 + Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.1622 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1623 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1624 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1625 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1626 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1627 +if f = Form'
125.1628 + (FormKF
125.1629 + (~1,
125.1630 + EdUndef,
125.1631 + 0,
125.1632 + Nundef,
125.1633 + (*"-4 * b ^^^ 2 + -4 * a * b + 4 * b ^^^ 2 + 8 * a * b +\n(-2 * a + -4 * a + -4 * b + 2 * a + 8 * b) * x +\n-4 * x ^^^ 2 =\n0" before MG*)
125.1634 + "4 * a * b + (-4 * a + 4 * b) * x + -4 * x ^^^ 2 = 0")) then ()
125.1635 +else raise error "rlang.sml: diff.behav. in Schalk II s.68 Bsp 61b";
125.1636 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1637 +(*val nxt = ("Model_Problem", Model_Problem
125.1638 + ["abcFormula","degree_2","polynomial","univariate","equation"])*)
125.1639 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1640 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1641 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1642 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1643 +(* f= ... "-4 * b ^^^ 2 + -4 * a * b + 4 * b ^^^ 2 + 8 * a * b +
125.1644 + (-2 * a + -4 * a + -4 * b + 2 * a + 8 * b) * x + -4 * x ^^^ 2 =0"*)
125.1645 +(*val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst ([#],"d2_polyeq_abcFormula_simplify"))*)
125.1646 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1647 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1648 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1649 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1650 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1651 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1652 +(*if f = Form' (FormKF (~1,EdUndef,0,Nundef, with norm_Rational before MG
125.1653 +"[x =\n (-2 * a + -4 * b + 6 * a +\n sqrt\n (32 * a * b + -16 * a ^^^ 2 + -48 * b ^^^ 2 + 24 * a ^^^ 2 +\n 64 * b ^^^ 2 +\n 8 * a ^^^ 2)) /\n -8,\n x =\n (-2 * a + -4 * b + 6 * a +\n -1 *\n sqrt\n (32 * a * b + -16 * a ^^^ 2 + -48 * b ^^^ 2 + 24 * a ^^^ 2 +\n 64 * b ^^^ 2 +\n 8 * a ^^^ 2)) /\n -8]")) then writeln"simplify MG"*)
125.1654 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"[x =\n (-4 * b + 4 * a + sqrt (32 * a * b + 16 * a ^^^ 2 + 16 * b ^^^ 2)) / -8,\n x =\n (-4 * b + 4 * a + -1 * sqrt (32 * a * b + 16 * a ^^^ 2 + 16 * b ^^^ 2)) /\n -8]")) then ()
125.1655 +else raise error "rlang.sml: diff.behav. Bsp 61b";
125.1656 +(*WN.18.12.03: extreme run-time !!!*)
125.1657 +
125.1658 +
125.1659 +(*----------------- Schalk II s.68 Bsp 62b ------------------------*)
125.1660 +"Schalk II s.68 Bsp 62b (sqrt((x+a)^^^2+(x - 2*b)^^^2)=a+2*b)";
125.1661 +val fmz = ["equality (sqrt((x+a)^^^2+(x - 2*b)^^^2)=a+2*b)",
125.1662 + "solveFor x","solutions L"];
125.1663 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
125.1664 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1665 +(*val nxt = ("Model_Problem",Model_Problem ["sq","root","univariate","equation"]) *)
125.1666 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1667 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1668 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1669 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1670 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1671 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1672 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1673 +(* val nxt = ("Model_Problem",
125.1674 + Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.1675 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1676 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1677 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1678 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1679 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1680 +if f = Form'
125.1681 + (FormKF
125.1682 + (~1,
125.1683 + EdUndef,
125.1684 + 0,
125.1685 + Nundef,
125.1686 + "-4 * a * b + (-4 * b + 2 * a) * x + 2 * x ^^^ 2 = 0")) then ()
125.1687 +else raise error "rlang.sml: diff.behav. in Schalk II s.68 Bsp 62b";
125.1688 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1689 +(*val nxt = ("Model_Problem", Model_Problem
125.1690 + ["abcFormula","degree_2","polynomial","univariate","equation"])*)
125.1691 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1692 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1693 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1694 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1695 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1696 +(*val f = ... "-4 * a * b + (-4 * b + 2 * a) * x + 2 * x ^^^ 2 = 0" *)
125.1697 +(*val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst ([#],"d2_polyeq_abcFormula_simplify"))*)
125.1698 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1699 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1700 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1701 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1702 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;introduc.MGs norm_Rational*)
125.1703 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,
125.1704 + "[x = (-2 * a + 4 * b + sqrt (16 * a * b + 16 * b ^^^ 2 + 4 * a ^^^ 2)) / 4,\n x =\n (-2 * a + 4 * b + -1 * sqrt (16 * a * b + 16 * b ^^^ 2 + 4 * a ^^^ 2)) / 4]")) then writeln "simplify MG"
125.1705 +else raise error "rlang.sml: diff.behav. in II 62b [x=...]";
125.1706 +val asms = get_assumptions_ pt p;
125.1707 +if asms = [(str2term"0 <= ((-2 * a + 4 * b + sqrt (16 * a * b + 16 * b ^^^ 2 + 4 * a ^^^ 2)) / 4 + a) ^^^ 2 + ((-2 * a + 4 * b + sqrt (16 * a * b + 16 * b ^^^ 2 + 4 * a ^^^ 2)) / 4 - 2 * b) ^^^ 2", []),
125.1708 + (str2term"0 <= a + 2 * b", []),
125.1709 + (str2term"8 * (-4 * a * b) <= (-4 * b + 2 * a) ^^^ 2", []),
125.1710 + (str2term"8 * (-4 * a * b) <= (-4 * b + 2 * a) ^^^ 2", []),
125.1711 + (str2term"0 <= ((-2 * a + 4 * b + -1 * sqrt (16 * a * b + 16 * b ^^^ 2 + 4 * a ^^^ 2)) / 4 + a) ^^^ 2 + ((-2 * a + 4 * b + -1 * sqrt (16 * a * b + 16 * b ^^^ 2 + 4 * a ^^^ 2)) / 4 - 2 * b) ^^^ 2", []),
125.1712 + (str2term"0 <= a + 2 * b", []),
125.1713 + (str2term"8 * (-4 * a * b) <= (-4 * b + 2 * a) ^^^ 2", []),
125.1714 + (str2term"8 * (-4 * a * b) <= (-4 * b + 2 * a) ^^^ 2", [])]
125.1715 +then writeln "should be simplified MG"
125.1716 +else raise error "rlang.sml: diff.behav. in II 62b asms";
125.1717 +
125.1718 +"------ WN.TEST---------------------------------";
125.1719 +"------ WN.TEST---------------------------------";
125.1720 +"------ WN.TEST---------------------------------";
125.1721 +(*EO-7*)
125.1722 +val fmz = ["equality ((2*x+1)*x^^^2 = 0)",
125.1723 + "solveFor x","solutions L"];
125.1724 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.1725 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1726 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1727 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1728 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1729 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1730 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1731 +(*
125.1732 +val f = Form' (FormKF (~1,EdUndef,1,Nundef,"(2 * x + 1) * x ^^^ 2 = 0"))
125.1733 +normiert nicht ... korr.WN:
125.1734 +val t = str2term "(2*x+1)*x^^^2 = 0";
125.1735 +val subst = [(str2term "bdv", str2term "x")];
125.1736 +val Some (t',_) = rewrite_set_inst_ thy false subst make_ratpoly_in t;
125.1737 +if term2str t' = "x ^^^ 2 + 2 * x ^^^ 3 = 0" then ()
125.1738 +else raise error "rlang.sml: 7";
125.1739 +*)
125.1740 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1741 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1742 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1743 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1744 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1745 +
125.1746 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1747 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1748 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1749 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1750 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
125.1751 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 0, x = 0, x = -1 / 2]")) then()
125.1752 +else raise error "rlang.sml WN.TEST new behaviour";
125.1753 +
125.1754 +"------ rlang.sml end---------------------------------";
125.1755 +
125.1756 +(*------------------------------vvv-Rewrite_Set "rat_eliminate"---------
125.1757 +> trace_rewrite:=true;
125.1758 +> val t = str2term
125.1759 + "(3 + -1 * x + 1 * x ^^^ 2) / (9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3) = 1 / x";
125.1760 +> val Some (t',asm) =
125.1761 + rewrite_ thy dummy_ord rateq_erls true rat_mult_denominator_both t;
125.1762 +> term2str t'; terms2str asm;
125.1763 +"(3 + -1 * x + 1 * x ^^^ 2) * x = 1 * (9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3)"
125.1764 +"[\"9 * x + -6 * x ^^^ 2 + 1 * x ^^^ 3 ~= 0\",\"x ~= 0\"]"
125.1765 +> trace_rewrite:=false;
125.1766 + ------------------------------^^^-Rewrite_Set "rat_eliminate"---------*)
125.1767 +
125.1768 +
125.1769 +"-------------------- WN.15.5.03: Pythagoras -------------------------------";
125.1770 +"-------------------- WN.15.5.03: Pythagoras -------------------------------";
125.1771 +"-------------------- WN.15.5.03: Pythagoras -------------------------------";
125.1772 +(*EO-9*)
125.1773 +val fmz = ["equality ((a/2)^^^2 + (b/2)^^^2 = r^^^2)",
125.1774 + "solveFor a","solutions L"];
125.1775 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.1776 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1777 +(* Model_Problem ["normalize","polynomial","univariate","equation"])*)
125.1778 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1779 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1780 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1781 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1782 +(*val nxt = ("Apply_Method",Apply_Method ["PolyEq","normalize_poly"])*)
125.1783 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1784 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1785 +(*val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"])*)
125.1786 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1787 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1788 +(*val nxt =Model_Problem ["sq_only","degree_2","polynomial","univariate","equation"])*)
125.1789 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1790 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1791 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1792 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1793 +(*val nxt = Apply_Method ["PolyEq","solve_d2_polyeq_sqonly_equation"])*)
125.1794 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1795 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1796 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1797 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1798 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1799 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1800 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1801 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,
125.1802 +"[a = sqrt ((-1 * b ^^^ 2 + 4 * r ^^^ 2) / 1),\n a = -1 * sqrt ((-1 * b ^^^ 2 + 4 * r ^^^ 2) / 1)]")) andalso nxt = ("End_Proof'",End_Proof')
125.1803 +then writeln"simplify result\nsimplify result\nsimplify result"
125.1804 +else raise error "rlang.sml: diff.behav. in Pythagoras";
125.1805 +val asms = get_assumptions_ pt p;
125.1806 +(*if asms = [(str2term"0 <= -4 * (b ^^^ 2 / 4 + -4 * r ^^^ 2 / 4)", []),
125.1807 + (str2term"0 <= -4 * (b ^^^ 2 / 4 + -4 * r ^^^ 2 / 4)", [])]*)
125.1808 +if asms2str asms =
125.1809 + "[(0 <= -4 * (b ^^^ 2 / 4 + -1 * r ^^^ 2 / 1), []),\
125.1810 + \(0 <= -4 * (b ^^^ 2 / 4 + -1 * r ^^^ 2 / 1), [])]"
125.1811 +then writeln"simplify result\nsimplify result\nsimplify result"
125.1812 +else raise error "rlang.sml: diff.behav. in Pythagoras asms";
125.1813 +
125.1814 +
125.1815 +"-------------------- WN.15.5.03: equation within the maximum example ------";
125.1816 +"-------------------- WN.15.5.03: equation within the maximum example ------";
125.1817 +"-------------------- WN.15.5.03: equation within the maximum example ------";
125.1818 +(*EO-10*)
125.1819 +val fmz = ["equality (2*sqrt(r^^^2 - (u/2)^^^2) - u^^^2/(2*sqrt(r^^^2 - (u/2)^^^2))= 0)",
125.1820 + "solveFor u","solutions L"];
125.1821 +val (dI',pI',mI') = ("PolyEq.thy",["univariate","equation"],["no_met"]);
125.1822 +
125.1823 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
125.1824 +(* Model_Problem ["normalize","root","univariate","equation"])*)
125.1825 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1826 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1827 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1828 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1829 +(*val nxt = Apply_Method ["RootEq","norm_sq_root_equation"]) *)
125.1830 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1831 +(*val nxt = Subproblem ("RootEq.thy",["univariate","equation"]))*)
125.1832 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1833 +(*val nxt = Model_Problem ["sq","root","univariate","equation"]) *)
125.1834 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1835 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1836 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1837 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1838 +(*val nxt = Apply_Method ["RootEq","solve_sq_root_equation"]) *)
125.1839 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1840 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1841 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1842 +(*val nxt = Subproblem ("RootEq.thy",["univariate","equation"]))*)
125.1843 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1844 +(*val nxt = Model_Problem ["rational","univariate","equation"]) *)
125.1845 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1846 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1847 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1848 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1849 +(*val nxt = Apply_Method ["RootEq","solve_rat_equation"]) *)
125.1850 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1851 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1852 +(*val nxt = Subproblem ("RootEq.thy",["univariate","equation"]))*)
125.1853 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1854 +(*val nxt = Model_Problem ["normalize","polynomial","univariate","equation"]) *)
125.1855 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1856 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1857 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1858 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1859 +(*val nxt = Apply_Method ["PolyEq","normalize_poly"]) *)
125.1860 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1861 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1862 +(*val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
125.1863 +if f = Form'
125.1864 + (FormKF
125.1865 + (~1,
125.1866 + EdUndef,
125.1867 + 0,
125.1868 + Nundef,
125.1869 + "-16 * r ^^^ 4 + 8 * r ^^^ 2 * u ^^^ 2 = 0")) then ()
125.1870 +else raise error "rlang.sml: diff.behav. in Schalk I s.87 Bsp 38b";
125.1871 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1872 +(*val nxt = Model_Problem ["sq_only","degree_2","polynomial","univariate","equation"]) *)
125.1873 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1874 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1875 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1876 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1877 +(*val nxt = Apply_Method ["PolyEq","solve_d2_polyeq_sqonly_equation"]) *)
125.1878 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1879 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1880 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1881 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1882 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1883 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1884 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
125.1885 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"[u = sqrt (2 * r ^^^ 2 / 1), u = -1 * sqrt (2 * r ^^^ 2 / 1)]")) then()
125.1886 +else raise error "rlang.sml WN.TEST new behaviour in max-rooteq";
126.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
126.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/root.sml Wed Jul 21 13:53:39 2010 +0200
126.3 @@ -0,0 +1,15 @@
126.4 +(* testexamples for Root, radicals
126.5 + *)
126.6 +
126.7 +val thy = Root.thy;
126.8 +
126.9 +val t = str2term "sqrt 1";
126.10 +val Some (t',_) = rewrite_set_ thy false Root_erls t;
126.11 +if term2str t' = "1" then () else raise error "root.sml: diff.behav. sqrt 1";
126.12 +val t = str2term "sqrt -1";
126.13 +val None = rewrite_set_ thy false Root_erls t;
126.14 +
126.15 +val t = str2term "sqrt 0";
126.16 +val Some (t',_) = rewrite_set_ thy false Root_erls t;
126.17 +term2str t';
126.18 +if term2str t' = "0" then () else raise error "root.sml: diff.behav. sqrt 1";
127.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
127.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/rooteq.sml Wed Jul 21 13:53:39 2010 +0200
127.3 @@ -0,0 +1,470 @@
127.4 +(* RL 10.02
127.5 + use"../kbtest/rooteq.sml";
127.6 + use"rooteq.sml";
127.7 + testexamples for RootEq, equations with fractions
127.8 +
127.9 + Compiler.Control.Print.printDepth:=10; (*4 default*)
127.10 + Compiler.Control.Print.printDepth:=5; (*4 default*)
127.11 + trace_rewrite:=true;
127.12 +*)
127.13 +"----------- rooteq.sml begin--------";
127.14 +"--------------(1/sqrt(x)=5)---------------------------------------";
127.15 +"--------------(4*sqrt(4*x+2)=3*sqrt(2*x+24))----------------------";
127.16 +"--------------(sqrt(x+1)=5)---------------------------------------";
127.17 +"--------------(sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))-----------------";
127.18 +"--------------(3*sqrt(x+3)+sqrt(x+6)=sqrt(4*x+33))----------------";
127.19 +"--------------(sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))-----------------";
127.20 +
127.21 +val t = (term_of o the o (parse RootEq.thy)) "(sqrt(2+x+3)) is_rootTerm_in x";
127.22 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.23 +val result = term2str t_;
127.24 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.25 +
127.26 +val t = (term_of o the o (parse RootEq.thy)) "(sqrt(2+x+3)) is_rootTerm_in x";
127.27 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.28 +val result = term2str t_;
127.29 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.30 +
127.31 +val t = (term_of o the o (parse RootEq.thy)) "(nroot 5 (x+4)) is_rootTerm_in x";
127.32 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.33 +val result = term2str t_;
127.34 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.35 +
127.36 +val t = (term_of o the o (parse RootEq.thy)) "(sqrt(2+x+3)) is_sqrtTerm_in x";
127.37 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.38 +val result = term2str t_;
127.39 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.40 +
127.41 +val t = (term_of o the o (parse RootEq.thy)) "(sqrt(25)) is_sqrtTerm_in x";
127.42 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.43 +val result = term2str t_;
127.44 +if result <> "False" then raise error "rooteq.sml: new behaviour:" else ();
127.45 +
127.46 +val t = (term_of o the o (parse RootEq.thy)) "sqrt(1 + x) is_normSqrtTerm_in x";
127.47 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.48 +val result = term2str t_;
127.49 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.50 +
127.51 +val t = (term_of o the o (parse RootEq.thy)) "(3+3*sqrt(x)) is_normSqrtTerm_in x";
127.52 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.53 +val result = term2str t_;
127.54 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.55 +
127.56 +val t = (term_of o the o (parse RootEq.thy)) "(sqrt(x+1)+1) is_normSqrtTerm_in x";
127.57 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.58 +val result = term2str t_;
127.59 +if result <> "False" then raise error "rooteq.sml: new behaviour:" else ();
127.60 +
127.61 +val t = (term_of o the o (parse RootEq.thy)) "(1 - u/(sqrt(r - u))) is_normSqrtTerm_in u";
127.62 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.63 +val result = term2str t_;
127.64 +if result <> "False" then raise error "rooteq.sml: new behaviour:" else ();
127.65 +
127.66 +val t = (term_of o the o (parse RootEq.thy)) "(x*(1+x)/(sqrt(x+1))) is_normSqrtTerm_in x";
127.67 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.68 +val result = term2str t_;
127.69 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.70 +
127.71 +val t = (term_of o the o (parse RootEq.thy)) "(1 - (sqrt(2+x+3)^^^3)) is_normSqrtTerm_in x";
127.72 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.73 +val result = term2str t_;
127.74 +if result <> "False" then raise error "rooteq.sml: new behaviour:" else ();
127.75 +
127.76 +val t = (term_of o the o (parse RootEq.thy)) "(1 + (sqrt(2+x+3)^^^3)) is_normSqrtTerm_in x";
127.77 +val Some(t_, _) = rewrite_set_ RootEq.thy false RootEq_prls t;
127.78 +val result = term2str t_;
127.79 +if result <> "True" then raise error "rooteq.sml: new behaviour:" else ();
127.80 +
127.81 +
127.82 +
127.83 +val result = match_pbl ["equality (sqrt(x)=1)","solveFor x","solutions L"]
127.84 + (get_pbt ["root","univariate","equation"]);
127.85 +case result of Matches' _ => () | _ => raise error "rooteq.sml: new behaviour:";
127.86 +
127.87 +val result = match_pbl ["equality (sqrt(25)=1)","solveFor x","solutions L"]
127.88 + (get_pbt ["root","univariate","equation"]);
127.89 +case result of NoMatch' _ => () | _ => raise error "rooteq.sml: new behaviour:";
127.90 +
127.91 +(*---------rooteq---- 23.8.02 ---------------------*)
127.92 +"---------(1/sqrt(x)=5)---------------------";
127.93 +val fmz = ["equality (1/sqrt(x)=5)","solveFor x","solutions L"];
127.94 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
127.95 +
127.96 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.97 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.98 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.99 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.100 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.101 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.102 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.103 +(*"1 / x = 25" -> Subproblem ("RootEq.thy", ["univariate", ...]) *)
127.104 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.105 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.106 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.107 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.108 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.109 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.110 +(*"1 = 25 * x" -> Subproblem ("RatEq.thy", ["univariate", ...])*)
127.111 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.112 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.113 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.114 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.115 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.116 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.117 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "1 + -25 * x = 0")) then ()
127.118 +else raise error "rooteq.sml: diff.behav.poly in (1/sqrt(x)=5)";
127.119 +(*-> Subproblem ("PolyEq.thy", ["polynomial", ...])*)
127.120 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.122 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.124 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.126 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.127 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.128 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.129 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.130 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.131 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1 / 25]")) => ()
127.132 + | _ => raise error "rooteq.sml: diff.behav. [x = 1 / 25]";
127.133 +if asms2str (get_assumptions_ pt p) = "[(0 <= 1 / 25, [])]"
127.134 +(*WN050916 before correction 'rewrite__set_ called with 'Erls' for ..:
127.135 + [(str2term"25 ~= 0",[])] *)
127.136 +then writeln "should be True\n\
127.137 + \should be True\n\
127.138 + \should be True\n"
127.139 +else raise error "rooteq.sml: diff.behav. with 25 ~= 0";
127.140 +
127.141 +"---------(sqrt(x+1)=5)---------------------";
127.142 +val fmz = ["equality (sqrt(x+1)=5)","solveFor x","solutions L"];
127.143 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
127.144 +(*val p = e_pos';
127.145 +val c = [];
127.146 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
127.147 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
127.148 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.149 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.150 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.151 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.152 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.153 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.154 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.155 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
127.156 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.157 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.158 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.159 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.160 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.161 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.162 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-24 + x = 0")) then ()
127.163 +else raise error "rooteq.sml: diff.behav.poly in sqrt(x+1)=5";
127.164 +(*-> Subproblem ("PolyEq.thy", ["polynomial", ...])*)
127.165 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.166 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.167 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.168 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.169 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.170 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.171 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.172 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.173 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.174 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 24]")) => ()
127.175 + | _ => raise error "rooteq.sml: diff.behav. [x = 24]";
127.176 +
127.177 +"-------------(4*sqrt(4*x+2)=3*sqrt(2*x+24))-----------------";
127.178 +val fmz = ["equality (4*sqrt(4*x+2)=3*sqrt(2*x+24))","solveFor x","solutions L"];
127.179 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
127.180 +
127.181 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.182 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.183 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.184 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.185 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.186 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.187 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.188 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.189 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.190 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.191 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.192 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.193 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-184 + 46 * x = 0")) then ()
127.194 +else raise error "rooteq.sml: diff.behav.poly in 4*sqrt(4*x+2)=3*sqrt(2*x+24)";
127.195 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.196 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.197 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.198 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.199 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.200 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.201 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.202 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.203 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
127.204 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4]")) => ()
127.205 + | _ => raise error "rooteq.sml: diff.behav. [x = 4]";
127.206 +if get_assumptions_ pt p = [(str2term"0 <= 12 * sqrt 2 * 4",[])]
127.207 +then writeln "should be True\nshould be True\nshould be True\n\
127.208 + \should be True\nshould be True\nshould be True\n"
127.209 +else raise error "rooteq.sml: diff.behav. with 0 <= 12 * sqrt 2 * 4";
127.210 +
127.211 +"--------------(sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))----------------";
127.212 +val fmz = ["equality (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))","solveFor x","solutions L"];
127.213 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
127.214 +
127.215 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.216 +(*val nxt = Model_Problem ["sq","root","univariate","equation"]) *)
127.217 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.218 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.219 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.220 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.221 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.222 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.223 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.224 +(*"13 + 13 * x + -2 * sqrt ((4 + 4 * x) * (9 + 9 * x)) = 1 + x"))
127.225 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"]))*)
127.226 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.227 +(*val nxt = Model_Problem ["sq","root","univariate","equation"]) *)
127.228 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.229 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.230 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.231 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.232 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.233 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.234 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.235 +(*"144 + 288 * x + 144 * x ^^^ 2 = 144 + x ^^^ 2 + 288 * x + 143 * x ^^^ 2"))
127.236 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"]))*)
127.237 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.238 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.239 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.240 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.241 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.242 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.243 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "0 = 0")) then ()
127.244 +else raise error "rooteq.sml: diff.behav.poly in (sqrt(x+1)+sqrt(4*x+4)=sqr..";
127.245 +(*-> Subproblem ("PolyEq.thy", ["degree_0", ...])*)
127.246 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.247 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.248 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.249 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.250 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.251 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.252 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.253 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.254 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.255 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.256 +val asm = get_assumptions_ pt p;
127.257 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"UniversalList")) andalso asm = []
127.258 +then () else raise error "rooteq.sml: diff.behav. in UniversalList 1";
127.259 +
127.260 +
127.261 +
127.262 +"--------------(sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))---------- SUBPBL.2.------";
127.263 +val fmz =
127.264 + ["equality (13 + 13 * x + -2 * sqrt ((4 + 4 * x) * (9 + 9 * x)) = 1 + x)",
127.265 + "solveFor x","solutions L"];
127.266 +val (dI',pI',mI') = ("RootEq.thy",["sq","root","univariate","equation"],
127.267 + ["RootEq","solve_sq_root_equation"]);
127.268 +(*val p = e_pos'; val c = [];
127.269 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
127.270 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
127.271 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.272 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.273 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.274 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.275 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.276 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.277 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.278 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.279 +(*"144 + 288 * x + 144 * x ^^^ 2 = 144 + x ^^^ 2 + 288 * x + 143 * x ^^^ 2"))
127.280 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"])) *)
127.281 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.282 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.283 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.284 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.285 +(*val p = ([6],Pbl)val nxt = Specify_Method ["PolyEq","normalize_poly"])*)
127.286 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.287 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.288 +(*val p = ([6,2],Res) val f = Form' (FormKF (~1,EdUndef,2,Nundef,"0 = 0"))
127.289 +val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
127.290 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "0 = 0")) then ()
127.291 +else raise error "rooteq.sml: diff.behav.poly in sqrt(x+1)+sqrt(4*x+4)=sqrt..";
127.292 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.293 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.294 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.295 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.296 +(*val nxt = Specify_Method ["PolyEq","solve_d0_polyeq_equation"]) *)
127.297 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.298 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.299 +(*val p = ([6,3,1],Res) val f = Form' (FormKF (~1,EdUndef,3,Nundef,"True"))
127.300 +val nxt = ("Or_to_List",Or_to_List) : string * tac*)
127.301 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.302 +(*val p = ([6,3,2],Res) val f = (~1,EdUndef,3,Nundef,"UniversalList"))
127.303 +val nxt = Check_Postcond ["degree_0","polynomial","univariate","equation"])*)
127.304 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.305 +(*val p = ([6,3],Res) val f =(~1,EdUndef,2,Nundef,"UniversalList"))
127.306 +val nxt = Check_Postcond ["normalize","polynomial","univariate","equation"])*)
127.307 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.308 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "UniversalList")) then ()
127.309 +else raise error "rooteq.sml: diff.behav.poly in sqrt(x+1)+sqrt(4*x+4)=sqrt..";
127.310 +(* val Form' (FormKF (~1, EdUndef, 0, Nundef, str)) = f;
127.311 + *)
127.312 +
127.313 +(*same error as full expl #######*)
127.314 +
127.315 +"--------------(sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))---------- OKversion----";
127.316 +val fmz = ["equality (sqrt(x) = 1)","solveFor x","solutions L"];
127.317 +val (dI',pI',mI') = ("RootEq.thy",["sq","root","univariate","equation"],
127.318 + ["RootEq","solve_sq_root_equation"]);
127.319 +(*val p = e_pos'; val c = [];
127.320 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
127.321 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
127.322 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.323 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.324 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.325 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.326 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.327 +(*val p = ([],Pbl)val nxt = Specify_Method ["RootEq","solve_sq_root_equation"*)
127.328 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.329 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.330 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.331 +(* val p = ([2],Res) val f = Form' (FormKF (~1,EdUndef,1,Nundef,"x = 1"))
127.332 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"]))*)
127.333 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.334 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.335 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.336 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.337 +(*val nxt = ("Specify_Method",Specify_Method ["PolyEq","normalize_poly"])*)
127.338 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.339 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.340 +(*val p = ([3,2],Res)val f = Form' (FormKF (~1,EdUndef,2,Nundef,"-1 + x = 0"))
127.341 +val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
127.342 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-1 + x = 0")) then ()
127.343 +else raise error "rooteq.sml: diff.behav.poly in sqrt(x+1)+sqrt(4*x+4)=sqrt..";
127.344 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.345 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.346 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.347 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.348 +(*val nxt = Specify_Method ["PolyEq","solve_d1_polyeq_equation"]) *)
127.349 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.350 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.351 +(*val p = ([3,3,2],Res) val f = Form' (FormKF (~1,EdUndef,3,Nundef,"x = 1"))
127.352 +val nxt = ("Or_to_List",Or_to_List) *)
127.353 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.354 +(*val p = ([3,3,3],Res) val f = Form' (FormKF (~1,EdUndef,3,Nundef,"[x = 1]"))
127.355 +val nxt = ("Check_elementwise",Check_elementwise "Assumptions")*)
127.356 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.357 +(*val p = ([3,3,4],Res) val f = Form' (FormKF (~1,EdUndef,3,Nundef,"[x = 1]"))
127.358 +val nxt = Check_Postcond ["degree_1","polynomial","univariate","equation"])*)
127.359 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.360 +(*val p = ([3,3],Res) val f = Form' (FormKF (~1,EdUndef,2,Nundef,"[x = 1]"))
127.361 +val nxt = Check_Postcond ["normalize","polynomial","univariate","equation"])*)
127.362 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.363 +
127.364 +(*val p = ([3],Res) val f = Form' (FormKF (~1,EdUndef,1,Nundef,"[x = 1]"))
127.365 +val nxt = ("Check_elementwise",Check_elementwise "Assumptions")
127.366 + --------------------------------*)
127.367 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.368 +(*val p = ([4],Res) val f = Form' (FormKF (~1,EdUndef,1,Nundef,"[x = 1]"))
127.369 +val nxt = Check_Postcond ["sq","root","univariate","equation"]) *)
127.370 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.371 +if p = ([],Res) andalso f = Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1]"))
127.372 +then () else raise error "diff.behav. in rooteq.sml: sqrt(x) = 1";
127.373 +
127.374 +
127.375 +"--------------(sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))---------- SHORTEST.1.----\
127.376 +\ with same error";
127.377 +val fmz = ["equality (sqrt x = sqrt x)","solveFor x","solutions L"];
127.378 +val (dI',pI',mI') = ("RootEq.thy",["sq","root","univariate","equation"],
127.379 + ["RootEq","solve_sq_root_equation"]);
127.380 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.381 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.382 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.383 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.384 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.385 +(*val p = ([],Pbl)val nxt = Specify_Method ["RootEq","solve_sq_root_equation"*)
127.386 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.387 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.388 +(*val p = ([1],Res) val f = Form' (FormKF (~1,EdUndef,1,Nundef,"x = x"))
127.389 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"]))*)
127.390 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.391 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.392 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.393 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.394 +(*val p = ([2],Pbl) val nxt = Specify_Method ["PolyEq","normalize_poly"])*)
127.395 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.396 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.397 +(*val p = ([2,2],Res) val f = Form' (FormKF (~1,EdUndef,2,Nundef,"0 = 0"))
127.398 +val nxt = Subproblem ("PolyEq.thy",["polynomial","univariate","equation"]))*)
127.399 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "0 = 0")) then ()
127.400 +else raise error "rooteq.sml: diff.behav.poly in sqrt(x+1)+sqrt(4*x+4)=sqrt..";
127.401 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.402 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.403 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.404 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.405 +(*val p = ([2,3],Pbl)nxt=Specify_Method ["PolyEq","solve_d0_polyeq_equation"]*)
127.406 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.407 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.408 +(*val p = ([2,3,2],Res) val f = (FormKF (~1,EdUndef,3,Nundef,"UniversalList"))
127.409 +val nxt = Check_Postcond ["degree_0","polynomial","univariate","equation"])*)
127.410 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.411 +(*val p = ([2,3],Res) val f = (FormKF (~1,EdUndef,2,Nundef,"UniversalList"))
127.412 +val nxt = Check_Postcond ["normalize","polynomial","univariate","equation"])*)
127.413 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.414 +(*val p = ([2],Res) val f = (FormKF (~1,EdUndef,1,Nundef,"UniversalList"))
127.415 +val nxt = Check_elementwise "Assumptions"*)
127.416 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.417 +(*val p = ([3],Res) val f = (FormKF (~1,EdUndef,1,Nundef,"UniversalList"))
127.418 +val nxt = Check_Postcond ["sq","root","univariate","equation"]) *)
127.419 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.420 +if p = ([],Res) andalso f = Form'(FormKF (~1,EdUndef,0,Nundef,"UniversalList"))
127.421 +then () else raise error "new behav. in rooteq.sml: sqrt x = sqrt x";
127.422 +
127.423 +
127.424 +"--------------(3*sqrt(x+3)+sqrt(x+6)=sqrt(4*x+33))----------------";
127.425 +val fmz = ["equality (3*sqrt(x+3)+sqrt(x+6)=sqrt(4*x+33))","solveFor x","solutions L"];
127.426 +val (dI',pI',mI') = ("RootEq.thy",["univariate","equation"],["no_met"]);
127.427 +
127.428 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
127.429 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.430 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.431 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.432 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.433 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.434 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.435 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.436 +(* "6 + x = 60 + 13 * x + -6 * sqrt ((3 + x) * (33 + 4 * x))")) : mout
127.437 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"]))*)
127.438 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.439 +(*val nxt = Model_Problem ["sq","root","univariate","equation"]) *)
127.440 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.441 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.442 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.443 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.444 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.445 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.446 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.447 +(*"2916 + x ^^^ 2 + 1296 * x + 143 * x ^^^ 2 = 3564 + 1620 * x + 144 * x ^^^ 2"))
127.448 +val nxt = ("Subproblem",Subproblem ("RootEq.thy",["univariate","equation"]))*)
127.449 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.450 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.451 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.452 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.453 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.454 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.455 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-648 + -324 * x = 0")) then ()
127.456 +else raise error "rooteq.sml: diff.behav.poly in 3*sqrt(x+3)+sqrt(x+6)=sqrt..";
127.457 +(*-> Subproblem ("PolyEq.thy", ["degree_1", ...])*)
127.458 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.459 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.460 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.461 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.462 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.463 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.464 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.465 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.466 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.467 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
127.468 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -2]")) => ()
127.469 + | _ => raise error "rooteq.sml: diff.behav. [x = -2]";
127.470 +
127.471 +"----------- rooteq.sml end--------";
127.472 +
127.473 +
128.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
128.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/rootrateq.sml Wed Jul 21 13:53:39 2010 +0200
128.3 @@ -0,0 +1,229 @@
128.4 +(* testexamples for RootratEq, equations mixing fractions and roots
128.5 + use"rootrateq.sml";
128.6 + *)
128.7 +
128.8 +val thy = Isac.thy;
128.9 +
128.10 +"--------------------- tests on predicates -------------------------------";
128.11 +"--------------------- tests on predicates -------------------------------";
128.12 +"--------------------- tests on predicates -------------------------------";
128.13 +(*
128.14 + Compiler.Control.Print.printDepth:=5; (*4 default*)
128.15 + trace_rewrite:=true;
128.16 + trace_rewrite:=false;
128.17 +*)
128.18 +val t1 = (term_of o the o (parse thy)) "(-8 - sqrt(x) + x^^^2) is_rootRatAddTerm_in x";
128.19 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.20 +if (term2str t) = "False" then ()
128.21 + else raise error "rootrateq.sml: diff.behav. 1 in is_rootRatAddTerm_in";
128.22 +
128.23 +val t1 = (term_of o the o (parse thy)) "(1/x) is_rootRatAddTerm_in x";
128.24 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.25 +if (term2str t) = "False" then ()
128.26 + else raise error "rootrateq.sml: diff.behav. 2 in is_rootRatAddTerm_in";
128.27 +
128.28 +val t1 = (term_of o the o (parse thy)) "(1/sqrt(x)) is_rootRatAddTerm_in x";
128.29 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.30 +if (term2str t) = "False" then ()
128.31 + else raise error "rootrateq.sml: diff.behav. 3 in is_rootRatAddTerm_in";
128.32 +
128.33 +val t1 = (term_of o the o (parse thy)) "(1/(sqrt(x)+1)) is_rootRatAddTerm_in x";
128.34 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.35 +if (term2str t) = "True" then ()
128.36 + else raise error "rootrateq.sml: diff.behav. 4 in is_rootRatAddTerm_in";
128.37 +
128.38 +val t1 = (term_of o the o (parse thy)) "(3 + 1/(1+sqrt(x))) is_rootRatAddTerm_in x";
128.39 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.40 +if (term2str t) = "True" then ()
128.41 + else raise error "rootrateq.sml: diff.behav. 5 in is_rootRatAddTerm_in";
128.42 +
128.43 +val t1 = (term_of o the o (parse thy)) "(1/(1+sqrt(y)) + 3 + 1/(1+sqrt(x))) is_rootRatAddTerm_in x";
128.44 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.45 +if (term2str t) = "True" then ()
128.46 + else raise error "rootrateq.sml: diff.behav. 6 in is_rootRatAddTerm_in";
128.47 +
128.48 +val t1 = (term_of o the o (parse thy)) "(1/(1+sqrt(x)) + 3 + 1/(1+sqrt(y))) is_rootRatAddTerm_in x";
128.49 +val Some (t,_) = rewrite_set_ RootRatEq.thy false RootRatEq_prls t1;
128.50 +if (term2str t) = "True" then ()
128.51 + else raise error "rootrateq.sml: diff.behav. 7 in is_rootRatAddTerm_in";
128.52 +
128.53 +
128.54 +"--------------------- test thm rootrat_equation_left_1 ---------------------";
128.55 +val fmz = ["equality ( -2 + 1/(1 - sqrt(x))= 0)", "solveFor x","solutions L"];
128.56 +val (dI',pI',mI') = ("RootRatEq.thy",["univariate","equation"],["no_met"]);
128.57 +
128.58 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
128.59 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.60 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.61 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.62 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.63 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.64 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.65 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
128.66 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.67 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.68 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.69 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.70 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.71 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.72 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
128.73 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.74 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.75 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.76 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.77 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.78 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.79 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
128.80 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.81 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.82 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.83 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.84 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.85 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.86 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "1 + -4 * x = 0")) then ()
128.87 +else raise error "rootrateq.sml: diff.behav. in rootrat_equation_left_1";
128.88 +(*-> Subproblem ("RootEq.thy", ["polynomial", ...])*)
128.89 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.90 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.91 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.92 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.93 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.94 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.95 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.96 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.97 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.98 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.99 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1 / 4]")) => ()
128.100 + | _ => raise error "rootrateq.sml: diff.behav. in -2 + 1/(1 - sqrt(x))= 0 -> [x = 1/4]";
128.101 +
128.102 +"--------------------- test thm rootrat_equation_left_2 ---------------------";
128.103 +val fmz = ["equality (3/(1+sqrt(x))= 1)", "solveFor x","solutions L"];
128.104 +val (dI',pI',mI') = ("RootRatEq.thy",["univariate","equation"],["no_met"]);
128.105 +
128.106 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
128.107 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.108 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.109 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.110 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.111 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.112 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
128.113 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.114 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.115 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.116 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.117 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.118 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.119 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
128.120 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.121 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.122 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.123 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.124 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.125 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.126 +(*-> Subproblem ("RootEq.thy", ["univariate", ...])*)
128.127 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.128 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.129 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.130 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.131 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.132 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.133 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "4 + -1 * x = 0")) then ()
128.134 +else raise error "rootrateq.sml: diff.behav. in rootrat_equation_left_2";
128.135 +(*-> Subproblem ("PolyEq.thy", ["polynomial", ...])*)
128.136 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.137 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.138 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.139 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.140 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.141 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.142 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.143 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.144 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.145 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.146 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4]")) => ()
128.147 + | _ => raise error "rootrateq.sml: diff.behav. in 3/(1+sqrt(x))= 1 -> [x = 4]";
128.148 +
128.149 +"--------------------- test thm rootrat_equation_right_1 ---------------";
128.150 +val fmz = ["equality ( 0= -2 + 1/(1 - sqrt(x)))", "solveFor x","solutions L"];
128.151 +val (dI',pI',mI') = ("RootRatEq.thy",["univariate","equation"],["no_met"]);
128.152 +
128.153 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
128.154 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.155 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.156 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.157 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.158 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.159 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.160 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.161 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.162 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.163 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.164 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.165 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.166 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.167 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.168 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.169 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.170 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.171 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.172 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.173 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.174 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.175 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.176 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-1 + 4 * x = 0")) then ()
128.177 +else raise error "rootrateq.sml: diff.behav.ppoly in rootrat_equation_right_1";
128.178 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.179 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.180 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.181 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.182 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.183 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.184 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.185 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.186 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.187 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.188 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.189 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 1 / 4]")) => ()
128.190 + | _ => raise error "rootrateq.sml: diff.behav. in -2 + 1/(1 - sqrt(x))= 0 -> [x = 1/4]";
128.191 +
128.192 +"--------------------- test thm rootrat_equation_right_2 --------------------";
128.193 +val fmz = ["equality (1 = 3/(1+sqrt(x)))", "solveFor x","solutions L"];
128.194 +val (dI',pI',mI') = ("RootRatEq.thy",["univariate","equation"],["no_met"]);
128.195 +
128.196 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
128.197 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.198 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.199 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.200 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.201 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.202 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.203 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.204 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.205 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.206 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.207 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.208 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.209 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.210 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.211 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.212 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.213 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.214 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.215 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.216 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.217 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.218 +if f = Form' (FormKF (~1, EdUndef, 0, Nundef, "-4 + x = 0")) then ()
128.219 +else raise error "rootrateq.sml: diff.behav. in rootrat_equation_right_2";
128.220 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.221 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.222 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.223 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.224 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.225 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.226 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.227 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.228 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.229 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.230 +val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
128.231 +case f of Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4]")) => ()
128.232 + | _ => raise error "rootrateq.sml: diff.behav. in 3/(1+sqrt(x))= 1 -> [x = 4]";
129.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
129.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/simplify.sml Wed Jul 21 13:53:39 2010 +0200
129.3 @@ -0,0 +1,57 @@
129.4 +(* tests on simplification
129.5 + author: Walther Neuper
129.6 + 061019
129.7 + (c) due to copyright terms
129.8 +
129.9 +use"../smltest/IsacKnowledge/simplify.sml";
129.10 +use"simplify.sml";
129.11 +*)
129.12 +val thy = Simplify.thy;
129.13 +
129.14 +"-----------------------------------------------------------------";
129.15 +"table of contents -----------------------------------------------";
129.16 +"-----------------------------------------------------------------";
129.17 +"----------- CAS-command Simplify --------------------------------";
129.18 +"----------- append inform with final result ---------------------";
129.19 +"-----------------------------------------------------------------";
129.20 +"-----------------------------------------------------------------";
129.21 +"-----------------------------------------------------------------";
129.22 +
129.23 +
129.24 +
129.25 +"----------- CAS-command Simplify --------------------------------";
129.26 +"----------- CAS-command Simplify --------------------------------";
129.27 +"----------- CAS-command Simplify --------------------------------";
129.28 +states:=[];
129.29 +CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
129.30 +Iterator 1;
129.31 +moveActiveRoot 1;
129.32 +replaceFormula 1 "Simplify (2*a + 3*a)";
129.33 +autoCalculate 1 (Step 1);
129.34 +autoCalculate 1 CompleteCalc;
129.35 +val ((pt,p),_) = get_calc 1;
129.36 +val Form res = (#1 o pt_extract) (pt, ([],Res));
129.37 +show_pt pt;
129.38 +if p = ([], Res) andalso term2str res = "5 * a" then ()
129.39 +else raise error "simplify.sml: diff.behav. CAScmd: Simplify (2*a + 3*a)";
129.40 +
129.41 +
129.42 +"----------- append inform with final result ---------------------";
129.43 +"----------- append inform with final result ---------------------";
129.44 +"----------- append inform with final result ---------------------";
129.45 +states:=[];
129.46 +CalcTree [(["term ((14 * x * y) / ( x * y ))", "normalform N"],
129.47 + ("Rational.thy",["rational","simplification"],
129.48 + ["simplification","of_rationals"]))];
129.49 +Iterator 1;
129.50 +moveActiveRoot 1;
129.51 +autoCalculate 1 CompleteCalcHead;
129.52 +autoCalculate 1 (Step 1);
129.53 +appendFormula 1 "14";
129.54 +val ((pt,p),_) = get_calc 1; show_pt pt;
129.55 +
129.56 +autoCalculate 1 (Step 1);
129.57 +val ((pt,p),_) = get_calc 1; show_pt pt;
129.58 +val Form res = (#1 o pt_extract) (pt, ([],Res));
129.59 +if p = ([], Res) andalso term2str res = "14" then ()
129.60 +else raise error "simplify.sml: append inform with final result ?!?";
130.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
130.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/system.sml Wed Jul 21 13:53:39 2010 +0200
130.3 @@ -0,0 +1,103 @@
130.4 +(* tests on systems of equations over the reals
130.5 + author: Walther Neuper 050905
130.6 + (c) due to copyright terms
130.7 +
130.8 +use"../smltest/IsacKnowledge/system.sml";
130.9 +*)
130.10 +val thy = EqSystem.thy;
130.11 +
130.12 +"-----------------------------------------------------------------";
130.13 +"table of contents -----------------------------------------------";
130.14 +"-----------------------------------------------------------------";
130.15 +"----------- normalize system ------------------------------------";
130.16 +"----------- me --------------------------------------------------";
130.17 +"-----------------------------------------------------------------";
130.18 +"-----------------------------------------------------------------";
130.19 +"-----------------------------------------------------------------";
130.20 +
130.21 +
130.22 +"----------- normalize system ------------------------------------";
130.23 +"----------- normalize system ------------------------------------";
130.24 +"----------- normalize system ------------------------------------";
130.25 +val t = str2term "[0 = c*0 + -1*q_0*(0^^^2 / 2) + c_2,\
130.26 + \ 0 = c*L + -1*q_0*(L^^^2 / 2) + c_2]";
130.27 +val Some (t,_) = rewrite_set_ thy false norm_Poly t;
130.28 +if term2str t =
130.29 +"[0 = -1 * q_0 * (0 / 2) + c_2, 0 = L * c + -1 * q_0 * (L ^^^ 2 / 2) + c_2]"
130.30 +then () else raise error "system.sml, diff.behav. in norm_Poly";
130.31 +
130.32 +val t = str2term "[0 = c*0 + -1*q_0*(0^^^2 / 2) + c_2,\
130.33 + \ 0 = c*L + -1*q_0*(L^^^2 / 2) + c_2]";
130.34 +val Some (t,_) = rewrite_set_ thy false norm_Rational t;
130.35 +if term2str t =
130.36 +"[0 = c_2, 0 = (2 * c_2 + 2 * L * c + -1 * L ^^^ 2 * q_0) / 2]"
130.37 +then () else raise error "system.sml, diff.behav. in norm_Rational";
130.38 +
130.39 +
130.40 +val t = str2term "nth_ 1 [0 = c*0 + -1*q_0*(0^^^2 / 2) + c_2,\
130.41 + \ 0 = c*L + -1*q_0*(L^^^2 / 2) + c_2]";
130.42 +val Some (t,_) = rewrite_set_ thy false list_rls t;
130.43 +if term2str t = "0 = c * 0 + -1 * q_0 * (0 ^^^ 2 / 2) + c_2"
130.44 +then () else raise error "system.sml, list_rls";
130.45 +
130.46 +
130.47 +"----------- me --------------------------------------------------";
130.48 +"----------- me --------------------------------------------------";
130.49 +"----------- me --------------------------------------------------";
130.50 +val fmz = ["equalities [0 = c_2 + c * 0 + -1 * q_0 / 2 * 0 ^^^ 2, 0 = c_2 + c * L + -1 * q_0 / 2 * L ^^^ 2]",
130.51 + "solveForVars [c, c_2]", "solution ss___"];
130.52 +val (dI',pI',mI') =
130.53 + ("Biegelinie.thy",["normalize","2x2","linear","system"],
130.54 + ["EqSystem","normalize","2x2"]);
130.55 +val p = e_pos'; val c = [];
130.56 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
130.57 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.58 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.59 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.60 +case nxt of (_, Specify_Theory "Biegelinie.thy") => ()
130.61 + | _ => raise error "system.sml diff.behav.in me --1";
130.62 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.63 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.64 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.65 +case nxt of (_, Apply_Method ["EqSystem", "normalize", "2x2"]) => ()
130.66 + | _ => raise error "system.sml diff.behav.in me --2";
130.67 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.68 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.69 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.70 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.71 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.72 +
130.73 +case nxt of (_, Subproblem ("Biegelinie.thy", ["triangular", "2x2",
130.74 + "linear", "system"])) => ()
130.75 + | _ => raise error "system.sml diff.behav.in me --3";
130.76 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
130.77 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.78 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.79 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.80 +case nxt of (_, Specify_Theory "Biegelinie.thy") => ()
130.81 + | _ => raise error "system.sml diff.behav.in me --1";
130.82 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.83 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.84 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
130.85 +case nxt of (_, Apply_Method ["EqSystem", "normalize", "2x2"]) => ()
130.86 + | _ => raise error "system.sml diff.behav.in me --2";
130.87 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.88 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.89 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.90 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.91 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
130.92 +
130.93 +
130.94 +(*---
130.95 +WN060421 stopped as soon as exp_IsacCore_Equ_Sys_Lin_No-1.xml worked ...
130.96 +
130.97 +if f2str f = "" then ()
130.98 +else raise error "system.sml diff.behav.in me --99";
130.99 +case nxt of ("End_Proof'", End_Proof') => ()
130.100 + | _ => raise error "system.sml diff.behav.in me --99";
130.101 +
130.102 +print_depth 11;nxt;print_depth 3;
130.103 +---*)
130.104 +(*
130.105 +use"../smltest/IsacKnowledge/system.sml";
130.106 +*)
131.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
131.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/termorder.sml Wed Jul 21 13:53:39 2010 +0200
131.3 @@ -0,0 +1,192 @@
131.4 + (* tests on rewrite orders
131.5 + author Matthias Goldgruber 2003
131.6 +
131.7 + WN0509 do not use this file anymore, since orders require thy:
131.8 + do tests in the smltest/IsacKnowledge/file.sml
131.9 + where file.ML defines the respective order !
131.10 +
131.11 +use"../smltest/IsacKnowledge/termorder.sml";
131.12 +*)
131.13 +
131.14 +
131.15 + (*MK die ersten Tests*)
131.16 + val substa = [(e_term, (term_of o the o (parse thy)) "a")];
131.17 + val substb = [(e_term, (term_of o the o (parse thy)) "b")];
131.18 + val substx = [(e_term, (term_of o the o (parse thy)) "x")];
131.19 +
131.20 + val x1 = (term_of o the o (parse thy)) "a + b + x";
131.21 + val x2 = (term_of o the o (parse thy)) "a + x + b";
131.22 + val x3 = (term_of o the o (parse thy)) "a + x + b";
131.23 + val x4 = (term_of o the o (parse thy)) "x + a + b";
131.24 +
131.25 +if ord_make_polynomial_in true thy substx (x1,x2) = true(*LESS *) then ()
131.26 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #1";
131.27 +
131.28 +if ord_make_polynomial_in true thy substa (x1,x2) = true(*LESS *) then ()
131.29 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #2";
131.30 +
131.31 +if ord_make_polynomial_in true thy substb (x1,x2) = false(*GREATER*) then ()
131.32 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #3";
131.33 +
131.34 + val aa = (term_of o the o (parse thy)) "-1 * a * x";
131.35 + val bb = (term_of o the o (parse thy)) "x^^^3";
131.36 + ord_make_polynomial_in true thy substx (aa, bb);
131.37 + true; (* => LESS *)
131.38 +
131.39 + val aa = (term_of o the o (parse thy)) "-1 * a * x";
131.40 + val bb = (term_of o the o (parse thy)) "x^^^3";
131.41 + ord_make_polynomial_in true thy substa (aa, bb);
131.42 + false; (* => GREATER *)
131.43 +
131.44 + (*und nach dem Re-engineering der Termorders in den 'rulesets'
131.45 + kannst Du die 'gr"osste' Variable frei w"ahlen: *)
131.46 + val bdv= (term_of o the o (parse thy)) "bdv";
131.47 + val x = (term_of o the o (parse thy)) "x";
131.48 + val a = (term_of o the o (parse thy)) "a";
131.49 + val b = (term_of o the o (parse thy)) "b";
131.50 + val Some (t',_) =
131.51 + rewrite_set_inst_ thy false [(bdv,a)] make_polynomial_in x2;
131.52 +if term2str t' = "b + x + a" then ()
131.53 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #11";
131.54 +
131.55 + val None =
131.56 + rewrite_set_inst_ thy false [(bdv,b)] make_polynomial_in x2;
131.57 + term2str t';
131.58 + "a + x + b";
131.59 +
131.60 + val Some (t',_) =
131.61 + rewrite_set_inst_ thy false [(bdv,x)] make_polynomial_in x2;
131.62 +if term2str t' = "a + b + x" then ()
131.63 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #13";
131.64 +
131.65 +
131.66 +
131.67 + val ppp' = "-6 + -5*x + x^^^3 + -1*x^^^2 + -1*x^^^3 + -14*x^^^2";
131.68 + val ppp = (term_of o the o (parse thy)) ppp';
131.69 + val Some (t',_) =
131.70 + rewrite_set_inst_ thy false [(bdv,x)] make_polynomial_in ppp;
131.71 +(*MG 2003...
131.72 + term2str t';
131.73 + "(-6) + (-5 * x + (-15 * x ^^^ 2))";*)
131.74 +if term2str t' = "-6 + -5 * x + -15 * x ^^^ 2 + 0" then ()
131.75 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #14";
131.76 +
131.77 + val Some (t',_) =
131.78 + rewrite_set_inst "Isac.thy"false [("bdv","x")] "make_polynomial_in" ppp';
131.79 +(*MG 2003...
131.80 + "(-6) + (-5 * x + (-15) * x ^^^ 2)";*)
131.81 +if t' = "-6 + -5 * x + -15 * x ^^^ 2 + 0" then ()
131.82 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #15";
131.83 +
131.84 + val ttt' = "(3*x + 5)/18";
131.85 + val ttt = (term_of o the o (parse thy)) ttt';
131.86 + val Some (uuu,_) =
131.87 + rewrite_set_inst_ thy false [(bdv,x)] make_polynomial_in ttt;
131.88 +if term2str uuu = "(5 + 3 * x) / 18" then ()
131.89 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #16";
131.90 +
131.91 + val Some (uuu,_) =
131.92 + rewrite_set_ thy false make_polynomial ttt;
131.93 +if term2str uuu = "(5 + 3 * x) / 18" then ()
131.94 +else raise error "termorder.sml diff.behav ord_make_polynomial_in #16";
131.95 +
131.96 +
131.97 +
131.98 +
131.99 +(*-----------28.2.03: war nicht upgedatet (und ausgeklammert in ROOT.ML
131.100 +
131.101 + (*Aufgabe zum Einstieg in die Arbeit...*)
131.102 + val t = (term_of o the o (parse thy)) "a*b - (a+b)*x + x^^^2 = 0";
131.103 + (*ein 'ruleset' aus Poly.ML wird angewandt...*)
131.104 + val Some (t,_) = rewrite_set_ thy Poly_erls false make_polynomial t;
131.105 + term2str t;
131.106 + "a * b + (-1 * (a * x) + (-1 * (b * x) + x ^^^ 2)) = 0";
131.107 + val Some (t,_) =
131.108 + rewrite_set_inst_ thy Poly_erls false [("bdv","a")] make_polynomial_in t;
131.109 + term2str t;
131.110 + "x ^^^ 2 + (-1 * (b * x) + (-1 * (x * a) + b * a)) = 0";
131.111 +(* bei Verwendung von "size_of-term" nach MG :*)
131.112 +(*"x ^^^ 2 + (-1 * (b * x) + (b * a + -1 * (x * a))) = 0" !!! *)
131.113 +
131.114 + (*wir holen 'a' wieder aus der Klammerung heraus...*)
131.115 + val Some (t,_) = rewrite_set_ thy Poly_erls false discard_parentheses t;
131.116 + term2str t;
131.117 + "x ^^^ 2 + -1 * b * x + -1 * x * a + b * a = 0";
131.118 +(* "x ^^^ 2 + -1 * b * x + b * a + -1 * x * a = 0" !!! *)
131.119 +
131.120 + val Some (t,_) =
131.121 + rewrite_set_inst_ thy Poly_erls false [("bdv","a")] make_polynomial_in t;
131.122 + term2str t;
131.123 + "x ^^^ 2 + (-1 * (b * x) + a * (b + -1 * x)) = 0";
131.124 + (*da sind wir fast am Ziel: make_polynomial_in 'a' sollte ergeben
131.125 + "x ^^^ 2 + (-1 * (b * x)) + (b + -1 * x) * a = 0"*)
131.126 +
131.127 + (*das rewriting l"asst sich beobachten mit
131.128 + trace_rewrite:=true;
131.129 + *)
131.130 +
131.131 +
131.132 +
131.133 +"------15.11.02 --------------------------";
131.134 + val t = (term_of o the o (parse thy)) "1 + a * x + b * x";
131.135 + val bdv = (term_of o the o (parse thy)) "bdv";
131.136 + val a = (term_of o the o (parse thy)) "a";
131.137 +
131.138 + trace_rewrite:=true;
131.139 + (* Anwenden einer Regelmenge aus Termorder.ML: *)
131.140 + val Some (t,_) =
131.141 + rewrite_set_inst_ thy false [(bdv,a)] make_polynomial_in t;
131.142 + term2str t;
131.143 + val Some (t,_) =
131.144 + rewrite_set_ thy false discard_parentheses t;
131.145 + term2str t;
131.146 +"1 + b * x + x * a";
131.147 +
131.148 + val t = (term_of o the o (parse thy)) "1 + a * (x + b * x) + a^^^2";
131.149 + val Some (t,_) =
131.150 + rewrite_set_inst_ thy false [(bdv,a)] make_polynomial_in t;
131.151 + term2str t;
131.152 + val Some (t,_) =
131.153 + rewrite_set_ thy false discard_parentheses t;
131.154 + term2str t;
131.155 +"1 + (x + b * x) * a + a ^^^ 2";
131.156 +
131.157 + val t = (term_of o the o (parse thy)) "1 + a ^^^2 * x + b * a + 7*a^^^2";
131.158 + val Some (t,_) =
131.159 + rewrite_set_inst_ thy false [(bdv,a)] make_polynomial_in t;
131.160 + term2str t;
131.161 + val Some (t,_) =
131.162 + rewrite_set_ thy false discard_parentheses t;
131.163 + term2str t;
131.164 +"1 + b * a + (7 + x) * a ^^^ 2";
131.165 +
131.166 +(* MG2003
131.167 + Atools.thy grundlegende Algebra
131.168 + Poly.thy Polynome
131.169 + Rational.thy Br"uche
131.170 + Root.thy Wurzeln
131.171 + RootRat.thy Wurzen + Br"uche
131.172 + Termorder.thy BITTE NUR HIERHER SCHREIBEN (...WN03)
131.173 +
131.174 + cd"knowledge";
131.175 + remove_thy"Termorder";
131.176 + use_thy"Isac";
131.177 +
131.178 + get_thm Termorder.thy "bdv_n_collect";
131.179 + get_thm Isac.thy "bdv_n_collect";
131.180 +
131.181 +*)
131.182 + val t = (term_of o the o (parse thy)) "a ^^^2 * x + 7 * a^^^2";
131.183 + val Some (t,_) =
131.184 + rewrite_set_inst_ thy false [(bdv,a)] make_polynomial_in t;
131.185 + term2str t;
131.186 + val Some (t,_) =
131.187 + rewrite_set_ thy false discard_parentheses t;
131.188 + term2str t;
131.189 +"(7 + x) * a ^^^ 2";
131.190 +
131.191 + val t = (term_of o the o (parse Termorder.thy)) "Pi";
131.192 +
131.193 + val t = (term_of o the o (parseold thy)) "7";
131.194 +
131.195 +----------------------------------------------------------------------*)
132.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
132.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/trig.sml Wed Jul 21 13:53:39 2010 +0200
132.3 @@ -0,0 +1,2 @@
132.4 +(* testexamples for Trig, trigonometry
132.5 + *)
132.6 \ No newline at end of file
133.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
133.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/vect.sml Wed Jul 21 13:53:39 2010 +0200
133.3 @@ -0,0 +1,2 @@
133.4 +(* testexamples for Vect, vector spaces
133.5 + *)
133.6 \ No newline at end of file
134.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
134.2 +++ b/src/Pure/isac/smltest/IsacKnowledge/wn.sml Wed Jul 21 13:53:39 2010 +0200
134.3 @@ -0,0 +1,12 @@
134.4 +(* use"kbtest/wn.sml";
134.5 + use"wn.sml";
134.6 +
134.7 + various test dependent on IsacKnowledge/ outside Test.thy, Test.ML*)
134.8 +
134.9 +
134.10 + val t = str2term "solve (a*x + b = c, x)";
134.11 + atomty t;
134.12 +(*
134.13 +"\n*** -------------"
134.14 +"\n*** Const ( Equation.solve, bool * real => bool list)"
134.15 +... ~~~~~ ~~~~~~~~*)
134.16 \ No newline at end of file
135.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
135.2 +++ b/src/Pure/isac/smltest/ME/calchead.sml Wed Jul 21 13:53:39 2010 +0200
135.3 @@ -0,0 +1,413 @@
135.4 +(* tests on calchead.sml
135.5 + author: Walther Neuper
135.6 + 051013,
135.7 + (c) due to copyright terms
135.8 +
135.9 +use"../smltest/ME/calchead.sml";
135.10 +use"calchead.sml";
135.11 +*)
135.12 +
135.13 +"-----------------------------------------------------------------";
135.14 +"table of contents -----------------------------------------------";
135.15 +"-----------------------------------------------------------------";
135.16 +"--------- get_interval after replace} other 2 -------------------";
135.17 +"--------- maximum example with 'specify' ------------------------";
135.18 +"--------- maximum example with 'specify', fmz <> [] -------------";
135.19 +"--------- maximum example with 'specify', fmz = [] --------------";
135.20 +"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)-----------";
135.21 +"-----------------------------------------------------------------";
135.22 +"-----------------------------------------------------------------";
135.23 +"-----------------------------------------------------------------";
135.24 +
135.25 +
135.26 +"--------- get_interval after replace} other 2 -------------------";
135.27 +"--------- get_interval after replace} other 2 -------------------";
135.28 +"--------- get_interval after replace} other 2 -------------------";
135.29 + states:=[];
135.30 + CalcTree
135.31 + [(["equality (x+1=2)", "solveFor x","solutions L"],
135.32 + ("Test.thy",
135.33 + ["sqroot-test","univariate","equation","test"],
135.34 + ["Test","squ-equ-test-subpbl1"]))];
135.35 + Iterator 1;
135.36 + moveActiveRoot 1;
135.37 + autoCalculate 1 CompleteCalc;
135.38 + moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
135.39 + replaceFormula 1 "x = 1";
135.40 + (*... returns calcChangedEvent with ...*)
135.41 + val (unc, del, gen) = (([1],Res), ([4],Res), ([3,2],Res));
135.42 + val ((pt,_),_) = get_calc 1;
135.43 +
135.44 +print_depth 99;map fst (get_interval ([],Pbl) ([],Res) 9999 pt);print_depth 3;
135.45 +if map fst (get_interval ([],Pbl) ([],Res) 9999 pt) =
135.46 + [([], Pbl), ([1], Frm),([1], Res), ([2], Res), ([3], Pbl), ([3, 1], Frm),
135.47 + ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
135.48 + ([3, 2], Res)] then () else
135.49 +raise error "calchead.sml: diff.behav. get_interval after replace} other 2 a";
135.50 +
135.51 +print_depth 99;map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt);
135.52 +print_depth 3;
135.53 +if map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt) =
135.54 + [([3, 2, 1], Res), ([3, 2, 2], Res), ([3, 2], Res)] then () else
135.55 +raise error "modspec.sml: diff.behav. get_interval after replace} other 2 b";
135.56 +
135.57 +
135.58 +
135.59 +
135.60 +"--------- maximum example with 'specify' ------------------------";
135.61 +"--------- maximum example with 'specify' ------------------------";
135.62 +"--------- maximum example with 'specify' ------------------------";
135.63 +(*" Specify_Problem (match_itms_oris) ";*)
135.64 +val fmz =
135.65 + ["fixedValues [r=Arbfix]","maximum A",
135.66 + "valuesFor [a,b]",
135.67 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
135.68 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
135.69 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
135.70 +
135.71 + "boundVariable a","boundVariable b","boundVariable alpha",
135.72 + "interval {x::real. 0 <= x & x <= 2*r}",
135.73 + "interval {x::real. 0 <= x & x <= 2*r}",
135.74 + "interval {x::real. 0 <= x & x <= pi}",
135.75 + "errorBound (eps=(0::real))"];
135.76 +val (dI',pI',mI') =
135.77 + ("DiffApp.thy",["maximum_of","function"],
135.78 + ["DiffApp","max_by_calculus"]);
135.79 +val c = []:cid;
135.80 +
135.81 +(*val nxt = Init_Proof' (fmz,(dI',pI',mI'));
135.82 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] EmptyPtree;
135.83 +*)
135.84 +val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
135.85 +val nxt = tac2tac_ pt p nxt;
135.86 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.87 +(*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
135.88 +
135.89 +val nxt = tac2tac_ pt p nxt;
135.90 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.91 +(**)
135.92 +
135.93 +(*---6.5.03
135.94 +val nxt = tac2tac_ pt p (Add_Find "valuesFor [(a::real)]");
135.95 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.96 +(*uncaught exception TYPE 6.5.03*)
135.97 +
135.98 +if ppc<>(Problem [],
135.99 + {Find=[Incompl "maximum",Incompl "valuesFor [a]"],
135.100 + Given=[Correct "fixedValues [r = Arbfix]"],
135.101 + Relate=[Incompl "relations []"], Where=[],With=[]})
135.102 +then raise error "test-maximum.sml: model stepwise - different behaviour"
135.103 +else (); (*different with show_types !!!*)
135.104 +6.5.03---*)
135.105 +
135.106 +(*-----appl_add should not create Error', but accept as Sup,Syn
135.107 +val nxt = tac2tac_ pt p (Add_Given "boundVariable a");
135.108 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.109 +(**)
135.110 +val nxt = tac2tac_ pt p (Add_Given "boundVariable a+");
135.111 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.112 +(**)---*)
135.113 +
135.114 +val m = Specify_Problem ["maximum_of","function"];
135.115 +val nxt = tac2tac_ pt p m;
135.116 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.117 +(**)
135.118 +
135.119 +if ppc<>(Problem ["maximum_of","function"],
135.120 + {Find=[Incompl "maximum",Incompl "valuesFor"],
135.121 + Given=[Correct "fixedValues [r = Arbfix]"],
135.122 + Relate=[Incompl "relations []"], Where=[],With=[]})
135.123 +then raise error "diffappl.sml: Specify_Problem different behaviour"
135.124 +else ();
135.125 +(* WN.3.9.03 (#391) Model_Specify did init_pbl newly
135.126 +if ppc<>(Problem ["maximum_of","function"],
135.127 + {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
135.128 + Given=[Correct "fixedValues [r = Arbfix]"],
135.129 + Relate=[Missing "relations rs_"],Where=[],With=[]})
135.130 +then raise error "diffappl.sml: Specify_Problem different behaviour"
135.131 +else ();*)
135.132 +
135.133 +val nxt = tac2tac_ pt p(Specify_Method ["DiffApp","max_by_calculus"]);
135.134 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.135 +(**)
135.136 +
135.137 +if ppc<>(Method ["DiffApp","max_by_calculus"],
135.138 + {Find=[Incompl "maximum",Incompl "valuesFor"],
135.139 + Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_",
135.140 + Missing "interval itv_",Missing "errorBound err_"],
135.141 + Relate=[Incompl "relations []"],Where=[],With=[]})
135.142 +then raise error "diffappl.sml: Specify_Method different behaviour"
135.143 +else ();
135.144 +(* WN.3.9.03 (#391) Model_Specify did init_pbl newly
135.145 +if ppc<>(Method ["DiffApp","max_by_calculus"],
135.146 + {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
135.147 + Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_",
135.148 + Missing "interval itv_",Missing "errorBound err_"],
135.149 + Relate=[Missing "relations rs_"],Where=[],With=[]})
135.150 +then raise error "diffappl.sml: Specify_Method different behaviour"
135.151 +else ();*)
135.152 +
135.153 +
135.154 +
135.155 +"--------- maximum example with 'specify', fmz <> [] -------------";
135.156 +"--------- maximum example with 'specify', fmz <> [] -------------";
135.157 +"--------- maximum example with 'specify', fmz <> [] -------------";
135.158 +val fmz =
135.159 + ["fixedValues [r=Arbfix]","maximum A",
135.160 + "valuesFor [a,b]",
135.161 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
135.162 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
135.163 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
135.164 +
135.165 + "boundVariable a","boundVariable b","boundVariable alpha",
135.166 + "interval {x::real. 0 <= x & x <= 2*r}",
135.167 + "interval {x::real. 0 <= x & x <= 2*r}",
135.168 + "interval {x::real. 0 <= x & x <= pi}",
135.169 + "errorBound (eps=(0::real))"];
135.170 +val (dI',pI',mI') =
135.171 + ("DiffApp.thy",["maximum_of","function"],
135.172 + ["DiffApp","max_by_calculus"]);
135.173 +val c = []:cid;
135.174 +(*val nxt = Init_Proof' (fmz,(dI',pI',mI'));*)
135.175 +val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
135.176 +
135.177 +val nxt = tac2tac_ pt p nxt;
135.178 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] pt;
135.179 +val nxt = tac2tac_ pt p nxt;
135.180 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.181 +(*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
135.182 +
135.183 +val nxt = tac2tac_ pt p nxt;
135.184 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.185 +(*val nxt = Add_Find "maximum (A::bool)" : tac*)
135.186 +
135.187 +val nxt = tac2tac_ pt p nxt;
135.188 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.189 +(*val nxt = Add_Find "valuesFor [(a::real)]" : tac*)
135.190 +
135.191 +val nxt = tac2tac_ pt p nxt;
135.192 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.193 +(*val nxt = Add_Find "valuesFor [(b::real)]" : tac*)
135.194 +
135.195 +val nxt = tac2tac_ pt p nxt;
135.196 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.197 +(*val nxt = Add_Relation "relations [A = a * b]" *)
135.198 +
135.199 +val nxt = tac2tac_ pt p nxt;
135.200 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.201 +(*Add_Relation "relations\n [((a::real) // (#2::real)) ..."*)
135.202 +
135.203 +(*---------------------------- FIXXXXME.meNEW !!! partial Add-Relation !!!
135.204 + nxt_specif <> specify ?!
135.205 +
135.206 +if nxt<>(Add_Relation
135.207 + "relations [(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]")
135.208 +then raise error "test specify, fmz <> []: nxt <> Add_Relation (a/2)^2.." else (); (*different with show_types !!!*)
135.209 +
135.210 +val nxt = tac2tac_ pt p nxt;
135.211 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.212 +------------------------------ FIXXXXME.meNEW !!! ---*)
135.213 +
135.214 +(*val nxt = Specify_Theory "DiffApp.thy" : tac*)
135.215 +
135.216 +val itms = get_obj g_pbl pt (fst p);writeln(itms2str thy itms);
135.217 +
135.218 +val nxt = tac2tac_ pt p nxt;
135.219 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.220 +(*val nxt = Specify_Problem ["maximum_of","function"]*)
135.221 +
135.222 +val nxt = tac2tac_ pt p nxt;
135.223 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.224 +(*val nxt = Specify_Method ("DiffApp.thy","max_by_calculus")*)
135.225 +
135.226 +val nxt = tac2tac_ pt p nxt;
135.227 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.228 +(*val nxt = Add_Given "boundVariable a" : tac*)
135.229 +
135.230 +val nxt = tac2tac_ pt p nxt;
135.231 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.232 +(*val nxt = Add_Given "interval {x. #0 <= x & x <= #2 * r}" : *)
135.233 +
135.234 +val nxt = tac2tac_ pt p nxt;
135.235 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.236 +(*val nxt = Add_Given "errorBound (eps = #0)" : tac*)
135.237 +
135.238 +val nxt = tac2tac_ pt p nxt;
135.239 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.240 +(*val nxt = Apply_Method ("DiffApp.thy","max_by_calculus") *)
135.241 +if nxt<>(Apply_Method ["DiffApp","max_by_calculus"])
135.242 +then raise error "test specify, fmz <> []: nxt <> Apply_Method max_by_calculus" else ();
135.243 +
135.244 +
135.245 +"--------- maximum example with 'specify', fmz = [] --------------";
135.246 +"--------- maximum example with 'specify', fmz = [] --------------";
135.247 +"--------- maximum example with 'specify', fmz = [] --------------";
135.248 +val fmz = [];
135.249 +val (dI',pI',mI') = empty_spec;
135.250 +val c = []:cid;
135.251 +
135.252 +val nxt = Init_Proof' (fmz,(dI',pI',mI'));(*!!!!!!!!*)
135.253 +(*val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))]; !!!*)
135.254 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' []
135.255 + EmptyPtree;
135.256 +val nxt = tac2tac_ pt p nxt;
135.257 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.258 +(*val nxt = Specify_Theory "e_domID" : tac*)
135.259 +
135.260 +val nxt = Specify_Theory "DiffApp.thy";
135.261 +val nxt = tac2tac_ pt p nxt;
135.262 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.263 +(*val nxt = Specify_Problem ["e_pblID"] : tac*)
135.264 +
135.265 +val nxt = Specify_Problem ["maximum_of","function"];
135.266 +val nxt = tac2tac_ pt p nxt;
135.267 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.268 +(*val nxt = Add_Given "fixedValues" : tac*)
135.269 +
135.270 +val nxt = Add_Given "fixedValues [r=Arbfix]";
135.271 +val nxt = tac2tac_ pt p nxt;
135.272 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.273 +(*val nxt = Add_Find "maximum" : tac*)
135.274 +
135.275 +val nxt = Add_Find "maximum A";
135.276 +val nxt = tac2tac_ pt p nxt;
135.277 +
135.278 +
135.279 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.280 +(*val nxt = Add_Find "valuesFor" : tac*)
135.281 +
135.282 +val nxt = Add_Find "valuesFor [a]";
135.283 +val nxt = tac2tac_ pt p nxt;
135.284 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.285 +(*val nxt = Add_Relation "relations" ---
135.286 + --- [b=Arbfix] KANN NICHT VERLANGT WERDEN !!!!*)
135.287 +
135.288 +(*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
135.289 +if nxt<>(Add_Relation "relations []")
135.290 +then raise error "test specify, fmz <> []: nxt <> Add_Relation.."
135.291 +else (); (*different with show_types !!!*)
135.292 +*)
135.293 +
135.294 +val nxt = Add_Relation "relations [(A=a+b)]";
135.295 +val nxt = tac2tac_ pt p nxt;
135.296 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.297 +(*val nxt = Specify_Method ("e_domID","e_metID") : tac*)
135.298 +
135.299 +val nxt = Specify_Method ["DiffApp","max_by_calculus"];
135.300 +val nxt = tac2tac_ pt p nxt;
135.301 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.302 +(*val nxt = Add_Given "boundVariable" : tac*)
135.303 +
135.304 +val nxt = Add_Given "boundVariable alpha";
135.305 +val nxt = tac2tac_ pt p nxt;
135.306 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.307 +(*val nxt = Add_Given "interval" : tac*)
135.308 +
135.309 +val nxt = Add_Given "interval {x. 2 <= x & x <= 3}";
135.310 +val nxt = tac2tac_ pt p nxt;
135.311 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.312 +(*val nxt = Add_Given "errorBound" : tac*)
135.313 +
135.314 +val nxt = Add_Given "errorBound (eps=999)";
135.315 +val nxt = tac2tac_ pt p nxt;
135.316 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
135.317 +(*val nxt = Apply_Method ("DiffApp","max_by_calculus") *)
135.318 +(*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
135.319 +if nxt<>(Apply_Method ("DiffApp.thy","max_by_calculus"))
135.320 +then raise error "test specify, fmz <> []: nxt <> Add_Relation.."
135.321 +else ();
135.322 +*)
135.323 +
135.324 +(* 2.4.00 nach Transfer specify -> hard_gen
135.325 +val nxt = Apply_Method ("DiffApp.thy","max_by_calculus");
135.326 +val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt; *)
135.327 +(*val nxt = Empty_Tac : tac*)
135.328 +
135.329 +
135.330 +"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)-----------";
135.331 +"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)-----------";
135.332 +"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)-----------";
135.333 +val Const ("Script.SubProblem",_) $
135.334 + (Const ("Pair",_) $
135.335 + Free (dI',_) $
135.336 + (Const ("Pair",_) $ pI' $ mI')) $ ags' =
135.337 + (*...copied from stac2tac_*)
135.338 + str2term
135.339 + "SubProblem (EqSystem_, [linear, system], [no_met])\
135.340 + \ [bool_list_ [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2],\
135.341 + \ real_list_ [c, c_2]]";
135.342 +val ags = isalist2list ags';
135.343 +val pI = ["linear","system"];
135.344 +val pats = (#ppc o get_pbt) pI;
135.345 +case match_ags Isac.thy pats ags of
135.346 + [(1, [1], "#Given", Const ("Descript.equalities", _), _),
135.347 + (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
135.348 + [ _ $ Free ("c", _) $ _, _ $ Free ("c_2", _) $ _]),
135.349 + (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss___", _)])]
135.350 + =>()
135.351 + | _ => raise error "calchead.sml match_ags 2 args OK -----------------";
135.352 +
135.353 +
135.354 +val Const ("Script.SubProblem",_) $
135.355 + (Const ("Pair",_) $
135.356 + Free (dI',_) $
135.357 + (Const ("Pair",_) $ pI' $ mI')) $ ags' =
135.358 + (*...copied from stac2tac_*)
135.359 + str2term
135.360 + "SubProblem (EqSystem_, [linear, system], [no_met])\
135.361 + \ [bool_list_ [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2],\
135.362 + \ real_list_ [c, c_2], bool_list_ ss___]";
135.363 +val ags = isalist2list ags';
135.364 +val pI = ["linear","system"];
135.365 +val pats = (#ppc o get_pbt) pI;
135.366 +case match_ags Isac.thy pats ags of
135.367 + [(1, [1], "#Given", Const ("Descript.equalities", _), _),
135.368 + (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
135.369 + [_ $ Free ("c", _) $ _,
135.370 + _ $ Free ("c_2", _) $ _]),
135.371 + (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss___", _)])]
135.372 + (* type of Find: [Free ("ss___", "bool List.list")]*)
135.373 + =>()
135.374 + | _ => raise error "calchead.sml match_ags copy-named dropped --------";
135.375 +
135.376 +
135.377 +val stac as Const ("Script.SubProblem",_) $
135.378 + (Const ("Pair",_) $
135.379 + Free (dI',_) $
135.380 + (Const ("Pair",_) $ pI' $ mI')) $ ags' =
135.381 + (*...copied from stac2tac_*)
135.382 + str2term
135.383 + "SubProblem (EqSystem_, [linear, system], [no_met])\
135.384 + \ [real_list_ [c, c_2]]";
135.385 +val ags = isalist2list ags';
135.386 +val pI = ["linear","system"];
135.387 +val pats = (#ppc o get_pbt) pI;
135.388 +case ((match_ags Isac.thy pats ags)
135.389 + handle TYPE _ => []) of
135.390 + [] => match_ags_msg pI stac ags
135.391 + | _ => raise error "calchead.sml match_ags 1st arg missing --------";
135.392 +
135.393 +(*
135.394 +use"../smltest/ME/calchead.sml";
135.395 +*)
135.396 +
135.397 +val stac as Const ("Script.SubProblem",_) $
135.398 + (Const ("Pair",_) $
135.399 + Free (dI',_) $
135.400 + (Const ("Pair",_) $ pI' $ mI')) $ ags' =
135.401 + (*...copied from stac2tac_*)
135.402 + str2term
135.403 + "SubProblem (Test_,[univariate,equation,test],\
135.404 + \ [no_met]) [bool_ (x+1=2), real_ x]";
135.405 +val ags = isalist2list ags';
135.406 +val pI = ["univariate","equation","test"];
135.407 +val pats = (#ppc o get_pbt) pI;
135.408 +case match_ags Isac.thy pats ags of
135.409 + [(1, [1], "#Given",
135.410 + Const ("Descript.equality", _),
135.411 + [Const ("op =", _) $ (Const ("op +", _) $ Free ("x", _) $ _) $ _]),
135.412 + (2, [1], "#Given", Const ("Descript.solveFor", _), [Free ("x", _)]),
135.413 + (3, [1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)])]
135.414 + (* type of Find: [Free ("x_i", "bool List.list")]*)
135.415 + => ()
135.416 + | _ => raise error "calchead.sml match_ags [univariate,equation,test]--";
136.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
136.2 +++ b/src/Pure/isac/smltest/ME/ctree.sml Wed Jul 21 13:53:39 2010 +0200
136.3 @@ -0,0 +1,1324 @@
136.4 +(* tests for sml/ME/ctree.sml
136.5 + authors: Walther Neuper 060113
136.6 + (c) due to copyright terms
136.7 +
136.8 +use"../smltest/ME/ctree.sml";
136.9 +use"ctree.sml";
136.10 +*)
136.11 +
136.12 +"-----------------------------------------------------------------";
136.13 +"table of contents -----------------------------------------------";
136.14 +"-----------------------------------------------------------------";
136.15 +"-----------------------------------------------------------------";
136.16 +"-------------- build miniscript stepwise BEFORE ALL TESTS -------";
136.17 +"-------------- get_allpos' (from ptree above)--------------------";
136.18 +(**#####################################################################(**)
136.19 +"-------------- cut_level (from ptree above)----------------------";
136.20 +"-------------- cut_tree (from ptree above)-----------------------";
136.21 +"=====new ptree 1a miniscript with mini-subpbl ===================";
136.22 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
136.23 +(**)#####################################################################**)
136.24 +"=====new ptree 2 miniscript with mini-subpbl ====================";
136.25 +"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
136.26 +"-------------- cappend (from ptree above)------------------------";
136.27 +"-------------- cappend minisubpbl -------------------------------";
136.28 +
136.29 +"=====new ptree 3 ================================================";
136.30 +"-------------- move_dn ------------------------------------------";
136.31 +"-------------- move_dn: Frm -> Res ------------------------------";
136.32 +"-------------- move_up ------------------------------------------";
136.33 +"------ move into detail -----------------------------------------";
136.34 +"=====new ptree 3a ===============================================";
136.35 +"-------------- move_dn in Incomplete ctree ----------------------";
136.36 +
136.37 +"=====new ptree 4: crooked by cut_level_'_ =======================";
136.38 +(*############## development stopped 0501 ########################*)
136.39 +(******************************************************************)
136.40 +(* val SAVE_get_trace = get_trace; *)
136.41 +(******************************************************************)
136.42 +"-------------- get_interval from ctree: incremental development--";
136.43 +(******************************************************************)
136.44 +(* val get_trace = SAVE_get_trace; *)
136.45 +(******************************************************************)
136.46 +(*############## development stopped 0501 ########################*)
136.47 +
136.48 +"=====new ptree 4 ratequation ====================================";
136.49 +"-------------- pt_extract form, tac, asm<>[] --------------------";
136.50 +"=====new ptree 5 minisubpbl =====================================";
136.51 +"-------------- pt_extract form, tac, asm ------------------------";
136.52 +
136.53 +(**#####################################################################(**)
136.54 +"=====new ptree 6 minisubpbl intersteps ==========================";
136.55 +"-------------- get_allpos' new ----------------------------------";
136.56 +"-------------- cut_tree new (from ptree above)-------------------";
136.57 +(**)#####################################################################**)
136.58 +
136.59 +"-----------------------------------------------------------------";
136.60 +"-----------------------------------------------------------------";
136.61 +"-----------------------------------------------------------------";
136.62 +
136.63 +
136.64 +"-------------- build miniscript stepwise BEFORE ALL TESTS -------";
136.65 +"-------------- build miniscript stepwise BEFORE ALL TESTS -------";
136.66 +"-------------- build miniscript stepwise BEFORE ALL TESTS -------";
136.67 +"this build should be detailed each time a test fails later \
136.68 +\i.e. all the tests should be caught here first \
136.69 +\and linked with a reference to the respective test environment";
136.70 +val fmz = ["equality (x+1=2)",
136.71 + "solveFor x","solutions L"];
136.72 +val (dI',pI',mI') =
136.73 + ("Test.thy",["sqroot-test","univariate","equation","test"],
136.74 + ["Test","squ-equ-test-subpbl1"]);
136.75 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
136.76 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.77 +(* nxt = Add_Given "equality (x + 1 = 2)"
136.78 + (writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
136.79 + *)
136.80 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.81 +(* (writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
136.82 + *)
136.83 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.84 +(* (writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
136.85 + *)
136.86 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.87 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.88 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.89 +"ctree.sml-------------- get_allpos' new ------------------------\"";
136.90 +val (PP, pp) = split_last [1];
136.91 +val ((pt', cuts), clevup) = cut_bottom (PP, pp) (get_nd pt PP);
136.92 +
136.93 +val cuts = get_allp [] ([], ([],Frm)) pt;
136.94 +val cuts2 = get_allps [] [1] (children pt);
136.95 +"ctree.sml-------------- cut_tree new (from ptree above)----------";
136.96 +val (pt', cuts) = cut_tree pt ([1],Frm);
136.97 +"ctree.sml-------------- cappend on complete ctree from above ----";
136.98 +val (pt', cuts) = cappend_form pt [1] e_istate (str2term "Inform[1]");
136.99 +"----------------------------------------------------------------/";
136.100 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[1]*);
136.101 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[1]*);
136.102 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[2]*);
136.103 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_problem: pos =[3]*);
136.104 +
136.105 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.106 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.107 +(*val nxt = ("Add_Given", Add_Given "equality (-1 + x = 0)").....*)
136.108 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.109 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.110 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.111 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.112 +(*val nxt = ("Apply_Method", Apply_Method ["Test", "solve_linear"])*)
136.113 +
136.114 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[3,1]*);
136.115 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,1]*);
136.116 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,2]*);
136.117 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[3]*);
136.118 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[4]*);
136.119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[]*);
136.120 +val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
136.121 +if (snd nxt)=End_Proof' andalso res="[x = 1]" then ()
136.122 +else raise error "new behaviour in test: miniscript with mini-subpbl";
136.123 +
136.124 + show_pt pt;
136.125 +
136.126 +
136.127 +"-------------- get_allpos' (from ptree above)--------------------";
136.128 +"-------------- get_allpos' (from ptree above)--------------------";
136.129 +"-------------- get_allpos' (from ptree above)--------------------";
136.130 +if get_allpos' ([], 1) pt =
136.131 + [([], Frm),
136.132 + ([1], Frm),
136.133 + ([1], Res),
136.134 + ([2], Res),
136.135 + ([3], Frm),
136.136 + ([3, 1], Frm),
136.137 + ([3, 1], Res),
136.138 + ([3, 2], Res),
136.139 + ([3], Res),
136.140 + ([4], Res),
136.141 + ([], Res)]
136.142 +then () else raise error "ctree.sml: diff:behav. in get_allpos' 1";
136.143 +
136.144 +if get_allpos's ([], 1) (children pt) =
136.145 + [([1], Frm),
136.146 + ([1], Res),
136.147 + ([2], Res),
136.148 + ([3], Frm),
136.149 + ([3, 1], Frm),
136.150 + ([3, 1], Res),
136.151 + ([3, 2], Res),
136.152 + ([3], Res),
136.153 + ([4], Res)]
136.154 +then () else raise error "ctree.sml: diff:behav. in get_allpos' 2";
136.155 +
136.156 +if get_allpos's ([], 2) (takerest (1, children pt)) =
136.157 + [([2], Res),
136.158 + ([3], Frm),
136.159 + ([3, 1], Frm),
136.160 + ([3, 1], Res),
136.161 + ([3, 2], Res),
136.162 + ([3], Res),
136.163 + ([4], Res)]
136.164 +then () else raise error "ctree.sml: diff:behav. in get_allpos' 3";
136.165 +
136.166 +if get_allpos's ([], 3) (takerest (2, children pt)) =
136.167 + [([3], Frm),
136.168 + ([3, 1], Frm),
136.169 + ([3, 1], Res),
136.170 + ([3, 2], Res),
136.171 + ([3], Res),
136.172 + ([4], Res)]
136.173 +then () else raise error "ctree.sml: diff:behav. in get_allpos' 4";
136.174 +
136.175 +if get_allpos's ([3], 1) (children (nth 3 (children pt))) =
136.176 + [([3, 1], Frm),
136.177 + ([3, 1], Res),
136.178 + ([3, 2], Res)]
136.179 +then () else raise error "ctree.sml: diff:behav. in get_allpos' 5";
136.180 +
136.181 +if get_allpos' ([3], 1) (nth 3 (children pt)) =
136.182 + [([3], Frm),
136.183 + ([3, 1], Frm),
136.184 + ([3, 1], Res),
136.185 + ([3, 2], Res),
136.186 + ([3], Res)]
136.187 +then () else raise error "ctree.sml: diff:behav. in get_allpos' 6";
136.188 +
136.189 +
136.190 +(**##############################################################(**)
136.191 +
136.192 +"-------------- cut_level (from ptree above)----------------------";
136.193 +"-------------- cut_level (from ptree above)----------------------";
136.194 +"-------------- cut_level (from ptree above)----------------------";
136.195 +show_pt pt;
136.196 +show_pt pt';
136.197 +print_depth 99; cuts; print_depth 3;
136.198 +
136.199 +(*if cuts = [([2], Res),
136.200 + ([3], Frm),
136.201 + ([3, 1], Frm),
136.202 + ([3, 1], Res),
136.203 + ([3, 2], Res),
136.204 + ([3], Res),
136.205 + ([4], Res)]
136.206 +then () else raise error "ctree.sml: diff:behav. in cut_level 1a";
136.207 +val (res,asm) = get_obj g_result pt' [2];
136.208 +if res = e_term andalso asm = [] then () else
136.209 +raise error "ctree.sml: diff:behav. in cut_level 1aa" WN050219*);
136.210 +if not (existpt [2] pt') then () else
136.211 +raise error "ctree.sml: diff:behav. in cut_level 1aa2" (*WN050220*);
136.212 +
136.213 +val (res,asm) = get_obj g_result pt' [];
136.214 +if term2str res = "[x = 1]" (*WN050219 e_term in cut_tree!!!*) then () else
136.215 +raise error "ctree.sml: diff:behav. in cut_level 1ab";
136.216 +if map fst (get_interval ([],Frm) ([],Res) 9999 pt') =
136.217 + [([], Frm),
136.218 + ([1], Frm),
136.219 + ([1], Res),
136.220 + ([2], Res),(*, e_term in cut_tree!!!*)
136.221 + ([], Res)] then () else
136.222 +raise error "ctree.sml: diff:behav. in cut_level 1b";
136.223 +
136.224 +
136.225 +val (pt',cuts) = cut_level [] [] pt ([2],Res);
136.226 +if cuts = [([3], Frm),
136.227 + ([3, 1], Frm),
136.228 + ([3, 1], Res),
136.229 + ([3, 2], Res),
136.230 + ([3], Res),
136.231 + ([4], Res)]
136.232 +then () else raise error "ctree.sml: diff:behav. in cut_level 2a";
136.233 +
136.234 +if pr_ptree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n"
136.235 +then () else raise error "ctree.sml: diff:behav. in cut_level 2b";
136.236 +
136.237 +val (pt',cuts) = cut_level [] [3] pt ([3,1],Frm);
136.238 +if cuts = [([3, 1], Res), ([3, 2], Res)]
136.239 +then () else raise error "ctree.sml: diff:behav. in cut_level 3a";
136.240 +if pr_ptree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n4. [x = 1]\n"
136.241 +then () else raise error "ctree.sml: diff:behav. in cut_level 3b";
136.242 +
136.243 +val (pt',cuts) = cut_level [] [3] pt ([3,1],Res);
136.244 +if cuts = [([3, 2], Res)]
136.245 +then () else raise error "ctree.sml: diff:behav. in cut_level 4a";
136.246 +if pr_ptree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n4. [x = 1]\n"
136.247 +then () else raise error "ctree.sml: diff:behav. in cut_level 4b";
136.248 +
136.249 +
136.250 +"-------------- cut_tree (from ptree above)-----------------------";
136.251 +"-------------- cut_tree (from ptree above)-----------------------";
136.252 +"-------------- cut_tree (from ptree above)-----------------------";
136.253 +val (pt', cuts) = cut_tree pt ([2],Frm);(*not created by move_dn -- not on WS*)
136.254 +if cuts = [([2], Res),
136.255 + ([3], Frm),
136.256 + ([3, 1], Frm),
136.257 + ([3, 1], Res),
136.258 + ([3, 2], Res),
136.259 + ([3], Res),
136.260 + ([4], Res),
136.261 + ([], Res)]
136.262 +then () else raise error "ctree.sml: diff:behav. in cut_tree 1a";
136.263 +
136.264 +val (res,asm) = get_obj g_result pt' [2];
136.265 +if res = e_term (*WN050219 done by cut_level*) then () else
136.266 +raise error "ctree.sml: diff:behav. in cut_tree 1aa";
136.267 +
136.268 +val form = get_obj g_form pt' [2];
136.269 +if term2str form = "x + 1 + -1 * 2 = 0" (*remained !!!*) then () else
136.270 +raise error "ctree.sml: diff:behav. in cut_tree 1ab";
136.271 +
136.272 +val (res,asm) = get_obj g_result pt' [];
136.273 +if res = e_term (*WN050219 done by cut_tree*) then () else
136.274 +raise error "ctree.sml: diff:behav. in cut_tree 1ac";
136.275 +
136.276 +if map fst (get_interval ([],Frm) ([],Res) 9999 pt') =
136.277 + [([], Frm),
136.278 + ([1], Frm),
136.279 + ([1], Res)] then () else
136.280 +raise error "ctree.sml: diff:behav. in cut_tree 1ad";
136.281 +
136.282 +val (pt', cuts) = cut_tree pt ([2],Res);
136.283 +if cuts = [([3], Frm),
136.284 + ([3, 1], Frm),
136.285 + ([3, 1], Res),
136.286 + ([3, 2], Res),
136.287 + ([3], Res),
136.288 + ([4], Res),
136.289 + ([], Res)]
136.290 +then () else raise error "ctree.sml: diff:behav. in cut_tree 2";
136.291 +
136.292 +val (pt', cuts) = cut_tree pt ([3,1],Frm);
136.293 +if cuts = [([3, 1], Res),
136.294 + ([3, 2], Res),
136.295 + ([3], Res),
136.296 + ([4], Res),
136.297 + ([], Res)]
136.298 +then () else raise error "ctree.sml: diff:behav. in cut_tree 3";
136.299 +
136.300 +val (pt', cuts) = cut_tree pt ([3,1],Res);
136.301 +if cuts = [([3, 2], Res),
136.302 + ([3], Res),
136.303 + ([4], Res),
136.304 + ([], Res)]
136.305 +then () else raise error "ctree.sml: diff:behav. in cut_tree 4";
136.306 +
136.307 +
136.308 +"=====new ptree 1a miniscript with mini-subpbl ===================";
136.309 +"=====new ptree 1a miniscript with mini-subpbl ===================";
136.310 +"=====new ptree 1a miniscript with mini-subpbl ===================";
136.311 +val fmz = ["equality (x+1=2)",
136.312 + "solveFor x","solutions L"];
136.313 +val (dI',pI',mI') =
136.314 + ("Test.thy",["sqroot-test","univariate","equation","test"],
136.315 + ["Test","squ-equ-test-subpbl1"]);
136.316 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
136.317 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.318 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.319 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.320 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.321 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.322 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.323 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.324 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.325 +show_pt pt;
136.326 +
136.327 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
136.328 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
136.329 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
136.330 +
136.331 +val (pt',cuts) = cut_level [] [3] pt ([1],Frm);(*([1],Frm) is stored*)
136.332 +if cuts = [](*([1],Res) is not yet stored (Nd.ostate=Incomplete)*)
136.333 +then () else raise error "ctree.sml: diff:behav. in cut_tree 4a";
136.334 +
136.335 +val (pt', cuts) = cut_tree pt ([1],Frm);
136.336 +if cuts = []
136.337 +then () else raise error "ctree.sml: diff:behav. in cut_tree 4a";
136.338 +
136.339 +(*WN050219
136.340 +val pos as ([p],_) = ([1],Frm);
136.341 +val pt as Nd (b,_) = pt;
136.342 +
136.343 +
136.344 +show_pt pt;
136.345 +show_pt pt';
136.346 +print_depth 99;cuts;print_depth 3;
136.347 +print_depth 99;map fst (get_interval ([],Frm) ([],Res) 9999 pt');print_depth 3;
136.348 +####################################################################*)*)
136.349 +
136.350 +"=====new ptree 2 miniscript with mini-subpbl ====================";
136.351 +"=====new ptree 2 miniscript with mini-subpbl ====================";
136.352 +"=====new ptree 2 miniscript with mini-subpbl ====================";
136.353 + states:=[];
136.354 + CalcTree
136.355 + [(["equality (x+1=2)", "solveFor x","solutions L"],
136.356 + ("Test.thy",
136.357 + ["sqroot-test","univariate","equation","test"],
136.358 + ["Test","squ-equ-test-subpbl1"]))];
136.359 + Iterator 1; moveActiveRoot 1;
136.360 + autoCalculate 1 CompleteCalc;
136.361 +
136.362 + interSteps 1 ([3,2],Res);
136.363 +
136.364 + val ((pt,_),_) = get_calc 1;
136.365 + show_pt pt;
136.366 +
136.367 +"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
136.368 +"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
136.369 +"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
136.370 +(*WN050225 intermed. outcommented
136.371 + val (pt', cuts) = cut_tree pt ([3,2,1],Frm);
136.372 + if cuts = [([3, 2, 1], Res),
136.373 + ([3, 2, 2], Res),
136.374 + ([3, 2], Res),
136.375 + ([3], Res),
136.376 + ([4], Res)]
136.377 + then () else raise error "ctree.sml: diff:behav. in cut_tree 3rd level 1";
136.378 +
136.379 + val (pt', cuts) = cut_tree pt ([3,2,1],Res);
136.380 + if cuts = [([3, 2, 2], Res),
136.381 + ([3, 2], Res),
136.382 + ([3], Res),
136.383 + ([4], Res)]
136.384 + then () else raise error "ctree.sml: diff:behav. in cut_tree 3rd level 2";
136.385 +
136.386 +
136.387 +"-------------- cappend (from ptree above)------------------------";
136.388 +"-------------- cappend (from ptree above)------------------------";
136.389 +"-------------- cappend (from ptree above)------------------------";
136.390 +val (pt',cuts) = cappend_form pt [3,2,1] e_istate (str2term "newnew");
136.391 +if cuts = [([3, 2, 1], Res),
136.392 + ([3, 2, 2], Res),
136.393 + ([3, 2], Res),
136.394 + ([3], Res),
136.395 + ([4], Res),
136.396 + ([], Res)]
136.397 +then () else raise error "ctree.sml: diff:behav. in cappend_form";
136.398 +if term2str (get_obj g_form pt' [3,2,1]) = "newnew" andalso
136.399 + get_obj g_tac pt' [3,2,1] = Empty_Tac andalso
136.400 + term2str (fst (get_obj g_result pt' [3,2,1])) = "??.empty"
136.401 + then () else raise error "ctree.sml: diff:behav. in cappend 1";
136.402 +
136.403 +val (pt',cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "newform")
136.404 + (Tac "test") (str2term "newresult",[]) Complete;
136.405 +if cuts = [([3, 2, 1], Res), (*?????????????*)
136.406 + ([3, 2, 2], Res),
136.407 + ([3, 2], Res),
136.408 + ([3], Res),
136.409 + ([4], Res),
136.410 + ([], Res)]
136.411 +then () else raise error "ctree.sml: diff:behav. in cappend_atomic";
136.412 +
136.413 +
136.414 +
136.415 +"-------------- cappend minisubpbl -------------------------------";
136.416 +"-------------- cappend minisubpbl -------------------------------";
136.417 +"-------------- cappend minisubpbl -------------------------------";
136.418 +"=====new ptree 1 miniscript with mini-subpbl ====================";
136.419 +val fmz = ["equality (x+1=2)",
136.420 + "solveFor x","solutions L"];
136.421 +val (dI',pI',mI') =
136.422 + ("Test.thy",["sqroot-test","univariate","equation","test"],
136.423 + ["Test","squ-equ-test-subpbl1"]);
136.424 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
136.425 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.426 +(* nxt = Add_Given "equality (x + 1 = 2)"
136.427 + (writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
136.428 + *)
136.429 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.430 +(* (writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
136.431 + *)
136.432 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.433 +(* (writeln o (itms2str thy)) (get_obj g_pbl pt (fst p));
136.434 + *)
136.435 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.436 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.437 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
136.438 +(*###cappend_form: pos =[1] ... while calculating nxt, which pt is dropped
136.439 +val nxt = ("Apply_Method", Apply_Method ["Test", "squ-equ-test-subpbl1"])*)
136.440 +
136.441 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[1]*);
136.442 +val p = ([1], Frm);
136.443 +val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "x + 1 = 2");
136.444 +val form = get_obj g_form pt (fst p);
136.445 +val (res,_) = get_obj g_result pt (fst p);
136.446 +if term2str form = "x + 1 = 2" andalso res = e_term then () else
136.447 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm)";
136.448 +if not (existpt ((lev_on o fst) p) pt) then () else
136.449 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm) nxt";
136.450 +
136.451 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[1]*);
136.452 +val p = ([1], Res);
136.453 +val (pt,cuts) =
136.454 + cappend_atomic pt (fst p) e_istate (str2term "x + 1 = 2")
136.455 + Empty_Tac (str2term "x + 1 + -1 * 2 = 0",[]) Incomplete;
136.456 +val form = get_obj g_form pt (fst p);
136.457 +val (res,_) = get_obj g_result pt (fst p);
136.458 +if term2str form = "x + 1 = 2" andalso term2str res = "x + 1 + -1 * 2 = 0"
136.459 +then () else raise error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res)";
136.460 +if not (existpt ((lev_on o fst) p) pt) then () else
136.461 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res) nxt";
136.462 +
136.463 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[2]*);
136.464 +val p = ([2], Res);
136.465 +val (pt,cuts) =
136.466 + cappend_atomic pt (fst p) e_istate (str2term "x + 1 + -1 * 2 = 0")
136.467 + Empty_Tac (str2term "-1 + x = 0",[]) Incomplete;
136.468 +val form = get_obj g_form pt (fst p);
136.469 +val (res,_) = get_obj g_result pt (fst p);
136.470 +if term2str form = "x + 1 + -1 * 2 = 0" andalso term2str res = "-1 + x = 0"
136.471 +then () else raise error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res)";
136.472 +if not (existpt ((lev_on o fst) p) pt) then () else
136.473 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res) nxt";
136.474 +
136.475 +
136.476 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_problem: pos =[3]*)
136.477 +val p = ([3], Pbl);
136.478 +val (pt,cuts) = cappend_problem pt (fst p) e_istate e_fmz ([],e_spec,e_term);
136.479 +if is_pblobj (get_obj I pt (fst p)) then () else
136.480 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl)";
136.481 +if not (existpt ((lev_on o fst) p) pt) then () else
136.482 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl) nxt";
136.483 +
136.484 +(* ...complete calchead skipped...*)
136.485 +
136.486 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
136.487 +val p = ([3, 1], Frm);
136.488 +val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "-1 + x = 0");
136.489 +val form = get_obj g_form pt (fst p);
136.490 +val (res,_) = get_obj g_result pt (fst p);
136.491 +if term2str form = "-1 + x = 0" andalso res = e_term then () else
136.492 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm)";
136.493 +if not (existpt ((lev_on o fst) p) pt) then () else
136.494 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm) nxt";
136.495 +
136.496 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_atomic: pos =[3,1]*)
136.497 +val p = ([3, 1], Res);
136.498 +val (pt,cuts) =
136.499 + cappend_atomic pt (fst p) e_istate (str2term "-1 + x = 0")
136.500 + Empty_Tac (str2term "x = 0 + -1 * -1",[]) Incomplete;
136.501 +val form = get_obj g_form pt (fst p);
136.502 +val (res,_) = get_obj g_result pt (fst p);
136.503 +if term2str form = "-1 + x = 0" andalso term2str res = "x = 0 + -1 * -1" then()
136.504 +else raise error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res)";
136.505 +if not (existpt ((lev_on o fst) p) pt) then () else
136.506 +raise error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res) nxt";
136.507 +
136.508 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
136.509 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,1]*);
136.510 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,2]*);
136.511 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[3]*);
136.512 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[4]*);
136.513 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[]*);
136.514 +
136.515 +WN050225 intermed. outcommented---*)
136.516 +
136.517 +"=====new ptree 3 ================================================";
136.518 +"=====new ptree 3 ================================================";
136.519 +"=====new ptree 3 ================================================";
136.520 + states:=[];
136.521 + CalcTree
136.522 + [(["equality (x+1=2)", "solveFor x","solutions L"],
136.523 + ("Test.thy",
136.524 + ["sqroot-test","univariate","equation","test"],
136.525 + ["Test","squ-equ-test-subpbl1"]))];
136.526 + Iterator 1; moveActiveRoot 1;
136.527 + autoCalculate 1 CompleteCalc;
136.528 +
136.529 + val ((pt,_),_) = get_calc 1;
136.530 + show_pt pt;
136.531 +
136.532 +"-------------- move_dn ------------------------------------------";
136.533 +"-------------- move_dn ------------------------------------------";
136.534 +"-------------- move_dn ------------------------------------------";
136.535 + val p = move_dn [] pt ([],Pbl) (*-> ([1],Frm)*);
136.536 + val p = move_dn [] pt p (*-> ([1],Res)*);
136.537 + val p = move_dn [] pt p (*-> ([2],Res)*);
136.538 + val p = move_dn [] pt p (*-> ([3],Pbl)*);
136.539 + val p = move_dn [] pt p (*-> ([3,1],Frm)*);
136.540 + val p = move_dn [] pt p (*-> ([3,1],Res)*);
136.541 + val p = move_dn [] pt p (*-> ([3,2],Res)*);
136.542 + val p = move_dn [] pt p (*-> ([3],Res)*);
136.543 +(* term2str (get_obj g_res pt [3]);
136.544 + term2str (get_obj g_form pt [4]);
136.545 + *)
136.546 + val p = move_dn [] pt p (*-> ([4],Res)*);
136.547 + val p = move_dn [] pt p (*-> ([],Res)*);
136.548 +(*
136.549 + val p = (move_dn [] pt p) handle e => print_exn_G e;
136.550 + Exception PTREE end of calculation*)
136.551 +if p=([],Res) then () else raise error "ctree.sml: diff:behav. in move_dn";
136.552 +
136.553 +
136.554 +"-------------- move_dn: Frm -> Res ------------------------------";
136.555 +"-------------- move_dn: Frm -> Res ------------------------------";
136.556 +"-------------- move_dn: Frm -> Res ------------------------------";
136.557 + states := [];
136.558 + CalcTree (*start of calculation, return No.1*)
136.559 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
136.560 + ("Test.thy",
136.561 + ["linear","univariate","equation","test"],
136.562 + ["Test","solve_linear"]))];
136.563 + Iterator 1; moveActiveRoot 1;
136.564 + autoCalculate 1 CompleteCalcHead;
136.565 + autoCalculate 1 (Step 1);
136.566 + refFormula 1 (get_pos 1 1);
136.567 +
136.568 + moveActiveRoot 1;
136.569 + moveActiveDown 1;
136.570 + if get_pos 1 1 = ([1], Frm) then ()
136.571 + else raise error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
136.572 + moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
136.573 +
136.574 + autoCalculate 1 (Step 1);
136.575 + refFormula 1 (get_pos 1 1);
136.576 +
136.577 + moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
136.578 + if get_pos 1 1 = ([1], Res) then ()
136.579 + else raise error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
136.580 + moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
136.581 +
136.582 +
136.583 +"-------------- move_up ------------------------------------------";
136.584 +"-------------- move_up ------------------------------------------";
136.585 +"-------------- move_up ------------------------------------------";
136.586 + val p = move_up [] pt ([],Res); (*-> ([4],Res)*)
136.587 + val p = move_up [] pt p; (*-> ([3],Res)*)
136.588 + val p = move_up [] pt p; (*-> ([3,2],Res)*)
136.589 + val p = move_up [] pt p; (*-> ([3,1],Res)*)
136.590 + val p = move_up [] pt p; (*-> ([3,1],Frm)*)
136.591 + val p = move_up [] pt p; (*-> ([3],Pbl)*)
136.592 + val p = move_up [] pt p; (*-> ([2],Res)*)
136.593 + val p = move_up [] pt p; (*-> ([1],Res)*)
136.594 + val p = move_up [] pt p; (*-> ([1],Frm)*)
136.595 + val p = move_up [] pt p; (*-> ([],Pbl)*)
136.596 +(*val p = (move_up [] pt p) handle e => print_exn_G e;
136.597 + Exception PTREE begin of calculation*)
136.598 +if p=([],Pbl) then () else raise error "ctree.sml: diff.behav. in move_up";
136.599 +
136.600 +
136.601 +"------ move into detail -----------------------------------------";
136.602 +"------ move into detail -----------------------------------------";
136.603 +"------ move into detail -----------------------------------------";
136.604 + states:=[];
136.605 + CalcTree
136.606 + [(["equality (x+1=2)", "solveFor x","solutions L"],
136.607 + ("Test.thy",
136.608 + ["sqroot-test","univariate","equation","test"],
136.609 + ["Test","squ-equ-test-subpbl1"]))];
136.610 + Iterator 1; moveActiveRoot 1;
136.611 + autoCalculate 1 CompleteCalc;
136.612 + moveActiveRoot 1;
136.613 + moveActiveDown 1;
136.614 + moveActiveDown 1;
136.615 + moveActiveDown 1;
136.616 + refFormula 1 (get_pos 1 1) (* 2 Res, <ISA> -1 + x = 0 </ISA> *);
136.617 +
136.618 + interSteps 1 ([2],Res);
136.619 +
136.620 + val ((pt,_),_) = get_calc 1; show_pt pt;
136.621 + val p = get_pos 1 1;
136.622 +
136.623 + val p = move_up [] pt p; (*([2, 6], Res)*);
136.624 + val p = movelevel_up [] pt p;(*([2], Frm)*);
136.625 + val p = move_dn [] pt p; (*([2, 1], Frm)*);
136.626 + val p = move_dn [] pt p; (*([2, 1], Res)*);
136.627 + val p = move_dn [] pt p; (*([2, 2], Res)*);
136.628 + val p = move_dn [] pt p; (*([2, 3], Res)*);
136.629 + val p = move_dn [] pt p; (*([2, 4], Res)*);
136.630 + val p = move_dn [] pt p; (*([2, 5], Res)*);
136.631 + val p = move_dn [] pt p; (*([2, 6], Res)*);
136.632 + if p = ([2, 6], Res) then()
136.633 + else raise error "ctree.sml: diff.behav. in move into detail";
136.634 +
136.635 +"=====new ptree 3a ===============================================";
136.636 +"=====new ptree 3a ===============================================";
136.637 +"=====new ptree 3a ===============================================";
136.638 + states:=[];
136.639 + CalcTree
136.640 + [(["equality (x+1=2)", "solveFor x","solutions L"],
136.641 + ("Test.thy",
136.642 + ["sqroot-test","univariate","equation","test"],
136.643 + ["Test","squ-equ-test-subpbl1"]))];
136.644 + Iterator 1; moveActiveRoot 1;
136.645 + autoCalculate 1 CompleteCalcHead;
136.646 + autoCalculate 1 (Step 1);
136.647 + autoCalculate 1 (Step 1);
136.648 + autoCalculate 1 (Step 1);
136.649 + val ((pt,_),_) = get_calc 1;
136.650 + val p = move_dn [] pt ([],Pbl) (*-> ([1], Frm)*);
136.651 + val p = move_dn [] pt ([1], Frm) (*-> ([1], Res)*);
136.652 + val p = move_dn [] pt ([1], Res) (*-> ([2], Res)*);
136.653 + (*val p = move_dn [] pt ([2], Res) ->Exception- PTREE "[] not complete"*);
136.654 +
136.655 + moveDown 1 ([],Pbl) (*-> ([1], Frm)*);
136.656 + moveDown 1 ([1],Frm) (*-> ([1],Res)*);
136.657 + moveDown 1 ([1],Res) (*-> ([2],Res)*);
136.658 + moveDown 1 ([2],Res) (*-> pos does not exist*);
136.659 +(*
136.660 + get_obj g_ostate pt [1];
136.661 + show_pt pt;
136.662 +*)
136.663 +
136.664 +"-------------- move_dn in Incomplete ctree ----------------------";
136.665 +"-------------- move_dn in Incomplete ctree ----------------------";
136.666 +"-------------- move_dn in Incomplete ctree ----------------------";
136.667 +
136.668 +
136.669 +
136.670 +"=====new ptree 4: crooked by cut_level_'_ =======================";
136.671 +"=====new ptree 4: crooked by cut_level_'_ =======================";
136.672 +"=====new ptree 4: crooked by cut_level_'_ =======================";
136.673 +states:=[];
136.674 +CalcTree
136.675 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
136.676 + "solveFor x","solutions L"],
136.677 + ("RatEq.thy",["univariate","equation"],["no_met"]))];
136.678 +Iterator 1; moveActiveRoot 1;
136.679 +autoCalculate 1 CompleteCalc;
136.680 +
136.681 +getTactic 1 ([1],Res);(*Rewrite_Set RatEq_simplify*)
136.682 +getTactic 1 ([2],Res);(*Rewrite_Set norm_Rational*)
136.683 +getTactic 1 ([3],Res);(*Rewrite_Set RatEq_eliminate*)
136.684 +getTactic 1 ([4,1],Res);(*Rewrite all_left*)
136.685 +getTactic 1 ([4,2],Res);(*Rewrite_Set expand_binoms*)
136.686 +getTactic 1 ([4,3],Res);(*Rewrite_Set_Inst make_ratpoly_in*)
136.687 +
136.688 +moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
136.689 +moveActiveFormula 1 ([2],Res)(**ME_Isa: 'expand' not known*);
136.690 +moveActiveFormula 1 ([3],Res)(*3.1.*);
136.691 +moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
136.692 +moveActiveFormula 1 ([4,3],Res)(**one_scr_arg: called by Script Stepwise t_=*);
136.693 +
136.694 +moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
136.695 +interSteps 1 ([1],Res)(*..is activeFormula !?!*);
136.696 +
136.697 +getTactic 1 ([1,1],Res);(*Rewrite real_diff_minus*)
136.698 +getTactic 1 ([1,2],Res);(*Rewrite real_diff_minus*)
136.699 +getTactic 1 ([1,3],Res);(*Rewrite real_diff_minus*)
136.700 +getTactic 1 ([1,4],Res);(*Rewrite real_rat_mult_1*)
136.701 +
136.702 +moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
136.703 +interSteps 1 ([4,2],Res)(*..is activeFormula !?!*);
136.704 +val ((pt,_),_) = get_calc 1;
136.705 +writeln(pr_ptree pr_short pt);
136.706 +(*delete [4,1] in order to make pos [4],[4,4] for pblobjs differen [4],[4,3]:
136.707 + ###########################################################################*)
136.708 +val (pt, ppp) = cut_level_'_ [] [] pt ([4,1],Frm);
136.709 +writeln(pr_ptree pr_short pt);
136.710 +
136.711 +
136.712 +"-------------- get_interval from ctree: incremental development--";
136.713 +"-------------- get_interval from ctree: incremental development--";
136.714 +"-------------- get_interval from ctree: incremental development--";
136.715 +"--- level 1: get pos from start b to end p ----------------------";
136.716 +"--- level 1: get pos from start b to end p ----------------------";
136.717 +"--- level 1: get pos from start b to end p ----------------------";
136.718 +(******************************************************************)
136.719 +(**) val SAVE_get_trace = get_trace; (**)
136.720 +(******************************************************************)
136.721 +(*'getnds' below is structured as such:*)
136.722 +fun www _ [x] = "l+r-margin"
136.723 + | www true [x1,x2] = "l-margin, r-margin"
136.724 + | www _ [x1,x2] = "intern, r-margin"
136.725 + | www true (x::(xs as _::_)) = "l-margin " ^ www false xs
136.726 + | www _ (x::(xs as _::_)) = "intern " ^ www false xs;
136.727 +www true [1,2,3,4,5];
136.728 +(*val it = "from intern intern intern to" : string*)
136.729 +www true [1,2];
136.730 +(*val it = "from to" : string*)
136.731 +www true [1];
136.732 +(*val it = "from+to" : string*)
136.733 +
136.734 +local
136.735 +(*specific values of hd of pos p,q for simple handling take_fromto,
136.736 + from-pos p, to-pos q: take_fromto (hdp p) (hdq q) (children pt) ...
136.737 + ... can be used even for positions _below_ p or q*)
136.738 +fun hdp [] = 1 | hdp [0] = 1 | hdp x = hd x;(*start with first*)
136.739 +fun hdq [] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
136.740 +(*analoguous for tl*)
136.741 +fun tlp [] = [0] | tlp [_] = [0] | tlp x = tl x;
136.742 +fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
136.743 +
136.744 +(*see modspec.sml#pt_form
136.745 +fun pt_form (PrfObj {form,...}) = term2str form
136.746 + | pt_form (PblObj {probl,spec,origin=(_,spec',_),...}) =
136.747 + let val (dI, pI, _) = get_somespec' spec spec'
136.748 + val {cas,...} = get_pbt pI
136.749 + in case cas of
136.750 + None => term2str (pblterm dI pI)
136.751 + | Some t => term2str (subst_atomic (mk_env probl) t)
136.752 + end;
136.753 +*)
136.754 +(*.get an 'interval' from ptree down to a certain level
136.755 + by 'take_fromto children' of the nodes with specific 'from' and 'to';
136.756 + 'i > 0' suppresses output during recursive descent towards 'from'
136.757 + b: the 'from' incremented to the actual pos
136.758 + p,q: specific 'from','to' for simple use of 'take_fromto'*)
136.759 +fun getnd i (b,p) q (Nd (po, nds)) =
136.760 + (if i <= 0 then [(*[(b, pt_form po)]*) (**)[b](**)] else [])
136.761 +
136.762 + @ (writeln("getnd : b="^(ints2str' b)^", p="^
136.763 + (ints2str' p)^", q="^(ints2str' q));
136.764 +
136.765 + getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
136.766 + (take_fromto (hdp p) (hdq q) nds))
136.767 +
136.768 +and getnds _ _ _ _ [] = [] (*no children*)
136.769 + | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
136.770 + | getnds i true (b,p) q [n1, n2] = (*l-margin, r-margin*)
136.771 + (writeln("getnds3: b="^ ints2str' b ^", p="^ ints2str' p ^
136.772 + ", q="^ ints2str' q);
136.773 + (getnd i ( b, p ) [99999] n1) @
136.774 + (getnd ~99999 (lev_on b,[0]) q n2))
136.775 + | getnds i _ (b,p) q [n1, n2] = (*intern, r-margin*)
136.776 + (writeln("getnds4: b="^ ints2str' b ^", p="^ ints2str' p ^
136.777 + ", q="^ ints2str' q);
136.778 + (getnd i ( b,[0]) [99999] n1) @
136.779 + (getnd ~99999 (lev_on b,[0]) q n2))
136.780 + | getnds i true (b,p) q (nd::(nds as _::_)) = (*l-margin, intern*)
136.781 + (writeln("getnds5: b="^ ints2str' b ^", p="^ ints2str' p ^
136.782 + ", q="^ ints2str' q);
136.783 + (getnd i ( b, p ) [99999] nd) @
136.784 + (getnds ~99999 false (lev_on b,[0]) q nds))
136.785 + | getnds i _ (b,p) q (nd::(nds as _::_)) = (*intern, ...*)
136.786 + (getnd i ( b,[0]) [99999] nd) @
136.787 + (getnds ~99999 false (lev_on b,[0]) q nds);
136.788 +in
136.789 +(*get an 'interval from to' from a ptree as 'intervals f t' of respective nodes
136.790 + where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
136.791 +(1) the 'f' are given
136.792 +(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
136.793 +(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
136.794 +(2) the 't' ar given
136.795 +(2a) by 'to' if 't' = the respective element of 'to' (right margin)
136.796 +(2b) inifinity, if 't' < the respective element of 'to (internal node)'
136.797 +the 'f' and 't' are set by hdp,... *)
136.798 +fun get_trace pt p q =
136.799 + (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q)))
136.800 + (take_fromto (hdp p) (hdq q) (children pt));
136.801 +end;
136.802 +
136.803 +writeln(pr_ptree pr_short pt);
136.804 +case get_trace pt [1,3] [4,1,1] of
136.805 + [[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1]] => ()
136.806 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1a";
136.807 +case get_trace pt [2] [4,3,2] of
136.808 + [[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1],[4,3,2]] => ()
136.809 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1b";
136.810 +case get_trace pt [1,4] [4,3,1] of
136.811 + [[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1]] => ()
136.812 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1c";
136.813 +case get_trace pt [4,2] [5] of
136.814 + (*[([4,2],_),([4,3],_),([4,4],_),([4,4,1],_),([4,4,2],_),([4,4,3],_),
136.815 + ([4,4,4],_),([4,4,5],_),([5],_)] => () ..with pt_form*)
136.816 + [[4,2],[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]]=>()
136.817 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1d";
136.818 +case get_trace pt [] [4,4,2] of
136.819 + [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
136.820 + [4,3],[4,3,1],[4,3,2]] => ()
136.821 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1e";
136.822 +case get_trace pt [] [] of
136.823 + [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
136.824 + [4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]] => ()
136.825 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1f";
136.826 +case get_trace pt [4,3] [4,3] of
136.827 + [[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5]] => ()
136.828 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1g";
136.829 +
136.830 +"--- level 2: get pos' from start b to end p ---------------------";
136.831 +"--- level 2: get pos' from start b to end p ---------------------";
136.832 +"--- level 2: get pos' from start b to end p ---------------------";
136.833 +(*idea: pos_ is _ONLY_ relevant exactly at (endpoint of) from, to
136.834 + development stopped in favour of move_dn, see get_interval
136.835 + actually used (inefficient) version with move_dn: see modspec.sml
136.836 +*)
136.837 +(*
136.838 +case get_trace pt ([1,4],Res) ([4,4,1],Frm) of
136.839 + [[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],[4,4],[4,4,1]] => ()
136.840 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1b";
136.841 +case get_trace pt ([],Pbl) ([],Res) of
136.842 + [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],
136.843 + [4,4],[4,4,1],[4,4,2],[4,4,3],[4,4,4],[4,4,5],[5]] => ()
136.844 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1e";
136.845 +*)
136.846 +
136.847 +(******************************************************************)
136.848 +(**) val get_trace = SAVE_get_trace; (**)
136.849 +(******************************************************************)
136.850 +
136.851 +
136.852 +"=====new ptree 4 ratequation ====================================";
136.853 +"=====new ptree 4 ratequation ====================================";
136.854 +"=====new ptree 4 ratequation ====================================";
136.855 +states:=[];
136.856 +CalcTree
136.857 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
136.858 + "solveFor x","solutions L"],
136.859 + ("RatEq.thy",["univariate","equation"],["no_met"]))];
136.860 +Iterator 1; moveActiveRoot 1;
136.861 +autoCalculate 1 CompleteCalc;
136.862 +val ((pt,_),_) = get_calc 1;
136.863 +show_pt pt;
136.864 +
136.865 +
136.866 +"-------------- pt_extract form, tac, asm<>[] --------------------";
136.867 +"-------------- pt_extract form, tac, asm<>[] --------------------";
136.868 +"-------------- pt_extract form, tac, asm<>[] --------------------";
136.869 +val (Form form, Some tac, asm) = pt_extract (pt, ([3], Res));
136.870 +case (term2str form, tac, terms2strs asm) of
136.871 + ("(3 + -1 * x + x ^^^ 2) * x = 1 * (9 * x + -6 * x ^^^ 2 + x ^^^ 3)",
136.872 + Subproblem
136.873 + ("PolyEq.thy",
136.874 + ["normalize", "polynomial", "univariate", "equation"]),
136.875 + ["9 * x + -6 * x ^^^ 2 + x ^^^ 3 ~= 0"]) => ()
136.876 + | _ => raise error "diff.behav.in ctree.sml: pt_extract asm<>[]";
136.877 +(*WN060717 unintentionally changed some rls/ord while
136.878 + completing knowl. for thes2file...
136.879 +
136.880 + case (term2str form, tac, terms2strs asm) of
136.881 + ((*"(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))",
136.882 + *)Subproblem
136.883 + ("PolyEq.thy",
136.884 + ["normalize", "polynomial", "univariate", "equation"]),
136.885 + ["9 * x + (x ^^^ 3 + -6 * x ^^^ 2) ~= 0"]) => ()
136.886 + | _ => raise error "diff.behav.in ctree.sml: pt_extract asm<>[]";
136.887 +
136.888 +.... but it became even better*)
136.889 +
136.890 +
136.891 +
136.892 +"=====new ptree 5 minisubpbl =====================================";
136.893 +"=====new ptree 5 minisubpbl =====================================";
136.894 +"=====new ptree 5 minisubpbl =====================================";
136.895 +states:=[];
136.896 +CalcTree
136.897 + [(["equality (x+1=2)", "solveFor x","solutions L"],
136.898 + ("Test.thy",
136.899 + ["sqroot-test","univariate","equation","test"],
136.900 + ["Test","squ-equ-test-subpbl1"]))];
136.901 +Iterator 1; moveActiveRoot 1;
136.902 +autoCalculate 1 CompleteCalc;
136.903 +val ((pt,_),_) = get_calc 1;
136.904 +show_pt pt;
136.905 +
136.906 +"-------------- pt_extract form, tac, asm ------------------------";
136.907 +"-------------- pt_extract form, tac, asm ------------------------";
136.908 +"-------------- pt_extract form, tac, asm ------------------------";
136.909 +val (ModSpec (_,_,form,_,_,_), Some tac, asm) = pt_extract (pt, ([], Frm));
136.910 +case (term2str form, tac, terms2strs asm) of
136.911 + ("solve (x + 1 = 2, x)",
136.912 + Apply_Method ["Test", "squ-equ-test-subpbl1"],
136.913 + []) => ()
136.914 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([], Pbl)";
136.915 +
136.916 +val (Form form, Some tac, asm) = pt_extract (pt, ([1], Frm));
136.917 +case (term2str form, tac, terms2strs asm) of
136.918 + ("x + 1 = 2", Rewrite_Set "norm_equation", []) => ()
136.919 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([1], Frm)";
136.920 +
136.921 +val (Form form, Some tac, asm) = pt_extract (pt, ([1], Res));
136.922 +case (term2str form, tac, terms2strs asm) of
136.923 + ("x + 1 + -1 * 2 = 0", Rewrite_Set "Test_simplify", []) => ()
136.924 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([1], Res)";
136.925 +
136.926 +val (Form form, Some tac, asm) = pt_extract (pt, ([2], Res));
136.927 +case (term2str form, tac, terms2strs asm) of
136.928 + ("-1 + x = 0",
136.929 + Subproblem ("Test.thy", ["linear", "univariate", "equation", "test"]),
136.930 + []) => ()
136.931 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([2], Res)";
136.932 +
136.933 +val (ModSpec (_,_,form,_,_,_), Some tac, asm) = pt_extract (pt, ([3], Pbl));
136.934 +case (term2str form, tac, terms2strs asm) of
136.935 + ("solve (-1 + x = 0, x)", Apply_Method ["Test", "solve_linear"], []) => ()
136.936 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([3], Pbl)";
136.937 +
136.938 +val (Form form, Some tac, asm) = pt_extract (pt, ([3,1], Frm));
136.939 +case (term2str form, tac, terms2strs asm) of
136.940 + ("-1 + x = 0", Rewrite_Set_Inst (["(bdv, x)"], "isolate_bdv"), []) => ()
136.941 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([3,1], Frm)";
136.942 +
136.943 +val (Form form, Some tac, asm) = pt_extract (pt, ([3,1], Res));
136.944 +case (term2str form, tac, terms2strs asm) of
136.945 + ("x = 0 + -1 * -1", Rewrite_Set "Test_simplify", []) => ()
136.946 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([3,1], Res)";
136.947 +
136.948 +val (Form form, Some tac, asm) = pt_extract (pt, ([3,2], Res));
136.949 +case (term2str form, tac, terms2strs asm) of
136.950 + ("x = 1", Check_Postcond ["linear", "univariate", "equation", "test"],
136.951 + []) => ()
136.952 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([3,2], Res)";
136.953 +
136.954 +val (Form form, Some tac, asm) = pt_extract (pt, ([3], Res));
136.955 +case (term2str form, tac, terms2strs asm) of
136.956 + ("[x = 1]", Check_elementwise "Assumptions", []) => ()
136.957 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([3], Res)";
136.958 +
136.959 +val (Form form, Some tac, asm) = pt_extract (pt, ([4], Res));
136.960 +case (term2str form, tac, terms2strs asm) of
136.961 + ("[x = 1]",
136.962 + Check_Postcond ["sqroot-test", "univariate", "equation", "test"],
136.963 + []) => ()
136.964 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([4], Res)";
136.965 +
136.966 +val (Form form, tac, asm) = pt_extract (pt, ([], Res));
136.967 +case (term2str form, tac, terms2strs asm) of
136.968 + ("[x = 1]", None, []) => ()
136.969 + | _ => raise error "diff.behav.in ctree.sml: pt_extract ([], Res)";
136.970 +
136.971 +"=====new ptree 6 minisubpbl intersteps ==========================";
136.972 +"=====new ptree 6 minisubpbl intersteps ==========================";
136.973 +"=====new ptree 6 minisubpbl intersteps ==========================";
136.974 +states:=[];
136.975 +CalcTree
136.976 + [(["equality (x+1=2)", "solveFor x","solutions L"],
136.977 + ("Test.thy",
136.978 + ["sqroot-test","univariate","equation","test"],
136.979 + ["Test","squ-equ-test-subpbl1"]))];
136.980 +Iterator 1; moveActiveRoot 1;
136.981 +autoCalculate 1 CompleteCalc;
136.982 +interSteps 1 ([2],Res);
136.983 +interSteps 1 ([3,2],Res);
136.984 +val ((pt,_),_) = get_calc 1;
136.985 +show_pt pt;
136.986 +
136.987 +(**##############################################################**)
136.988 +"-------------- get_allpos' new ----------------------------------";
136.989 +"-------------- get_allpos' new ----------------------------------";
136.990 +"-------------- get_allpos' new ----------------------------------";
136.991 +"--- whole ctree";
136.992 +print_depth 99;
136.993 +val cuts = get_allp [] ([], ([],Frm)) pt;
136.994 +print_depth 3;
136.995 +if cuts =
136.996 + [(*never returns the first pos'*)
136.997 + ([1], Frm),
136.998 + ([1], Res),
136.999 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
136.1000 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1001 + ([2], Res),
136.1002 + ([3], Pbl),
136.1003 + ([3, 1], Frm), ([3, 1], Res),
136.1004 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1005 + ([3, 2], Res),
136.1006 + ([3], Res),
136.1007 + ([4], Res),
136.1008 + ([], Res)] then () else
136.1009 +raise error "ctree.sml diff.behav. get_allp new []";
136.1010 +
136.1011 +print_depth 99;
136.1012 +val cuts2 = get_allps [] [1] (children pt);
136.1013 +print_depth 3;
136.1014 +if cuts = cuts2 @ [([], Res)] then () else
136.1015 +raise error "ctree.sml diff.behav. get_allps new []";
136.1016 +
136.1017 +"---(3) on S(606)..S(608)--------";
136.1018 +"--- nd [2] with 6 children---------------------------------";
136.1019 +val cuts = get_allp [] ([2], ([],Frm)) (get_nd pt [2]);
136.1020 +if cuts =
136.1021 + [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
136.1022 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1023 + ([2], Res)] then () else
136.1024 +raise error "ctree.sml diff.behav. get_allp new [2]";
136.1025 +
136.1026 +val cuts2 = get_allps [] [2,1] (children (get_nd pt [2]));
136.1027 +if cuts = cuts2 @ [([2], Res)] then () else
136.1028 +raise error "ctree.sml diff.behav. get_allps new [2]";
136.1029 +
136.1030 +
136.1031 +"---(4) on S(606)..S(608)--------";
136.1032 +"--- nd [3] subproblem--------------------------------------";
136.1033 +val cuts = get_allp [] ([3], ([],Frm)) (get_nd pt [3]);
136.1034 +if cuts =
136.1035 + [([3, 1], Frm),
136.1036 + ([3, 1], Res),
136.1037 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1038 + ([3, 2], Res),
136.1039 + ([3], Res)] then () else
136.1040 +raise error "ctree.sml diff.behav. get_allp new [3]";
136.1041 +
136.1042 +val cuts2 = get_allps [] [3,1] (children (get_nd pt [3]));
136.1043 +if cuts = cuts2 @ [([3], Res)] then () else
136.1044 +raise error "ctree.sml diff.behav. get_allps new [3]";
136.1045 +
136.1046 +"--- nd [3,2] with 2 children--------------------------------";
136.1047 +val cuts = get_allp [] ([3,2], ([],Frm)) (get_nd pt [3,2]);
136.1048 +if cuts =
136.1049 + [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1050 + ([3, 2], Res)] then () else
136.1051 +raise error "ctree.sml diff.behav. get_allp new [3,2]";
136.1052 +
136.1053 +val cuts2 = get_allps [] [3,2,1] (children (get_nd pt [3,2]));
136.1054 +if cuts = cuts2 @ [([3, 2], Res)] then () else
136.1055 +raise error "ctree.sml diff.behav. get_allps new [3,2]";
136.1056 +
136.1057 +"---(5a) on S(606)..S(608)--------";
136.1058 +"--- nd [3,2,1] with 0 children------------------------------";
136.1059 +val cuts = get_allp [] ([3,2,1], ([],Frm)) (get_nd pt [3,2,1]);
136.1060 +if cuts =
136.1061 + [] then () else
136.1062 +raise error "ctree.sml diff.behav. get_allp new [3,2,1]";
136.1063 +
136.1064 +val cuts2 = get_allps [] [3,2,1,1] (children (get_nd pt [3,2,1]));
136.1065 +if cuts = cuts2 @ [] then () else
136.1066 +raise error "ctree.sml diff.behav. get_allps new [3,2,1]";
136.1067 +
136.1068 +
136.1069 +(**#################################################################**)
136.1070 +"-------------- cut_tree new (from ptree above)-------------------";
136.1071 +"-------------- cut_tree new (from ptree above)-------------------";
136.1072 +"-------------- cut_tree new (from ptree above)-------------------";
136.1073 +show_pt pt;
136.1074 +val b = get_obj g_branch pt [];
136.1075 +if b = TransitiveB then () else
136.1076 +raise error ("ctree.sml diff.behav. in [] branch="^branch2str b);
136.1077 +val b = get_obj g_branch pt [3];
136.1078 +if b = TransitiveB then () else
136.1079 +raise error ("ctree.sml diff.behav. in [3] branch="^branch2str b);
136.1080 +
136.1081 +"---(2) on S(606)..S(608)--------";
136.1082 +val (pt', cuts) = cut_tree pt ([1],Res);
136.1083 +print_depth 99;
136.1084 +cuts;
136.1085 +print_depth 3;
136.1086 +if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
136.1087 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
136.1088 + ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
136.1089 + ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
136.1090 +(*WN060727 after replacing cutlevup by test_trans:*)([], Res)] then () else
136.1091 +raise error "ctree.sml: diff.behav. cut_tree ([1],Res)";
136.1092 +
136.1093 +
136.1094 +"---(3) on S(606)..S(608)--------";
136.1095 +val (pt', cuts) = cut_tree pt ([2],Res);
136.1096 +print_depth 99;
136.1097 +cuts;
136.1098 +print_depth 3;
136.1099 +if cuts = [(*preceding step on WS was ([1]),Res*)
136.1100 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
136.1101 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1102 + ([2], Res),
136.1103 + ([3], Pbl),
136.1104 + ([3, 1], Frm),
136.1105 + ([3, 1], Res),
136.1106 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1107 + ([3, 2], Res),
136.1108 + ([3], Res),
136.1109 + ([4], Res),
136.1110 +(*WN060727 added after replacing cutlevup by test_trans:*)([],Res)] then ()
136.1111 +else raise error "ctree.sml: diff.behav. cut_tree ([2],Res)";
136.1112 +
136.1113 +"---(4) on S(606)..S(608)--------";
136.1114 +val (pt', cuts) = cut_tree pt ([3],Pbl);
136.1115 +print_depth 99;
136.1116 +cuts;
136.1117 +print_depth 3;
136.1118 +if cuts = [([3], Pbl),
136.1119 + ([3, 1], Frm), ([3, 1], Res),
136.1120 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1121 + ([3, 2], Res),
136.1122 + ([3], Res),
136.1123 + ([4], Res),
136.1124 +(*WN060727 added after replacing cutlevup by test_trans:*)([], Res)]
136.1125 +then () else raise error "ctree.sml: diff.behav. cut_tree ([3],Pbl)";
136.1126 +
136.1127 +"---(5a) on S(606)..S(608) cut_tree --------";
136.1128 +val (pt', cuts) = cut_tree pt ([3,2,1],Res);
136.1129 +print_depth 99;
136.1130 +cuts;
136.1131 +print_depth 1;
136.1132 +if cuts = [([3, 2, 2], Res), ([3, 2], Res),
136.1133 +(*WN060727 added after replacing cutlevup by test_trans:*)
136.1134 +([3], Res), ([4], Res),([],Res)] then ()
136.1135 +else raise error "ctree.sml: diff.behav. cut_tree ([3,2,1],Res)";
136.1136 +show_pt pt';
136.1137 +
136.1138 +
136.1139 +"-------------- cappend on complete ctree from above -------------";
136.1140 +"-------------- cappend on complete ctree from above -------------";
136.1141 +"-------------- cappend on complete ctree from above -------------";
136.1142 +show_pt pt;
136.1143 +
136.1144 +"---(2) on S(606)..S(608)--------";
136.1145 +val (pt', cuts) = cappend_atomic pt [1] e_istate (str2term "Inform[1]")
136.1146 + (Tac "test") (str2term "Inres[1]",[]) Complete;
136.1147 +print_depth 99;
136.1148 +cuts;
136.1149 +print_depth 3;
136.1150 +if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
136.1151 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
136.1152 + ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
136.1153 + ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
136.1154 +(*WN060727 added after replacing cutlevup by test_trans:*) ([], Res)] then ()
136.1155 +else raise error "ctree.sml: diff:behav. in complete pt:append_atomic[1] cuts";
136.1156 +val afterins = get_allp [] ([], ([],Frm)) pt';
136.1157 +print_depth 99;
136.1158 +afterins;
136.1159 +print_depth 3;
136.1160 +if afterins = [([1], Frm), ([1], Res)
136.1161 +(*, WN060727 removed after replacing cutlevup by test_trans:([], Res)*)] then()
136.1162 +else raise error "ctree.sml: diff:behav. in complete pt: append_atomic[1] afterins";
136.1163 +show_pt pt';
136.1164 +
136.1165 +"---(3) on S(606)..S(608)--------";
136.1166 +show_pt pt;
136.1167 +val (pt', cuts) = cappend_atomic pt [2] e_istate (str2term "Inform[2]")
136.1168 + (Tac "test") (str2term "Inres[2]",[]) Complete;
136.1169 +print_depth 99;
136.1170 +cuts;
136.1171 +print_depth 3;
136.1172 +if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
136.1173 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
136.1174 + ([3, 1], Frm),([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
136.1175 + ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
136.1176 +(*WN060727 added after replacing cutlevup by test_trans:*) ([], Res)] then ()
136.1177 +else raise error "ctree.sml: diff:behav.in complete pt: append_atomic[2] cuts";
136.1178 +val afterins = get_allp [] ([], ([],Frm)) pt';
136.1179 +print_depth 99;
136.1180 +afterins;
136.1181 +print_depth 3;
136.1182 +if afterins = [([1], Frm), ([1], Res), ([2], Frm), ([2], Res)
136.1183 +(*, WN060727 removed after replacing cutlevup by test_trans:([], Res)*)]
136.1184 +then () else
136.1185 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[2] afterins";
136.1186 +show_pt pt';
136.1187 +(*
136.1188 + val p = move_dn [] pt' ([],Pbl) (*-> ([1],Frm)*);
136.1189 + val p = move_dn [] pt' p (*-> ([1],Res)*);
136.1190 + val p = move_dn [] pt' p (*-> ([2],Frm)*);
136.1191 + val p = move_dn [] pt' p (*-> ([2],Res)*);
136.1192 +
136.1193 + term2str (get_obj g_form pt' [2]);
136.1194 + term2str (get_obj g_res pt' [2]);
136.1195 + ostate2str (get_obj g_ostate pt' [2]);
136.1196 + *)
136.1197 +
136.1198 +"---(4) on S(606)..S(608)--------";
136.1199 +val (pt', cuts) = cappend_problem pt [3] e_istate ([],e_spec)
136.1200 + ([],e_spec, str2term "Inhead[3]");
136.1201 +print_depth 99;
136.1202 +cuts;
136.1203 +print_depth 3;
136.1204 +if cuts = [([3], Pbl),
136.1205 + ([3, 1], Frm), ([3, 1], Res),
136.1206 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1207 + ([3, 2], Res),
136.1208 + ([3], Res), ([4], Res),
136.1209 +(*WN060727 added after replacing cutlevup by test_trans*)([], Res)] then ()else
136.1210 +raise error "ctree.sml: diff:behav. in ccomplete pt: append_problem[3] cuts";
136.1211 +val afterins = get_allp [] ([], ([],Frm)) pt';
136.1212 +print_depth 99;
136.1213 +afterins;
136.1214 +print_depth 3;
136.1215 +if afterins =
136.1216 + [([1], Frm), ([1], Res),([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
136.1217 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res),
136.1218 + ([3], Pbl)] then () else
136.1219 +raise error "ctree.sml: diff:behav.in complete pt: append_problem[3] afterins";
136.1220 +(* use"systest/ctree.sml";
136.1221 + use"ctree.sml";
136.1222 + *)
136.1223 +
136.1224 +"---(6-1) on S(606)..S(608)--------";
136.1225 +val (pt', cuts) = cappend_atomic pt [3,1] e_istate (str2term "Inform[3,1]")
136.1226 + (Tac "test") (str2term "Inres[3,1]",[]) Complete;
136.1227 +print_depth 99;
136.1228 +cuts;
136.1229 +print_depth 3;
136.1230 +if cuts = [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
136.1231 + ([3, 2], Res),
136.1232 +(*WN060727 added*)([3], Res), ([4], Res), ([], Res)] then () else
136.1233 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] cuts";
136.1234 +val afterins = get_allp [] ([], ([],Frm)) pt';
136.1235 +print_depth 99;
136.1236 +afterins;
136.1237 +print_depth 3;
136.1238 +(*WN060727 replaced after overwriting cutlevup by test_trans
136.1239 +if afterins = [([1], Frm), ([1], Res),
136.1240 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
136.1241 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1242 + ([2], Res),
136.1243 + ([3], Pbl),
136.1244 + ([3, 1], Frm), ([3, 1], Res)(*replaced*), (*([3, 2], Res) cut!*)
136.1245 + ([3], Res)(*cutlevup=false*),
136.1246 + ([4], Res),
136.1247 + ([], Res)(*cutlevup=false*)] then () else
136.1248 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] insrtd";
136.1249 +*)
136.1250 +if afterins = [([1], Frm), ([1], Res),
136.1251 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
136.1252 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1253 + ([2], Res),
136.1254 + ([3], Pbl),
136.1255 + ([3, 1], Frm), ([3, 1], Res)] then () else
136.1256 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] insrtd";
136.1257 +
136.1258 +if term2str (get_obj g_form pt' [3,1]) = "Inform [3, 1]" then () else
136.1259 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] Inform";
136.1260 +
136.1261 +"---(6) on S(606)..S(608)--------";
136.1262 +val (pt', cuts) = cappend_atomic pt [3,2] e_istate (str2term "Inform[3,2]")
136.1263 + (Tac "test") (str2term "Inres[3,2]",[]) Complete;
136.1264 +print_depth 99;
136.1265 +cuts;
136.1266 +print_depth 3;
136.1267 +if cuts = [(*just after is: cutlevup=false in [3]*)
136.1268 +(*WN060727 after test_trans instead cutlevup added:*)
136.1269 + ([3], Res), ([4], Res), ([], Res)] then () else
136.1270 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] cuts";
136.1271 +val afterins = get_allp [] ([], ([],Frm)) pt';
136.1272 +print_depth 99;
136.1273 +afterins;
136.1274 +print_depth 3;
136.1275 +(*WN060727 replaced after overwriting cutlevup by test_trans
136.1276 +if afterins = [([1], Frm), ([1], Res),
136.1277 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
136.1278 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1279 + ([2], Res),
136.1280 + ([3], Pbl),
136.1281 + ([3, 1], Frm), ([3, 1], Res), ([3, 2], Frm), ([3, 2], Res),
136.1282 + ([3], Res),
136.1283 + ([4], Res), ([], Res)] then () else
136.1284 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] insrtd";
136.1285 +*)
136.1286 +if afterins = [([1], Frm), ([1], Res),
136.1287 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
136.1288 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1289 + ([2], Res),
136.1290 + ([3], Pbl),
136.1291 + ([3, 1], Frm), ([3, 1], Res), ([3, 2], Frm), ([3, 2], Res)]
136.1292 +then () else
136.1293 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] insrtd";
136.1294 +
136.1295 +if term2str (get_obj g_form pt' [3,2]) = "Inform [3, 2]" then () else
136.1296 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] Inform";
136.1297 +
136.1298 +"---(6++) on S(606)..S(608)--------";
136.1299 +(**)
136.1300 +val (pt', cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "Inform[3,2,1]")
136.1301 + (Tac "test") (str2term "Inres[3,2,1]",[]) Complete;
136.1302 +print_depth 99;
136.1303 +cuts;
136.1304 +print_depth 1;
136.1305 +if cuts = [([3, 2, 2], Res), ([3, 2], Res),
136.1306 +(*WN060727 {cutlevup->test_trans} added:*)([3], Res), ([4], Res), ([], Res)]
136.1307 +then () else
136.1308 +raise error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2,1] cuts";
136.1309 +val afterins = get_allp [] ([], ([],Frm)) pt';
136.1310 +print_depth 99;
136.1311 +afterins;
136.1312 +print_depth 3;
136.1313 +if afterins = [([1], Frm), ([1], Res),
136.1314 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
136.1315 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
136.1316 + ([2], Res),
136.1317 + ([3], Pbl),
136.1318 + ([3, 1], Frm), ([3, 1], Res),
136.1319 + ([3, 2, 1], Frm), ([3, 2, 1], Res)] then () else
136.1320 +raise error "ctree.sml: diff:behav. in complete pt: append_atom[3,2,1] insrtd";
136.1321 +if term2str (get_obj g_form pt' [3,2,1]) = "Inform [3, 2, 1]" then () else
136.1322 +raise error "ctree.sml: diff:behav. complete pt: append_atomic[3,2,1] Inform";
136.1323 +(*
136.1324 +show_pt pt';
136.1325 +show_pt pt;
136.1326 +*)
136.1327 +
137.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
137.2 +++ b/src/Pure/isac/smltest/ME/inform.sml Wed Jul 21 13:53:39 2010 +0200
137.3 @@ -0,0 +1,772 @@
137.4 +(* tests on inform.sml
137.5 + author: Walther Neuper
137.6 + 060225,
137.7 + (c) due to copyright terms
137.8 +
137.9 +use"../smltest/ME/inform.sml";
137.10 +use"inform.sml";
137.11 +*)
137.12 +
137.13 +"-----------------------------------------------------------------";
137.14 +"table of contents -----------------------------------------------";
137.15 +"-----------------------------------------------------------------";
137.16 +"appendForm with miniscript with mini-subpbl:";
137.17 +"--------- appendFormula: on Res + equ_nrls ----------------------";
137.18 +"--------- appendFormula: on Frm + equ_nrls ----------------------";
137.19 +"--------- appendFormula: on Res + NO deriv ----------------------";
137.20 +"--------- appendFormula: on Res + late deriv --------------------";
137.21 +"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
137.22 +"replaceForm with miniscript with mini-subpbl:";
137.23 +"--------- replaceFormula: on Res + = ----------------------------";
137.24 +"--------- replaceFormula: on Res + = 1st Nd ---------------------";
137.25 +"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
137.26 +"--------- replaceFormula: cut calculation -----------------------";
137.27 +"--------- replaceFormula: cut calculation -----------------------";
137.28 +(* 040307 copied from informtest.sml ... old versions
137.29 +"--------- maximum-example, UC: Modeling / modifyCalcHead --------";*)
137.30 +"--------- syntax error ------------------------------------------";
137.31 +"CAS-command:";
137.32 +"--------- CAS-command on ([],Pbl) -------------------------------";
137.33 +"--------- CAS-command on ([],Pbl) FE-interface ------------------";
137.34 +"--------- inform [rational,simplification] ----------------------";
137.35 +"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
137.36 +"--------- Take as 1st tac, start from exp -----------------------";
137.37 +"--------- init_form, start with <NEW> (CAS input) ---------------";
137.38 +"-----------------------------------------------------------------";
137.39 +"-----------------------------------------------------------------";
137.40 +"-----------------------------------------------------------------";
137.41 +
137.42 +
137.43 +
137.44 +
137.45 +
137.46 +
137.47 +"--------- appendFormula: on Res + equ_nrls ----------------------";
137.48 +"--------- appendFormula: on Res + equ_nrls ----------------------";
137.49 +"--------- appendFormula: on Res + equ_nrls ----------------------";
137.50 + val Script sc = (#scr o get_met) ["Test","squ-equ-test-subpbl1"];
137.51 + (writeln o term2str) sc;
137.52 + val Script sc = (#scr o get_met) ["Test","solve_linear"];
137.53 + (writeln o term2str) sc;
137.54 +
137.55 + states:=[];
137.56 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.57 + ("Test.thy",
137.58 + ["sqroot-test","univariate","equation","test"],
137.59 + ["Test","squ-equ-test-subpbl1"]))];
137.60 + Iterator 1; moveActiveRoot 1;
137.61 + autoCalculate 1 CompleteCalcHead;
137.62 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.63 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.64 +
137.65 + appendFormula 1 "-2 * 1 + (1 + x) = 0"; refFormula 1 (get_pos 1 1);
137.66 + val ((pt,_),_) = get_calc 1;
137.67 + val str = pr_ptree pr_short pt;
137.68 + writeln str;
137.69 + if str = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n2.1. x + 1 + -1 * 2 = 0\n2.2. -1 * 2 + (x + 1) = 0\n2.3. -1 * 2 + (1 + x) = 0\n2.4. 1 + (-1 * 2 + x) = 0\n2.5. 1 + (-2 + x) = 0\n2.6. 1 + (-2 * 1 + x) = 0\n" then ()
137.70 + else raise error "inform.sml: diff.behav.appendFormula: on Res + equ 1";
137.71 +
137.72 + moveDown 1 ([ ],Pbl); refFormula 1 ([1],Frm); (*x + 1 = 2*)
137.73 + moveDown 1 ([1],Frm); refFormula 1 ([1],Res); (*x + 1 + -1 * 2 = 0*)
137.74 +
137.75 + (*the seven steps of detailed derivation*)
137.76 + moveDown 1 ([1 ],Res); refFormula 1 ([2,1],Frm);
137.77 + moveDown 1 ([2,1],Frm); refFormula 1 ([2,1],Res);
137.78 + moveDown 1 ([2,1],Res); refFormula 1 ([2,2],Res);
137.79 + moveDown 1 ([2,2],Res); refFormula 1 ([2,3],Res);
137.80 + moveDown 1 ([2,3],Res); refFormula 1 ([2,4],Res);
137.81 + moveDown 1 ([2,4],Res); refFormula 1 ([2,5],Res);
137.82 + moveDown 1 ([2,5],Res); refFormula 1 ([2,6],Res);
137.83 + val ((pt,_),_) = get_calc 1;
137.84 + if "-2 * 1 + (1 + x) = 0" = term2str (fst (get_obj g_result pt [2,6])) then()
137.85 + else raise error "inform.sml: diff.behav.appendFormula: on Res + equ 2";
137.86 +
137.87 + fetchProposedTactic 1; (*takes Iterator 1 _1_*)
137.88 + val (_,(tac,_,_)::_) = get_calc 1;
137.89 + if tac = Rewrite_Set "Test_simplify" then ()
137.90 + else raise error "inform.sml: diff.behav.appendFormula: on Res + equ 3";
137.91 + autoCalculate 1 CompleteCalc;
137.92 + val ((pt,_),_) = get_calc 1;
137.93 + if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
137.94 + else raise error "inform.sml: diff.behav.appendFormula: on Res + equ 4";
137.95 + (* autoCalculate 1 CompleteCalc;
137.96 + val ((pt,p),_) = get_calc 1;
137.97 + (writeln o istates2str) (get_obj g_loc pt [ ]);
137.98 + (writeln o istates2str) (get_obj g_loc pt [1]);
137.99 + (writeln o istates2str) (get_obj g_loc pt [2]);
137.100 + (writeln o istates2str) (get_obj g_loc pt [3]);
137.101 + (writeln o istates2str) (get_obj g_loc pt [3,1]);
137.102 + (writeln o istates2str) (get_obj g_loc pt [3,2]);
137.103 + (writeln o istates2str) (get_obj g_loc pt [4]);
137.104 +
137.105 + *)
137.106 +"----------------------------------------------------------";
137.107 + val fod = make_deriv Isac.thy Atools_erls
137.108 + ((#rules o rep_rls) Test_simplify)
137.109 + (sqrt_right false ProtoPure.thy) None
137.110 + (str2term "x + 1 + -1 * 2 = 0");
137.111 + (writeln o trtas2str) fod;
137.112 +
137.113 + val ifod = make_deriv Isac.thy Atools_erls
137.114 + ((#rules o rep_rls) Test_simplify)
137.115 + (sqrt_right false ProtoPure.thy) None
137.116 + (str2term "-2 * 1 + (1 + x) = 0");
137.117 + (writeln o trtas2str) ifod;
137.118 + fun equal (_,_,(t1, _)) (_,_,(t2, _)) = t1=t2;
137.119 + val (fod', rifod') = dropwhile' equal (rev fod) (rev ifod);
137.120 + val der = fod' @ (map rev_deriv' rifod');
137.121 + (writeln o trtas2str) der;
137.122 + "----------------------------------------------------------";
137.123 +
137.124 +
137.125 +"--------- appendFormula: on Frm + equ_nrls ----------------------";
137.126 +"--------- appendFormula: on Frm + equ_nrls ----------------------";
137.127 +"--------- appendFormula: on Frm + equ_nrls ----------------------";
137.128 + states:=[];
137.129 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.130 + ("Test.thy",
137.131 + ["sqroot-test","univariate","equation","test"],
137.132 + ["Test","squ-equ-test-subpbl1"]))];
137.133 + Iterator 1; moveActiveRoot 1;
137.134 + autoCalculate 1 CompleteCalcHead;
137.135 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x + 1 = 2*);
137.136 +
137.137 + appendFormula 1 "2+ -1 + x = 2"; refFormula 1 (get_pos 1 1);
137.138 +
137.139 + moveDown 1 ([],Pbl); refFormula 1 ([1],Frm) (*x + 1 = 2*);
137.140 +
137.141 + moveDown 1 ([1 ],Frm); refFormula 1 ([1,1],Frm);
137.142 + moveDown 1 ([1,1],Frm); refFormula 1 ([1,1],Res);
137.143 + moveDown 1 ([1,1],Res); refFormula 1 ([1,2],Res);
137.144 + moveDown 1 ([1,2],Res); refFormula 1 ([1,3],Res);
137.145 + moveDown 1 ([1,3],Res); refFormula 1 ([1,4],Res);
137.146 + moveDown 1 ([1,4],Res); refFormula 1 ([1,5],Res);
137.147 + moveDown 1 ([1,5],Res); refFormula 1 ([1,6],Res);
137.148 + val ((pt,_),_) = get_calc 1;
137.149 + if "2 + -1 + x = 2" = term2str (fst (get_obj g_result pt [1,6])) then()
137.150 + else raise error "inform.sml: diff.behav.appendFormula: on Frm + equ 1";
137.151 +
137.152 + fetchProposedTactic 1; (*takes Iterator 1 _1_*)
137.153 + val (_,(tac,_,_)::_) = get_calc 1;
137.154 + if tac = Rewrite_Set "norm_equation" then ()
137.155 + else raise error "inform.sml: diff.behav.appendFormula: on Frm + equ 2";
137.156 + autoCalculate 1 CompleteCalc;
137.157 + val ((pt,_),_) = get_calc 1;
137.158 + if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
137.159 + else raise error "inform.sml: diff.behav.appendFormula: on Frm + equ 3";
137.160 +
137.161 +
137.162 +"--------- appendFormula: on Res + NO deriv ----------------------";
137.163 +"--------- appendFormula: on Res + NO deriv ----------------------";
137.164 +"--------- appendFormula: on Res + NO deriv ----------------------";
137.165 + states:=[];
137.166 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.167 + ("Test.thy",
137.168 + ["sqroot-test","univariate","equation","test"],
137.169 + ["Test","squ-equ-test-subpbl1"]))];
137.170 + Iterator 1; moveActiveRoot 1;
137.171 + autoCalculate 1 CompleteCalcHead;
137.172 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.173 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.174 +
137.175 + appendFormula 1 "x = 2";
137.176 + val ((pt,p),_) = get_calc 1;
137.177 + val str = pr_ptree pr_short pt;
137.178 + writeln str;
137.179 + if str = ". ----- pblobj -----\n1. x + 1 = 2\n" andalso p = ([1], Res)
137.180 + then ()
137.181 + else raise error "inform.sml: diff.behav.appendFormula: Res + NOder 1";
137.182 +
137.183 + fetchProposedTactic 1;
137.184 + val (_,(tac,_,_)::_) = get_calc 1;
137.185 + if tac = Rewrite_Set "Test_simplify" then ()
137.186 + else raise error "inform.sml: diff.behav.appendFormula: Res + NOder 2";
137.187 + autoCalculate 1 CompleteCalc;
137.188 + val ((pt,_),_) = get_calc 1;
137.189 + if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
137.190 + else raise error "inform.sml: diff.behav.appendFormula: on Frm + equ 3";
137.191 +
137.192 +
137.193 +"--------- appendFormula: on Res + late deriv --------------------";
137.194 +"--------- appendFormula: on Res + late deriv --------------------";
137.195 +"--------- appendFormula: on Res + late deriv --------------------";
137.196 + states:=[];
137.197 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.198 + ("Test.thy",
137.199 + ["sqroot-test","univariate","equation","test"],
137.200 + ["Test","squ-equ-test-subpbl1"]))];
137.201 + Iterator 1; moveActiveRoot 1;
137.202 + autoCalculate 1 CompleteCalcHead;
137.203 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.204 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.205 +
137.206 + appendFormula 1 "x = 1";
137.207 + val ((pt,p),_) = get_calc 1;
137.208 + val str = pr_ptree pr_short pt;
137.209 + writeln str;
137.210 + if str = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n3.2. x = 0 + -1 * -1\n3.2.1. x = 0 + -1 * -1\n3.2.2. x = 0 + 1\n" andalso p = ([3,2], Res)
137.211 + then () (*finds 1 step too early: ([3,2], Res) "x = 1" also by script !!!*)
137.212 + else raise error "inform.sml: diff.behav.appendFormula: Res + late d 1";
137.213 +
137.214 + fetchProposedTactic 1;
137.215 + val (_,(tac,_,_)::_) = get_calc 1;
137.216 + if tac = Check_Postcond ["linear", "univariate", "equation", "test"] then ()
137.217 + else raise error "inform.sml: diff.behav.appendFormula: Res + late d 2";
137.218 + autoCalculate 1 CompleteCalc;
137.219 + val ((pt,_),_) = get_calc 1;
137.220 + if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
137.221 + else raise error "inform.sml: diff.behav.appendFormula: Res + late d 3";
137.222 +
137.223 +
137.224 +"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
137.225 +"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
137.226 +"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
137.227 + states:=[];
137.228 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.229 + ("Test.thy",
137.230 + ["sqroot-test","univariate","equation","test"],
137.231 + ["Test","squ-equ-test-subpbl1"]))];
137.232 + Iterator 1; moveActiveRoot 1;
137.233 + autoCalculate 1 CompleteCalcHead;
137.234 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.235 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.236 + appendFormula 1 "[x = 3 + -2*1]";
137.237 + val ((pt,p),_) = get_calc 1;
137.238 + val str = pr_ptree pr_short pt;
137.239 + writeln str;
137.240 + if str=". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n3.2. x = 0 + -1 * -1\n4. [x = 1]\n4.1. [x = 1]\n4.2. [x = -2 + 3]\n4.3. [x = 3 + -2]\n" then ()
137.241 + else raise error "inform.sml: diff.behav.appendFormula: Res + latEE 1";
137.242 + autoCalculate 1 CompleteCalc;
137.243 + val ((pt,p),_) = get_calc 1;
137.244 + if "[x = 3 + -2 * 1]" = term2str (fst (get_obj g_result pt [])) then ()
137.245 + (* ~~~~~~~~~~ simplify as last step in any script ?!*)
137.246 + else raise error "inform.sml: diff.behav.appendFormula: Res + latEE 2";
137.247 +
137.248 +
137.249 +
137.250 +"--------- replaceFormula: on Res + = ----------------------------";
137.251 +"--------- replaceFormula: on Res + = ----------------------------";
137.252 +"--------- replaceFormula: on Res + = ----------------------------";
137.253 + states:=[];
137.254 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.255 + ("Test.thy",
137.256 + ["sqroot-test","univariate","equation","test"],
137.257 + ["Test","squ-equ-test-subpbl1"]))];
137.258 + Iterator 1; moveActiveRoot 1;
137.259 + autoCalculate 1 CompleteCalcHead;
137.260 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.261 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.262 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*-1 + x*);
137.263 +
137.264 + replaceFormula 1 "-2 * 1 + (1 + x) = 0"; refFormula 1 (get_pos 1 1);
137.265 + val ((pt,_),_) = get_calc 1;
137.266 + val str = pr_ptree pr_short pt;
137.267 + writeln str;
137.268 + if str=". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n2.1. x + 1 + -1 * 2 = 0\n2.2. -1 * 2 + (x + 1) = 0\n2.3. -1 * 2 + (1 + x) = 0\n2.4. 1 + (-1 * 2 + x) = 0\n2.5. 1 + (-2 + x) = 0\n2.6. 1 + (-2 * 1 + x) = 0\n" then()
137.269 + else raise error "inform.sml: diff.behav.replaceFormula: on Res += 1";
137.270 + autoCalculate 1 CompleteCalc;
137.271 + val ((pt,pos as(p,_)),_) = get_calc 1;
137.272 + if pos=([],Res)andalso"[x = 1]"=(term2str o fst)(get_obj g_result pt p)then()
137.273 + else raise error "inform.sml: diff.behav.replaceFormula: on Res + = 2";
137.274 +
137.275 +
137.276 +"--------- replaceFormula: on Res + = 1st Nd ---------------------";
137.277 +"--------- replaceFormula: on Res + = 1st Nd ---------------------";
137.278 +"--------- replaceFormula: on Res + = 1st Nd ---------------------";
137.279 + states:=[];
137.280 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.281 + ("Test.thy",
137.282 + ["sqroot-test","univariate","equation","test"],
137.283 + ["Test","squ-equ-test-subpbl1"]))];
137.284 + Iterator 1; moveActiveRoot 1;
137.285 + autoCalculate 1 CompleteCalcHead;
137.286 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.287 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.288 +
137.289 + replaceFormula 1 "x + 1 = 4 + -2"; refFormula 1 (get_pos 1 1);
137.290 + val ((pt,_),_) = get_calc 1;
137.291 + val str = pr_ptree pr_short pt;
137.292 + writeln str;
137.293 + if str=". ----- pblobj -----\n1. x + 1 = 2\n1.1. x + 1 = 2\n1.2. 1 + x = 2\n1.3. 1 + x = -2 + 4\n1.4. x + 1 = -2 + 4\n" then ()
137.294 + else raise error "inform.sml: diff.behav.replaceFormula: on Res 1 + = 1";
137.295 + autoCalculate 1 CompleteCalc;
137.296 + val ((pt,pos as(p,_)),_) = get_calc 1;
137.297 + if pos=([],Res)andalso"[x = 1]"=(term2str o fst)(get_obj g_result pt p)then()
137.298 + else raise error "inform.sml: diff.behav.replaceFormula: on Res + = 2";
137.299 +
137.300 +
137.301 +"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
137.302 +"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
137.303 +"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
137.304 + states:=[];
137.305 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.306 + ("Test.thy",
137.307 + ["sqroot-test","univariate","equation","test"],
137.308 + ["Test","squ-equ-test-subpbl1"]))];
137.309 + Iterator 1; moveActiveRoot 1;
137.310 + autoCalculate 1 CompleteCalcHead;
137.311 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.312 +
137.313 + replaceFormula 1 "x + 1 = 4 + -2"; refFormula 1 (get_pos 1 1);
137.314 + val ((pt,_),_) = get_calc 1;
137.315 + val str = pr_ptree pr_short pt;
137.316 + writeln str;
137.317 + if str=". ----- pblobj -----\n1. x + 1 = 2\n1.1. x + 1 = 2\n1.2. 1 + x = 2\n1.3. 1 + x = -2 + 4\n1.4. x + 1 = -2 + 4\n" then ()
137.318 + else raise error "inform.sml: diff.behav.replaceFormula: on Frm 1 + = 1";
137.319 + autoCalculate 1 CompleteCalc;
137.320 + val ((pt,pos as(p,_)),_) = get_calc 1;
137.321 + if pos=([],Res)andalso"[x = 1]"=(term2str o fst)(get_obj g_result pt p)then()
137.322 + else raise error "inform.sml: diff.behav.replaceFormula: on Frm 1 + = 2";
137.323 +
137.324 +
137.325 +"--------- replaceFormula: cut calculation -----------------------";
137.326 +"--------- replaceFormula: cut calculation -----------------------";
137.327 +"--------- replaceFormula: cut calculation -----------------------";
137.328 + states:=[];
137.329 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.330 + ("Test.thy",
137.331 + ["sqroot-test","univariate","equation","test"],
137.332 + ["Test","squ-equ-test-subpbl1"]))];
137.333 + Iterator 1; moveActiveRoot 1;
137.334 + autoCalculate 1 CompleteCalc;
137.335 + moveActiveRoot 1; moveActiveDown 1;
137.336 + if get_pos 1 1 = ([1], Frm) then ()
137.337 + else raise error "inform.sml: diff.behav. cut calculation 1";
137.338 +
137.339 + replaceFormula 1 "x + 1 = 4 + -2"; refFormula 1 (get_pos 1 1);
137.340 + val ((pt,p),_) = get_calc 1;
137.341 + val str = pr_ptree pr_short pt;
137.342 + writeln str;
137.343 + if p = ([1], Res) then ()
137.344 + else raise error "inform.sml: diff.behav. cut calculation 2";
137.345 +
137.346 +
137.347 +
137.348 +(* 040307 copied from informtest.sml; ... old version
137.349 + "---------------- maximum-example, UC: Modeling / modifyCalcHead -";
137.350 + "---------------- maximum-example, UC: Modeling / modifyCalcHead -";
137.351 + "---------------- maximum-example, UC: Modeling / modifyCalcHead -";
137.352 +
137.353 + val p = ([],Pbl);
137.354 + val elems = ["fixedValues [r=Arbfix]","maximum A","valuesFor [a,b]",
137.355 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
137.356 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
137.357 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
137.358 + (*^^^ these are the elements for the root-problem (in variants)*)
137.359 + (*vvv these are elements required for subproblems*)
137.360 + "boundVariable a","boundVariable b","boundVariable alpha",
137.361 + "interval {x::real. 0 <= x & x <= 2*r}",
137.362 + "interval {x::real. 0 <= x & x <= 2*r}",
137.363 + "interval {x::real. 0 <= x & x <= pi}",
137.364 + "errorBound (eps=(0::real))"]
137.365 + (*specifying is not interesting for this example*)
137.366 + val spec = ("DiffApp.thy", ["maximum_of","function"],
137.367 + ["DiffApp","max_by_calculus"]);
137.368 + (*the empty model with descriptions for user-guidance by Model_Problem*)
137.369 + val empty_model = [Given ["fixedValues []"],
137.370 + Find ["maximum", "valuesFor"],
137.371 + Relate ["relations []"]];
137.372 +
137.373 +
137.374 + (*!!!!!!!!!!!!!!!!! DON'T USE me FOR FINDING nxt !!!!!!!!!!!!!!!!!!*)
137.375 + val (p,_,f,nxt,_,pt) = CalcTreeTEST [(elems, spec)];
137.376 + (*val nxt = ("Model_Problem", ...*)
137.377 + val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str thy)) pbl;
137.378 +
137.379 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
137.380 + (*nxt = Add_Given "fixedValues [r = Arbfix]"*)
137.381 + val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str thy)) pbl;
137.382 +(*[
137.383 +(0 ,[] ,false ,#Given ,Inc fixedValues [] ,(??.empty, [])),
137.384 +(0 ,[] ,false ,#Find ,Inc maximum ,(??.empty, [])),
137.385 +(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),
137.386 +(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, []))]*)
137.387 +
137.388 + (*the empty CalcHead is checked w.r.t the model and re-established as such*)
137.389 + val (b,pt,ocalhd) = input_icalhd pt (p,"", empty_model, Pbl, e_spec);
137.390 + val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str thy)) pbl;
137.391 + if ocalhd2str ocalhd = "(Pbl, ??.empty, [\n(0 ,[] ,false ,#Given ,Inc fixedValues [] ,(??.empty, [])),\n(0 ,[] ,false ,#Find ,Inc maximum ,(??.empty, [])),\n(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),\n(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, []))], [], \n(\"e_domID\", [\"e_pblID\"], [\"e_metID\"]) )" then () else raise error "informtest.sml: diff.behav. max 1";
137.392 +
137.393 + (*there is one input to the model (could be more)*)
137.394 + val (b,pt,ocalhd) =
137.395 + input_icalhd pt (p,"", [Given ["fixedValues [r=Arbfix]"],
137.396 + Find ["maximum", "valuesFor"],
137.397 + Relate ["relations"]], Pbl, e_spec);
137.398 + val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str thy)) pbl;
137.399 + if ocalhd2str ocalhd = "(Pbl, ??.empty, [\n(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),\n(0 ,[] ,false ,#Find ,Inc maximum ,(??.empty, [])),\n(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),\n(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, []))], [], \n(\"e_domID\", [\"e_pblID\"], [\"e_metID\"]) )" then ()
137.400 + else raise error "informtest.sml: diff.behav. max 2";
137.401 +
137.402 + (*this input is complete in variant 3, but the ME doesn't recognize FIXXXXME
137.403 + val (b,pt''''',ocalhd) =
137.404 + input_icalhd pt (p,"", [Given ["fixedValues [r=Arbfix]"],
137.405 + Find ["maximum A", "valuesFor [a,b]"],
137.406 + Relate ["relations [A=a*b, a/2=r*sin alpha, \
137.407 + \b/2=r*cos alpha]"]], Pbl, e_spec);
137.408 + val pbl = get_obj g_pbl pt''''' (fst p); (writeln o (itms2str thy)) pbl;
137.409 + if ocalhd2str ocalhd = ------------^^^^^^^^^^ missing !!!*)
137.410 +
137.411 + (*this input is complete in variant 1 (variant 3 does not work yet)*)
137.412 + val (b,pt''''',ocalhd) =
137.413 + input_icalhd pt (p,"", [Given ["fixedValues [r=Arbfix]"],
137.414 + Find ["maximum A", "valuesFor [a,b]"],
137.415 + Relate ["relations [A=a*b, \
137.416 + \(a/2)^^^2 + (b/2)^^^2 = r^^^2]"]],
137.417 + Pbl, e_spec);
137.418 + val pbl = get_obj g_pbl pt''''' (fst p); (writeln o (itms2str thy)) pbl;
137.419 +
137.420 + modifycalcheadOK2xml 111 (bool2str b) ocalhd;
137.421 +*)
137.422 +
137.423 +"--------- syntax error ------------------------------------------";
137.424 +"--------- syntax error ------------------------------------------";
137.425 +"--------- syntax error ------------------------------------------";
137.426 + states:=[];
137.427 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
137.428 + ("Test.thy",
137.429 + ["sqroot-test","univariate","equation","test"],
137.430 + ["Test","squ-equ-test-subpbl1"]))];
137.431 + Iterator 1; moveActiveRoot 1;
137.432 + autoCalculate 1 CompleteCalcHead;
137.433 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
137.434 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
137.435 +
137.436 + appendFormula 1 " x - "; (*<ERROR> syntax error in ' x - ' </ERROR>*)
137.437 + val ((pt,_),_) = get_calc 1;
137.438 + val str = pr_ptree pr_short pt;
137.439 + writeln str;
137.440 + if str = ". ----- pblobj -----\n1. x + 1 = 2\n" then ()
137.441 + else raise error "inform.sml: diff.behav.appendFormula: syntax error";
137.442 +
137.443 +
137.444 +"--------- CAS-command on ([],Pbl) -------------------------------";
137.445 +"--------- CAS-command on ([],Pbl) -------------------------------";
137.446 +"--------- CAS-command on ([],Pbl) -------------------------------";
137.447 +val (p,_,f,nxt,_,pt) =
137.448 + CalcTreeTEST [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
137.449 +val ifo = "solve(x+1=2,x)";
137.450 +val (_,(_,c,(pt,p))) = inform ([],[],(pt,p)) "solve(x+1=2,x)";
137.451 +show_pt pt;
137.452 +val nxt = ("Apply_Method",Apply_Method ["Test","squ-equ-test-subpbl1"]);
137.453 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
137.454 +if p = ([1], Frm) andalso f2str f = "x + 1 = 2" then ()
137.455 +else raise error "inform.sml: diff.behav. CAScmd ([],Pbl)";
137.456 +
137.457 +
137.458 +"--------- CAS-command on ([],Pbl) FE-interface ------------------";
137.459 +"--------- CAS-command on ([],Pbl) FE-interface ------------------";
137.460 +"--------- CAS-command on ([],Pbl) FE-interface ------------------";
137.461 +states:=[];
137.462 +CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
137.463 +Iterator 1;
137.464 +moveActiveRoot 1;
137.465 +replaceFormula 1 "solve(x+1=2,x)";
137.466 +autoCalculate 1 CompleteCalc;
137.467 +val ((pt,p),_) = get_calc 1;
137.468 +show_pt pt;
137.469 +if p = ([], Res) then ()
137.470 +else raise error "inform.sml: diff.behav. CAScmd ([],Pbl) FE-interface";
137.471 +
137.472 +
137.473 +"--------- inform [rational,simplification] ----------------------";
137.474 +"--------- inform [rational,simplification] ----------------------";
137.475 +"--------- inform [rational,simplification] ----------------------";
137.476 +states:=[];
137.477 +CalcTree [(["term (4/x - 3/y - 1)", "normalform N"],
137.478 + ("Rational.thy",["rational","simplification"],
137.479 + ["simplification","of_rationals"]))];
137.480 +Iterator 1; moveActiveRoot 1;
137.481 +autoCalculate 1 CompleteCalcHead;
137.482 +autoCalculate 1 (Step 1);
137.483 +autoCalculate 1 (Step 1);
137.484 +autoCalculate 1 (Step 1);
137.485 +autoCalculate 1 (Step 1);
137.486 +"--- input the next formula that _should_ be presented by mat-engine";
137.487 +appendFormula 1 "(4 * y + -3 * x) / (x * y) + -1";
137.488 +val ((pt,p),_) = get_calc 1;
137.489 +if p = ([4], Res) andalso (length o children o (get_nd pt)) (fst p) = 2 then ()
137.490 +else raise error ("inform.sml: [rational,simplification] 1");
137.491 +
137.492 +"--- input the next formula that would be presented by mat-engine";
137.493 +(*autoCalculate 1 (Step 1);*)
137.494 +appendFormula 1 "(4 * y + -3 * x + -1 * (x * y)) / (x * y)";
137.495 +val ((pt,p),_) = get_calc 1;
137.496 +if p = ([5], Res) andalso (length o children o (get_nd pt)) (fst p) = 0 then ()
137.497 +else raise error ("inform.sml: [rational,simplification] 2");
137.498 +
137.499 +"--- input the exact final result";(*TODO: Exception- LIST "last_elem" raised*)
137.500 +appendFormula 1 "(-3 * x + 4 * y + -1 * x * y) / (x * y)";
137.501 +val ((pt,p),_) = get_calc 1;
137.502 +if p = ([6], Res) andalso (length o children o (get_nd pt)) (fst p) = 2 then ()
137.503 +else raise error ("inform.sml: [rational,simplification] 3");
137.504 +show_pt pt;
137.505 +
137.506 +"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
137.507 +"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
137.508 +"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
137.509 +val t = str2term "Diff (x^^^2 + x + 1, x)";
137.510 +case t of Const ("Diff.Diff", _) $ _ => ()
137.511 + | _ => raise
137.512 + error "diff.sml behav.changed for CAS Diff (..., x)";
137.513 +atomty t;
137.514 +"-----------------------------------------------------------------";
137.515 +(*1>*)states:=[];
137.516 +(*2>*)CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
137.517 +(*3>*)Iterator 1;moveActiveRoot 1;
137.518 +"----- here the Headline has been finished";
137.519 +(*4>*)moveActiveFormula 1 ([],Pbl);
137.520 +(*5>*)replaceFormula 1 "Diff (x^2 + x + 1, x)";
137.521 +val ((pt,_),_) = get_calc 1;
137.522 +val PblObj {probl, meth, spec, fmz, env, loc, ...} = get_obj I pt [];
137.523 +val None = env;
137.524 +val (Some istate, None) = loc;
137.525 +print_depth 5;
137.526 +writeln"-----------------------------------------------------------";
137.527 +spec;
137.528 +writeln (itms2str thy probl);
137.529 +writeln (itms2str thy meth);
137.530 +writeln (istate2str istate);
137.531 +
137.532 +print_depth 3;
137.533 +
137.534 +refFormula 1 ([],Pbl) (*--> correct CalcHead*);
137.535 + (*081016 NOT necessary (but leave it in Java):*)
137.536 +(*6>*)(*completeCalcHead*)autoCalculate 1 CompleteCalcHead;
137.537 +"----- here the CalcHead has been completed --- ONCE MORE ?????";
137.538 +
137.539 +(***difference II***)
137.540 +val ((pt,p),_) = get_calc 1;
137.541 +(*val p = ([], Pbl)*)
137.542 +val PblObj {probl, meth, spec, fmz, env, loc, ...} = get_obj I pt [];
137.543 +val None = env;
137.544 +val (Some istate, None) = loc;
137.545 +print_depth 5; writeln (istate2str istate); print_depth 3;
137.546 +(*ScrState ([],
137.547 + [], None,
137.548 + ??.empty, Sundef, false)*)
137.549 +print_depth 5; spec; print_depth 3;
137.550 +(*("Isac.thy",
137.551 + ["derivative_of", "function"],
137.552 + ["diff", "differentiate_on_R"]) : spec*)
137.553 +writeln (itms2str thy probl);
137.554 +(*[
137.555 +(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
137.556 +(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
137.557 +(3 ,[1] ,true ,#Find ,Cor derivative f_'_ ,(f_'_, [f_'_]))]*)
137.558 +writeln (itms2str thy meth);
137.559 +(*[
137.560 +(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
137.561 +(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
137.562 +(3 ,[1] ,true ,#Find ,Cor derivative f_'_ ,(f_'_, [f_'_]))]*)
137.563 +writeln"-----------------------------------------------------------";
137.564 +(*7>*)fetchProposedTactic 1 (*--> Apply_Method*);
137.565 +(*WN081028 fixed <ERROR> helpless </ERROR> by inform returning ...(.,Met)*)
137.566 +autoCalculate 1 CompleteCalc;
137.567 +val ((pt,p),_) = get_calc 1;
137.568 +val Form res = (#1 o pt_extract) (pt, ([],Res));
137.569 +show_pt pt;
137.570 +if p = ([], Res) andalso term2str res = "1 + 2 * x" then ()
137.571 +else raise error "diff.sml behav.changed for Diff (x^2 + x + 1, x)";
137.572 +
137.573 +
137.574 +"--------- Take as 1st tac, start from exp -----------------------";
137.575 +"--------- Take as 1st tac, start from exp -----------------------";
137.576 +"--------- Take as 1st tac, start from exp -----------------------";
137.577 +(*the following input is copied from BridgeLog Java <==> SML,
137.578 + omitting unnecessary inputs*)
137.579 +(*1>*)states:=[];
137.580 +(*2>*)CalcTree [(["functionTerm (x^2 + x + 1)", "differentiateFor x", "derivative f_'_"],("Isac.thy",["derivative_of","function"],["diff","differentiate_on_R"]))];
137.581 +(*3>*)Iterator 1; moveActiveRoot 1;
137.582 +
137.583 +(*6>*)(*completeCalcHead*)autoCalculate 1 CompleteCalcHead;
137.584 +
137.585 +(***difference II***)
137.586 +val ((pt,_),_) = get_calc 1;
137.587 +val PblObj {probl, meth, spec, fmz, env, loc, ...} = get_obj I pt [];
137.588 +val None = env;
137.589 +val (Some istate, None) = loc;
137.590 +print_depth 5; writeln (istate2str istate); print_depth 3;
137.591 +(*ScrState ([],
137.592 + [], None,
137.593 + ??.empty, Sundef, false)*)
137.594 +print_depth 5; spec; print_depth 3;
137.595 +(*("Isac.thy",
137.596 + ["derivative_of", "function"],
137.597 + ["diff", "differentiate_on_R"]) : spec*)
137.598 +writeln (itms2str thy probl);
137.599 +(*[
137.600 +(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
137.601 +(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
137.602 +(3 ,[1] ,true ,#Find ,Cor derivative f_'_ ,(f_'_, [f_'_]))]*)
137.603 +writeln (itms2str thy meth);
137.604 +(*[
137.605 +(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
137.606 +(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
137.607 +(3 ,[1] ,true ,#Find ,Cor derivative f_'_ ,(f_'_, [f_'_]))]*)
137.608 +writeln"-----------------------------------------------------------";
137.609 +(*7>*)fetchProposedTactic 1 (*--> Apply_Method*);
137.610 +
137.611 +autoCalculate 1 (Step 1);
137.612 +val ((pt,p),_) = get_calc 1;
137.613 +val Form res = (#1 o pt_extract) (pt, p);
137.614 +if term2str res = "d_d x (x ^^^ 2 + x + 1)" then ()
137.615 +else raise error "diff.sml Diff (x^2 + x + 1, x) from exp";
137.616 +
137.617 +
137.618 +"--------- init_form, start with <NEW> (CAS input) ---------------";
137.619 +"--------- init_form, start with <NEW> (CAS input) ---------------";
137.620 +"--------- init_form, start with <NEW> (CAS input) ---------------";
137.621 +states:=[];
137.622 +CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
137.623 +(*[[from sml: > @@@@@begin@@@@@
137.624 +[[from sml: 1
137.625 +[[from sml: <CALCTREE>
137.626 +[[from sml: <CALCID> 1 </CALCID>
137.627 +[[from sml: </CALCTREE>
137.628 +[[from sml: @@@@@end@@@@@*)
137.629 +Iterator 1;
137.630 +(*[[from sml: > @@@@@begin@@@@@
137.631 +[[from sml: 1
137.632 +[[from sml: <ADDUSER>
137.633 +[[from sml: <CALCID> 1 </CALCID>
137.634 +[[from sml: <USERID> 1 </USERID>
137.635 +[[from sml: </ADDUSER>
137.636 +[[from sml: @@@@@end@@@@@*)
137.637 +moveActiveRoot 1;
137.638 +(*[[from sml: > @@@@@begin@@@@@
137.639 +[[from sml: 1
137.640 +[[from sml: <CALCITERATOR>
137.641 +[[from sml: <CALCID> 1 </CALCID>
137.642 +[[from sml: <POSITION>
137.643 +[[from sml: <INTLIST>
137.644 +[[from sml: </INTLIST>
137.645 +[[from sml: <POS> Pbl </POS>
137.646 +[[from sml: </POSITION>
137.647 +[[from sml: </CALCITERATOR>
137.648 +[[from sml: @@@@@end@@@@@*)
137.649 +getFormulaeFromTo 1 ([],Pbl) ([],Pbl) 0 false;
137.650 +(*[[from sml: > @@@@@begin@@@@@ STILL CORRECT
137.651 +[[from sml: 1
137.652 +[[from sml: <GETELEMENTSFROMTO>
137.653 +[[from sml: <CALCID> 1 </CALCID>
137.654 +[[from sml: <FORMHEADS>
137.655 +[[from sml: <CALCFORMULA>
137.656 +[[from sml: <POSITION>
137.657 +[[from sml: <INTLIST>
137.658 +[[from sml: </INTLIST>
137.659 +[[from sml: <POS> Pbl </POS>
137.660 +[[from sml: </POSITION>
137.661 +[[from sml: <FORMULA>
137.662 +[[from sml: <MATHML>
137.663 +[[from sml: <ISA> ________________________________________________ </ISA>
137.664 +[[from sml: </MATHML>
137.665 +[[from sml:
137.666 +[[from sml: </FORMULA>
137.667 +[[from sml: </CALCFORMULA>
137.668 +[[from sml: </FORMHEADS>
137.669 +[[from sml: </GETELEMENTSFROMTO>
137.670 +[[from sml: @@@@@end@@@@@*)
137.671 +refFormula 1 ([],Pbl);
137.672 +(*[[from sml: > @@@@@begin@@@@@ STILL CORRECT
137.673 +[[from sml: 1
137.674 +[[from sml: <REFFORMULA>
137.675 +[[from sml: <CALCID> 1 </CALCID>
137.676 +[[from sml: <CALCHEAD status = "incorrect">
137.677 +[[from sml: <POSITION>
137.678 +[[from sml: <INTLIST>
137.679 +[[from sml: </INTLIST>
137.680 +[[from sml: <POS> Pbl </POS>
137.681 +[[from sml: </POSITION>
137.682 +[[from sml: <HEAD>
137.683 +[[from sml: <MATHML>
137.684 +[[from sml: <ISA> Problem (e_domID, [e_pblID]) </ISA>
137.685 +[[from sml: </MATHML>
137.686 +[[from sml: </HEAD>
137.687 +[[from sml: <MODEL>
137.688 +[[from sml: <GIVEN> </GIVEN>
137.689 +[[from sml: <WHERE> </WHERE>
137.690 +[[from sml: <FIND> </FIND>
137.691 +[[from sml: <RELATE> </RELATE>
137.692 +[[from sml: </MODEL>
137.693 +[[from sml: <BELONGSTO> Pbl </BELONGSTO>
137.694 +[[from sml: <SPECIFICATION>
137.695 +[[from sml: <THEORYID> e_domID </THEORYID>
137.696 +[[from sml: <PROBLEMID>
137.697 +[[from sml: <STRINGLIST>
137.698 +[[from sml: <STRING> e_pblID </STRING>
137.699 +[[from sml: </STRINGLIST>
137.700 +[[from sml: </PROBLEMID>
137.701 +[[from sml: <METHODID>
137.702 +[[from sml: <STRINGLIST>
137.703 +[[from sml: <STRING> e_metID </STRING>
137.704 +[[from sml: </STRINGLIST>
137.705 +[[from sml: </METHODID>
137.706 +[[from sml: </SPECIFICATION>
137.707 +[[from sml: </CALCHEAD>
137.708 +[[from sml: </REFFORMULA>
137.709 +[[from sml: @@@@@end@@@@@*)
137.710 +moveActiveFormula 1 ([],Pbl);
137.711 +(*[[from sml: > @@@@@begin@@@@@
137.712 +[[from sml: 1
137.713 +[[from sml: <CALCITERATOR>
137.714 +[[from sml: <CALCID> 1 </CALCID>
137.715 +[[from sml: <POSITION>
137.716 +[[from sml: <INTLIST>
137.717 +[[from sml: </INTLIST>
137.718 +[[from sml: <POS> Pbl </POS>
137.719 +[[from sml: </POSITION>
137.720 +[[from sml: </CALCITERATOR>
137.721 +[[from sml: @@@@@end@@@@@*)
137.722 +replaceFormula 1 "Simplify (1+2)";
137.723 +(*[[from sml: > @@@@@begin@@@@@
137.724 +[[from sml: 1
137.725 +[[from sml: <REPLACEFORMULA>
137.726 +[[from sml: <CALCID> 1 </CALCID>
137.727 +[[from sml: <CALCCHANGED>
137.728 +[[from sml: <UNCHANGED>
137.729 +[[from sml: <INTLIST>
137.730 +[[from sml: </INTLIST>
137.731 +[[from sml: <POS> Pbl </POS>
137.732 +[[from sml: </UNCHANGED>
137.733 +[[from sml: <DELETED>
137.734 +[[from sml: <INTLIST>
137.735 +[[from sml: </INTLIST>
137.736 +[[from sml: <POS> Pbl </POS>
137.737 +[[from sml: </DELETED>
137.738 +[[from sml: <GENERATED>
137.739 +[[from sml: <INTLIST>
137.740 +[[from sml: </INTLIST>
137.741 +[[from sml: <POS> Met </POS> DIFFERENCE: Pbl
137.742 +[[from sml: </GENERATED>
137.743 +[[from sml: </CALCCHANGED>
137.744 +[[from sml: </REPLACEFORMULA>
137.745 +[[from sml: @@@@@end@@@@@*)
137.746 +getFormulaeFromTo 1 ([],Pbl) ([],Pbl) 0 false(* DIFFERENCE: Pbl*);
137.747 +(*@@@@@begin@@@@@
137.748 + 1
137.749 +<GETELEMENTSFROMTO>
137.750 + <CALCID> 1 </CALCID>
137.751 + <FORMHEADS>
137.752 + <CALCFORMULA>
137.753 + <POSITION>
137.754 + <INTLIST>
137.755 + </INTLIST>
137.756 + <POS> Pbl </POS>
137.757 + </POSITION>
137.758 + <FORMULA>
137.759 + <MATHML>
137.760 + <ISA> Simplify (1 + 2) </ISA> WORKS !!!!!
137.761 + </MATHML>
137.762 + </FORMULA>
137.763 + </CALCFORMULA>
137.764 + </FORMHEADS>
137.765 +</GETELEMENTSFROMTO>
137.766 +@@@@@end@@@@@*)
137.767 +getFormulaeFromTo 1 ([],Pbl) ([],Met) 0 false;
137.768 +(*[[from sml: > @@@@@begin@@@@@
137.769 +[[from sml: 1
137.770 +[[from sml: <SYSERROR>
137.771 +[[from sml: <CALCID> 1 </CALCID>
137.772 +[[from sml: <ERROR> error in getFormulaeFromTo </ERROR>
137.773 +[[from sml: </SYSERROR>
137.774 +[[from sml: @@@@@end@@@@@*)
137.775 +(*step into getFormulaeFromTo --- bug corrected...*)
138.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
138.2 +++ b/src/Pure/isac/smltest/ME/mathengine.sml Wed Jul 21 13:53:39 2010 +0200
138.3 @@ -0,0 +1,69 @@
138.4 +(* test for sml/ME/mathengine.sml
138.5 + authors: Walther Neuper 2000, 2006
138.6 + (c) due to copyright terms
138.7 +
138.8 +use"../smltest/ME/mathengine.sml";
138.9 +use"mathengine.sml";
138.10 +*)
138.11 +
138.12 +"-----------------------------------------------------------------";
138.13 +"table of contents -----------------------------------------------";
138.14 +"-----------------------------------------------------------------";
138.15 +"----------- debugging setContext..pbl_ --------------------------";
138.16 +"----------- tryrefine -------------------------------------------";
138.17 +"-----------------------------------------------------------------";
138.18 +"-----------------------------------------------------------------";
138.19 +"-----------------------------------------------------------------";
138.20 +
138.21 +
138.22 +
138.23 +"----------- debugging setContext..pbl_ --------------------------";
138.24 +"----------- debugging setContext..pbl_ --------------------------";
138.25 +"----------- debugging setContext..pbl_ --------------------------";
138.26 +states:=[];
138.27 +CalcTree
138.28 +[(["equality (x+1=2)", "solveFor x","solutions L"],
138.29 + ("Test.thy",
138.30 + ["sqroot-test","univariate","equation","test"],
138.31 + ["Test","squ-equ-test-subpbl1"]))];
138.32 +Iterator 1;
138.33 +moveActiveRoot 1; modelProblem 1;
138.34 +
138.35 +val pos as (p,_) = ([],Pbl);
138.36 +val guh = "pbl_equ_univ";
138.37 +checkContext 1 pos guh;
138.38 +val ((pt,_),_) = get_calc 1;
138.39 +val pp = par_pblobj pt p;
138.40 +val keID = guh2kestoreID guh;
138.41 +case context_pbl keID pt pp of (true,["univariate", "equation"],_,_,_)=>()
138.42 +| _ => raise error "mathengine.sml: context_pbl .. pbl_equ_univ checked";
138.43 +
138.44 +case get_obj g_spec pt p of (_, ["e_pblID"], _) => ()
138.45 +| _ => raise error "mathengine.sml: context_pbl .. pbl still empty";
138.46 +setContext 1 pos guh;
138.47 +val ((pt,_),_) = get_calc 1;
138.48 +case get_obj g_spec pt p of (_, ["univariate", "equation"], _) => ()
138.49 +| _ => raise error "mathengine.sml: context_pbl .. pbl set";
138.50 +
138.51 +
138.52 +setContext 1 pos "met_eq_lin";
138.53 +val ((pt,_),_) = get_calc 1;
138.54 +case get_obj g_spec pt p of (_, _, ["LinEq", "solve_lineq_equation"]) => ()
138.55 +| _ => raise error "mathengine.sml: context_pbl .. pbl set";
138.56 +
138.57 +
138.58 +"----------- tryrefine -------------------------------------------";
138.59 +"----------- tryrefine -------------------------------------------";
138.60 +"----------- tryrefine -------------------------------------------";
138.61 +states:=[];
138.62 +CalcTree [(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
138.63 + "solveFor x", "solutions L"],
138.64 + ("RatEq.thy",["univariate","equation"],["no_met"]))];
138.65 +Iterator 1;
138.66 +moveActiveRoot 1; autoCalculate 1 CompleteCalc;
138.67 +
138.68 +refineProblem 1 ([1],Res) "pbl_equ_univ"
138.69 +(*gives "pbl_equ_univ_rat" correct*);
138.70 +
138.71 +refineProblem 1 ([1],Res) (pblID2guh ["linear","univariate","equation"])
138.72 +(*ives "pbl_equ_univ_lin" incorrect*);
139.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
139.2 +++ b/src/Pure/isac/smltest/ME/me.sml Wed Jul 21 13:53:39 2010 +0200
139.3 @@ -0,0 +1,528 @@
139.4 +(* tests on me.sml
139.5 + author: Walther Neuper
139.6 + 060225,
139.7 + (c) due to copyright terms
139.8 +
139.9 +use"../smltest/ME/me.sml";
139.10 +use"me.sml";
139.11 +*)
139.12 +
139.13 +"-----------------------------------------------------------------";
139.14 +"table of contents -----------------------------------------------";
139.15 +"-----------------------------------------------------------------";
139.16 +"=====new ptree 1: crippled by cut_level_'_ ======================";
139.17 +"-------------- get_interval from ctree with move_dn:modspec.sml -";
139.18 +"=====new ptree 2 without changes ================================";
139.19 +"-------------- getFormulaeFromTo --------------------------------";
139.20 +"autoCalculate";
139.21 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
139.22 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalcHead-";
139.23 +"--------- maximum-example: complete_metitms ---------------------";
139.24 +"--------- maximum-example: complete_mod -------------------------";
139.25 +"-----------------------------------------------------------------";
139.26 +"-----------------------------------------------------------------";
139.27 +"-----------------------------------------------------------------";
139.28 +
139.29 +
139.30 +
139.31 +"=====new ptree 1: crippled by cut_level_'_ ======================";
139.32 +"=====new ptree 1: crippled by cut_level_'_ ======================";
139.33 +"=====new ptree 1: crippled by cut_level_'_ ======================";
139.34 +states:=[];
139.35 +CalcTree
139.36 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
139.37 + "solveFor x","solutions L"],
139.38 + ("RatEq.thy",["univariate","equation"],["no_met"]))];
139.39 +Iterator 1; moveActiveRoot 1;
139.40 +autoCalculate 1 CompleteCalc;
139.41 +
139.42 +getTactic 1 ([1],Res);(*Rewrite_Set RatEq_simplify*)
139.43 +getTactic 1 ([2],Res);(*Rewrite_Set norm_Rational*)
139.44 +getTactic 1 ([3],Res);(*Rewrite_Set RatEq_eliminate*)
139.45 +getTactic 1 ([4,1],Res);(*Rewrite all_left*)
139.46 +getTactic 1 ([4,2],Res);(*Rewrite_Set expand_binoms*)
139.47 +getTactic 1 ([4,3],Res);(*Rewrite_Set_Inst make_ratpoly_in*)
139.48 +
139.49 +moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
139.50 +moveActiveFormula 1 ([2],Res)(**ME_Isa: 'expand' not known*);
139.51 +moveActiveFormula 1 ([3],Res)(*3.1.*);
139.52 +moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
139.53 +moveActiveFormula 1 ([4,3],Res)(**one_scr_arg: called by Script Stepwise t_=*);
139.54 +
139.55 +moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
139.56 +interSteps 1 ([1],Res)(*..is activeFormula !?!*);
139.57 +
139.58 +getTactic 1 ([1,1],Res);(*Rewrite real_diff_minus*)
139.59 +getTactic 1 ([1,2],Res);(*Rewrite real_diff_minus*)
139.60 +getTactic 1 ([1,3],Res);(*Rewrite real_diff_minus*)
139.61 +getTactic 1 ([1,4],Res);(*Rewrite real_rat_mult_1*)
139.62 +
139.63 +moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
139.64 +interSteps 1 ([4,2],Res)(*..is activeFormula !?!*);
139.65 +val ((pt,_),_) = get_calc 1;
139.66 +writeln(pr_ptree pr_short pt);
139.67 +(*delete [4,1] in order to make pos [4],[4,4] for pblobjs differen [4],[4,3]:
139.68 + ###########################################################################*)
139.69 +val (pt, _) = cut_level_'_ [] [] pt ([4,1],Frm); (*#*)
139.70 +(*##########################################################################*)
139.71 +writeln(pr_ptree pr_short pt);
139.72 +(*##########################################################################
139.73 + attention: the ctree in states is still the old (perfect) !!!
139.74 +############################################################################*)
139.75 +
139.76 +
139.77 +
139.78 +"-------------- get_interval from ctree with move_dn:modspec.sml -";
139.79 +"-------------- get_interval from ctree with move_dn:modspec.sml -";
139.80 +"-------------- get_interval from ctree with move_dn:modspec.sml -";
139.81 +writeln(pr_ptree pr_short pt);
139.82 +writeln(posterms2str (get_interval ([],Frm) ([],Res) 99999 pt));
139.83 +
139.84 +case map fst (get_interval ([],Frm) ([],Res) 99999 pt) of
139.85 + [([], Frm),
139.86 + ([1], Frm),
139.87 + ([1, 1], Frm),
139.88 + ([1, 1], Res),
139.89 + ([1, 2], Res),
139.90 + ([1, 3], Res),
139.91 + ([1, 4], Res),
139.92 + ([1], Res),
139.93 + ([2], Res),
139.94 + ([3], Res),
139.95 + ([4], Pbl),
139.96 + ([4, 1], Frm),
139.97 + ([4, 1, 1], Frm),
139.98 + ([4, 1, 1], Res),
139.99 + ([4, 1], Res),
139.100 + ([4, 2], Res),
139.101 + ([4, 3], Pbl),
139.102 + ([4, 3, 1], Frm),
139.103 + ([4, 3, 1], Res),
139.104 + ([4, 3, 2], Res),
139.105 + ([4, 3, 3], Res),
139.106 + ([4, 3, 4], Res),
139.107 + ([4, 3, 5], Res),
139.108 + ([4, 3], Res),
139.109 + ([4], Res),
139.110 + ([5], Res),
139.111 + ([], Res)] => ()
139.112 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1f";
139.113 +case map fst (get_interval ([],Frm) ([],Res) 1 pt) of
139.114 + [([], Frm),
139.115 + ([1], Frm),
139.116 + ([1], Res),
139.117 + ([2], Res),
139.118 + ([3], Res),
139.119 + ([4], Pbl),
139.120 + ([4], Res),
139.121 + ([5], Res),
139.122 + ([], Res)] => ()
139.123 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1f";
139.124 +case map fst (get_interval ([],Frm) ([],Res) 0 pt) of
139.125 + [([], Frm),
139.126 + ([], Res)] => ()
139.127 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1f";
139.128 +
139.129 +case map fst (get_interval ([1,3],Res) ([4,1,1],Frm) 99999 pt) of
139.130 + [([1, 3], Res),
139.131 + ([1, 4], Res),
139.132 + ([1], Res),
139.133 + ([2], Res),
139.134 + ([3], Res),
139.135 + ([4], Pbl),
139.136 + ([4, 1], Frm),
139.137 + ([4, 1, 1], Frm)] => ()
139.138 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1a";
139.139 +
139.140 +(*this pos' is not generated bu move_dn:......vvv: goes to end of calc*)
139.141 +case map fst (get_interval ([2],Res) ([4,3,2],Frm) 99999 pt) of
139.142 + [([2], Res),
139.143 + ([3], Res),
139.144 + ([4], Pbl),
139.145 + ([4, 1], Frm),
139.146 + ([4, 1, 1], Frm),
139.147 + ([4, 1, 1], Res),
139.148 + ([4, 1], Res),
139.149 + ([4, 2], Res),
139.150 + ([4, 3], Pbl),
139.151 + ([4, 3, 1], Frm),
139.152 + ([4, 3, 1], Res),
139.153 + ([4, 3, 2], Res),
139.154 + ([4, 3, 3], Res),(*this is beyond 'to'*)
139.155 + ([4, 3, 4], Res),(*this is beyond 'to'*)
139.156 + ([4, 3, 5], Res),(*this is beyond 'to'*)
139.157 + ([4, 3], Res), (*this is beyond 'to'*)
139.158 + ([4], Res), (*this is beyond 'to'*)
139.159 + ([5], Res), (*this is beyond 'to'*)
139.160 + ([], Res)] => () (*this is beyond 'to'*)
139.161 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1b";
139.162 +case map fst (get_interval ([1,4],Res) ([4,3,1],Frm) 99999 pt) of
139.163 + [([1, 4], Res),
139.164 + ([1], Res),
139.165 + ([2], Res),
139.166 + ([3], Res),
139.167 + ([4], Pbl),
139.168 + ([4, 1], Frm),
139.169 + ([4, 1, 1], Frm),
139.170 + ([4, 1, 1], Res),
139.171 + ([4, 1], Res),
139.172 + ([4, 2], Res),
139.173 + ([4, 3], Pbl),
139.174 + ([4, 3, 1], Frm)] => ()
139.175 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1c";
139.176 +case map fst (get_interval ([4,2],Res) ([5],Res) 99999 pt) of
139.177 + [([4, 2], Res),
139.178 + ([4, 3], Pbl),
139.179 + ([4, 3, 1], Frm),
139.180 + ([4, 3, 1], Res),
139.181 + ([4, 3, 2], Res),
139.182 + ([4, 3, 3], Res),
139.183 + ([4, 3, 4], Res),
139.184 + ([4, 3, 5], Res),
139.185 + ([4, 3], Res),
139.186 + ([4], Res),
139.187 + ([5], Res)]=>()
139.188 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1d";
139.189 +case map fst (get_interval ([],Frm) ([4,3,2],Res) 99999 pt) of
139.190 + [([], Frm),
139.191 + ([1], Frm),
139.192 + ([1, 1], Frm),
139.193 + ([1, 1], Res),
139.194 + ([1, 2], Res),
139.195 + ([1, 3], Res),
139.196 + ([1, 4], Res),
139.197 + ([1], Res),
139.198 + ([2], Res),
139.199 + ([3], Res),
139.200 + ([4], Pbl),
139.201 + ([4, 1], Frm),
139.202 + ([4, 1, 1], Frm),
139.203 + ([4, 1, 1], Res),
139.204 + ([4, 1], Res),
139.205 + ([4, 2], Res),
139.206 + ([4, 3], Pbl),
139.207 + ([4, 3, 1], Frm),
139.208 + ([4, 3, 1], Res),
139.209 + ([4, 3, 2], Res)] => ()
139.210 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1e";
139.211 +case map fst (get_interval ([4,3],Frm) ([4,3],Res) 99999 pt) of
139.212 + [([4, 3], Frm),
139.213 + ([4, 3, 1], Frm),
139.214 + ([4, 3, 1], Res),
139.215 + ([4, 3, 2], Res),
139.216 + ([4, 3, 3], Res),
139.217 + ([4, 3, 4], Res),
139.218 + ([4, 3, 5], Res),
139.219 + ([4, 3], Res)] => ()
139.220 + | _ => raise error "diff.behav.in ctree.sml: get_interval lev 1g";
139.221 +
139.222 +
139.223 +
139.224 +
139.225 +"=====new ptree 2 without changes ================================";
139.226 +"=====new ptree 2 without changes ================================";
139.227 +"=====new ptree 2 without changes ================================";
139.228 +states:=[];
139.229 +CalcTree
139.230 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
139.231 + "solveFor x","solutions L"],
139.232 + ("RatEq.thy",["univariate","equation"],["no_met"]))];
139.233 +Iterator 1; moveActiveRoot 1;
139.234 +autoCalculate 1 CompleteCalc;
139.235 +val ((pt,_),_) = get_calc 1;
139.236 +writeln(pr_ptree pr_short pt);
139.237 +
139.238 +
139.239 +"-------------- getFormulaeFromTo --------------------------------";
139.240 +"-------------- getFormulaeFromTo --------------------------------";
139.241 +"-------------- getFormulaeFromTo --------------------------------";
139.242 +getFormulaeFromTo 1 ([4, 2], Res) ([4, 4], Pbl) 000;
139.243 +(*
139.244 +"@@@@@begin@@@@@" //...................................................
139.245 ++ " 1" //..............................................................
139.246 ++ "<GETELEMENTSFROMTO>" //...................................................
139.247 ++ " <CALCID> 1 </CALCID>" //..........................................
139.248 ++ " <POSFORMHEADS>" //................................................
139.249 ++ " <POSFORM>" //...................................................
139.250 ++ " <GENERATED>" //...............................................
139.251 ++ " <INTLIST>" //...............................................
139.252 ++ " <INT> 4 </INT>" //........................................
139.253 ++ " <INT> 3 </INT>" //........................................
139.254 ++ " </INTLIST>" //..............................................
139.255 ++ " <POS> Res </POS>" //........................................
139.256 ++ " </GENERATED>" //..............................................
139.257 ++ " <FORMULA>" //.................................................
139.258 ++ " <MATHML>" //................................................
139.259 ++ " <ISA> -6 * x + 5 * x ^^^ 2 = 0 </ISA>" //.................
139.260 ++ " </MATHML>" //...............................................
139.261 ++ " </FORMULA>" //................................................
139.262 ++ " </POSFORM>" //..................................................
139.263 ++ " <POSHEAD>" //...................................................
139.264 ++ " <GENERATED>" //...............................................
139.265 ++ " <INTLIST>" //...............................................
139.266 ++ " <INT> 4 </INT>" //........................................
139.267 ++ " <INT> 4 </INT>" //........................................
139.268 ++ " </INTLIST>" //..............................................
139.269 ++ " <POS> Pbl </POS>" //........................................
139.270 ++ " </GENERATED>" //..............................................
139.271 ++ " <CALCHEAD status = "correct">" //.............................
139.272 ++ " <HEAD>" //...................................................
139.273 ++ " <MATHML>" //...............................................
139.274 ++ " <ISA> solve (-6 * x + 5 * x ^^^ 2 = 0, x) </ISA>" //.....
139.275 ++ " </MATHML>" //..............................................
139.276 ++ " </HEAD>" //..................................................
139.277 ++ " <MODEL>" //.................................................
139.278 ++ " <GIVEN>" //...............................................
139.279 ++ " <ITEM status="correct">" //.............................
139.280 ++ " <MATHML>" //..........................................
139.281 ++ " <ISA> equality (-6 * x + 5 * x ^^^ 2 = 0) </ISA>" //
139.282 ++ " </MATHML>" //.........................................
139.283 ++ " </ITEM>" //.............................................
139.284 ++ " <ITEM status="correct">" //.............................
139.285 ++ " <MATHML>" //..........................................
139.286 ++ " <ISA> solveFor x </ISA>" //.........................
139.287 ++ " </MATHML>" //.........................................
139.288 ++ " </ITEM>" //.............................................
139.289 ++ " </GIVEN>" //..............................................
139.290 ++ " <WHERE>" //...............................................
139.291 ++ " <ITEM status="correct">" //.............................
139.292 ++ " <MATHML>" //..........................................
139.293 ++ " <ISA> matches (?a * ?v_ + ?v_ ^^^ 2 = 0) (-6 * x + 5 * x ^^^ 2 = 0) |"
139.294 ++ "matches (?v_ + ?v_ ^^^ 2 = 0) (-6 * x + 5 * x ^^^ 2 = 0) |" //......
139.295 ++ "matches (?v_ + ?b * ?v_ ^^^ 2 = 0) (-6 * x + 5 * x ^^^ 2 = 0) |"
139.296 ++ "matches (?a * ?v_ + ?b * ?v_ ^^^ 2 = 0) (-6 * x + 5 * x ^^^ 2 = 0) |"
139.297 ++ "matches (?v_ ^^^ 2 = 0) (-6 * x + 5 * x ^^^ 2 = 0) |" //............
139.298 ++ "matches (?b * ?v_ ^^^ 2 = 0) (-6 * x + 5 * x ^^^ 2 = 0) </ISA>" //..
139.299 ++ " </MATHML>" //.........................................
139.300 ++ " </ITEM>" //.............................................
139.301 ++ " </WHERE>" //..............................................
139.302 ++ " <FIND>" //................................................
139.303 ++ " <ITEM status="correct">" //.............................
139.304 ++ " <MATHML>" //..........................................
139.305 ++ " <ISA> solutions x_i </ISA>" //......................
139.306 ++ " </MATHML>" //.........................................
139.307 ++ " </ITEM>" //.............................................
139.308 ++ " </FIND>" //...............................................
139.309 ++ " <RELATE> </RELATE>" //...................................
139.310 ++ " </MODEL>" //................................................
139.311 ++ " <BELONGSTO> Pbl </BELONGSTO>" //............................
139.312 ++ " <SPECIFICATION>" //.........................................
139.313 ++ " <THEORYID> PolyEq.thy </THEORYID>" //.....................
139.314 ++ " <PROBLEMID>" //...........................................
139.315 ++ " <STRINGLIST>" //........................................
139.316 ++ " <STRING> bdv_only </STRING>" //.......................
139.317 ++ " <STRING> degree_2 </STRING>" //.......................
139.318 ++ " <STRING> polynomial </STRING>" //.....................
139.319 ++ " <STRING> univariate </STRING>" //.....................
139.320 ++ " <STRING> equation </STRING>" //.......................
139.321 ++ " </STRINGLIST>" //.......................................
139.322 ++ " </PROBLEMID>" //..........................................
139.323 ++ " <METHODID>" //............................................
139.324 ++ " <STRINGLIST>" //........................................
139.325 ++ " <STRING> PolyEq </STRING>" //.........................
139.326 ++ " <STRING> solve_d2_polyeq_bdvonly_equation </STRING>"
139.327 ++ " </STRINGLIST>" //.......................................
139.328 ++ " </METHODID>" //...........................................
139.329 ++ " </SPECIFICATION>" //........................................
139.330 ++ " </CALCHEAD>" //...............................................
139.331 ++ " </POSHEAD>" //..................................................
139.332 ++ " <POSFORMHEADS>" //................................................
139.333 ++ "</GETELEMENTSFROMTO>" //..................................................
139.334 ++ "@@@@@end@@@@@"
139.335 +*)
139.336 +
139.337 +
139.338 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
139.339 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
139.340 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteModel ---";
139.341 + val c = [];
139.342 + val (p,_,f,nxt,_,pt) = CalcTreeTEST
139.343 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
139.344 + ("Test.thy",
139.345 + ["linear","univariate","equation","test"],
139.346 + ["Test","solve_linear"]))];
139.347 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.348 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.349 + (*xt = Add_Given "solveFor x"*)
139.350 + writeln (itms2str thy (get_obj g_pbl pt (fst p)));
139.351 +(*[
139.352 +(0 ,[] ,false ,#Given ,Inc solveFor ,(??.empty, [])),
139.353 +(0 ,[] ,false ,#Find ,Inc solutions [] ,(??.empty, [])),
139.354 +(1 ,[1] ,true ,#Given ,Cor equality (1 + -1 * 2 + x = 0) ,(e_, [1 + -1 * 2 + x = 0]))]*)
139.355 + val (pt,p) = complete_mod (pt, p);
139.356 + if itms2str thy (get_obj g_pbl pt (fst p)) = "[\n(1 ,[1] ,true ,#Given ,Cor equality (1 + -1 * 2 + x = 0) ,(e_, [1 + -1 * 2 + x = 0])),\n(2 ,[1] ,true ,#Given ,Cor solveFor x ,(v_, [x])),\n(3 ,[1] ,true ,#Find ,Cor solutions L ,(v_i_, [L]))]" then ()
139.357 + else raise error "completetest.sml: new behav. in complete_mod 1";
139.358 + writeln (itms2str thy (get_obj g_pbl pt (fst p)));
139.359 +(*[
139.360 +(1 ,[1] ,true ,#Given ,Cor equality (1 + -1 * 2 + x = 0) ,(e_, [1 + -1 * 2 + x = 0])),
139.361 +(2 ,[1] ,true ,#Given ,Cor solveFor x ,(solveFor, [x])),
139.362 +(3 ,[1] ,true ,#Find ,Cor solutions L ,(solutions, [L]))]*)
139.363 + val mits = get_obj g_met pt (fst p);
139.364 + if itms2str thy mits = "[\n(1 ,[1] ,true ,#Given ,Cor equality (1 + -1 * 2 + x = 0) ,(e_, [1 + -1 * 2 + x = 0])),\n(2 ,[1] ,true ,#Given ,Cor solveFor x ,(v_, [x])),\n(3 ,[1] ,true ,#Find ,Cor solutions L ,(v_i_, [L]))]"
139.365 + then () else raise error "completetest.sml: new behav. in complete_mod 2";
139.366 + writeln (itms2str thy mits);
139.367 +(*[
139.368 +(1 ,[1] ,true ,#Given ,Cor equality (1 + -1 * 2 + x = 0) ,(e_, [1 + -1 * 2 + x = 0])),
139.369 +(2 ,[1] ,true ,#Given ,Cor solveFor x ,(solveFor, [x])),
139.370 +(3 ,[1] ,true ,#Find ,Cor solutions L ,(solutions, [L]))]*)
139.371 +
139.372 +
139.373 +
139.374 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalcHead-";
139.375 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalcHead-";
139.376 +"--------- solve_linear as rootpbl AUTOCALCULATE CompleteCalcHead-";
139.377 + states:=[];
139.378 + CalcTree (*start of calculation, return No.1*)
139.379 + [(["equality (1+-1*2+x=0)", "solveFor x","solutions L"],
139.380 + ("Test.thy",
139.381 + ["linear","univariate","equation","test"],
139.382 + ["Test","solve_linear"]))];
139.383 + Iterator 1; moveActiveRoot 1;
139.384 +
139.385 +(*
139.386 + autoCalculate 1 CompleteCalcHead;
139.387 + autoCalculate 1 (Step 1);
139.388 + refFormula 1 (get_pos 1 1);
139.389 +
139.390 +... works
139.391 +
139.392 + autoCalculate 1 CompleteCalcHead;
139.393 + fetchProposedTactic 1; (*-> Apply_Method*);
139.394 + setNextTactic 1 (Apply_Method ["Test","solve_linear"]);
139.395 + autoCalculate 1 (Step 1);
139.396 + refFormula 1 (get_pos 1 1);
139.397 +
139.398 +... works *)
139.399 +
139.400 + autoCalculate 1 (Step 1);
139.401 + refFormula 1 (get_pos 1 1);
139.402 +
139.403 + autoCalculate 1 CompleteModel;
139.404 + refFormula 1 (get_pos 1 1);
139.405 +
139.406 + autoCalculate 1 CompleteCalcHead;
139.407 +(* *** complete_mod: only impl.for Pbl, called with ([], Met) FIXXXXXXXXXXME*)
139.408 +
139.409 +
139.410 +
139.411 +"--------- maximum-example: complete_metitms ---------------------";
139.412 +"--------- maximum-example: complete_metitms ---------------------";
139.413 +"--------- maximum-example: complete_metitms ---------------------";
139.414 + val (p,_,f,nxt,_,pt) =
139.415 + CalcTreeTEST
139.416 + [(["fixedValues [r=Arbfix]","maximum A",
139.417 + "valuesFor [a,b]",
139.418 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
139.419 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
139.420 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
139.421 +
139.422 + "boundVariable a","boundVariable b","boundVariable alpha",
139.423 + "interval {x::real. 0 <= x & x <= 2*r}",
139.424 + "interval {x::real. 0 <= x & x <= 2*r}",
139.425 + "interval {x::real. 0 <= x & x <= pi}",
139.426 + "errorBound (eps=(0::real))"],
139.427 + ("DiffApp.thy",["maximum_of","function"],["DiffApp","max_by_calculus"])
139.428 + )];
139.429 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.430 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.431 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.432 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.433 + val (p,_,f,nxt,_,pt) = (me nxt p c pt) handle e => print_exn e;
139.434 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.435 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.436 + (*nxt = Specify_Theory "DiffApp.thy"*)
139.437 + val (oris, _, _) = get_obj g_origin pt (fst p);
139.438 + writeln (oris2str oris);
139.439 +(*[
139.440 +(1, ["1","2","3"], #Given,fixedValues, ["[r = Arbfix]"]),
139.441 +(2, ["1","2","3"], #Find,maximum, ["A"]),
139.442 +(3, ["1","2","3"], #Find,valuesFor, ["[a]","[b]"]),
139.443 +(4, ["1","2"], #Relate,relations, ["[A = a * b]","[(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]"]),
139.444 +(5, ["3"], #Relate,relations, ["[A = a * b]","[a / 2 = r * sin alpha]","[b / 2 = r * cos alpha]"]),
139.445 +(6, ["1"], #undef,boundVariable, ["a"]),
139.446 +(7, ["2"], #undef,boundVariable, ["b"]),
139.447 +(8, ["3"], #undef,boundVariable, ["alpha"]),
139.448 +(9, ["1","2"], #undef,interval, ["{x. 0 <= x & x <= 2 * r}"]),
139.449 +(10, ["3"], #undef,interval, ["{x. 0 <= x & x <= pi}"]),
139.450 +(11, ["1","2","3"], #undef,errorBound, ["eps = 0"])]*)
139.451 + val pits = get_obj g_pbl pt (fst p);
139.452 + writeln (itms2str thy pits);
139.453 +(*[
139.454 +(1 ,[1,2,3] ,true,#Given ,Cor fixedValues [r = Arbfix],(fix_, [[r = Arbfix]])),
139.455 +(2 ,[1,2,3] ,true,#Find ,Cor maximum A ,(m_, [A])),
139.456 +(3 ,[1,2,3] ,true,#Find ,Cor valuesFor [a, b] ,(vs_, [[a, b]])),
139.457 +(4 ,[1,2] ,true,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^
139.458 +2 = r ^^^ 2] ,(rs_, [[A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]]))]*)
139.459 + val mits = get_obj g_met pt (fst p);
139.460 + val mits = complete_metitms oris pits []
139.461 + ((#ppc o get_met) ["DiffApp","max_by_calculus"]);
139.462 + writeln (itms2str thy mits);
139.463 +(*[
139.464 +(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),
139.465 +(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),
139.466 +(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(vs_, [[a, b]])),
139.467 +(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^
139.468 +2 = r ^^^ 2] ,(rs_, [[A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]])),
139.469 +(6 ,[1] ,true ,#undef ,Cor boundVariable a ,(boundVariable, [a])),
139.470 +(9 ,[1,2] ,true ,#undef ,Cor interval {x. 0 <= x & x <= 2 * r} ,(interval, [{x.
139.471 +0 <= x & x <= 2 * r}])),
139.472 +(11 ,[1,2,3] ,true ,#undef ,Cor errorBound (eps = 0) ,(errorBound, [eps = 0]))]*)
139.473 + if itms2str thy mits = "[\n(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),\n(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),\n(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(vs_, [[a, b]])),\n(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2] ,(rs_, [[A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]])),\n(6 ,[1] ,true ,#undef ,Cor boundVariable a ,(v_, [a])),\n(9 ,[1,2] ,true ,#undef ,Cor interval {x. 0 <= x & x <= 2 * r} ,(itv_, [{x. 0 <= x & x <= 2 * r}])),\n(11 ,[1,2,3] ,true ,#undef ,Cor errorBound (eps = 0) ,(err_, [eps = 0]))]" then ()
139.474 + else raise error "completetest.sml: new behav. in complete_metitms 1";
139.475 +
139.476 +
139.477 +"--------- maximum-example: complete_mod -------------------------";
139.478 +"--------- maximum-example: complete_mod -------------------------";
139.479 +"--------- maximum-example: complete_mod -------------------------";
139.480 + val (p,_,f,nxt,_,pt) =
139.481 + CalcTreeTEST
139.482 + [(["fixedValues [r=Arbfix]","maximum A",
139.483 + "valuesFor [a,b]",
139.484 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
139.485 + "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
139.486 + "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
139.487 +
139.488 + "boundVariable a","boundVariable b","boundVariable alpha",
139.489 + "interval {x::real. 0 <= x & x <= 2*r}",
139.490 + "interval {x::real. 0 <= x & x <= 2*r}",
139.491 + "interval {x::real. 0 <= x & x <= pi}",
139.492 + "errorBound (eps=(0::real))"],
139.493 + ("DiffApp.thy",["maximum_of","function"],["DiffApp","max_by_calculus"])
139.494 + )];
139.495 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.496 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.497 + val (p,_,f,nxt,_,pt) = me nxt p c pt;
139.498 + (*nxt = nxt = Add_Find "valuesFor [a]" FIXME.12.03 +handle Inc !*)
139.499 + val pits = get_obj g_pbl pt (fst p);
139.500 + writeln (itms2str thy pits);
139.501 +(*[
139.502 +(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),
139.503 +(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, [])),
139.504 +(1 ,[1,2,3] ,true,#Given,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),
139.505 +(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A]))]*)
139.506 + val (pt,p) = complete_mod (pt,p);
139.507 + val pits = get_obj g_pbl pt (fst p);
139.508 + if itms2str thy pits = "[\n(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),\n(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),\n(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(vs_, [[a],[b]])),\n(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2] ,(rs_, [[A = a * b],[(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]]))]"
139.509 + then () else raise error "completetest.sml: new behav. in complete_mod 3";
139.510 + writeln (itms2str thy pits);
139.511 +(*[
139.512 +(1 ,[1,2,3] ,true,#Given,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),
139.513 +(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),
139.514 +(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(valuesFor, [[a],[b]])),
139.515 +(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^
139.516 +2 = r ^^^ 2] ,(relations, [[A = a * b],[(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]]))]*)
139.517 + val mits = get_obj g_met pt (fst p);
139.518 + if itms2str thy mits = "[\n(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),\n(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),\n(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(vs_, [[a],[b]])),\n(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2] ,(rs_, [[A = a * b],[(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]])),\n(6 ,[1] ,true ,#undef ,Cor boundVariable a ,(v_, [a])),\n(9 ,[1,2] ,true ,#undef ,Cor interval {x. 0 <= x & x <= 2 * r} ,(itv_, [{x. 0 <= x & x <= 2 * r}])),\n(11 ,[1,2,3] ,true ,#undef ,Cor errorBound (eps = 0) ,(err_, [eps = 0]))]"
139.519 + then () else raise error "completetest.sml: new behav. in complete_mod 3";
139.520 + writeln (itms2str thy mits);
139.521 +(*[
139.522 +(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),
139.523 +(2 ,[1,2,3] ,true ,#Find ,Cor maximum A ,(m_, [A])),
139.524 +(3 ,[1,2,3] ,true ,#Find ,Cor valuesFor [a, b] ,(valuesFor, [[a],[b]])),
139.525 +(4 ,[1,2] ,true ,#Relate ,Cor relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^
139.526 +2 = r ^^^ 2] ,(relations, [[A = a * b],[(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]])),
139.527 +(6 ,[1] ,true ,#undef ,Cor boundVariable a ,(boundVariable, [a])),
139.528 +(9 ,[1,2] ,true ,#undef ,Cor interval {x. 0 <= x & x <= 2 * r} ,(interval, [{x.
139.529 +0 <= x & x <= 2 * r}])),
139.530 +(11 ,[1,2,3] ,true ,#undef ,Cor errorBound (eps = 0) ,(errorBound, [eps = 0]))]*)
139.531 +
140.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
140.2 +++ b/src/Pure/isac/smltest/ME/mstools.sml Wed Jul 21 13:53:39 2010 +0200
140.3 @@ -0,0 +1,20 @@
140.4 +(* tests on mstools.sml
140.5 + author: Walther Neuper
140.6 + 051019,
140.7 + (c) due to copyright terms
140.8 +
140.9 +use"../smltest/ME/mstools.sml";
140.10 +use"mstools.sml";
140.11 + *)
140.12 +
140.13 +"-----------------------------------------------------------------";
140.14 +"table of contents -----------------------------------------------";
140.15 +"-----------------------------------------------------------------";
140.16 +"--------- head_precond ------------------------------------------";
140.17 +"-----------------------------------------------------------------";
140.18 +
140.19 +
140.20 +
140.21 +"--------- head_precond ------------------------------------------";
140.22 +"--------- head_precond ------------------------------------------";
140.23 +"--------- head_precond ------------------------------------------";
141.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
141.2 +++ b/src/Pure/isac/smltest/ME/ptyps.sml Wed Jul 21 13:53:39 2010 +0200
141.3 @@ -0,0 +1,474 @@
141.4 +(* tests for ME/ptyps.sml
141.5 + CAUTION: intermediately stores !ptyps THUS EVALUATE IN 1 GO
141.6 + author: Walther Neuper
141.7 + 010916,
141.8 + (c) due to copyright terms
141.9 +
141.10 +use"../smltest/ME/ptyps.sml";
141.11 +use"ptyps.sml";
141.12 +*)
141.13 +
141.14 +"-----------------------------------------------------------------";
141.15 +"table of contents -----------------------------------------------";
141.16 +"-----------------------------------------------------------------";
141.17 +"###### val intermediate_ptyps = !ptyps; #########################";
141.18 +"----------- store test-pbtyps -----------------------------------";
141.19 +"----------- refin test-pbtyps -----------------------------------";
141.20 +"----------- refine_ori test-pbtyps ------------------------------";
141.21 +"----------- refine test-pbtyps ----------------------------------";
141.22 +"###### ptyps:= intermediate_ptyps;###############################";
141.23 +"----------- Refine_Problem (aus subp-rooteq.sml) ----------------";
141.24 +"----------- fun coll_guhs ---------------------------------------";
141.25 +"----------- fun guh2kestoreID -----------------------------------";
141.26 +"-----------------------------------------------------------------";
141.27 +"-----------------------------------------------------------------";
141.28 +"-----------------------------------------------------------------";
141.29 +
141.30 +
141.31 +
141.32 +"###### val intermediate_ptyps = !ptyps; #########################";
141.33 +"###### val intermediate_ptyps = !ptyps; #########################";
141.34 +"###### val intermediate_ptyps = !ptyps; #########################";
141.35 +val intermediate_ptyps = !ptyps;
141.36 +
141.37 +"----------- store test-pbtyps -----------------------------------";
141.38 +"----------- store test-pbtyps -----------------------------------";
141.39 +"----------- store test-pbtyps -----------------------------------";
141.40 +ptyps:= ([]:ptyps);
141.41 +
141.42 +store_pbt
141.43 + (prep_pbt DiffApp.thy "pbl_pbla" [] e_pblID
141.44 + (["pbla"],
141.45 + [("#Given", ["fixedValues a_"])], e_rls, None, []));
141.46 +store_pbt
141.47 + (prep_pbt DiffApp.thy "pbl_pbla1" [] e_pblID
141.48 + (["pbla1","pbla"],
141.49 + [("#Given", ["fixedValues a_","maximum a1_"])], e_rls, None, []));
141.50 +store_pbt
141.51 + (prep_pbt DiffApp.thy "pbl_pbla2" [] e_pblID
141.52 + (["pbla2","pbla"],
141.53 + [("#Given", ["fixedValues a_","valuesFor a2_"])], e_rls, None, []));
141.54 +store_pbt
141.55 + (prep_pbt DiffApp.thy "pbl_pbla2x" [] e_pblID
141.56 + (["pbla2x","pbla2","pbla"],
141.57 + [("#Given", ["fixedValues a_","valuesFor a2_","functionOf a2x_"])],
141.58 + e_rls, None, []));
141.59 +store_pbt
141.60 + (prep_pbt DiffApp.thy "pbl_pbla2y" [] e_pblID
141.61 + (["pbla2y","pbla2","pbla"],
141.62 + [("#Given" ,["fixedValues a_","valuesFor a2_","boundVariable a2y_"])],
141.63 + e_rls, None, []));
141.64 +store_pbt
141.65 + (prep_pbt DiffApp.thy "pbl_pbla2z" [] e_pblID
141.66 + (["pbla2z","pbla2","pbla"],
141.67 + [("#Given" ,["fixedValues a_","valuesFor a2_","interval a2z_"])],
141.68 + e_rls, None, []));
141.69 +store_pbt
141.70 + (prep_pbt DiffApp.thy "pbl_pbla3" [] e_pblID
141.71 + (["pbla3","pbla"],
141.72 + [("#Given" ,["fixedValues a_","relations a3_"])],
141.73 + e_rls, None, []));
141.74 +
141.75 +show_ptyps();
141.76 +
141.77 +(*case 1: no refinement *)
141.78 +val thy = Isac.thy;
141.79 +val (d1,ts1) = split_dts thy ((term_of o the o (parse thy))
141.80 + "fixedValues [aaa=0]");
141.81 +val (d2,ts2) = split_dts thy ((term_of o the o (parse thy))
141.82 + "errorBound (ddd=0)");
141.83 +val ori1 = [(1,[1],"#Given",d1,ts1),
141.84 + (2,[1],"#Given",d2,ts2)]:ori list;
141.85 +
141.86 +
141.87 +(*case 2: refined to pbt without children *)
141.88 +val (d2,ts2) = split_dts thy ((term_of o the o (parse thy))
141.89 + "relations [aaa333]");
141.90 +val ori2 = [(1,[1],"#Given",d1,ts1),
141.91 + (2,[1],"#Given",d2,ts2)]:ori list;
141.92 +
141.93 +
141.94 +(*case 3: refined to pbt with children *)
141.95 +val (d2,ts2) = split_dts thy ((term_of o the o (parse thy))
141.96 + "valuesFor [aaa222]");
141.97 +val ori3 = [(1,[1],"#Given",d1,ts1),
141.98 + (2,[1],"#Given",d2,ts2)]:ori list;
141.99 +
141.100 +
141.101 +(*case 4: refined to children (without child)*)
141.102 +val (d3,ts3) = split_dts thy ((term_of o the o (parse thy))
141.103 + "boundVariable aaa222yyy");
141.104 +val ori4 = [(1,[1],"#Given",d1,ts1),
141.105 + (2,[1],"#Given",d2,ts2),
141.106 + (3,[1],"#Given",d3,ts3)]:ori list;
141.107 +
141.108 +"----------- refin test-pbtyps -----------------------------------";
141.109 +"----------- refin test-pbtyps -----------------------------------";
141.110 +"----------- refin test-pbtyps -----------------------------------";
141.111 +(*case 1: no refinement *)
141.112 +refin [] ori1 (hd (!ptyps));
141.113 +(*val it = Some ["pbla"] : pblID option*)
141.114 +
141.115 +(*case 2: refined to pbt without children *)
141.116 +refin [] ori2 (hd (!ptyps));
141.117 +(*val it = Some ["pbla","pbla3"] : pblID option*)
141.118 +
141.119 +(*case 3: refined to pbt with children *)
141.120 +refin [] ori3 (hd (!ptyps));
141.121 +(*val it = Some ["pbla","pbla2"] : pblID option*)
141.122 +
141.123 +(*case 4: refined to children (without child)*)
141.124 +refin [] ori4 (hd (!ptyps));
141.125 +(*val it = Some ["pbla","pbla2","pbla2y"] : pblID option*)
141.126 +
141.127 +(*case 5: start refinement somewhere in ptyps*)
141.128 +val [Ptyp ("pbla",_,[_, ppp as Ptyp ("pbla2",_,_), _])] = !ptyps;
141.129 +refin ["pbla"] ori4 ppp;
141.130 +(*val it = Some ["pbla2","pbla2y"] : pblRD option*)
141.131 +
141.132 +
141.133 +"----------- refine_ori test-pbtyps ------------------------------";
141.134 +"----------- refine_ori test-pbtyps ------------------------------";
141.135 +"----------- refine_ori test-pbtyps ------------------------------";
141.136 +(*case 1: no refinement *)
141.137 +refine_ori ori1 ["pbla"];
141.138 +(*val it = None : pblID option !!!!*)
141.139 +
141.140 +(*case 2: refined to pbt without children *)
141.141 +refine_ori ori2 ["pbla"];
141.142 +(*val it = Some ["pbla3","pbla"] : pblID option*)
141.143 +
141.144 +(*case 3: refined to pbt with children *)
141.145 +refine_ori ori3 ["pbla"];
141.146 +(*val it = Some ["pbla2","pbla"] : pblID option*)
141.147 +
141.148 +(*case 4: refined to children (without child)*)
141.149 +val opt = refine_ori ori4 ["pbla"];
141.150 +if opt = Some ["pbla2y","pbla2","pbla"] then ()
141.151 +else raise error "new behaviour in refine.sml case 4";
141.152 +
141.153 +(*case 5: start refinement somewhere in ptyps*)
141.154 +refine_ori ori4 ["pbla2","pbla"];
141.155 +(*val it = Some ["pbla2y","pbla2","pbla"] : pblID option*)
141.156 +
141.157 +
141.158 +"----------- refine test-pbtyps ----------------------------------";
141.159 +"----------- refine test-pbtyps ----------------------------------";
141.160 +"----------- refine test-pbtyps ----------------------------------";
141.161 +val fmz1 = ["fixedValues [aaa=0]","errorBound (ddd=0)"];
141.162 +val fmz2 = ["fixedValues [aaa=0]","relations aaa333"];
141.163 +val fmz3 = ["fixedValues [aaa=0]","valuesFor [aaa222]"];
141.164 +val fmz4 = ["fixedValues [aaa=0]","valuesFor [aaa222]",
141.165 + "boundVariable aaa222yyy"];
141.166 +
141.167 +(*case 1: no refinement *)
141.168 +refine fmz1 ["pbla"];
141.169 +(*
141.170 +*** pass ["pbla"]
141.171 +*** pass ["pbla","pbla1"]
141.172 +*** pass ["pbla","pbla2"]
141.173 +*** pass ["pbla","pbla3"]
141.174 +val it =
141.175 + [Matches
141.176 + (["pbla"],
141.177 + {Find=[],
141.178 + Given=[Correct "fixedValues [aaa = #0]",
141.179 + Superfl "errorBound (ddd = #0)"],Relate=[],Where=[],With=[]}),
141.180 + NoMatch
141.181 + (["pbla1","pbla"],
141.182 + {Find=[],
141.183 + Given=[Correct "fixedValues [aaa = #0]",Missing "maximum a1_",
141.184 + Superfl "errorBound (ddd = #0)"],Relate=[],Where=[],With=[]}),
141.185 + NoMatch
141.186 + (["pbla2","pbla"],
141.187 + {Find=[],
141.188 + Given=[Correct "fixedValues [aaa = #0]",Missing "valuesFor a2_",
141.189 + Superfl "errorBound (ddd = #0)"],Relate=[],Where=[],With=[]}),
141.190 + NoMatch
141.191 + (["pbla3","pbla"],
141.192 + {Find=[],
141.193 + Given=[Correct "fixedValues [aaa = #0]",Missing "relations a3_",
141.194 + Superfl "errorBound (ddd = #0)"],Relate=[],Where=[],With=[]})]
141.195 + : match list*)
141.196 +
141.197 +(*case 2: refined to pbt without children *)
141.198 +refine fmz2 ["pbla"];
141.199 +(*
141.200 +*** pass ["pbla"]
141.201 +*** pass ["pbla","pbla1"]
141.202 +*** pass ["pbla","pbla2"]
141.203 +*** pass ["pbla","pbla3"]
141.204 +val it =
141.205 + [Matches
141.206 + (["pbla"],
141.207 + {Find=[],
141.208 + Given=[Correct "fixedValues [aaa = #0]",Superfl "relations aaa333"],
141.209 + Relate=[],Where=[],With=[]}),
141.210 + NoMatch
141.211 + (["pbla1","pbla"],
141.212 + {Find=[],
141.213 + Given=[Correct "fixedValues [aaa = #0]",Missing "maximum a1_",
141.214 + Superfl "relations aaa333"],Relate=[],Where=[],With=[]}),
141.215 + NoMatch
141.216 + (["pbla2","pbla"],
141.217 + {Find=[],
141.218 + Given=[Correct "fixedValues [aaa = #0]",Missing "valuesFor a2_",
141.219 + Superfl "relations aaa333"],Relate=[],Where=[],With=[]}),
141.220 + Matches
141.221 + (["pbla3","pbla"],
141.222 + {Find=[],
141.223 + Given=[Correct "fixedValues [aaa = #0]",Correct "relations aaa333"],
141.224 + Relate=[],Where=[],With=[]})] : match list*)
141.225 +
141.226 +(*case 3: refined to pbt with children *)
141.227 +refine fmz3 ["pbla"];
141.228 +(*
141.229 +*** pass ["pbla"]
141.230 +*** pass ["pbla","pbla1"]
141.231 +*** pass ["pbla","pbla2"]
141.232 +*** pass ["pbla","pbla2","pbla2x"]
141.233 +*** pass ["pbla","pbla2","pbla2y"]
141.234 +*** pass ["pbla","pbla2","pbla2z"]
141.235 +*** pass ["pbla","pbla3"]
141.236 +val it =
141.237 + [Matches
141.238 + (["pbla"],
141.239 + {Find=[],
141.240 + Given=[Correct "fixedValues [aaa = #0]",Superfl "valuesFor aaa222"],
141.241 + Relate=[],Where=[],With=[]}),
141.242 + NoMatch
141.243 + (["pbla1","pbla"],
141.244 + {Find=[],
141.245 + Given=[Correct "fixedValues [aaa = #0]",Missing "maximum a1_",
141.246 + Superfl "valuesFor aaa222"],Relate=[],Where=[],With=[]}),
141.247 + Matches
141.248 + (["pbla2","pbla"],
141.249 + {Find=[],
141.250 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222"],
141.251 + Relate=[],Where=[],With=[]}),
141.252 + NoMatch
141.253 + (["pbla2x","pbla2","pbla"],
141.254 + {Find=[],
141.255 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.256 + Missing "functionOf a2x_"],Relate=[],Where=[],With=[]}),
141.257 + NoMatch
141.258 + (["pbla2y","pbla2","pbla"],
141.259 + {Find=[],
141.260 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.261 + Missing "boundVariable a2y_"],Relate=[],Where=[],With=[]}),
141.262 + NoMatch
141.263 + (["pbla2z","pbla2","pbla"],
141.264 + {Find=[],
141.265 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.266 + Missing "interval a2z_"],Relate=[],Where=[],With=[]}),
141.267 + NoMatch
141.268 + (["pbla3","pbla"],
141.269 + {Find=[],
141.270 + Given=[Correct "fixedValues [aaa = #0]",Missing "relations a3_",
141.271 + Superfl "valuesFor aaa222"],Relate=[],Where=[],With=[]})]
141.272 + : match list*)
141.273 +
141.274 +(*case 4: refined to children (without child)*)
141.275 +refine fmz4 ["pbla"];
141.276 +(*
141.277 +*** pass ["pbla"]
141.278 +*** pass ["pbla","pbla1"]
141.279 +*** pass ["pbla","pbla2"]
141.280 +*** pass ["pbla","pbla2","pbla2x"]
141.281 +*** pass ["pbla","pbla2","pbla2y"]
141.282 +val it =
141.283 + [Matches
141.284 + (["pbla"],
141.285 + {Find=[],
141.286 + Given=[Correct "fixedValues [aaa = #0]",Superfl "valuesFor aaa222",
141.287 + Superfl "boundVariable aaa222yyy"],Relate=[],Where=[],With=[]}),
141.288 + NoMatch
141.289 + (["pbla1","pbla"],
141.290 + {Find=[],
141.291 + Given=[Correct "fixedValues [aaa = #0]",Missing "maximum a1_",
141.292 + Superfl "valuesFor aaa222",Superfl "boundVariable aaa222yyy"],
141.293 + Relate=[],Where=[],With=[]}),
141.294 + Matches
141.295 + (["pbla2","pbla"],
141.296 + {Find=[],
141.297 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.298 + Superfl "boundVariable aaa222yyy"],Relate=[],Where=[],With=[]}),
141.299 + NoMatch
141.300 + (["pbla2x","pbla2","pbla"],
141.301 + {Find=[],
141.302 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.303 + Missing "functionOf a2x_",Superfl "boundVariable aaa222yyy"],
141.304 + Relate=[],Where=[],With=[]}),
141.305 + Matches
141.306 + (["pbla2y","pbla2","pbla"],
141.307 + {Find=[],
141.308 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.309 + Correct "boundVariable aaa222yyy"],Relate=[],Where=[],With=[]})]
141.310 + : match list*)
141.311 +
141.312 +(*case 5: start refinement somewhere in ptyps*)
141.313 +refine fmz4 ["pbla2","pbla"];
141.314 +(*
141.315 +*** pass ["pbla","pbla2"]
141.316 +*** pass ["pbla","pbla2","pbla2x"]
141.317 +*** pass ["pbla","pbla2","pbla2y"]
141.318 +val it =
141.319 + [Matches
141.320 + (["pbla2","pbla"],
141.321 + {Find=[],
141.322 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.323 + Superfl "boundVariable aaa222yyy"],Relate=[],Where=[],With=[]}),
141.324 + NoMatch
141.325 + (["pbla2x","pbla2","pbla"],
141.326 + {Find=[],
141.327 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.328 + Missing "functionOf a2x_",Superfl "boundVariable aaa222yyy"],
141.329 + Relate=[],Where=[],With=[]}),
141.330 + Matches
141.331 + (["pbla2y","pbla2","pbla"],
141.332 + {Find=[],
141.333 + Given=[Correct "fixedValues [aaa = #0]",Correct "valuesFor aaa222",
141.334 + Correct "boundVariable aaa222yyy"],Relate=[],Where=[],With=[]})]
141.335 + : match list*)
141.336 +
141.337 +"###### ptyps:= intermediate_ptyps;###############################";
141.338 +"###### ptyps:= intermediate_ptyps;###############################";
141.339 +"###### ptyps:= intermediate_ptyps;###############################";
141.340 +ptyps:= intermediate_ptyps;
141.341 +show_ptyps();
141.342 +
141.343 +"----------- Refine_Problem (aus subp-rooteq.sml) ----------------";
141.344 +"----------- Refine_Problem (aus subp-rooteq.sml) ----------------";
141.345 +"----------- Refine_Problem (aus subp-rooteq.sml) ----------------";
141.346 +val fmz = ["equality ((x+1)*(x+2)=x^^^2+8)","solveFor x",
141.347 + "errorBound (eps=0)","solutions L"];
141.348 +val (dI',pI',mI') = ("Test.thy",["sqroot-test","univariate","equation","test"],
141.349 + ["Test","squ-equ-test-subpbl1"]);
141.350 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
141.351 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.352 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.353 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.354 +(*nxt = ("Add_Find", Add_Find "solutions L")*)
141.355 +
141.356 +val nxt = ("Specify_Problem",(*vvvv---specify a not-matching problem*)
141.357 + Specify_Problem ["linear","univariate","equation","test"]);
141.358 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.359 +(*ML> f;
141.360 +val it = Form' (PpcKF (0,EdUndef,0,Nundef,
141.361 + (Problem ["linear","univariate","equation","test"],
141.362 + {Find=[Incompl "solutions []"],
141.363 + Given=[Correct "equality ((x + #1) * (x + #2) = x ^^^ #2 + #8)",
141.364 + Correct "solveFor x"],Relate=[],
141.365 + Where=[False "matches (x = #0) ((x + #1) * (x + #2) = x ^^^ #2 + #8)
141.366 + |\nmatches (?b * x = #0) ((x + #1) * (x + #2) = x ^^^ #2 + #8)
141.367 + |\nmatches (?a + x = #0) ((x + #1) * (x + #2) = x ^^^ #2 + #8)
141.368 + |\nmatches (?a + ?b * x = #0) ((x + #1) * (x + #2) = x ^^^ #2 + #8)"],
141.369 + With=[]}))) : mout
141.370 +val nxt = ("Add_Find",Add_Find "solutions L") ????!!!!????*)
141.371 +
141.372 +val (p,_,f,nxt,_,pt) = (me nxt p c pt) handle e => print_exn e;
141.373 +val (p,_,f,nxt,_,pt) = me nxt p c pt(*NEW2*);
141.374 +(*val nxt = ("Empty_Tac",Empty_Tac)
141.375 +... Refine_Problem ["linear"..] fails internally 040312: works!?!*)
141.376 +
141.377 +val nxt = ("Refine_Problem",Refine_Problem ["univariate","equation","test"]);
141.378 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.379 +(*("Specify_Problem", Specify_Problem ["normalize", "univariate", ...])*)
141.380 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.381 +(*nxt = ("Specify_Theory", Specify_Theory "Test.thy")*)
141.382 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.383 +(*nxt = ("Specify_Method", Specify_Method ["Test", "squ-equ-test-subpbl1"]*)
141.384 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.385 +(*nxt = ("Apply_Method", *)
141.386 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.387 +(*nxt = ("Rewrite_Set", Rewrite_Set "norm_equation")*)
141.388 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.389 +(*nxt = ("Rewrite_Set", Rewrite_Set "Test_simplify")*)
141.390 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.391 +(*Subproblem ("Test.thy", ["linear", "univariate", "equation", "test"]*)
141.392 +
141.393 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.394 +(*nxt = Model_Problem ["linear","univariate","equation","test"]*)
141.395 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.396 +(*nxt = ("Add_Given", Add_Given "equality (-6 + 3 * x = 0)"*)
141.397 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.398 +(**)
141.399 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.400 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.401 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.402 +(*nxt = Specify_Problem ["linear","univariate","equation","test"])*)
141.403 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.404 +(*xt = ("Specify_Method", Specify_Method ["Test", "solve_linear"])*)
141.405 +val nxt = ("Refine_Problem",Refine_Problem ["univariate","equation","test"]);
141.406 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.407 +(*("Specify_Problem", Specify_Problem ["linear", "univariate", ...])*)
141.408 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.409 +(*val nxt = ("Specify_Method",Specify_Method ("Test","solve_linear"))*)
141.410 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.411 +(*val nxt = ("Apply_Method",Apply_Method ("Test","solve_linear"))*)
141.412 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.413 +(*val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst ([#],"isolate_bdv"))*)
141.414 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.415 +(*val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify")*)
141.416 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.417 +(*val nxt = ("Check_Postcond",Check_Postcond ["linear","univariate","eq*)
141.418 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.419 +(*val nxt = ("Check_elementwise",Check_elementwise "Assumptions")*)
141.420 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.421 +(*Check_Postcond ["normalize","univariate","equation","test"])*)
141.422 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
141.423 +val Form' (FormKF (~1,EdUndef,_,Nundef,res)) = f;
141.424 +if (snd nxt)=End_Proof' andalso res="[x = 2]" then ()
141.425 +else raise error "new behaviour in test:refine.sml:miniscript with mini-subpb";
141.426 +
141.427 +
141.428 +"----------- fun coll_guhs ---------------------------------------";
141.429 +"----------- fun coll_guhs ---------------------------------------";
141.430 +"----------- fun coll_guhs ---------------------------------------";
141.431 +val n = e_pbt;
141.432 +(#guh : pbt -> guh) e_pbt;
141.433 +
141.434 +fun XXXnode coll (Ptyp (_,[n],ns)) =
141.435 + [(#guh : pbt -> guh) n]
141.436 +and XXXnodes coll [] = coll
141.437 + | XXXnodes coll (n::ns : pbt ptyp list) = (XXXnode coll n) @
141.438 + (XXXnodes coll ns);
141.439 +(*^^^ this works, but not this ...
141.440 +fun node coll (Ptyp (_,[n],ns)) =
141.441 + [(#guh : 'a -> guh) n]
141.442 +and nodes coll [] = coll
141.443 + | nodes coll (n::ns : 'a ptyp list) = (node coll n) @ (nodes coll ns);
141.444 +
141.445 +Error:
141.446 +Can't unify {guh: 'a, ...} with 'b (Cannot unify with explicit type variable)
141.447 + Found near #guh : 'a -> guh
141.448 +
141.449 +i.e. there is no common fun for pbls and mets ?!?*)
141.450 +
141.451 +coll_pblguhs (!ptyps);
141.452 +sort string_ord (coll_pblguhs (!ptyps));
141.453 +show_pblguhs ();
141.454 +sort_pblguhs ();
141.455 +
141.456 +"----------- fun guh2kestoreID -----------------------------------";
141.457 +"----------- fun guh2kestoreID -----------------------------------";
141.458 +"----------- fun guh2kestoreID -----------------------------------";
141.459 +"----- we assumed the problem-hierarchy containing 3 elements on toplevel";
141.460 +val (Ptyp (id1,[n1 as {guh=guh1,...} : pbt], ns1)::
141.461 + Ptyp (id2,[n2 as {guh=guh2,...} : pbt], ns2):: _) = (!ptyps);
141.462 +(*
141.463 +nodes [] guh1 (!ptyps);
141.464 +nodes [] guh2 (!ptyps);
141.465 +*)
141.466 +val (Ptyp (id1,[n1 as {guh=guh1,...} : pbt], ns1)
141.467 + ::
141.468 + Ptyp (id2,[n2 as {guh=guh2,...} : pbt],
141.469 + (Ptyp (id21,[n21 as {guh=guh21,...} : pbt], ns21)) :: _ )
141.470 + ::
141.471 + Ptyp (id3,[n3 as {guh=guh3,...} : pbt], ns3)
141.472 + ::
141.473 + _ ) = (!ptyps);
141.474 +(*
141.475 +nodes [] guh3 (!ptyps);
141.476 +nodes [] guh21 (!ptyps);
141.477 +*)
141.478 \ No newline at end of file
142.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
142.2 +++ b/src/Pure/isac/smltest/ME/rewtools.sml Wed Jul 21 13:53:39 2010 +0200
142.3 @@ -0,0 +1,531 @@
142.4 +(* test for sml/ME/rewtools.sml
142.5 + authors: Walther Neuper 2000, 2006
142.6 + (c) due to copyright terms
142.7 +
142.8 +use"../smltest/ME/rewtools.sml";
142.9 +use"rewtools.sml";
142.10 +*)
142.11 +
142.12 +"-----------------------------------------------------------------";
142.13 +"table of contents -----------------------------------------------";
142.14 +"-----------------------------------------------------------------";
142.15 +"----------- fun collect_isab_thys -------------------------------";
142.16 +"----------- fun thy_containing_thm ------------------------------";
142.17 +"----------- fun thy_containing_rls ------------------------------";
142.18 +"----------- fun thy_containing_cal ------------------------------";
142.19 +"----------- initContext Thy_ Integration-demo -------------------";
142.20 +"----------- initContext..Thy_, fun context_thm ------------------";
142.21 +"----------- initContext..Thy_, fun context_rls ------------------";
142.22 +"----------- checkContext..Thy_, fun context_thy -----------------";
142.23 +"----------- checkContext..Thy_, fun context_rls -----------------";
142.24 +"----------- checkContext..Thy_ on last formula ------------------";
142.25 +"----------- fun guh2theID ---------------------------------------";
142.26 +"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
142.27 +"-----------------------------------------------------------------";
142.28 +"----------- fun string_of_thmI for_[.]_) ------------------------";
142.29 +"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
142.30 +"-----------------------------------------------------------------";
142.31 +"----------- fun filter_appl_rews --------------------------------";
142.32 +"----------- fun is_contained_in ---------------------------------";
142.33 +"-----------------------------------------------------------------";
142.34 +"-----------------------------------------------------------------";
142.35 +
142.36 +
142.37 +
142.38 +"----------- fun collect_isab_thys -------------------------------";
142.39 +"----------- fun collect_isab_thys -------------------------------";
142.40 +"----------- fun collect_isab_thys -------------------------------";
142.41 +val thy = first_isac_thy (*def. in Script/ListG.ML*);
142.42 +val {ancestors,...} = rep_theory thy;
142.43 +print_depth 99; map string_of_thy ancestors; print_depth 3;
142.44 +length ancestors;
142.45 +val ancestors = (#ancestors o rep_theory) first_isac_thy;
142.46 +length ancestors;
142.47 +print_depth 99; map theory2theory' ancestors; print_depth 3;
142.48 +val isabthms = (flat o (map thms_of)) ancestors;
142.49 +length isabthms;
142.50 +
142.51 +val isacrules = (flat o (map (thms_of_rls o #2 o #2))) (!ruleset');
142.52 +(*thms from rulesets*)
142.53 +val isacrlsthms = ((map rep_thm_G') o flat o
142.54 + (map (thms_of_rls o #2 o #2))) (!ruleset');
142.55 +length isacrlsthms;
142.56 +(*takes a few seconds...
142.57 +val isacrlsthms = gen_distinct eq_thmI isacrlsthms;
142.58 +length isacrlsthms;
142.59 +"----- theorems used in isac's rulesets -----vvvvvvvvvvvvvvvvvvvvv";
142.60 +print_depth 99; map #1 isacrlsthms; print_depth 3;
142.61 +"----- theorems used in isac's rulesets -----^^^^^^^^^^^^^^^^^^^^^";
142.62 +...*)
142.63 +
142.64 +(!theory');
142.65 +map #2 (!theory');
142.66 +map (thms_of o #2) (!theory');
142.67 +val isacthms = (flat o (map (thms_of o #2))) (!theory');
142.68 +(*takes a few seconds...
142.69 +val rlsthmsNOTisac = gen_diff eq_thmI (isacrlsthms, isacthms);
142.70 +length rlsthmsNOTisac;
142.71 +"----- theorems from rulesets NOT def. in isac -----vvvvvvvvvvvvvv";
142.72 +print_depth 99; map #1 rlsthmsNOTisac; print_depth 3;
142.73 +"----- theorems from rulesets NOT def. in isac -----^^^^^^^^^^^^^^";
142.74 +...*)
142.75 +
142.76 +"----- for 'fun make_isab_thm_thy'";
142.77 +gen_inter eq_thmI (isacrlsthms, (thms_of (nth 1 ancestors)));
142.78 +gen_inter eq_thmI;
142.79 +curry (gen_inter eq_thmI);
142.80 +curry (gen_inter eq_thmI) isacrlsthms;
142.81 +(*takes a few seconds...
142.82 +curry (gen_inter eq_thmI) isacrlsthms (thms_of (nth 9 ancestors));
142.83 +
142.84 +val thy = (nth 52 ancestors);
142.85 +val sec = (curry (gen_inter eq_thmI) isacrlsthms o thms_of) (nth 52 ancestors);
142.86 +length (thms_of (nth 9 ancestors));
142.87 +length sec;
142.88 +...*)
142.89 +
142.90 +(*takes 1 minute...
142.91 +print_depth 99;
142.92 +map (curry (gen_inter eq_thmI) rlsthmsNOTisac o thms_of) ancestors;
142.93 +print_depth 3;
142.94 +*)
142.95 +
142.96 +(*takes some seconds...
142.97 +val isab_thm_thy = (flat o (map (make_isab_thm_thy rlsthmsNOTisac)))
142.98 + ((#ancestors o rep_theory) first_isac_thy);
142.99 +print_depth 99; isab_thm_thy; print_depth 3;
142.100 +*)
142.101 +
142.102 +
142.103 +"----------- fun thy_containing_thm ------------------------------";
142.104 +"----------- fun thy_containing_thm ------------------------------";
142.105 +"----------- fun thy_containing_thm ------------------------------";
142.106 +val (str, (thy', thy)) = ("real_diff_minus",("Root.thy", Root.thy));
142.107 +if thy_contains_thm str ("XXX",thy) then ()
142.108 +else raise error "rewtools.sml: NOT thy_contains_thm \
142.109 + \(real_diff_minus,(Root.thy,.";
142.110 +(rev (!theory'));
142.111 +dropuntil (curry op= thy');
142.112 +dropuntil ((curry op= thy') o (#1:theory' * theory -> theory'));
142.113 +val startsearch = dropuntil ((curry op= thy') o
142.114 + (#1:theory' * theory -> theory'))
142.115 + (rev (!theory'));
142.116 +if thy_containing_thm thy' str = ("IsacKnowledge", "Root.thy") then ()
142.117 +else raise error "rewtools.sml: NOT thy_containin_thm \
142.118 + \(real_diff_minus,(Root.thy,.";
142.119 +
142.120 +"----- search the same theorem somewhere further below in the list";
142.121 +if thy_contains_thm str ("XXX",Poly.thy) then ()
142.122 +else raise error "rewtools.sml: NOT thy_contains_thm \
142.123 + \(real_diff_minus,(Poly.thy,.";
142.124 +if thy_containing_thm "LinEq.thy" str = ("IsacKnowledge", "Poly.thy") then ()
142.125 +else raise error "rewtools.sml: NOT thy_containing_thm \
142.126 + \(real_diff_minus,(Poly.thy,.";
142.127 +
142.128 +"----- second test -------------------------------";
142.129 +show_thes();
142.130 +(*args vor thy_containing_thm...*)
142.131 +val (thy',str) = ("Test.thy", "radd_commute");
142.132 +val startsearch = dropuntil ((curry op= thy') o
142.133 + (#1:theory' * theory -> theory'))
142.134 + (rev (!theory'));
142.135 +length (!theory');
142.136 +length startsearch;
142.137 +if thy_containing_thm thy' str = ("IsacKnowledge", "Test.thy") then ()
142.138 +else raise error "rewtools.sml: diff.behav. in \
142.139 + \thy_containing_thm Test radd_commute";
142.140 +
142.141 +
142.142 +"----------- fun thy_containing_rls ------------------------------";
142.143 +"----------- fun thy_containing_rls ------------------------------";
142.144 +"----------- fun thy_containing_rls ------------------------------";
142.145 +val thy' = "Biegelinie.thy";
142.146 +val dropthys = takewhile [] (not o (curry op= thy') o
142.147 + (#1:theory' * theory -> theory'))
142.148 + (rev (!theory'));
142.149 +if length (!theory') <> length dropthys then ()
142.150 +else raise error "rewtools.sml: diff.behav. in thy_containing_rls 1";
142.151 +val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
142.152 + dropthys;
142.153 +print_depth 99; dropthy's; print_depth 3;
142.154 +
142.155 +"Isac" mem dropthy's;
142.156 +op mem ("Isac", dropthy's);
142.157 +(op mem) o swap;
142.158 +((op mem) o swap) (dropthy's, "Isac");
142.159 +curry ((op mem) o swap);
142.160 +curry ((op mem) o swap) dropthy's "Isac";
142.161 +val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o
142.162 + ((#1 o #2) : rls' * (theory' * rls) -> theory'))
142.163 + (rev (!ruleset'));
142.164 +print_depth 99; map (#1 o #2) startsearch; print_depth 3;
142.165 +if length (!ruleset') <> length startsearch then ()
142.166 +else raise error "rewtools.sml: diff.behav. in thy_containing_rls 2";
142.167 +
142.168 +val rls' = "norm_Poly";
142.169 +case assoc (startsearch, rls') of
142.170 + Some (thy', _) => thyID2theory' thy'
142.171 + | _ => raise error ("thy_containing_rls : rls '"^str^
142.172 + "' not in !rulset' und thy '"^thy'^"'");
142.173 +
142.174 +if thy_containing_rls thy' rls' = ("IsacKnowledge", "Poly.thy") then ()
142.175 +else raise error "rewtools.sml: diff.behav. in thy_containing_rls 3";
142.176 +
142.177 +
142.178 +"----------- fun thy_containing_cal ------------------------------";
142.179 +"----------- fun thy_containing_cal ------------------------------";
142.180 +"----------- fun thy_containing_cal ------------------------------";
142.181 +val thy' = "Atools.thy";
142.182 +val dropthys = takewhile [] (not o (curry op= thy') o
142.183 + (#1:theory' * theory -> theory'))
142.184 + (rev (!theory'));
142.185 +length dropthys <> length (!theory');
142.186 +val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
142.187 + dropthys;
142.188 +
142.189 +(rev (!calclist'));
142.190 +map #1 (rev (!calclist'));
142.191 +map (#1 : calc -> string) (rev (!calclist'));
142.192 +val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o
142.193 + (#1 : calc -> string)) (rev (!calclist'));
142.194 +
142.195 +"----------- initContext Thy_ Integration-demo -------------------";
142.196 +"----------- initContext Thy_ Integration-demo -------------------";
142.197 +"----------- initContext Thy_ Integration-demo -------------------";
142.198 +states:=[];
142.199 +CalcTree
142.200 +[(["functionTerm (2 * x)","integrateBy x","antiDerivative FF"],
142.201 + ("Integrate.thy",["integrate","function"],
142.202 + ["diff","integration"]))];
142.203 +Iterator 1;
142.204 +moveActiveRoot 1;
142.205 +(*TODO.new_c: cvs before 071227, 11:50------------------
142.206 +autoCalculate 1 CompleteCalc;
142.207 +interSteps 1 ([1],Res);
142.208 +interSteps 1 ([1,1],Res);
142.209 +val ((pt,p),_) = get_calc 1; show_pt pt;
142.210 +if existpt' ([1,1,1], Frm) pt then ()
142.211 +else raise error "integrate.sml: interSteps on Rewrite_Set_Inst 1";
142.212 +
142.213 +initContext 1 Thy_ ([1,1,1], Frm);
142.214 +--------------------TODO.new_c: cvs before 071227, 11:50*)
142.215 +
142.216 +"----------- initContext..Thy_, fun context_thm ------------------";
142.217 +"----------- initContext..Thy_, fun context_thm ------------------";
142.218 +"----------- initContext..Thy_, fun context_thm ------------------";
142.219 +states:=[];
142.220 +CalcTree (*start of calculation, return No.1*)
142.221 +[(["equality (x+1=2)", "solveFor x","solutions L"],
142.222 + ("Test.thy",
142.223 + ["sqroot-test","univariate","equation","test"],
142.224 + ["Test","squ-equ-test-subpbl1"]))];
142.225 +Iterator 1; moveActiveRoot 1;
142.226 +autoCalculate 1 CompleteCalc;
142.227 +
142.228 +"----- no thy-context at result -----";
142.229 +val p = ([], Res);
142.230 +initContext 1 Thy_ p;
142.231 +
142.232 +
142.233 +interSteps 1 ([2], Res);
142.234 +interSteps 1 ([3,1], Res);
142.235 +val ((pt,_),_) = get_calc 1; show_pt pt;
142.236 +
142.237 +val p = ([2,4], Res);
142.238 +val tac = Rewrite ("radd_left_commute","");
142.239 +initContext 1 Thy_ p;
142.240 +(*Res->Res, Rewrite "radd_left_commute 1 + (-2 + x) = 0 -> -2 + (1 + x) = 0
142.241 + --- in initContext..Thy_ ---*)
142.242 +val ContThm {thm,result,...} = context_thy (pt,p) tac;
142.243 +if thm = "thy_isac_Test-thm-radd_left_commute"
142.244 + andalso term2str result = "-2 + (1 + x) = 0" then ()
142.245 +else raise error"rewtools.sml initContext..Th_ thy_Test-thm-radd_left_commute";
142.246 +
142.247 +val p = ([3,1,1], Frm);
142.248 +val tac = Rewrite_Inst (["(bdv, x)"],("risolate_bdv_add",""));
142.249 +initContext 1 Thy_ p;
142.250 +(*Frm->Res, Rewrite_Inst "risolate_bdv_add" -1 + x = 0 -> x = 0 + -1 * -1
142.251 + --- in initContext..Thy_ ---*)
142.252 +val ContThmInst {thm,result,...} = context_thy (pt,p) tac;
142.253 +if thm = "thy_isac_Test-thm-risolate_bdv_add"
142.254 + andalso term2str result = "x = 0 + -1 * -1" then ()
142.255 +else raise error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
142.256 +
142.257 +initContext 1 Thy_ ([2,5], Res);
142.258 +(*Res->Res, Calculate "plus" -2 + (1 + x) = 0 -> -1 + x = 0
142.259 + --- in initContext..Thy_ ---*)
142.260 +
142.261 +
142.262 +"----------- initContext..Thy_, fun context_rls ------------------";
142.263 +"----------- initContext..Thy_, fun context_rls ------------------";
142.264 +"----------- initContext..Thy_, fun context_rls ------------------";
142.265 +(*using pt from above*)
142.266 +val p = ([1], Res);
142.267 +val tac = Rewrite_Set "Test_simplify";
142.268 +initContext 1 Thy_ p;
142.269 +(*Res->Res, Rewrite_Set "Test_simplify" x + 1 + -1 * 2 = 0 -> -1 + x = 0
142.270 + --- in initContext..Thy_ ---*)
142.271 +val ContRls {rls,result,...} = context_thy (pt,p) tac;
142.272 +if rls = "thy_isac_Test-rls-Test_simplify"
142.273 + andalso term2str result = "-1 + x = 0" then ()
142.274 +else raise error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
142.275 +
142.276 +val p = ([3,1], Frm);
142.277 +val tac = Rewrite_Set_Inst (["(bdv, x)"],"isolate_bdv");
142.278 +initContext 1 Thy_ p;
142.279 +(*Frm->Res, Rewrite_Set_Inst "isolate_bdv" -1 + x = 0 -> x = 0 + -1 * -1
142.280 + --- in initContext..Thy_ ---*)
142.281 +val ContRlsInst {rls,result,...} = context_thy (pt,p) tac;
142.282 +if rls = "thy_isac_Test-rls-isolate_bdv"
142.283 + andalso term2str result = "x = 0 + -1 * -1" then ()
142.284 +else raise error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
142.285 +
142.286 +
142.287 +
142.288 +"----------- checkContext..Thy_, fun context_thy -----------------";
142.289 +"----------- checkContext..Thy_, fun context_thy -----------------";
142.290 +"----------- checkContext..Thy_, fun context_thy -----------------";
142.291 +(*using pt from above*)
142.292 +
142.293 +val p = ([2,4], Res);
142.294 +val tac = Rewrite ("radd_left_commute","");
142.295 +checkContext 1 p "thy_Test-thm-radd_left_commute";
142.296 +(* radd_left_commute: 1 + (-2 + x) = 0 -> -2 + (1 + x) = 0
142.297 + --- in checkContext..Thy_ ---*)
142.298 +val ContThm {thm,result,...} = context_thy (pt,p) tac;
142.299 +if thm = "thy_isac_Test-thm-radd_left_commute"
142.300 + andalso term2str result = "-2 + (1 + x) = 0" then ()
142.301 +else raise error "rewtools.sml checkContext.._ thy_Test-thm-radd_left_commute";
142.302 +
142.303 +val p = ([3,1,1], Frm);
142.304 +val tac = Rewrite_Inst (["(bdv,x)"],("risolate_bdv_add",""));
142.305 +checkContext 1 p "thy_Test-thm-risolate_bdv_add";
142.306 +(* risolate_bdv_add: -1 + x = 0 -> x = 0 + -1 * -1
142.307 + --- in checkContext..Thy_ ---*)
142.308 +val ContThmInst {thm,result,...} = context_thy (pt,p) tac;
142.309 +if thm = "thy_isac_Test-thm-risolate_bdv_add"
142.310 + andalso term2str result = "x = 0 + -1 * -1" then ()
142.311 +else raise error "rewtools.sml checkContext..T_ thy_Test-thm-risolate_bdv_add";
142.312 +
142.313 +val p = ([2,5], Res);
142.314 +val tac = Calculate "plus";
142.315 +(*checkContext..Thy_ 1 ([2,5], Res);*)
142.316 +(*FIXXXME #######################vvvvv kestoreID !!!!!!!!!!!!!!!!*)
142.317 +checkContext 1 p ;
142.318 +(* Calculate "plus" -2 + (1 + x) = 0 -> -1 + x = 0
142.319 + --- in checkContext..Thy_ ---*)
142.320 +
142.321 +
142.322 +"----------- checkContext..Thy_, fun context_rls -----------------";
142.323 +"----------- checkContext..Thy_, fun context_rls -----------------";
142.324 +"----------- checkContext..Thy_, fun context_rls -----------------";
142.325 +(*using pt from above*)
142.326 +show_pt pt;
142.327 +
142.328 +val p = ([1], Res);
142.329 +val tac = Rewrite_Set "Test_simplify";
142.330 +checkContext 1 p "thy_isac_Test-rls-Test_simplify";
142.331 +(*Res->Res, Rewrite_Set "Test_simplify" x + 1 + -1 * 2 = 0 -> -1 + x = 0
142.332 + --- in checkContext..Thy_ ---*)
142.333 +val ContRls {rls,result,...} = context_thy (pt,p) tac;
142.334 +if rls = "thy_isac_Test-rls-Test_simplify"
142.335 + andalso term2str result = "-1 + x = 0" then ()
142.336 +else raise error "rewtools.sml checkContext..Thy_ thy_Test-rls-Test_simplify";
142.337 +
142.338 +val p = ([3,1], Frm);
142.339 +val tac = Rewrite_Set_Inst (["(bdv, x)"],"isolate_bdv");
142.340 +checkContext 1 p "thy_Test-rls-isolate_bdv";
142.341 +val ContRlsInst {rls,result,...} = context_thy (pt,p) tac;
142.342 +if rls = "thy_isac_Test-rls-isolate_bdv"
142.343 + andalso term2str result = "x = 0 + -1 * -1" then ()
142.344 +else raise error "rewtools.sml checkContext..Thy_ thy_Test-thm-isolate_bdv";
142.345 +
142.346 +
142.347 +"----------- checkContext..Thy_ on last formula ------------------";
142.348 +"----------- checkContext..Thy_ on last formula ------------------";
142.349 +"----------- checkContext..Thy_ on last formula ------------------";
142.350 +states:=[];
142.351 +CalcTree (*start of calculation, return No.1*)
142.352 +[(["equality (x+1=2)", "solveFor x","solutions L"],
142.353 + ("Test.thy",
142.354 + ["sqroot-test","univariate","equation","test"],
142.355 + ["Test","squ-equ-test-subpbl1"]))];
142.356 +Iterator 1; moveActiveRoot 1;
142.357 +
142.358 +autoCalculate 1 CompleteCalcHead;
142.359 +autoCalculate 1 (Step 1);
142.360 +val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
142.361 +initContext 1 Thy_ ([1], Frm);
142.362 +checkContext 1 ([1], Frm) "thy_isac_Test-thm-radd_left_commute";
142.363 +
142.364 +autoCalculate 1 (Step 1);
142.365 +val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
142.366 +initContext 1 Thy_ ([1], Res);
142.367 +checkContext 1 ([1], Res) "thy_isac_Test-rls-Test_simplify";
142.368 +
142.369 +
142.370 +
142.371 +"----------- fun guh2theID ---------------------------------------";
142.372 +"----------- fun guh2theID ---------------------------------------";
142.373 +"----------- fun guh2theID ---------------------------------------";
142.374 +val guh = "thy_scri_ListG-thm-zip_Nil";
142.375 +
142.376 +take_fromto 1 4 (explode guh);
142.377 +take_fromto 5 9 (explode guh);
142.378 +val rest = takerest (9,(explode guh));
142.379 +
142.380 +separate "-" rest;
142.381 +space_implode "-" rest;
142.382 +commas rest;
142.383 +
142.384 +val delim = "-";
142.385 +val thyID = takewhile [] (not o (curry op= delim)) rest;
142.386 +val rest' = dropuntil (curry op= delim) rest;
142.387 +val setc = take_fromto 1 5 rest';
142.388 +val xstr = takerest (5, rest');
142.389 +
142.390 +if guh2theID guh = ["IsacScripts", "ListG", "Theorems", "zip_Nil"] then ()
142.391 +else raise error "rewtools.sml: guh2theID thy_scri_ListG-thm-zip_Nil changed";
142.392 +
142.393 +
142.394 +"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
142.395 +"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
142.396 +"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
142.397 +"----- initContext -----";
142.398 +states:=[];
142.399 +CalcTree
142.400 + [(["equality (1+-1*2+x=0)", "solveFor x", "solutions L"],
142.401 + ("Test.thy",
142.402 + ["linear","univariate","equation","test"],
142.403 + ["Test","solve_linear"]))];
142.404 +Iterator 1; moveActiveRoot 1;
142.405 +autoCalculate 1 CompleteCalcHead;
142.406 +
142.407 +autoCalculate 1 (Step 1); val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
142.408 +if is_curr_endof_calc pt ([1],Frm) then ()
142.409 +else raise error "rewtools.sml is_curr_endof_calc ([1],Frm)";
142.410 +
142.411 +autoCalculate 1 (Step 1); val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
142.412 +if not (is_curr_endof_calc pt ([1],Frm)) then ()
142.413 +else raise error "rewtools.sml is_curr_endof_calc ([1],Frm) not";
142.414 +if is_curr_endof_calc pt ([1],Res) then ()
142.415 +else raise error "rewtools.sml is_curr_endof_calc ([1],Res)";
142.416 +
142.417 +initContext 1 Thy_ ([1],Res);
142.418 +
142.419 +"----- checkContext -----";
142.420 +states:=[];
142.421 +CalcTree
142.422 + [(["equality (1+-1*2+x=0)", "solveFor x", "solutions L"],
142.423 + ("Test.thy",
142.424 + ["linear","univariate","equation","test"],
142.425 + ["Test","solve_linear"]))];
142.426 +Iterator 1; moveActiveRoot 1;
142.427 +autoCalculate 1 CompleteCalc;
142.428 +interSteps 1 ([1],Res);
142.429 +val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
142.430 +
142.431 +checkContext 1 ([1],Res) "thy_isac_Test-rls-Test_simplify";
142.432 +
142.433 +interSteps 1 ([2],Res);
142.434 +val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
142.435 +
142.436 +checkContext 1 ([2,1],Res) "thy_isac_Test-rls-Test_simplify";
142.437 +checkContext 1 ([2,2],Res) "thy_isac_Test-rls-Test_simplify";
142.438 +
142.439 +
142.440 +"----------- fun string_of_thmI for_[.]_) ------------------------";
142.441 +"----------- fun string_of_thmI for_[.]_) ------------------------";
142.442 +"----------- fun string_of_thmI for_[.]_) ------------------------";
142.443 +"----- these work ?!?";
142.444 +val th = sym_thm real_minus_eq_cancel;
142.445 +val Th = sym_Thm (Thm ("real_minus_eq_cancel", real_minus_eq_cancel));
142.446 +val th'= mk_thm Isac.thy ((de_quote o string_of_thm) real_minus_eq_cancel);
142.447 +val th'= mk_thm Biegelinie.thy((de_quote o string_of_thm)real_minus_eq_cancel);
142.448 +
142.449 +"----- DIFFERENCE TO ABOVE ?!?: this is still ok, when called in next_tac...";
142.450 +val ((pt,(p,p_)), _) = get_calc 1; show_pt pt;
142.451 +val Appl (Rewrite' (_,_,_,_,thm',_,_)) =
142.452 + applicable_in (p,p_) pt (Rewrite ("sym_real_minus_eq_cancel",""));
142.453 +"- compose stac as done in | appy (*leaf*) by handle_leaf";
142.454 +val (th, sr, E, a, v, t) =
142.455 + ("Biegelinie.thy",
142.456 + (#srls o get_met) ["IntegrierenUndKonstanteBestimmen"],
142.457 + [(str2term "q__::bool", str2term "q x = q_0")],
142.458 + Some (str2term "q x = q_0"),
142.459 + str2term "q__::bool",
142.460 + str2term "(Rewrite sym_real_minus_eq_cancel False) (q__::bool)");
142.461 +val (a', STac stac) = handle_leaf "next " th sr E a v t;
142.462 +term2str stac;
142.463 +"--- but this \"m\" is already corrupted";
142.464 +val (m,_) = stac2tac_ EmptyPtree (assoc_thy th) stac;
142.465 +"- because in assoc_thm'...";
142.466 +val (thy, (thmid, ct')) = (Biegelinie.thy, ("sym_real_minus_eq_cancel",""));
142.467 +val "s"::"y"::"m"::"_"::id = explode thmid;
142.468 +((num_str o (get_thm thy)) (implode id)) RS sym;
142.469 +((get_thm thy) (implode id)) RS sym;
142.470 +"... this creates [.]";
142.471 +((get_thm thy) (implode id));
142.472 +"... while this has _NO_ [.]";
142.473 +
142.474 +"----- thus we repair the [.] in string_of_thmI...";
142.475 +val thm = ((num_str o (get_thm thy)) (implode id)) RS sym;
142.476 +if string_of_thmI thm = "(?b1 = ?a1) = (- ?b1 = - ?a1)" then ()
142.477 +else raise error ("rewtools.sml: string_of_thmI " ^ string_of_thm thm ^
142.478 + " = " ^ string_of_thmI thm);
142.479 +
142.480 +
142.481 +"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
142.482 +"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
142.483 +"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
142.484 +states:=[];
142.485 +CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
142.486 + "RandbedingungenBiegung [y 0 = 0, y L = 0]",
142.487 + "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
142.488 + "FunktionsVariable x"],
142.489 + ("Biegelinie.thy",
142.490 + ["MomentBestimmte","Biegelinien"],
142.491 + ["IntegrierenUndKonstanteBestimmen"]))];
142.492 +moveActiveRoot 1;
142.493 +autoCalculate 1 CompleteCalcHead;
142.494 +autoCalculate 1 (Step 1) (*Apply_Method*);
142.495 +autoCalculate 1 (Step 1) (*->GENERATED ([1], Frm)*);
142.496 +"--- this was corrupted before 'fun string_of_thmI'";
142.497 +val ((pt,(p,p_)), _) = get_calc 1; show_pt pt;
142.498 +if get_obj g_tac pt p = Rewrite ("sym_real_minus_eq_cancel",
142.499 + "(?b1 = ?a1) = (- ?b1 = - ?a1)") then ()
142.500 +else raise error "rewtools.sml: string_of_thmI ?!?";
142.501 +
142.502 +getTactic 1 ([1],Frm);
142.503 +
142.504 +"----------- fun filter_appl_rews --------------------------------";
142.505 +"----------- fun filter_appl_rews --------------------------------";
142.506 +"----------- fun filter_appl_rews --------------------------------";
142.507 +val f = str2term "a + z + 2*a + 3*z + 5 + 6";
142.508 +val thy = assoc_thy "Isac.thy";
142.509 +val subst = [(*TODO.WN071231 test Rewrite_Inst*)];
142.510 +val rls = Test_simplify;
142.511 +(* val rls = rls_p_33; filter_appl_rews ---> length 2
142.512 + val rls = norm_Poly; filter_appl_rews ---> length 1
142.513 + *)
142.514 +if filter_appl_rews thy subst f rls =
142.515 + [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
142.516 + Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
142.517 + Calculate "plus"] then ()
142.518 +else raise error "rewtools.sml filter_appl_rews a + z + 2*a + 3*z + 5 + 6";
142.519 +
142.520 +
142.521 +"----------- fun is_contained_in ---------------------------------";
142.522 +"----------- fun is_contained_in ---------------------------------";
142.523 +"----------- fun is_contained_in ---------------------------------";
142.524 +val r1 = Thm ("real_diff_minus",num_str real_diff_minus);
142.525 +if contains_rule r1 Test_simplify then ()
142.526 +else raise error "rewtools.sml contains_rule Thm";
142.527 +
142.528 +val r1 = Calc ("op +", eval_binop "#add_");
142.529 +if contains_rule r1 Test_simplify then ()
142.530 +else raise error "rewtools.sml contains_rule Calc";
142.531 +
142.532 +val r1 = Calc ("op -", eval_binop "#add_");
142.533 +if not (contains_rule r1 Test_simplify) then ()
142.534 +else raise error "rewtools.sml contains_rule Calc";
143.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
143.2 +++ b/src/Pure/isac/smltest/ME/script.sml Wed Jul 21 13:53:39 2010 +0200
143.3 @@ -0,0 +1,250 @@
143.4 +(* tests for ME/script.sml
143.5 + TODO.WN0509 collect typical tests from systest here !!!!!
143.6 + author: Walther Neuper 050908
143.7 + (c) copyright due to lincense terms.
143.8 +
143.9 +use"../smltest/ME/script.sml";
143.10 +use"script.sml";
143.11 +*)
143.12 +"-----------------------------------------------------------------";
143.13 +"table of contents -----------------------------------------------";
143.14 +"-----------------------------------------------------------------";
143.15 +"----------- WN0509 why does next_tac doesnt find Substitute -----";
143.16 +"----------- WN0509 Substitute 2nd part --------------------------";
143.17 +"----------- fun sel_appl_atomic_tacs ----------------------------";
143.18 +"-----------------------------------------------------------------";
143.19 +"-----------------------------------------------------------------";
143.20 +"-----------------------------------------------------------------";
143.21 +
143.22 +
143.23 +"----------- WN0509 why does next_tac doesnt find Substitute -----";
143.24 +"----------- WN0509 why does next_tac doesnt find Substitute -----";
143.25 +"----------- WN0509 why does next_tac doesnt find Substitute -----";
143.26 +
143.27 +(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
143.28 +val str = (*#1#*)
143.29 +"Script BiegelinieScript \
143.30 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.31 +\(rb_::bool list) (rm_::bool list) = \
143.32 +\ (let q___ = Take (M_b v_ = q__); \
143.33 +\ (M1__::bool) = ((Substitute [v_ = 0])) q___ \
143.34 +\ in True)";
143.35 +val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
143.36 +
143.37 +val str = (*#2#*)
143.38 +"Script BiegelinieScript \
143.39 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.40 +\(rb_::bool list) (rm_::bool list) = \
143.41 +\ (let q___ = Take (q_ v_ = q__); \
143.42 +\ (M1__::bool) = ((Substitute [v_ = 0]) @@ \
143.43 +\ (Substitute [M_b 0 = 0])) q___ \
143.44 +\ in True)";(*..doesnt find Substitute with ..@@ !!!!!!!!!!!!!!!!!!!!!*)
143.45 +
143.46 +val str = (*#3#*)
143.47 +"Script BiegelinieScript \
143.48 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.49 +\(rb_::bool list) (rm_::bool list) = \
143.50 +\ (let q___ = Take (q_ v_ = q__); \
143.51 +\ (M1__::bool) = Substitute [v_ = 0] q___ ; \
143.52 +\ M1__ = Substitute [M_b 0 = 0] M1__ \
143.53 +\ in True)"
143.54 +;
143.55 +val str = (*#4#*)
143.56 +"Script BiegelinieScript \
143.57 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.58 +\(rb_::bool list) (rm_::bool list) = \
143.59 +\ (let q___ = Take (q_ v_ = q__); \
143.60 +\ (M1__::bool) = Substitute [v_ = 0] q___ ; \
143.61 +\ M1__ = Substitute [v_ = 1] q___ ; \
143.62 +\ M1__ = Substitute [v_ = 2] q___ ; \
143.63 +\ M1__ = Substitute [v_ = 3] q___ ; \
143.64 +\ M1__ = Substitute [M_b 0 = 0] M1__ \
143.65 +\ in True)"
143.66 +;
143.67 +val str = (*#5#*)
143.68 +"Script BiegelinieScript \
143.69 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.70 +\(rb_::bool list) (rm_::bool list) = \
143.71 +\ (let q___ = Take (M_b v_ = q__); \
143.72 +\ (M1__::bool) = Substitute [v_ = 0] q___ ; \
143.73 +\ M2__ = Take q___ ; \
143.74 +\ M2__ = Substitute [v_ = 2] q___ \
143.75 +\ in True)"
143.76 +;
143.77 +val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
143.78 +atomty sc';
143.79 +val {scr=Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
143.80 +(*---------------------------------------------------------------------
143.81 +if sc = sc' then () else raise error"script.sml, doesnt find Substitute #1";
143.82 +---------------------------------------------------------------------*)
143.83 +
143.84 +val fmz = ["Traegerlaenge L",
143.85 + "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
143.86 + "Biegelinie y",
143.87 + "RandbedingungenBiegung [y 0 = 0, y L = 0]",
143.88 + "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
143.89 + "FunktionsVariable x"];
143.90 +val (dI',pI',mI') =
143.91 + ("Biegelinie.thy",["MomentBestimmte","Biegelinien"],
143.92 + ["IntegrierenUndKonstanteBestimmen"]);
143.93 +val p = e_pos'; val c = [];
143.94 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
143.95 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.96 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.97 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.98 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.99 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.100 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.101 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.102 +case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
143.103 + | _ => raise error "script.sml, doesnt find Substitute #2";
143.104 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
143.105 +(* *** generate1: not impl.for Substitute' !!!!!!!!!!(*#1#*)!!!!!!!!!!!*)
143.106 +(* val nxt = ("Check_Postcond",.. !!!!!!!!!!!!!!!!!!!(*#2#*)!!!!!!!!!!!*)
143.107 +
143.108 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
143.109 +(* *** generate1: not impl.for Empty_Tac_ !!!!!!!!!!(*#3#*)!!!!!!!!!!!*)
143.110 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
143.111 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
143.112 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
143.113 +(*---------------------------------------------------------------------*)
143.114 +case nxt of (_, End_Proof') => ()
143.115 + | _ => raise error "script.sml, doesnt find Substitute #3";
143.116 +(*---------------------------------------------------------------------*)
143.117 +(*the reason, that next_tac didnt find the 2nd Substitute, was that
143.118 + the Take inbetween was missing, and thus the 2nd Substitute was applied
143.119 + the last formula in ctree, and not to argument from script*)
143.120 +
143.121 +
143.122 +"----------- WN0509 Substitute 2nd part --------------------------";
143.123 +"----------- WN0509 Substitute 2nd part --------------------------";
143.124 +"----------- WN0509 Substitute 2nd part --------------------------";
143.125 +(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
143.126 +val str = (*Substitute ; Substitute works*)
143.127 +"Script BiegelinieScript \
143.128 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.129 +\(rb_::bool list) (rm_::bool list) = "^
143.130 +(*begin after the 2nd integrate*)
143.131 +" (let M__ = Take (M_b v_ = q__); \
143.132 +\ e1__ = nth_ 1 rm_ ; \
143.133 +\ (x1__::real) = argument_in (lhs e1__); \
143.134 +\ (M1__::bool) = Substitute [v_ = x1__] M__; \
143.135 +\ M1__ = Substitute [e1__] M1__ \
143.136 +\ in True)"
143.137 +;
143.138 +(*---^^^-OK-----------------------------------------------------------------*)
143.139 +val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
143.140 +atomty sc';
143.141 +(*---vvv-NOT ok-------------------------------------------------------------*)
143.142 +val str = (*Substitute @@ Substitute does NOT work???*)
143.143 +"Script BiegelinieScript \
143.144 +\(l_::real) (q__::real) (v_::real) (b_::real=>real) \
143.145 +\(rb_::bool list) (rm_::bool list) = "^
143.146 +(*begin after the 2nd integrate*)
143.147 +" (let M__ = Take (M_b v_ = q__); \
143.148 +\ e1__ = nth_ 1 rm_ ; \
143.149 +\ (x1__::real) = argument_in (lhs e1__); \
143.150 +\ (M1__::bool) = ((Substitute [v_ = x1__]) @@ \
143.151 +\ (Substitute [e1__])) M__ \
143.152 +\ in True)"
143.153 +;
143.154 +
143.155 +val {scr=Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
143.156 +(*---------------------------------------------------------------------
143.157 +if sc = sc' then () else raise error"script.sml, doesnt find Substitute #1";
143.158 +---------------------------------------------------------------------*)
143.159 +val fmz = ["Traegerlaenge L",
143.160 + "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
143.161 + "Biegelinie y",
143.162 + "RandbedingungenBiegung [y 0 = 0, y L = 0]",
143.163 + "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
143.164 + "FunktionsVariable x"];
143.165 +val (dI',pI',mI') =
143.166 + ("Biegelinie.thy",["MomentBestimmte","Biegelinien"],
143.167 + ["IntegrierenUndKonstanteBestimmen"]);
143.168 +val p = e_pos'; val c = [];
143.169 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
143.170 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.171 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.172 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.173 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.174 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.175 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.176 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
143.177 +case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
143.178 + | _ => raise error "script.sml, doesnt find Substitute #2";
143.179 +trace_rewrite:=true;
143.180 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
143.181 +trace_rewrite:=false;
143.182 +(*Exception TYPE raised:
143.183 +Illegal type for constant "op =" :: "[real, bool] => bool"
143.184 +Atools.argument'_in (Tools.lhs (ListG.nth_ (1 + -1 + -1) [])) =
143.185 +ListG.nth_ (1 + -1 + -1) []
143.186 +Exception-
143.187 + TYPE
143.188 + ("Illegal type for constant \"op =\" :: \"[real, bool] => bool\"",
143.189 + [],
143.190 + [Const ("Trueprop", "bool => prop") $
143.191 + (Const ("op =", "[RealDef.real, bool] => bool") $ ... $ ...)])
143.192 + raised
143.193 +... this was because eval_argument_in took "argument_in (lhs (M_b 0 = 0))"
143.194 +ie. the argument had not been simplified before ^^^^^^^^^^^^^^^
143.195 +thus corrected eval_argument_in OK*)
143.196 +
143.197 +val {srls,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
143.198 +val e1__ = str2term"nth_ 1 [M_b 0 = 0, M_b L = 0]";
143.199 +val e1__ = eval_listexpr_ Biegelinie.thy srls e1__; term2str e1__;
143.200 +if term2str e1__ = "M_b 0 = 0" then () else
143.201 +raise error"script.sml diff.beh. eval_listexpr_ nth_ 1 [...";
143.202 +
143.203 +(*TODO.WN050913 ??? doesnt eval_listexpr_ go into subterms ???...
143.204 +val x1__ = str2term"argument_in (lhs (M_b 0 = 0))";
143.205 +val x1__ = eval_listexpr_ Biegelinie.thy srls x1__; term2str x1__;
143.206 +(*no rewrite*)
143.207 +calculate_ Biegelinie.thy ("Tools.lhs", eval_rhs"eval_lhs_") x1__;
143.208 +val Some (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;*)
143.209 +
143.210 +val l__ = str2term"lhs (M_b 0 = 0)";
143.211 +val l__ = eval_listexpr_ Biegelinie.thy srls l__; term2str l__;
143.212 +val Some (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;
143.213 +
143.214 +
143.215 +trace_rewrite:=true;
143.216 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
143.217 +trace_rewrite:=false;
143.218 +
143.219 +show_mets();
143.220 +
143.221 +"----------- fun sel_appl_atomic_tacs ----------------------------";
143.222 +"----------- fun sel_appl_atomic_tacs ----------------------------";
143.223 +"----------- fun sel_appl_atomic_tacs ----------------------------";
143.224 +states:=[];
143.225 +CalcTree
143.226 +[(["equality (x+1=2)", "solveFor x","solutions L"],
143.227 + ("Test.thy",
143.228 + ["sqroot-test","univariate","equation","test"],
143.229 + ["Test","squ-equ-test-subpbl1"]))];
143.230 +Iterator 1;
143.231 +moveActiveRoot 1;
143.232 +autoCalculate 1 CompleteCalcHead;
143.233 +autoCalculate 1 (Step 1);
143.234 +autoCalculate 1 (Step 1);
143.235 +val ((pt, p), _) = get_calc 1; show_pt pt;
143.236 +val appltacs = sel_appl_atomic_tacs pt p;
143.237 +if appltacs =
143.238 + [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
143.239 + Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
143.240 + Calculate "times"] then ()
143.241 +else raise error "script.sml fun sel_appl_atomic_tacs diff.behav.";
143.242 +
143.243 +trace_script := true;
143.244 +trace_script := false;
143.245 +applyTactic 1 p (hd appltacs);
143.246 +val ((pt, p), _) = get_calc 1; show_pt pt;
143.247 +val appltacs = sel_appl_atomic_tacs pt p;
143.248 +
143.249 +"----- WN080102 these vvv do not work, because locatetac starts the search\
143.250 + \1 stac too low";
143.251 +applyTactic 1 p (hd appltacs);
143.252 +autoCalculate 1 CompleteCalc;
143.253 +
144.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
144.2 +++ b/src/Pure/isac/smltest/ME/solve.sml Wed Jul 21 13:53:39 2010 +0200
144.3 @@ -0,0 +1,537 @@
144.4 +(* tests on solve.sml
144.5 + author: Walther Neuper
144.6 + 060508,
144.7 + (c) due to copyright terms
144.8 +
144.9 +is NOT ONLY dependent on Test, but on other thys:
144.10 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
144.11 +uses from Rational.ML: Rrls cancel_p, Rrls cancel
144.12 +which in turn
144.13 +uses from Poly.ML: Rls make_polynomial, Rls expand_binom
144.14 +
144.15 +use"../smltest/ME/solve.sml";
144.16 +use"solve.sml";
144.17 +*)
144.18 +
144.19 +"-----------------------------------------------------------------";
144.20 +"table of contents -----------------------------------------------";
144.21 +"-----------------------------------------------------------------";
144.22 +"--------- interSteps on norm_Rational ---------------------------";
144.23 +(*---vvv NOT working after meNEW.04mmdd*)
144.24 +"###### val intermediate_ptyps = !ptyps;val intermediate_mets = !mets";
144.25 +"--------- prepare pbl, met --------------------------------------";
144.26 +"-------- cancel, without detail ------------------------------";
144.27 +"-------- cancel, detail rev-rew (cancel) afterwards ----------";
144.28 +"-------------- cancel_p, without detail ------------------------------";
144.29 +"-------------- cancel_p, detail rev-rew (cancel) afterwards ----------";
144.30 +(*---^^^ NOT working*)
144.31 +"on 'miniscript with mini-subpbl':";
144.32 +"------ interSteps'donesteps': on 'miniscript with mini-subpbl'---";
144.33 +"------ interSteps'detailrls' after CompleteCalc -----------------";
144.34 +"------ interSteps after appendFormula ---------------------------";
144.35 +(*---vvv not brought to work 0403*)
144.36 +"------ Detail_Set -----------------------------------------------";
144.37 +"###### ptyps:= intermediate_ptyps;met:= intermediate_mets;#######";
144.38 +"-----------------------------------------------------------------";
144.39 +"-----------------------------------------------------------------";
144.40 +"-----------------------------------------------------------------";
144.41 +
144.42 +
144.43 +"--------- interSteps on norm_Rational ---------------------------";
144.44 +"--------- interSteps on norm_Rational ---------------------------";
144.45 +"--------- interSteps on norm_Rational ---------------------------";
144.46 +states:=[];(*exp_IsacCore_Simp_Rat_Double_No-7.xml*)
144.47 +CalcTree [(["term ((2/(x+3) + 2/(x - 3)) / (8*x/(x^2 - 9)))","normalform N"],
144.48 + ("Rational.thy",
144.49 + ["rational","simplification"],
144.50 + ["simplification","of_rationals"]))];
144.51 +moveActiveRoot 1;
144.52 +autoCalculate 1 CompleteCalc;
144.53 +val ((pt,_),_) = get_calc 1; show_pt pt;
144.54 +
144.55 +(*with "Script SimplifyScript (t_::real) = -----------------
144.56 + \ ((Rewrite_Set norm_Rational False) t_)"
144.57 +case pt of Nd (PblObj _, [Nd _]) => ((*met only applies norm_Rational*))
144.58 + | _ => raise error "solve.sml: interSteps on norm_Rational 1";
144.59 +interSteps 1 ([1], Res);
144.60 +getFormulaeFromTo 1 ([1], Frm) ([1,12], Res) 99999 false;
144.61 +interSteps 1 ([1,3], Res);
144.62 +
144.63 +getTactic 1 ([1,4], Res) (*here get the tactic, and ...*);
144.64 +interSteps 1 ([1,5], Res) (*... here get the intermediate steps above*);
144.65 +
144.66 +getTactic 1 ([1,5,1], Frm);
144.67 +val ((pt,_),_) = get_calc 1; show_pt pt;
144.68 +
144.69 +getTactic 1 ([1,8], Res) (*Rewrite_Set "common_nominator_p" *);
144.70 +interSteps 1 ([1,9], Res)(*TODO.WN060606 reverse rew*);
144.71 +--------------------------------------------------------------------*)
144.72 +
144.73 +case pt of Nd (PblObj _, [Nd _, Nd _, Nd _, Nd _, Nd _, Nd _]) => ()
144.74 + | _ => raise error "solve.sml: interSteps on norm_Rational 1";
144.75 +(*these have been done now by the script ^^^ immediately...
144.76 +interSteps 1 ([1], Res);
144.77 +getFormulaeFromTo 1 ([1], Frm) ([1,12], Res) 99999 false;
144.78 +*)
144.79 +interSteps 1 ([6], Res);
144.80 +
144.81 +getTactic 1 ([6,1], Frm) (*here get the tactic, and ...*);
144.82 +interSteps 1 ([6,1], Res) (*... here get the intermediate steps above*);
144.83 +
144.84 +getTactic 1 ([3,4,1], Frm);
144.85 +val ((pt,_),_) = get_calc 1; show_pt pt;
144.86 +val (Form form, Some tac, asm) = pt_extract (pt, ([6], Res));
144.87 +case (term2str form, tac, terms2strs asm) of
144.88 + ("1 / 2", Check_Postcond ["rational", "simplification"],
144.89 + ["-36 * x + 4 * x ^^^ 3 ~= 0"]) => ()
144.90 + | _ => raise error "solve.sml: interSteps on norm_Rational 2";
144.91 +
144.92 +
144.93 +
144.94 +"###### val intermediate_ptyps = !ptyps;val intermediate_mets = !mets";
144.95 +"###### val intermediate_ptyps = !ptyps;val intermediate_mets = !mets";
144.96 +"###### val intermediate_ptyps = !ptyps;val intermediate_mets = !mets";
144.97 +val intermediate_ptyps = !ptyps;
144.98 +val intermediate_mets = !mets;
144.99 +
144.100 +"--------- prepare pbl, met --------------------------------------";
144.101 +"--------- prepare pbl, met --------------------------------------";
144.102 +"--------- prepare pbl, met --------------------------------------";
144.103 +store_pbt
144.104 + (prep_pbt Test.thy "pbl_ttestt" [] e_pblID
144.105 + (["test"],
144.106 + [],
144.107 + e_rls, None, []));
144.108 +store_pbt
144.109 + (prep_pbt Test.thy "pbl_ttestt_detail" [] e_pblID
144.110 + (["detail","test"],
144.111 + [("#Given" ,["realTestGiven t_"]),
144.112 + ("#Find" ,["realTestFind s_"])
144.113 + ],
144.114 + e_rls, None, [["Test","test_detail"]]));
144.115 +
144.116 +store_met
144.117 + (prep_met Test.thy "met_detbin" [] e_metID
144.118 + (["Test","test_detail_binom"]:metID,
144.119 + [("#Given" ,["realTestGiven t_"]),
144.120 + ("#Find" ,["realTestFind s_"])
144.121 + ],
144.122 + {rew_ord'="sqrt_right",rls'=tval_rls,calc = [],srls=e_rls,prls=e_rls,
144.123 + crls=tval_rls, nrls=e_rls(*,
144.124 + asm_rls=[],asm_thm=[("real_mult_div_cancel2","")]*)},
144.125 + "Script Testterm (g_::real) = \
144.126 + \(((Rewrite_Set expand_binoms False) @@\
144.127 + \ (Rewrite_Set cancel False)) g_)"
144.128 + ));
144.129 +store_met
144.130 + (prep_met Test.thy "met_detpoly" [] e_metID
144.131 + (["Test","test_detail_poly"]:metID,
144.132 + [("#Given" ,["realTestGiven t_"]),
144.133 + ("#Find" ,["realTestFind s_"])
144.134 + ],
144.135 + {rew_ord'="sqrt_right",rls'=tval_rls,calc=[],srls=e_rls,prls=e_rls,
144.136 + crls=tval_rls, nrls=e_rls(*,
144.137 + asm_rls=[],asm_thm=[("real_mult_div_cancel2","")]*)},
144.138 + "Script Testterm (g_::real) = \
144.139 + \(((Rewrite_Set make_polynomial False) @@\
144.140 + \ (Rewrite_Set cancel_p False)) g_)"
144.141 + ));
144.142 +
144.143 +(*---- funktionieren mit Rationals.ML: dummy-Funktionen(1)--------*)
144.144 +
144.145 +"-------- cancel, without detail ------------------------------";
144.146 +"-------- cancel, without detail ------------------------------";
144.147 +"-------- cancel, without detail ------------------------------";
144.148 +val fmz = ["realTestGiven (((3 + x) * (3 - x)) / ((3 + x) * (3 + x)))",
144.149 + "realTestFind s"];
144.150 +val (dI',pI',mI') =
144.151 + ("Test.thy",["detail","test"],["Test","test_detail_binom"]);
144.152 +
144.153 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
144.154 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.155 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.156 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.157 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.158 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.159 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.160 +(*nxt = ("Apply_Method",Apply_Method ("Test.thy","test_detail"))*)
144.161 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.162 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.163 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.164 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.165 +(*"(3 + -1 * x) / (3 + x)"*)
144.166 +if nxt = ("End_Proof'",End_Proof') then ()
144.167 +else raise error "details.sml, changed behaviour in: without detail";
144.168 +
144.169 + val str = pr_ptree pr_short pt;
144.170 + writeln str;
144.171 +
144.172 +
144.173 +"-------- cancel, detail rev-rew (cancel) afterwards ----------";
144.174 +"-------- cancel, detail rev-rew (cancel) afterwards ----------";
144.175 +"-------- cancel, detail rev-rew (cancel) afterwards ----------";
144.176 + val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
144.177 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.178 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.179 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.180 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.181 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.182 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.183 + (*nxt = ("Apply_Method",Apply_Method ("Test.thy","test_detail"))*)
144.184 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.185 + (*val nxt = ("Rewrite_Set",Rewrite_Set "expand_binoms")*)
144.186 + val (p,_,f,nxt,_,pt) = me nxt p [] pt; (* rewrite must exist for Detail*)
144.187 +(* val nxt = ("Detail",Detail);"----------------------";*)
144.188 +
144.189 +
144.190 +(*WN.11.9.03: after meNEW not yet implemented -------------------------*)
144.191 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.192 +(*FIXXXXXME.040216 #####################################################
144.193 +# val nxt = ("Detail", Detail) : string * tac
144.194 +val it = "----------------------" : string
144.195 +> val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.196 +val f = Form' (FormKF (~1, EdUndef, ...)) : mout
144.197 +val nxt = ("Empty_Tac", Empty_Tac) : string * tac
144.198 +val p = ([2, 1], Res) : pos'
144.199 +#########################################################################
144.200 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.201 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.202 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.203 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.204 + (*val nxt = ("End_Detail",End_Detail)*)
144.205 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.206 + (*val nxt = ("Rewrite_Set",Rewrite_Set "cancel")*)
144.207 + val (p,_,f,nxt,_,pt) = me nxt p [] pt; (* rewrite must exist for Detail*)
144.208 + val nxt = ("Detail",Detail);"----------------------";
144.209 + val (p,_,f,nxt,_,pt) = (me nxt p [] pt) handle e => print_exn e;
144.210 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.211 +(*15.10.02*)
144.212 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.213 +(*
144.214 +rewrite "Rationals.thy" "tless_true""e_rls"true("sym_real_plus_minus_binom","")
144.215 + "3 ^^^ 2 - x ^^^ 2";
144.216 +*)
144.217 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.218 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.219 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.220 + val (p,_,f,nxt,_,pt) = (me nxt p [] pt) handle e => print_exn e;
144.221 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.222 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"(3 - x) / (3 + x)"))
144.223 + andalso nxt = ("End_Proof'",End_Proof') then ()
144.224 +else raise error "new behaviour in details.sml, \
144.225 + \cancel, rev-rew (cancel) afterwards";
144.226 +FIXXXXXME.040216 #####################################################*)
144.227 +
144.228 +(*---- funktionieren mit Rationals.ML: dummy-Funktionen(1)--------*)
144.229 +
144.230 +"-------------- cancel_p, without detail ------------------------------";
144.231 +"-------------- cancel_p, without detail ------------------------------";
144.232 +"-------------- cancel_p, without detail ------------------------------";
144.233 +val fmz = ["realTestGiven (((3 + x)*(3+(-1)*x)) / ((3+x) * (3+x)))",
144.234 + "realTestFind s"];
144.235 +val (dI',pI',mI') =
144.236 + ("Test.thy",["detail","test"],["Test","test_detail_poly"]);
144.237 +
144.238 +(*val p = e_pos'; val c = [];
144.239 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
144.240 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
144.241 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
144.242 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.243 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.244 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.245 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.246 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.247 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.248 +(*nxt = ("Apply_Method",Apply_Method ("Test.thy","test_detail"))*)
144.249 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.250 +"(3 + x) * (3 + -1 * x) / ((3 + x) * (3 + x))";
144.251 +
144.252 + (*14.3.03*)
144.253 +(*---------------WN060614?!?---
144.254 + val t = str2term "(3 + x) * (3 + -1 * x) / ((3 + x) * (3 + x))";
144.255 + val Some (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
144.256 + "(9 + - (x ^^^ 2)) / (9 + 6 * x + x ^^^ 2)";
144.257 + val Some (t,_) = rewrite_set_ thy false cancel_p t; term2str t;
144.258 + cancel_p_ thy t;
144.259 +(---------------WN060614?!?---*)
144.260 +
144.261 + val t = str2term "(3 + x) * (3 + -1 * x)";
144.262 + val Some (t,_) = rewrite_set_ thy false expand_poly t; term2str t;
144.263 + "3 * 3 + 3 * (-1 * x) + (x * 3 + x * (-1 * x))";
144.264 + val Some (t,_) = rewrite_set_ thy false order_add_mult t; term2str t;
144.265 + "3 * 3 + (3 * x + (-1 * (3 * x) + -1 * (x * x)))";
144.266 + val Some (t,_) = rewrite_set_ thy false simplify_power t; term2str t;
144.267 + "3 ^^^ 2 + (3 * x + (-1 * (3 * x) + -1 * x ^^^ 2))";
144.268 + val Some (t,_) = rewrite_set_ thy false collect_numerals t; term2str t;
144.269 + "9 + (0 * x + -1 * x ^^^ 2)";
144.270 + val Some (t,_) = rewrite_set_ thy false reduce_012 t; term2str t;
144.271 + "9 + - (x ^^^ 2)";
144.272 + (*14.3.03*)
144.273 +
144.274 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.275 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.276 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.277 +(*"(3 + -1 * x) / (3 + x)"*)
144.278 +if nxt = ("End_Proof'",End_Proof') then ()
144.279 +else raise error "details.sml, changed behaviour in: cancel_p, without detail";
144.280 +
144.281 +"-------------- cancel_p, detail rev-rew (cancel) afterwards ----------";
144.282 +"-------------- cancel_p, detail rev-rew (cancel) afterwards ----------";
144.283 +"-------------- cancel_p, detail rev-rew (cancel) afterwards ----------";
144.284 +(* val p = e_pos'; val c = [];
144.285 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
144.286 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
144.287 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
144.288 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.289 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.290 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.291 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.292 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.293 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.294 + (*nxt = ("Apply_Method",Apply_Method ("Test.thy","test_detail_poly"))*)
144.295 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.296 + (*val nxt = ("Rewrite_Set",Rewrite_Set "make_polynomial")*)
144.297 + val (p,_,f,nxt,_,pt) = me nxt p [] pt; (* rewrite must exist for Detail*)
144.298 +
144.299 +(*14.3.03.FIXXXXXME since Isa02/reverse-rew.sml:
144.300 + fun make_deriv ... Rls_ not yet impl. (| Thm | Calc)
144.301 + Rls_ needed for make_polynomial ----------------------
144.302 + val nxt = ("Detail",Detail);"----------------------";
144.303 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.304 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.305 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.306 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.307 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.308 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.309 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.310 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.311 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.312 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.313 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.314 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.315 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.316 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.317 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.318 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.319 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.320 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.321 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.322 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.323 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.324 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.325 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.326 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.327 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.328 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.329 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.330 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.331 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.332 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.333 + if nxt = ("End_Detail",End_Detail) then ()
144.334 + else raise error "details.sml: new behav. in Detail make_polynomial";
144.335 +----------------------------------------------------------------------*)
144.336 +
144.337 +(*---------------
144.338 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.339 + (*val nxt = ("Rewrite_Set",Rewrite_Set "cancel_p")*)
144.340 + val (p,_,f,nxt,_,pt) = me nxt p [] pt; (* rewrite must exist for Detail*)
144.341 + val nxt = ("Detail",Detail);"----------------------";
144.342 + val (p,_,f,nxt,_,pt) = (me nxt p [] pt) handle e => print_exn e;
144.343 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.344 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.345 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.346 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.347 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.348 + val (p,_,f,nxt,_,pt) = (me nxt p [] pt) handle e => print_exn e;
144.349 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.350 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"(3 + x) / (3 - x)"))
144.351 + andalso nxt = ("End_Proof'",End_Proof') then ()
144.352 +else raise error "new behaviour in details.sml, cancel_p afterwards";
144.353 +
144.354 +----------------*)
144.355 +
144.356 +
144.357 +
144.358 +
144.359 +
144.360 +val fmz = ["realTestGiven ((x+3)+(-1)*(2+6*x))",
144.361 + "realTestFind s"];
144.362 +val (dI',pI',mI') =
144.363 + ("Test.thy",["detail","test"],["Test","test_detail_poly"]);
144.364 +
144.365 +(* val p = e_pos'; val c = [];
144.366 + val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
144.367 + val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
144.368 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
144.369 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.370 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.371 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.372 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.373 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.374 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.375 + (*nxt = ("Apply_Method",Apply_Method ("Test.thy","test_detail_poly"))*)
144.376 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.377 +(*16.10.02 --- kommt auf POLY_EXCEPTION ?!??? ----------------------------
144.378 + (*val nxt = ("Rewrite_Set",Rewrite_Set "make_polynomial")*)
144.379 + val (p,_,f,nxt,_,pt) = me nxt p [] pt; (* rewrite must exist for Detail*)
144.380 + val nxt = ("Detail",Detail);"----------------------";
144.381 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.382 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.383 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.384 + val (p,_,f,nxt,_,pt) = me nxt p [] pt;
144.385 +-------------------------------------------------------------------------*)
144.386 +
144.387 +
144.388 +"------ interSteps'donesteps': on 'miniscript with mini-subpbl'---";
144.389 +"------ interSteps'donesteps': on 'miniscript with mini-subpbl'---";
144.390 +"------ interSteps'donesteps': on 'miniscript with mini-subpbl'---";
144.391 + states:=[];
144.392 + CalcTree
144.393 + [(["equality (x+1=2)", "solveFor x","solutions L"],
144.394 + ("Test.thy",
144.395 + ["sqroot-test","univariate","equation","test"],
144.396 + ["Test","squ-equ-test-subpbl1"]))];
144.397 + Iterator 1;
144.398 + moveActiveRoot 1;
144.399 + autoCalculate 1 CompleteCalc;
144.400 + moveActiveRoot 1;
144.401 +
144.402 + interSteps 1 ([],Res);
144.403 + val [(_,(((pt,_),_),[(_,ip)]))] = !states;
144.404 + val ("donesteps",_(*,ss*), lastpos) = detailstep pt ip;
144.405 + (*case ss of [(_,_,t1),(_,_,t2),(_,_,t3),(_,_,t4),(_,_,t5),(_,_,t6)] =>
144.406 + (writeln o terms2str) [t1,t2,t3,t4,t5,t6]
144.407 + | _ => raise error "details.sml: diff.behav. in detail miniscript";*) if lastpos = ([4], Res) then ()
144.408 + else raise error "details.sml: diff.behav. in interSteps'donesteps' 1";
144.409 +
144.410 + moveActiveDown 1;
144.411 + moveActiveDown 1;
144.412 + moveActiveDown 1;
144.413 + moveActiveDown 1;
144.414 +
144.415 + interSteps 1 ([3],Pbl) (*subproblem*);
144.416 + val [(_,(((pt,_),_),[(_,ip)]))] = !states;
144.417 + val ("donesteps",_(*,ss*), lastpos) = detailstep pt ip;
144.418 + (*case ss of [(_,_,t1),(_,_,t2),(_,_,t3)] =>
144.419 + (writeln o terms2str) [t1,t2,t3]
144.420 + | _ => raise error "details.sml: diff.behav. in detail miniscript";*) if lastpos = ([3, 2], Res) then ()
144.421 + else raise error "details.sml: diff.behav. in interSteps'donesteps' 1";
144.422 +
144.423 +
144.424 +(* val [(_,(((pt,_),_),[(_,ip)]))] = !states;
144.425 + writeln (pr_ptree pr_short pt);
144.426 + get_obj g_tac pt [4];
144.427 + *)
144.428 +
144.429 +
144.430 +"------ interSteps'detailrls' after CompleteCalc -----------------";
144.431 +"------ interSteps'detailrls' after CompleteCalc -----------------";
144.432 +"------ interSteps'detailrls' after CompleteCalc -----------------";
144.433 + states:=[];
144.434 + CalcTree
144.435 + [(["equality (x+1=2)", "solveFor x","solutions L"],
144.436 + ("Test.thy",
144.437 + ["sqroot-test","univariate","equation","test"],
144.438 + ["Test","squ-equ-test-subpbl1"]))];
144.439 + Iterator 1;
144.440 + moveActiveRoot 1;
144.441 + autoCalculate 1 CompleteCalc;
144.442 + interSteps 1 ([],Res);
144.443 + moveActiveRoot 1;
144.444 + moveActiveDown 1;
144.445 + moveActiveDown 1;
144.446 + moveActiveDown 1;
144.447 + refFormula 1 (get_pos 1 1); (* 2 Res, <ISA> -1 + x = 0 </ISA> *)
144.448 +
144.449 + interSteps 1 ([2],Res);
144.450 + val [(_,(((pt,_),_),[(_,(p,_))]))] = !states;
144.451 + if length (children (get_nd pt p)) = 6 then ()
144.452 + else raise error "details.sml: diff.behav. in interSteps'detailrls' 1";
144.453 +
144.454 + moveActiveDown 1;
144.455 + moveActiveDown 1; refFormula 1 (get_pos 1 1); (* 3,1 Frm, <ISA> -1 + x = 0 </ISA> *);
144.456 +
144.457 + interSteps 1 ([3,1],Frm) (*<ERROR> first formula on level has NO detail </E*);
144.458 + val [(_,(((pt,_),_),[(_,(p,_))]))] = !states;
144.459 + if length (children (get_nd pt p)) = 0 then () (*NO detail at ([xxx,1],Frm)*)
144.460 + else raise error "details.sml: diff.behav. in interSteps'detailrls' 2";
144.461 +
144.462 + moveActiveDown 1;
144.463 + refFormula 1 (get_pos 1 1); (* 3,1 Res, <ISA> x = 0 + -1 * -1 </ISA> *)
144.464 +
144.465 + interSteps 1 ([3,1],Res);
144.466 + val ((pt,p),_) = get_calc 1; show_pt pt;
144.467 + term2str (get_obj g_res pt [3,1,1]);(*"x = 0 + -1 * -1" ok*)
144.468 + term2str (get_obj g_form pt [3,2]); (*"x = 0 + -1 * -1" ok*)
144.469 + get_obj g_tac pt [3,1,1]; (*Rewrite_Inst.."risolate_bdv_add ok*)
144.470 +
144.471 + moveActiveDown 1;
144.472 + refFormula 1 (get_pos 1 1); (* 3,2 Res, <ISA> x = 1 </ISA> *)
144.473 +
144.474 + interSteps 1 ([3,2],Res);
144.475 + val [(_,(((pt,_),_),[(_,(p,_))]))] = !states;
144.476 + if length (children (get_nd pt p)) = 2 then ()
144.477 + else raise error "details.sml: diff.behav. in interSteps'detailrls' 3";
144.478 +
144.479 + val ((pt,p),_) = get_calc 1; show_pt pt;
144.480 +
144.481 +
144.482 +"------ interSteps after appendFormula ---------------------------";
144.483 +"------ interSteps after appendFormula ---------------------------";
144.484 +"------ interSteps after appendFormula ---------------------------";
144.485 +states:=[];
144.486 +CalcTree
144.487 +[(["equality (x+1=2)", "solveFor x","solutions L"],
144.488 + ("Test.thy",
144.489 + ["sqroot-test","univariate","equation","test"],
144.490 + ["Test","squ-equ-test-subpbl1"]))];
144.491 +Iterator 1;
144.492 +moveActiveRoot 1;
144.493 +autoCalculate 1 CompleteCalcHead;
144.494 +autoCalculate 1 (Step 1);
144.495 +autoCalculate 1 (Step 1);
144.496 +appendFormula 1 "x - 1 = 0"(*generates intermediate steps*);
144.497 +(*these are not shown, because the resulting formula is on the same
144.498 + level as the previous formula*)
144.499 +interSteps 1 ([2],Res) (*error: last unchanged was ([2, 9], Res)*);
144.500 +(*...and these are the internals*)
144.501 +val ((pt,p),_) = get_calc 1; show_pt pt;
144.502 +val (_,_,lastpos) =detailstep pt p;
144.503 +if p = ([2], Res) andalso lastpos = ([2, 9], Res) then ()
144.504 +else raise error "solve.sml: diff.beh. after appendFormula x - 1 = 0";
144.505 +
144.506 +
144.507 +"------ Detail_Set -----------------------------------------------";
144.508 +"------ Detail_Set -----------------------------------------------";
144.509 +"------ Detail_Set -----------------------------------------------";
144.510 + states:=[];
144.511 + CalcTree (*start of calculation, return No.1*)
144.512 + [(["equality (x+1=2)", "solveFor x","solutions L"],
144.513 + ("Test.thy",
144.514 + ["sqroot-test","univariate","equation","test"],
144.515 + ["Test","squ-equ-test-subpbl1"]))];
144.516 + Iterator 1; moveActiveRoot 1;
144.517 + autoCalculate 1 CompleteCalcHead;
144.518 + autoCalculate 1 (Step 1);
144.519 + autoCalculate 1 (Step 1);
144.520 +
144.521 + fetchProposedTactic 1 (*DG decides to do this tactic in detail*);
144.522 + (*TODO ...*)
144.523 + setNextTactic 1 (Detail_Set "Test_simplify");
144.524 +
144.525 +
144.526 + val ((pt,p),tacis) = get_calc 1;
144.527 + val str = pr_ptree pr_short pt;
144.528 + writeln str;
144.529 +
144.530 + print_depth 3;
144.531 + term2str (fst (get_obj g_result pt [1]));
144.532 +
144.533 +
144.534 +
144.535 +
144.536 +"###### ptyps:= intermediate_ptyps;met:= intermediate_mets;#######";
144.537 +"###### ptyps:= intermediate_ptyps;met:= intermediate_mets;#######";
144.538 +"###### ptyps:= intermediate_ptyps;met:= intermediate_mets;#######";
144.539 +ptyps:= intermediate_ptyps;
144.540 +mets:= intermediate_mets;
145.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
145.2 +++ b/src/Pure/isac/smltest/OLDTESTS/README Wed Jul 21 13:53:39 2010 +0200
145.3 @@ -0,0 +1,4 @@
145.4 +isac/src/sml/systest/README
145.5 +WN100225
145.6 +
145.7 +while copying to proto3: unclear, where these files come from and what they are for
145.8 \ No newline at end of file
146.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
146.2 +++ b/src/Pure/isac/smltest/OLDTESTS/interface-xml.sml Wed Jul 21 13:53:39 2010 +0200
146.3 @@ -0,0 +1,12 @@
146.4 +(* use"systest/interface-xml.sml";
146.5 + use"interface-xml.sml";
146.6 + *)
146.7 +
146.8 +(*see javatest.isac.util.parse.TestXMLParserDigest#testParseRefFormula*)
146.9 +refformulaOK2xml 1 ([1],Frm) (Form (str2term "x+1=2"));
146.10 +(*see javatest.isac.util.parse.TestXMLParserDigest#testParseRefCalcHead*)
146.11 +refformulaOK2xml 1 ([1],Pbl) (ModSpec e_ocalhd);
146.12 +
146.13 +getintervalOK 1 [(([2],Res), str2term "x = 4"),
146.14 + (([3],Pbl), str2term "e_headline"),
146.15 + (([3,1],Frm), str2term "-1+x=0")];
147.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
147.2 +++ b/src/Pure/isac/smltest/OLDTESTS/modspec.sml Wed Jul 21 13:53:39 2010 +0200
147.3 @@ -0,0 +1,40 @@
147.4 +(* WN040107
147.5 + use"../systest/modspec.sml";
147.6 + use"systest/modspec.sml";
147.7 + use"modspec.sml";
147.8 + *)
147.9 +
147.10 +"--------- get_interval after replace} other 2 -------------------";
147.11 +"-----------------------------------------------------------------";
147.12 +
147.13 +
147.14 +"--------- get_interval after replace} other 2 -------------------";
147.15 +"--------- get_interval after replace} other 2 -------------------";
147.16 +"--------- get_interval after replace} other 2 -------------------";
147.17 + states:=[];
147.18 + CalcTree
147.19 + [(["equality (x+1=2)", "solveFor x","solutions L"],
147.20 + ("Test.thy",
147.21 + ["sqroot-test","univariate","equation","test"],
147.22 + ["Test","squ-equ-test-subpbl1"]))];
147.23 + Iterator 1;
147.24 + moveActiveRoot 1;
147.25 + autoCalculate 1 CompleteCalc;
147.26 + moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
147.27 + replaceFormula 1 "x = 1";
147.28 + (*... returns calcChangedEvent with ...*)
147.29 + val (unc, del, gen) = (([1],Res), ([4],Res), ([3,2],Res));
147.30 + val ((pt,_),_) = get_calc 1;
147.31 +
147.32 +print_depth 99;map fst (get_interval ([],Pbl) ([],Res) 9999 pt);print_depth 3;
147.33 +if map fst (get_interval ([],Pbl) ([],Res) 9999 pt) =
147.34 + [([], Pbl), ([1], Frm),([1], Res), ([2], Res), ([3], Pbl), ([3, 1], Frm),
147.35 + ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
147.36 + ([3, 2], Res)] then () else
147.37 +raise error "modspec.sml: diff.behav. get_interval after replace} other 2 a";
147.38 +
147.39 +print_depth 99;map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt);
147.40 +print_depth 3;
147.41 +if map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt) =
147.42 + [([3, 2, 1], Res), ([3, 2, 2], Res), ([3, 2], Res)] then () else
147.43 +raise error "modspec.sml: diff.behav. get_interval after replace} other 2 b";
148.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
148.2 +++ b/src/Pure/isac/smltest/OLDTESTS/root-equ.sml Wed Jul 21 13:53:39 2010 +0200
148.3 @@ -0,0 +1,638 @@
148.4 +(* use"../systest/root-equ.sml";
148.5 + use"systest/root-equ.sml";
148.6 + use"root-equ.sml";
148.7 + trace_rewrite:= true;
148.8 + trace_rewrite:= false;
148.9 +
148.10 + method "sqrt-equ-test", _NOT_ "square-equation"
148.11 +*)
148.12 +
148.13 +
148.14 +" ================= equation with x =(-12)/5, but L ={} ======= ";
148.15 +" _________________ rewrite _________________ ";
148.16 +
148.17 +
148.18 +" ================= equation with result={4} ================== ";
148.19 +" -------------- model, specify ------------ ";
148.20 +" ________________ rewrite _________________";
148.21 +" _________________ rewrite_ x=4_________________ ";
148.22 +" _________________ rewrite + cappend _________________ ";
148.23 +" _________________ me Free_Solve _________________ ";
148.24 +" _________________ me + tacs input _________________ ";
148.25 +(*" _______________ me + nxt_step from script _________---> scriptnew.sml*)
148.26 +(*" _________________ me + nxt_step from script (check_elementwise..)______
148.27 + ... L_a = Tac subproblem_equation_dummy; ";*)
148.28 +(*" _______________ me + root-equ: 1.norm_equation ___---> scriptnew.sml*)
148.29 +
148.30 +val c = [];
148.31 +
148.32 +
148.33 +
148.34 +
148.35 +(*
148.36 +> val t = (term_of o the o (parse thy)) "#2^^^#3";
148.37 +> val eval_fn = the (assoc (!eval_list, "pow"));
148.38 +> val (Some (id,t')) = get_pair thy "pow" eval_fn t;
148.39 +> Sign.string_of_term (sign_of thy) t';
148.40 +*)
148.41 +(******************************************************************)
148.42 +(* ------------------------------------- *)
148.43 +" _________________ equation with x =(-12)/5, but L ={} ------- ";
148.44 +(* ------------------------------------- *)
148.45 +" _________________ rewrite _________________ ";
148.46 +val thy' = "Test.thy";
148.47 +val ct = "sqrt(9+4*x)=sqrt x + sqrt(-3+x)";
148.48 +val thm = ("square_equation_left","");
148.49 +val Some (ct,asm) = rewrite thy' "tless_true" "tval_rls" true thm ct;
148.50 +(*"9 + 4 * x = (sqrt x + sqrt (-3 + x)) ^^^ 2"*)
148.51 +val rls = ("Test_simplify");
148.52 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.53 +(*"9 + 4 * x = -3 + (2 * x + 2 * sqrt (x ^^^ 2 + -3 * x))"*)
148.54 +val rls = ("rearrange_assoc");
148.55 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.56 +(*"9 + 4 * x = -3 + 2 * x + 2 * sqrt (x ^^^ 2 + -3 * x)"*)
148.57 +val rls = ("isolate_root");
148.58 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.59 +(*"sqrt (x ^^^ 2 + -3 * x) =
148.60 +(-3 + 2 * x + -1 * (9 + 4 * x)) // (-1 * 2)"*)
148.61 +val rls = ("Test_simplify");
148.62 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.63 +(*"sqrt (x ^^^ 2 + -3 * x) = 6 + x"*)
148.64 +val thm = ("square_equation_left","");
148.65 +val (ct,asm') = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
148.66 +val asm = asm union asm';
148.67 +(*"x ^^^ 2 + -3 * x = (6 + x) ^^^ 2"*)
148.68 +val rls = ("Test_simplify");
148.69 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.70 +(*"x ^^^ 2 + -3 * x = 36 + (x ^^^ 2 + 12 * x)"*)
148.71 +val rls = ("norm_equation");
148.72 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.73 +(*"x ^^^ 2 + -3 * x + -1 * (36 + (x ^^^ 2 + 12 * x)) = 0"*)
148.74 +val rls = ("Test_simplify");
148.75 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.76 +(*"-36 + -15 * x = 0"*)
148.77 +val rls = ("isolate_bdv");
148.78 +val (ct,_) = the (rewrite_set_inst thy' false
148.79 + [("bdv","x::real")] rls ct);
148.80 +(*"x = (0 + -1 * -36) // -15"*)
148.81 +val rls = ("Test_simplify");
148.82 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.83 +if ct<>"x = -12 / 5"then raise error "new behaviour in testexample"else ();
148.84 +
148.85 +(*
148.86 +val ct = "x = (-12) / 5" : cterm'
148.87 +> asm;
148.88 +val it =
148.89 + ["(+0) <= sqrt x + sqrt ((-3) + x) ","(+0) <= 9 + 4 * x",
148.90 + "(+0) <= (-3) * x + x ^^^ 2","(+0) <= 6 + x"] : cterm' list
148.91 +*)
148.92 +
148.93 +
148.94 +
148.95 +
148.96 +
148.97 +" ================== equation with result={4} ================== ";
148.98 +" ================== equation with result={4} ================== ";
148.99 +" ================== equation with result={4} ================== ";
148.100 +
148.101 +" -------------- model, specify ------------ ";
148.102 +" -------------- model, specify ------------ ";
148.103 +" -------------- model, specify ------------ ";
148.104 +" --- subproblem 1: linear-equation --- ";
148.105 +val origin = ["equation (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
148.106 + "bound_variable x","error_bound 0"(*,
148.107 + "solutions L::real set" ,
148.108 + "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < eps}"*)];
148.109 +val thy = Isac.thy;
148.110 +val formals = map (the o (parse thy)) origin;
148.111 +
148.112 +val given = ["equation (l=(r::real))",
148.113 + "bound_variable bdv", (* TODO type *)
148.114 + "error_bound eps"];
148.115 +val where_ = [(*"(l=r) is_root_equation_in bdv", 5.3.yy*)
148.116 + "bdv is_var",
148.117 + "eps is_const_expr"];
148.118 +val find = ["solutions (L::bool list)"];
148.119 +val with_ = [(* parseold ...
148.120 + "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < eps}"*)];
148.121 +val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
148.122 +val givens = map (the o (parse thy)) given;
148.123 +parseold thy "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < apx}";
148.124 +(* 31.1.00
148.125 +val tag__forms = chktyps thy (formals, givens);
148.126 +map ((atomty) o term_of) tag__forms; *)
148.127 +
148.128 +" --- subproblem 2: linear-equation --- ";
148.129 +val origin = ["x + 4 = (0::real)","x::real"];
148.130 +val formals = map (the o (parse thy)) origin;
148.131 +
148.132 +val given = ["equation (l=(0::real))",
148.133 + "bound_variable bdv"];
148.134 +val where_ = ["l is_linear_in bdv","bdv is_const"];
148.135 +val find = ["l::real"];
148.136 +val with_ = ["l = (%x. l) bdv"];
148.137 +val chkpbl = map (the o (parseold thy)) (given @ where_ @ find @ with_);
148.138 +val givens = map (the o (parse thy)) given;
148.139 +
148.140 +val tag__forms = chktyps thy (formals, givens);
148.141 +map ((atomty) o term_of) tag__forms;
148.142 +
148.143 +
148.144 +
148.145 +" _________________ rewrite_ x+4_________________ ";
148.146 +" _________________ rewrite_ x+4_________________ ";
148.147 +" _________________ rewrite_ x+4_________________ ";
148.148 +val t = (term_of o the o (parse thy)) "sqrt(9+4*x)=sqrt x + sqrt(5+x)";
148.149 +val thm = num_str square_equation_left;
148.150 +val (t,asm) = the (rewrite_ thy tless_true tval_rls true thm t);
148.151 +val rls = Test_simplify;
148.152 +val (t,_) = the (rewrite_set_ thy false rls t);
148.153 +val rls = rearrange_assoc;
148.154 +val (t,_) = the (rewrite_set_ thy false rls t);
148.155 +val rls = isolate_root;
148.156 +val (t,_) = the (rewrite_set_ thy false rls t);
148.157 +
148.158 +val rls = Test_simplify;
148.159 +val (t,_) = the (rewrite_set_ thy false rls t);
148.160 +(*
148.161 +sqrt (x ^^^ 2 + 5 * x) =
148.162 +(5 + 2 * x + (-1 * 9 + -1 * (4 * x))) / (-1 * 2)
148.163 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148.164 +### trying thm 'rdistr_div_right'
148.165 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.166 +(5 + 2 * x) / (-1 * 2) + (-1 * 9 + -1 * (4 * x)) / (-1 * 2)
148.167 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.168 +(5 + 2 * x) / (-1 * 2) + (-1 * 9 / (-1 * 2) + -1 * (4 * x) / (-1 * 2))
148.169 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.170 +5 / (-1 * 2) + 2 * x / (-1 * 2) +
148.171 +(-1 * 9 / (-1 * 2) + -1 * (4 * x) / (-1 * 2))
148.172 +
148.173 +### trying thm 'radd_left_commute'
148.174 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.175 +-1 * 9 / (-1 * 2) +
148.176 +(5 / (-1 * 2) + 2 * x / (-1 * 2) + -1 * (4 * x) / (-1 * 2))
148.177 +### trying thm 'radd_assoc'
148.178 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.179 +-1 * 9 / (-1 * 2) +
148.180 +(5 / (-1 * 2) + (2 * x / (-1 * 2) + -1 * (4 * x) / (-1 * 2)))
148.181 +
148.182 +### trying thm 'radd_real_const_eq'
148.183 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.184 +-1 * 9 / (-1 * 2) + (5 / (-1 * 2) + (2 * x + -1 * (4 * x)) / (-1 * 2))
148.185 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.186 +-1 * 9 / (-1 * 2) + (5 + (2 * x + -1 * (4 * x))) / (-1 * 2)
148.187 +### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
148.188 +(-1 * 9 + (5 + (2 * x + -1 * (4 * x)))) / (-1 * 2)
148.189 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148.190 +
148.191 +28.8.02: ruleset besser zusammenstellen !!!
148.192 +*)
148.193 +val thm = num_str square_equation_left;
148.194 +val (t,asm') = the (rewrite_ thy tless_true tval_rls true thm t);
148.195 +val asm = asm union asm';
148.196 +val rls = Test_simplify;
148.197 +val (t,_) = the (rewrite_set_ thy false rls t);
148.198 +val rls = norm_equation;
148.199 +val (t,_) = the (rewrite_set_ thy false rls t);
148.200 +val rls = Test_simplify;
148.201 +val (t,_) = the (rewrite_set_ thy false rls t);
148.202 +val rls = isolate_bdv;
148.203 +val subst = [(str2term "bdv", str2term "x")];
148.204 +val (t,_) = the (rewrite_set_inst_ thy false subst rls t);
148.205 +val rls = Test_simplify;
148.206 +val (t,_) = the (rewrite_set_ thy false rls t);
148.207 +val t' = term2str t;
148.208 +if t' = "x = 4" then ()
148.209 +else raise error "root-equ.sml: new behav. in rewrite_ x+4";
148.210 +
148.211 +" _________________ rewrite x=4_________________ ";
148.212 +" _________________ rewrite x=4_________________ ";
148.213 +" _________________ rewrite x=4_________________ ";
148.214 +(*
148.215 +rewrite thy' "tless_true" "tval_rls" true (num_str rbinom_power_2) ct;
148.216 +atomty ((#prop o rep_thm) (!tthm));
148.217 +atomty (term_of (!tct));
148.218 +*)
148.219 +val thy' = "Test.thy";
148.220 +val ct = "sqrt(9+4*x)=sqrt x + sqrt(5+x)";
148.221 +(*1*)val thm = ("square_equation_left","");
148.222 +val (ct,asm) = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
148.223 +"9 + 4 * x = (sqrt x + sqrt (5 + x)) ^^^ 2";
148.224 +(*2*)val rls = "Test_simplify";
148.225 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.226 +"9 + 4 * x = 5 + (2 * x + 2 * sqrt (x ^^^ 2 + 5 * x))";
148.227 +(*3*)val rls = "rearrange_assoc";
148.228 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.229 +"9 + 4 * x = 5 + 2 * x + 2 * sqrt (x ^^^ 2 + 5 * x)";
148.230 +(*4*)val rls = "isolate_root";
148.231 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.232 +"sqrt (x ^^^ 2 + 5 * x) = (5 + 2 * x + -1 * (9 + 4 * x)) // (-1 * 2)";
148.233 +(*5*)val rls = "Test_simplify";
148.234 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.235 +"sqrt (x ^^^ 2 + 5 * x) = 2 + x";
148.236 +(*6*)val thm = ("square_equation_left","");
148.237 +val (ct,asm') = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
148.238 +val asm = asm union asm';
148.239 +"x ^^^ 2 + 5 * x = (2 + x) ^^^ 2";
148.240 +(*7*)val rls = "Test_simplify";
148.241 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.242 +"x ^^^ 2 + 5 * x = 4 + (x ^^^ 2 + 4 * x)";
148.243 +(*8*)val rls = "norm_equation";
148.244 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.245 +"x ^^^ 2 + 5 * x + -1 * (4 + (x ^^^ 2 + 4 * x)) = 0";
148.246 +(*9*)val rls = "Test_simplify";
148.247 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.248 +"-4 + x = 0";
148.249 +(*10*)val rls = "isolate_bdv";
148.250 +val (ct,_) = the (rewrite_set_inst thy' false
148.251 + [("bdv","x")] rls ct);
148.252 +"x = 0 + -1 * -4";
148.253 +(*11*)val rls = "Test_simplify";
148.254 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.255 +if ct="x = 4" then () else raise error "new behaviour in test-example";
148.256 +
148.257 +
148.258 +
148.259 +
148.260 +" _________________ rewrite + cappend _________________ ";
148.261 +" _________________ rewrite + cappend _________________ ";
148.262 +" _________________ rewrite + cappend _________________ ";
148.263 +val thy' = "Test.thy";
148.264 +val ct = str2term"sqrt(9+4*x)=sqrt x + sqrt(5+x)";
148.265 +val ctl = ["sqrt(9+4*x)=sqrt x + sqrt(5+x)","x::real","0"];
148.266 +val oris = prep_ori ctl thy
148.267 + ((#ppc o get_pbt)
148.268 + ["sqroot-test","univariate","equation","test"]);
148.269 +val loc = e_istate;
148.270 +val (pt,pos) = (e_ptree,[]);
148.271 +val (pt,_) = cappend_problem pt pos loc e_fmz (oris,empty_spec,e_term);
148.272 +val pt = update_branch pt [] TransitiveB;
148.273 +(*
148.274 +val pt = update_model pt [] (map init_item (snd (get_obj g_origin pt [])));
148.275 +*)
148.276 +(*val pt = update_model pt [] (fst (get_obj g_origin pt [])); *)
148.277 +val pt = update_domID pt [] "Test";
148.278 +val pt = update_pblID pt [] ["Test",
148.279 + "equations","univariate","square-root"];
148.280 +val pt = update_metID pt [] ["Test","sqrt-equ-test"];
148.281 +val pt = update_pbl pt [] [];
148.282 +val pt = update_met pt [] [];
148.283 +(*
148.284 +> get_obj g_spec pt [];
148.285 +val it = ("e_domID",["e_pblID"],("e_domID","e_metID")) : spec
148.286 +> val pt = update_domID pt [] "RatArith";
148.287 +> get_obj g_spec pt [];
148.288 +val it = ("RatArith",["e_pblID"],("e_domID","e_metID")) : spec
148.289 +> val pt = update_pblID pt [] ["RatArith",
148.290 + "equations","univariate","square-root"];
148.291 +> get_obj g_spec pt [];
148.292 +("RatArith",["RatArith","equations","univariate","square-root"],
148.293 + ("e_domID","e_metID")) : spec
148.294 +> val pt = update_metID pt [] ("RatArith","sqrt-equ-test");
148.295 +> get_obj g_spec pt [];
148.296 + ("RatArith",["RatArith","equations","univariate","square-root"],
148.297 + ("RatArith","sqrt-equ-test")) : spec
148.298 +*)
148.299 +
148.300 +
148.301 +val pos = [1]:pos;
148.302 +val (pt,_) = cappend_parent pt pos loc ct (Tac "repeat") TransitiveB;
148.303 +
148.304 +val pos = (lev_on o lev_dn) pos;
148.305 +val thm = ("square_equation_left",""); val ctold = ct;
148.306 +val (ct,asm) = the (rewrite thy' "tless_true" ("tval_rls") true thm (term2str ct));
148.307 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac (fst thm)) (str2term ct,[])Complete;
148.308 +(*val pt = union_asm pt [] (map (rpair []) asm);*)
148.309 +
148.310 +val pos = lev_on pos;
148.311 +val rls = ("Test_simplify"); val ctold = str2term ct;
148.312 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.313 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.314 +
148.315 +val pos = lev_on pos;
148.316 +val rls = ("rearrange_assoc"); val ctold = str2term ct;
148.317 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.318 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.319 +
148.320 +val pos = lev_on pos;
148.321 +val rls = ("isolate_root"); val ctold = str2term ct;
148.322 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.323 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.324 +
148.325 +val pos = lev_on pos;
148.326 +val rls = ("Test_simplify"); val ctold = str2term ct;
148.327 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.328 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.329 +
148.330 +val pos = lev_on pos;
148.331 +val thm = ("square_equation_left",""); val ctold = str2term ct;
148.332 +val (ct,asm) = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
148.333 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.334 +(*val pt = union_asm pt [] (map (rpair []) asm);*)
148.335 +
148.336 +val pos = lev_up pos;
148.337 +val (pt,_) = append_result pt pos e_istate (str2term ct,[]) Complete;
148.338 +
148.339 +val pos = lev_on pos;
148.340 +val rls = ("Test_simplify"); val ctold = str2term ct;
148.341 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.342 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.343 +
148.344 +val pos = lev_on pos;
148.345 +val rls = ("norm_equation"); val ctold = str2term ct;
148.346 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.347 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.348 +
148.349 +val pos = lev_on pos;
148.350 +val rls = ("Test_simplify"); val ctold = str2term ct;
148.351 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.352 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.353 +
148.354 +(* --- see comments in interface_ME_ISA/instantiate''
148.355 +val rlsdat' = instantiate_rls' thy' [("bdv","x")] ("isolate_bdv");
148.356 +val (ct,_) = the (rewrite_set thy' false
148.357 + ("#isolate_bdv",rlsdat') ct); *)
148.358 +val pos = lev_on pos;
148.359 +val rls = ("isolate_bdv"); val ctold = str2term ct;
148.360 +val (ct,_) = the (rewrite_set_inst thy' false
148.361 + [("bdv","x")] rls ct);
148.362 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.363 +
148.364 +val pos = lev_on pos;
148.365 +val rls = ("Test_simplify"); val ctold = str2term ct;
148.366 +val (ct,_) = the (rewrite_set thy' false rls ct);
148.367 +val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
148.368 +
148.369 +val pos = lev_up pos;
148.370 +val (pt,pos) = append_result pt pos e_istate (str2term ct,[]) Complete;
148.371 +get_assumptions_ pt ([],Res);
148.372 +
148.373 +writeln (pr_ptree pr_short pt);
148.374 +(* aus src.24-11-99:
148.375 +. sqrt(9+4*x)=sqrt x + sqrt(5+x), x, (+0)
148.376 +1. sqrt(9+4*x)=sqrt x + sqrt(5+x)
148.377 +1.1. sqrt(9+4*x)=sqrt x + sqrt(5+x)
148.378 +1.2. 9 + 4 * x = (sqrt x + sqrt (5 + x) ) ^^^ 2
148.379 +1.3. 9 + 4 * x = 5 + ((+2) * x + (+2) * sqrt (5 * x + x ^^^ 2) )
148.380 +1.4. 9 + 4 * x = 5 + (+2) * x + (+2) * sqrt (5 * x + x ^^^ 2)
148.381 +1.5. sqrt (5 * x + x ^^^ 2) = (5 + (+2) * x + (-1) * (9 + 4 * x)) / ((-1) * (+2))
148.382 +1.6. sqrt (5 * x + x ^^^ 2) = (+2) + x
148.383 +2. 5 * x + x ^^^ 2 = ((+2) + x) ^^^ 2
148.384 +3. 5 * x + x ^^^ 2 = 4 + (4 * x + x ^^^ 2) ###12.12.99: indent 2.1. !?!
148.385 +4. 5 * x + x ^^^ 2 + (-1) * (4 + (4 * x + x ^^^ 2)) = (+0)
148.386 +5. (-4) + x = (+0)
148.387 +6. x = (+0) + (-1) * (-4)
148.388 +*)
148.389 +
148.390 +(*
148.391 +val t = (term_of o the o (parse thy)) "solutions (L::real set)";
148.392 +atomty t;
148.393 +*)
148.394 +
148.395 +
148.396 +(*- 20.9.02: Free_Solve would need the erls (for conditions of rules)
148.397 + from thy ???, i.e. together with the *_simplify ?!!!? ----------
148.398 +" _________________ me Free_Solve _________________ ";
148.399 +" _________________ me Free_Solve _________________ ";
148.400 +" _________________ me Free_Solve _________________ ";
148.401 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
148.402 + "solveFor x","errorBound (eps=0)",
148.403 + "solutions L"(*,
148.404 + "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < eps}"*)];
148.405 +val (dI',pI',mI') =
148.406 + ("Test.thy",["sqroot-test","univariate","equation","test"],
148.407 + ("Test.thy","sqrt-equ-test"));
148.408 +val p = e_pos'; val c = [];
148.409 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
148.410 +
148.411 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;
148.412 +(*val nxt = ("Add_Given", Add_Given "equation (sqrt (#9 + #4 * x) = sqrt x + sqrt (#5 + x) )");*)
148.413 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.414 +(* val nxt = ("Add_Given",Add_Given "bound_variable x");*)
148.415 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.416 +(* val nxt = ("Add_Given",Add_Given "error_bound #0");*)
148.417 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.418 +(* val nxt = ("Add_Find",Add_Find "solutions L"); *)
148.419 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.420 +(* val nxt = ("Specify_Theory",Specify_Theory "DiffAppl.thy");
148.421 +> get_obj g_spec pt (fst p);
148.422 +val it = ("e_domID",["e_pblID"],("e_domID","e_metID")) : spec*)
148.423 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.424 +(*val nxt = ("Specify_Problem", Specify_Problem *)
148.425 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.426 +(*val nxt = ("Specify_Method",Specify_Method ("DiffAppl.thy","sqrt-equ-test"));*)
148.427 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.428 +(*val nxt = ("Apply_Method",Apply_Method ("DiffAppl.thy","sqrt-equ-test"));*)
148.429 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.430 +val nxt = ("Free_Solve",Free_Solve);
148.431 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
148.432 +get_obj g_spec pt [];
148.433 +
148.434 +"--- -2 ---";
148.435 +get_form ("Take",Take"sqrt(9+4*x)=sqrt x + sqrt(5+x)") p pt;
148.436 +val (p,_,f,nxt,_,pt)=
148.437 +me ("Take",Take "sqrt(9+4*x)=sqrt x + sqrt(5+x)") p [3] pt;
148.438 +(* 15.4.
148.439 +"--- -1 ---";
148.440 +get_form ("Begin_Trans",Begin_Trans) p pt;
148.441 +val (p,_,f,nxt,_,pt)=
148.442 +me ("Begin_Trans",Begin_Trans) p [4] pt; *)
148.443 +
148.444 +"--- 1 ---";
148.445 +get_form ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p pt;
148.446 +val (p,_,f,nxt,_,pt)=
148.447 +me ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p [5] pt;
148.448 +"--- 2 ---";
148.449 +get_form ("Rewrite_Set",Rewrite_Set "Test_simplify")p pt;
148.450 +val (p,_,f,nxt,_,pt)=
148.451 +me ("Rewrite_Set",Rewrite_Set "Test_simplify")p [6] pt;
148.452 +"--- 3 ---";
148.453 +get_form ("Rewrite_Set",Rewrite_Set "rearrange_assoc") p pt;
148.454 +val (p,_,f,nxt,_,pt)=
148.455 +me ("Rewrite_Set",Rewrite_Set "rearrange_assoc") p [7] pt;
148.456 +"--- 4 ---";
148.457 +get_form ("Rewrite_Set",Rewrite_Set "isolate_root") p pt;
148.458 +val (p,_,f,nxt,_,pt)=
148.459 +me ("Rewrite_Set",Rewrite_Set "isolate_root") p [8] pt;
148.460 +"--- 5 ---";
148.461 +get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
148.462 +val (p,_,f,nxt,_,pt)=
148.463 +me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [9] pt;
148.464 +"--- 6 ---";
148.465 +get_form ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p pt;
148.466 +val (p,_,f,nxt,_,pt)=
148.467 +me ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p [10] pt;
148.468 +(* 15.4.
148.469 +"--- ---";
148.470 +get_form ("End_Trans",End_Trans) p pt;
148.471 +val (p,_,f,nxt,_,pt)=
148.472 +me ("End_Trans",End_Trans) p [11] pt; *)
148.473 +"--- 7 ---";
148.474 +get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
148.475 +val (p,_,f,nxt,_,pt)=
148.476 +me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [12] pt;
148.477 +"--- 8 ---";
148.478 +get_form ("Rewrite_Set",Rewrite_Set "norm_equation") p pt;
148.479 +val (p,_,f,nxt,_,pt)=
148.480 +me ("Rewrite_Set",Rewrite_Set "norm_equation") p [13] pt;
148.481 +"--- 9 ---";
148.482 +get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
148.483 +val (p,_,f,nxt,_,pt)=
148.484 +me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [14] pt;
148.485 +"--- 10 ---.";
148.486 +get_form ("Rewrite_Set_Inst",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv")) p pt;
148.487 +val (p,_,f,nxt,_,pt)=
148.488 +me ("Rewrite_Set",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv")) p [15] pt;
148.489 +"--- 11 ---";
148.490 +get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
148.491 +val ((p,p_),_,f,nxt,_,pt)=
148.492 +me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [16] pt;
148.493 +(* 5.4.00.: ---
148.494 +get_form ("Check_Postcond",Check_Postcond ("Test.thy","solve-root-equation")) (p,Met) pt;
148.495 +val (p,_,f,nxt,_,pt)=
148.496 +me ("Check_Postcond",Check_Postcond ("Test.thy","solve-root-equation")) (p,Met) [17] pt;
148.497 +--- *)
148.498 +writeln (pr_ptree pr_short pt);
148.499 +writeln("result: "^(get_obj g_result pt [])^"\n==================================================================="*;
148.500 +*)
148.501 +
148.502 +
148.503 +" _________________ me + tacs input _________________ ";
148.504 +" _________________ me + tacs input _________________ ";
148.505 +" _________________ me + tacs input _________________ ";
148.506 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
148.507 + "solveFor x","errorBound (eps=0)",
148.508 + "solutions L"];
148.509 +val (dI',pI',mI') =
148.510 + ("Test.thy",["sqroot-test","univariate","equation","test"],
148.511 + ["Test","sqrt-equ-test"]);
148.512 +"--- s1 ---";
148.513 +(*val p = e_pos'; val c = [];
148.514 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
148.515 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
148.516 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
148.517 +"--- s1b ---";
148.518 +val nxt = ("Model_Problem",
148.519 + Model_Problem(*["sqroot-test","univariate","equation","test"]*));
148.520 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.521 +"--- s2 ---";
148.522 +val nxt = ("Add_Given",
148.523 +Add_Given "equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))");
148.524 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.525 +"--- s3 ---";
148.526 +val nxt = ("Add_Given",Add_Given "solveFor x");
148.527 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.528 +(*"--- s4 ---";
148.529 +val nxt = ("Add_Given",Add_Given "errorBound (eps = 0)");
148.530 +val (p,_,f,nxt,_,pt) = me nxt p c pt;*)
148.531 +"--- s5 ---";
148.532 +val nxt = ("Add_Find",Add_Find "solutions L");
148.533 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.534 +"--- s6 ---";
148.535 +val nxt = ("Specify_Theory",Specify_Theory "Test.thy");
148.536 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.537 +"--- s7 ---";
148.538 +val nxt = ("Specify_Problem",
148.539 +Specify_Problem ["sqroot-test","univariate","equation","test"]);
148.540 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.541 +"--- s8 ---";
148.542 +val nxt = ("Specify_Method",Specify_Method ["Test","sqrt-equ-test"]);
148.543 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.544 +"--- s9 ---";
148.545 +val nxt = ("Apply_Method",Apply_Method ["Test","sqrt-equ-test"]);
148.546 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.547 +"--- 1 ---";
148.548 +val nxt = ("Rewrite",Rewrite ("square_equation_left",""));
148.549 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.550 +
148.551 +(*.9.6.03
148.552 + val t = str2term "sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x)";
148.553 + val Some (t',asm) = rewrite_set_ thy false rls t;
148.554 + term2str t';
148.555 + trace_rewrite:=true;
148.556 + trace_rewrite:=false;
148.557 +*)
148.558 +
148.559 +(*me------------
148.560 + val (mI,m) = nxt; val pos' as (p,p_) = p;
148.561 +
148.562 + val Appl m = applicable_in (p,p_) pt m;
148.563 +(*solve*)
148.564 + val pp = par_pblobj pt p;
148.565 + val metID = get_obj g_metID pt pp;
148.566 + val sc = (#scr o get_met) metID;
148.567 + val is = get_istate pt (p,p_);
148.568 + val thy' = get_obj g_domID pt pp;
148.569 + val thy = assoc_thy thy';
148.570 + val d = e_rls;
148.571 + val Steps [(m',f',pt',p',c',s')] =
148.572 + locate_gen thy' m (pt,(p,p_)) (sc,d) is;
148.573 + val is' = get_istate pt' p';
148.574 + next_tac thy' (pt'(*'*),p') sc is';
148.575 +
148.576 +
148.577 +
148.578 +
148.579 +val ttt = (term_of o the o (parse Test.thy))
148.580 +"Let (((While contains_root e_ Do\
148.581 +\Rewrite square_equation_left True @@\
148.582 +\Try (Rewrite_Set Test_simplify False) @@\
148.583 +\Try (Rewrite_Set rearrange_assoc False) @@\
148.584 +\Try (Rewrite_Set Test_simplify False)) @@\
148.585 +\Try (Rewrite_Set norm_equation False) @@\
148.586 +\Try (Rewrite_Set Test_simplify False) @@\
148.587 +\Rewrite_Set_Inst [(bdv, v_)] isolate_bdv False @@\
148.588 +\Try (Rewrite_Set Test_simplify False))\
148.589 +\e_)";
148.590 +
148.591 +-------------------------*)
148.592 +
148.593 +
148.594 +"--- 2 ---";
148.595 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
148.596 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.597 +"--- 3 ---";
148.598 +val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
148.599 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.600 +"--- 4 ---";
148.601 +val nxt = ("Rewrite_Set",Rewrite_Set "isolate_root");
148.602 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.603 +"--- 5 ---";
148.604 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
148.605 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.606 +"--- 6 ---";
148.607 +val nxt = ("Rewrite",Rewrite ("square_equation_left",""));
148.608 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.609 +"--- 7 ---";
148.610 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
148.611 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.612 +"--- 8<> ---";
148.613 +val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
148.614 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.615 +"--- 9<> ---";
148.616 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
148.617 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.618 +"--- 10<> ---";
148.619 +val nxt = ("Rewrite_Set",Rewrite_Set "norm_equation");
148.620 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.621 +"--- 11<> ---.";
148.622 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
148.623 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.624 +"--- 12<> ---";
148.625 +val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv"));
148.626 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.627 +"--- 13<> ---";
148.628 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
148.629 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
148.630 +"--- 1<> ---";
148.631 +val nxt = ("Check_Postcond",Check_Postcond ["sqroot-test","univariate","equation","test"]);
148.632 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
148.633 +(* val nxt = ("End_Proof'",End_Proof');*)
148.634 +if f <> (Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4]")))
148.635 +then raise error "root-equ.sml: diff.behav. in me + tacs input"
148.636 +else ();
148.637 +
148.638 +writeln (pr_ptree pr_short pt);
148.639 +writeln("result: "^((term2str o fst o (get_obj g_result pt)) [])^
148.640 +"\n==============================================================");
148.641 +
149.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
149.2 +++ b/src/Pure/isac/smltest/OLDTESTS/script.sml Wed Jul 21 13:53:39 2010 +0200
149.3 @@ -0,0 +1,345 @@
149.4 +(* tests for ME/script.sml
149.5 + WN.13.3.00
149.6 +
149.7 + WN050908 OLD FILE, MERGE WITH smltest/ME/script.sml
149.8 +
149.9 +use"systest/script.sml";
149.10 +use"script.sml";
149.11 +*)
149.12 +
149.13 +
149.14 +" scripts: Variante 'funktional' ";
149.15 +"############## Make_fun_by_new_variable ##############";
149.16 +"############## Make_fun_by_explicit ##############";
149.17 +"################ Solve_root_equation #################";
149.18 +"------- Notlocatable: Free_Solve -------";
149.19 +
149.20 +" --- test100: nxt_tac order------------------------------------ ";
149.21 +" --- test100: order 1 3 1 2 ----------------------------------- ";
149.22 +" --- test200: nxt_tac order ------------------------------------- ";
149.23 +" --- test200: order 3 1 1 2 --------------------------------- ";
149.24 +
149.25 +" --- root-equation: nxt_tac order------------------------------ ";
149.26 +" --- root-equation: 1.norm_equation ------------------------------ ";
149.27 +(* --- test200: calculate -----------------------------------------*)
149.28 +" --- check_elementwise ------------------------------ ";
149.29 +
149.30 +" --- test 30.4.02 Testterm: Repeat Repeat Or ------------------ ";
149.31 +" --- test 9.5.02 Testeq: While Try Repeat @@ ------------------ ";
149.32 +
149.33 +"--------- sel_rules ---------------------------------------------";
149.34 +"-----------------------------------------------------------------";
149.35 +
149.36 +
149.37 +
149.38 +
149.39 +
149.40 +" ################################################# 6.5.03";
149.41 +" scripts: Variante 'funktional' 6.5.03";
149.42 +" ################################################# 6.5.03 ";
149.43 +
149.44 +val c = (the o (parse DiffApp.thy))
149.45 + "Script Maximum_value(fix_::bool list)(m_::real) (rs_::bool list)\
149.46 + \ (v_::real) (itv_::real set) (err_::bool) = \
149.47 + \ (let e_ = (hd o (filterVar m_)) rs_; \
149.48 + \ t_ = (if 1 < length_ rs_ \
149.49 + \ then (SubProblem (Reals_,[make,function],[no_met])\
149.50 + \ [real_ m_, real_ v_, bool_list_ rs_])\
149.51 + \ else (hd rs_)); \
149.52 + \ (mx_::real) = SubProblem (Reals_,[on_interval,max_of,function], \
149.53 + \ [Isac,maximum_on_interval])\
149.54 + \ [bool_ t_, real_ v_, real_set_ itv_]\
149.55 + \ in ((SubProblem (Reals_,[find_values,tool],[Isac,find_values]) \
149.56 + \ [real_ mx_, real_ (Rhs t_), real_ v_, real_ m_, \
149.57 + \ bool_list_ (dropWhile (ident e_) rs_)])::bool list))";
149.58 +
149.59 +
149.60 +"################################################### 6.5.03";
149.61 +"############## Make_fun_by_new_variable ########### 6.5.03";
149.62 +"################################################### 6.5.03";
149.63 +
149.64 +val sc = (the o (parse DiffApp.thy)) (*start interpretieren*)
149.65 + "Script Make_fun_by_new_variable (f_::real) (v_::real) \
149.66 + \ (eqs_::bool list) = \
149.67 + \(let h_ = (hd o (filterVar f_)) eqs_; \
149.68 + \ es_ = dropWhile (ident h_) eqs_; \
149.69 + \ vs_ = dropWhile (ident f_) (Vars h_); \
149.70 + \ v_1 = nth_ 1 vs_; \
149.71 + \ v_2 = nth_ 2 vs_; \
149.72 + \ e_1 = (hd o (filterVar v_1)) es_; \
149.73 + \ e_2 = (hd o (filterVar v_2)) es_; \
149.74 + \ (s_1::bool list) = (SubProblem (Reals_,[univar,equation],[no_met])\
149.75 + \ [bool_ e_1, real_ v_1]);\
149.76 + \ (s_2::bool list) = (SubProblem (Reals_,[univar,equation],[no_met])\
149.77 + \ [bool_ e_2, real_ v_2])\
149.78 + \in Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] h_)";
149.79 +
149.80 +val ags = map (term_of o the o (parse DiffApp.thy))
149.81 + ["A::real", "alpha::real",
149.82 + "[A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]"];
149.83 +val ll = [](*:loc_*);
149.84 +(* problem with exn PTREE + eval_to -------------------------
149.85 +"-------------- subproblem with empty formalizaton -------";
149.86 +val (mI1,m1) =
149.87 + ("Subproblem", tac2tac_ pt p
149.88 + (Subproblem (("Reals",["univar","equation","test"],
149.89 + (""(*"ANDERN !!!!!!!*),"no_met")),[])));
149.90 +val (mI2,m2) = (mI1,m1);
149.91 +val (mI3,m3) =
149.92 + ("Substitute", tac2tac_ pt p
149.93 + (Substitute [("a","#2*r*sin alpha"),("b","#2*r*cos alpha")]));
149.94 +"------- same_tacpbl + eval_to -------";
149.95 +val Some(l1,t1) = same_tacpbl sc ll (mI1,m1);
149.96 +loc_2str l1;
149.97 +(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, L, R]"*)
149.98 +Sign.string_of_term (sign_of DiffApp.thy) t1;
149.99 +(*"solve_univar (Reals, [univar, equation], no_met) B.1 B.3 "?6 ?4 *)
149.100 +
149.101 +val Some(l2,t2) = same_tacpbl sc l1 (mI2,m2);
149.102 +loc_2str l2;
149.103 +(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D, L, R]"*)
149.104 +Sign.string_of_term (sign_of DiffApp.thy) t2;
149.105 +(*"solve_univar (Reals, [univar, equation], no_met) B.1 B.3 "?7 ?3 *)
149.106 +
149.107 +val Some(l3,t3) = same_tacpbl sc l2 (mI3,m3);
149.108 +loc_2str l3;
149.109 +(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D]"*)
149.110 +Sign.string_of_term (sign_of DiffApp.thy) t3;
149.111 +(*"Substitute [(v_1, (Rhs o hd) B.1), (v_2, (Rhs o hd) B.0)] B.8"*)
149.112 +
149.113 +
149.114 +"------- eq_tacIDs + eq_consts + eval_args -------";
149.115 +val eq_ids = eq_tacIDs (*start-loc_*)[] sc (mI,m) [];
149.116 +val eq_cons = filter (eq_consts m) eq_ids;
149.117 +val Ready (l,(_,m)::_,_) = eval_args sc (mI,m) [(1,ags)] eq_cons;
149.118 +"------- locate -------";
149.119 +
149.120 +
149.121 +"-------------- subproblem with formalizaton -------";
149.122 +val (mI,m) =
149.123 + ("Subproblem", tac2tac_ pt []
149.124 + (Subproblem (("Reals",["univar","equation","test"],
149.125 + (""(*"ANDERN !!!!!!!*),"no_met")),
149.126 + ["a//#2=r*sin alpha","a"])));
149.127 +"------- same_tacpbl + eval_to -------";
149.128 +
149.129 +
149.130 +"------- eq_tacIDs + eq_consts + eval_args -------";
149.131 +val eq_ids = eq_tacIDs [] sc (mI,m) [];
149.132 +val eq_cons = filter (eq_consts m) eq_ids;
149.133 +val Ready (l,(_,m)::_,_) = eval_args sc (mI,m) [(1,ags)] eq_cons;
149.134 +
149.135 +
149.136 +"------- locate -------";
149.137 +-------------------------------------------------------*)
149.138 +(* use"ME/script.sml";
149.139 + use"test-script.sml";
149.140 + *)
149.141 +
149.142 +
149.143 +
149.144 +"############## Make_fun_by_explicit ############## 6.5.03";
149.145 +"############## Make_fun_by_explicit ############## 6.5.03";
149.146 +"############## Make_fun_by_explicit ############## 6.5.03";
149.147 +val c = (the o (parse DiffApp.thy))
149.148 + "Script Make_fun_by_explicit (f_::real) (v_::real) \
149.149 + \ (eqs_::bool list) = \
149.150 + \ (let h_ = (hd o (filterVar f_)) eqs_; \
149.151 + \ e_1 = hd (dropWhile (ident h_) eqs_); \
149.152 + \ vs_ = dropWhile (ident f_) (Vars h_); \
149.153 + \ v_1 = hd (dropWhile (ident v_) vs_); \
149.154 + \ (s_1::bool list)=(SubProblem(Reals_,[univar,equation],[no_met])\
149.155 + \ [bool_ e_1, real_ v_1])\
149.156 + \ in Substitute [(v_1 = (rhs o hd) s_1)] h_)";
149.157 +
149.158 +
149.159 +(*#####################################################--------11.5.02
149.160 +"################ Solve_root_equation #################";
149.161 +(*#####################################################*)
149.162 +val sc = (term_of o the o (parse Test.thy))
149.163 + "Script Solve_root_equation (eq_::bool) (v_::real) (err_::bool) =\
149.164 + \ (let e_ = Rewrite square_equation_left True eq_; \
149.165 + \ e_ = Rewrite_Set Test_simplify False e_; \
149.166 + \ e_ = Rewrite_Set rearrange_assoc False e_; \
149.167 + \ e_ = Rewrite_Set isolate_root False e_; \
149.168 + \ e_ = Rewrite_Set Test_simplify False e_; \
149.169 +
149.170 + \ e_ = Rewrite square_equation_left True e_; \
149.171 + \ e_ = Rewrite_Set Test_simplify False e_; \
149.172 +
149.173 + \ e_ = Rewrite_Set norm_equation False e_; \
149.174 + \ e_ = Rewrite_Set Test_simplify False e_; \
149.175 + \ e_ = Rewrite_Set_Inst [(bdv,v_)] isolate_bdv False e_;\
149.176 + \ e_ = Rewrite_Set Test_simplify False e_ \
149.177 + \ in [e_::bool])";
149.178 +val ags = map (term_of o the o (parse Test.thy))
149.179 + ["sqrt(#9+#4*x)=sqrt x + sqrt(#5+x)", "x::real","#0"];
149.180 +val fmz =
149.181 + ["equality (sqrt(#9+#4*x)=sqrt x + sqrt(#5+x))",
149.182 + "solveFor x","errorBound (eps = #0)","solutions v_i_"];
149.183 +----------------------------------------------------------------11.5.02...*)
149.184 +
149.185 +
149.186 +(*################################# meNEW raises exception with not-locatable
149.187 +"--------------------- Notlocatable: Free_Solve ---------------------";
149.188 +"--------------------- Notlocatable: Free_Solve ---------------------";
149.189 +"--------------------- Notlocatable: Free_Solve ---------------------";
149.190 +val fmz = [];
149.191 +val (dI',pI',mI') =
149.192 + ("Test.thy",["sqroot-test","univariate","equation","test"],
149.193 + ["Test","sqrt-equ-test"]);
149.194 +(*val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
149.195 +val (p,_,f,nxt,_,pt) = me (mI,m) e_pos'[1] EmptyPtree;*)
149.196 +
149.197 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
149.198 +val nxt = ("Model_Problem",
149.199 + Model_Problem ["sqroot-test","univariate","equation","test"]);
149.200 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.201 +val nxt =
149.202 + ("Add_Given",
149.203 + Add_Given "equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))");
149.204 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.205 +val nxt = ("Add_Given",Add_Given "solveFor x");
149.206 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.207 +val nxt = ("Add_Given",Add_Given "errorBound (eps = 0)");
149.208 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.209 +val nxt = ("Add_Find",Add_Find "solutions v_i_");
149.210 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.211 +val nxt = ("Specify_Theory",Specify_Theory "Test.thy");
149.212 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.213 +val nxt =
149.214 + ("Specify_Problem",Specify_Problem ["sqroot-test","univariate","equation","test"]);
149.215 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.216 +val nxt = ("Specify_Method",Specify_Method ["Test","sqrt-equ-test"]);
149.217 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
149.218 +
149.219 +"--- -1 ---";
149.220 +val nxt = ("Free_Solve",Free_Solve);
149.221 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
149.222 +
149.223 +"--- 0 ---";
149.224 +val nxt = ("Take",Take "sqrt(9+4*x)=sqrt x + sqrt(5+x)");
149.225 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
149.226 +(*me ("Begin_Trans" ////*)
149.227 +
149.228 +"--- 1 ---";
149.229 +val nxt = ("Rewrite_Asm",Rewrite_Asm ("square_equation_left",""));
149.230 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
149.231 +
149.232 +"--- 2 ---";
149.233 +val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
149.234 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
149.235 +
149.236 +"--- 3 ---";
149.237 +val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
149.238 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
149.239 +if f = Form'
149.240 + (FormKF
149.241 + (~1,EdUndef,1,Nundef,
149.242 + "9 + 4 * x = 5 + 2 * x + 2 * sqrt (x ^^^ 2 + 5 * x)"))
149.243 +then () else raise error "behaviour in root-expl. Free_Solve changed";
149.244 +writeln (pr_ptree pr_short pt);
149.245 +---------------------------------meNEW raises exception with not-locatable*)
149.246 +
149.247 +
149.248 +val d = e_rls;
149.249 +
149.250 +" --- test100: nxt_tac order------------------------------------ ";
149.251 +" --- test100: nxt_tac order------------------------------------ ";
149.252 +
149.253 +val scr as (Script sc) = Script (((inst_abs Test.thy)
149.254 + o term_of o the o (parse thy))
149.255 + "Script Testeq (e_::bool) = \
149.256 + \(While (contains_root e_) Do \
149.257 + \((Try (Repeat (Rewrite rroot_square_inv False))) @@ \
149.258 + \ (Try (Repeat (Rewrite square_equation_left True))) @@ \
149.259 + \ (Try (Repeat (Rewrite radd_0 False)))))\
149.260 + \ e_ ");
149.261 +atomty sc;
149.262 +val (dI',pI',mI') = ("Test.thy",["sqroot-test","univariate","equation","test"],
149.263 + ["Test","sqrt-equ-test"]);
149.264 +val p = e_pos'; val c = [];
149.265 +val (mI,m) = ("Init_Proof",Init_Proof ([], (dI',pI',mI')));
149.266 +val (p,_,_,_,_,pt) = me (mI,m) p c EmptyPtree;
149.267 +val nxt = ("Specify_Theory",Specify_Theory "Test.thy");
149.268 +val (p,_,_,_,_,pt) = me nxt p c pt;
149.269 +val nxt = ("Specify_Method",Specify_Method ["Test","sqrt-equ-test"]); (*for asm in square_equation_left*)
149.270 +val (p,_,_,_,_,pt) = me nxt p c pt;
149.271 +val p = ([1],Res):pos';
149.272 +val eq_ = (term_of o the o (parse thy))"e_::bool";
149.273 +
149.274 +val ct = "0+(sqrt(sqrt(sqrt a))^^^2)^^^2=0";
149.275 +val ve0_= (term_of o the o (parse thy)) ct;
149.276 +val ets0=[([],(Tac_(Script.thy,"BS","",""),[(eq_,ve0_)],[(eq_,ve0_)],
149.277 + e_term,e_term,Safe)),
149.278 + ([],(User', [], [], e_term, e_term,Sundef))]:ets;
149.279 +val l0 = [];
149.280 +" --------------- 1. ---------------------------------------------";
149.281 +val (pt,_) = cappend_atomic pt[1]e_istate e_term(Rewrite("test",""))(str2term ct,[])Complete;
149.282 +(*12.10.03:*** Unknown theorem(s) "rroot_square_inv"
149.283 +val Appl m'=applicable_in p pt (Rewrite("rroot_square_inv",""));
149.284 +*)
149.285 +
149.286 +
149.287 +val scr as (Script sc) =
149.288 + Script (((inst_abs Test.thy) o term_of o the o (parse thy))
149.289 + "Script Testterm (g_::real) = (Calculate cancel g_)");
149.290 +(*
149.291 +val scr as (Script sc) =
149.292 + Script (((inst_abs Test.thy) o term_of o the o (parse thy))
149.293 + "Script Testterm (g_::real) = (Calculate power g_)");
149.294 +val scr as (Script sc) =
149.295 + Script (((inst_abs Test.thy) o term_of o the o (parse thy))
149.296 + "Script Testterm (g_::real) = (Calculate pow g_)");
149.297 +..............................................................*)
149.298 +writeln
149.299 +"%%%%%%%%%%TODO 7.9.00---vvvvvv--- conflicts with Isa-types \n\
149.300 +\ (Repeat (Calculate cancel g_)) Or \n\
149.301 +\ (Repeat (Calculate power g_)) Or \n\
149.302 +\%%%%%%%%%%%%%%%%%%%%%---^^^^^^--- conflicts with Isa-types \n\
149.303 +\%%%%%%%%%%%%%%%%%%%%%TODO before Detail Rewrite_Set";
149.304 +
149.305 +
149.306 +"--------- sel_rules ---------------------------------------------";
149.307 +"--------- sel_rules ---------------------------------------------";
149.308 +"--------- sel_rules ---------------------------------------------";
149.309 + states:=[];
149.310 + CalcTree
149.311 + [(["equality (x+1=2)", "solveFor x","solutions L"],
149.312 + ("Test.thy",
149.313 + ["sqroot-test","univariate","equation","test"],
149.314 + ["Test","squ-equ-test-subpbl1"]))];
149.315 + Iterator 1;
149.316 + moveActiveRoot 1;
149.317 + autoCalculate 1 CompleteCalc;
149.318 + val ((pt,_),_) = get_calc 1;
149.319 + show_pt pt;
149.320 +
149.321 + val tacs = sel_rules pt ([],Pbl);
149.322 + if tacs = [Apply_Method ["Test", "squ-equ-test-subpbl1"]] then ()
149.323 + else raise error "script.sml: diff.behav. in sel_rules ([],Pbl)";
149.324 +
149.325 + val tacs = sel_rules pt ([1],Res);
149.326 + if tacs = [Rewrite_Set "norm_equation", Rewrite_Set "Test_simplify",
149.327 + Subproblem ("Test.thy", ["linear", "univariate", "equation", "test"]),
149.328 + Check_elementwise "Assumptions"] then ()
149.329 + else raise error "script.sml: diff.behav. in sel_rules ([1],Res)";
149.330 +
149.331 + val tacs = sel_rules pt ([3],Pbl);
149.332 + if tacs = [Apply_Method ["Test", "solve_linear"]] then ()
149.333 + else raise error "script.sml: diff.behav. in sel_rules ([3],Pbl)";
149.334 +
149.335 + val tacs = sel_rules pt ([3,1],Res);
149.336 + if tacs = [Rewrite_Set_Inst (["(bdv, x)"], "isolate_bdv"),
149.337 + Rewrite_Set "Test_simplify"] then ()
149.338 + else raise error "script.sml: diff.behav. in sel_rules ([3,1],Res)";
149.339 +
149.340 + val tacs = sel_rules pt ([3],Res);
149.341 + if tacs = [Rewrite_Set "norm_equation", Rewrite_Set "Test_simplify",
149.342 + Subproblem ("Test.thy", ["linear", "univariate", "equation", "test"]),
149.343 + Check_elementwise "Assumptions"] then ()
149.344 + else raise error "script.sml: diff.behav. in sel_rules ([3],Res)";
149.345 +
149.346 + val tacs = (sel_rules pt ([],Res)) handle PTREE str => [Tac str];
149.347 + if tacs = [Tac "no tactics applicable at the end of a calculation"] then ()
149.348 + else raise error "script.sml: diff.behav. in sel_rules ([],Res)";
150.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
150.2 +++ b/src/Pure/isac/smltest/OLDTESTS/script_if.sml Wed Jul 21 13:53:39 2010 +0200
150.3 @@ -0,0 +1,169 @@
150.4 +(* 1.if-te-else- 8.02 f"ur Richard
150.5 +
150.6 + use"ifthenelse.sml";
150.7 + use"tests/rationals2.sml";
150.8 + *)
150.9 +
150.10 +
150.11 +
150.12 +(*---------------- 25.7.02 ---------------------*)
150.13 +
150.14 +val thy = Isac.thy;
150.15 +val t = (term_of o the o (parse thy)) "contains_root (sqrt(x)=1)";
150.16 +val Some(ss,tt) = eval_contains_root "xxx" 1 t thy;
150.17 +
150.18 +val t = (term_of o the o (parse thy)) "is_rootequation_in (sqrt(x)=1) x";
150.19 +val Some(ss,tt) = eval_is_rootequation_in "is_rootequation_i" 1 t thy;
150.20 +
150.21 +(*---
150.22 +val v = (term_of o the o (parse thy)) "x";
150.23 +val t = (term_of o the o (parse thy)) "sqrt(#3+#4*x)";
150.24 +scan t v;
150.25 +val t = (term_of o the o (parse thy)) "sqrt(#3+#4*a)";
150.26 +scan t v;
150.27 +val t = (term_of o the o (parse thy)) "#1 + #2*sqrt(#3+#4*x)";
150.28 +scan t v;
150.29 +val t = (term_of o the o (parse thy)) "x + #2*sqrt(#3+#4*a)";
150.30 +scan t v;
150.31 +---*)
150.32 +val t = (term_of o the o (parse thy))
150.33 + "is_rootequation_in (1 + 2*sqrt(3+4*x)=0) x";
150.34 +val Some(ss,tt) = eval_is_rootequation_in "is_rootequation_i" 1 t thy;
150.35 +
150.36 +val t = (term_of o the o (parse thy))
150.37 + "is_rootequation_in (x + 2*sqrt(3+4*a)=0) x";
150.38 +val Some(ss,tt) = eval_is_rootequation_in "is_rootequation_i" 1 t thy;
150.39 +
150.40 +val t = (term_of o the o (parse Test.thy))
150.41 + "is_rootequation_in (sqrt(x)=1) x";
150.42 +atomty t;
150.43 +val t = (term_of o the o (parse Isac.thy))
150.44 + "is_rootequation_in (sqrt(x)=1) x";
150.45 +atomty t;
150.46 +
150.47 +(*
150.48 +val Some(tt,_) = rewrite_set_ Test.thytrue tval_rls t;
150.49 +*)
150.50 +val Some(tt,_) = rewrite_set_ Isac.thy true tval_rls t;
150.51 +
150.52 +rewrite_set "Isac.thy" true
150.53 + "tval_rls" "is_rootequation_in (sqrt(x)=1) x";
150.54 +rewrite_set "Test.thy" true
150.55 + "tval_rls" "is_rootequation_in (sqrt(x)=1) x";
150.56 +
150.57 +
150.58 +(*WN: ^^^--- bitte nimm vorerst immer Isac.thy, damit wird richtig gematcht,
150.59 + siehe unten. Wir werden w"ahrend der Arbeit auf diesen Fehler drauskommen*)
150.60 +store_pbt
150.61 + (prep_pbt (*Test.thy*) Isac.thy
150.62 + (["root","univariate","equation","test"],
150.63 + [("#Given" ,["equality e_","solveFor v_"]),
150.64 + ("#Where" ,["is_rootequation_in (e_::bool) (v_::real)"]),
150.65 + ("#Find" ,["solutions v_i_"])
150.66 + ],
150.67 + append_rls e_rls [Calc ("Test.is'_rootequation'_in",
150.68 + eval_is_rootequation_in "")],
150.69 + [("Test.thy","methode")]));
150.70 +
150.71 +match_pbl ["equality (sqrt(x)=1)","solveFor x","solutions L"] (get_pbt ["root","univariate","equation","test"]);
150.72 +
150.73 +
150.74 +(*---------------- 29.7.02 ---------------------*)
150.75 +
150.76 +store_pbt
150.77 + (prep_pbt Isac.thy
150.78 + (["approximate","univariate","equation","test"],
150.79 + [("#Given" ,["equality e_","solveFor v_","errorBound err_"]),
150.80 + ("#Where" ,["matches (?a = ?b) e_"]),
150.81 + ("#Find" ,["solutions v_i_"])
150.82 + ],
150.83 + append_rls e_rls [Calc ("Tools.matches",eval_matches "#matches_")],
150.84 + []));
150.85 +
150.86 +methods:= overwritel (!methods,
150.87 +[
150.88 + prep_met
150.89 + (("Isac.thy","solve_univar_err"):metID,
150.90 + [("#Given" ,["equality e_","solveFor v_","errorBound err_"]),
150.91 + ("#Find" ,["solutions v_i_"])
150.92 + ],
150.93 + {rew_ord'="tless_true",rls'="tval_rls",erls=e_rls,prls=e_rls,calc=[],
150.94 + asm_rls=[],asm_thm=[]},
150.95 + "Script Solve_univar_err (e_::bool) (v_::real) (err_::bool) = \
150.96 + \ (if (is_rootequation_in e_ v_)\
150.97 + \ then ((SubProblem (Isac_,[squareroot,univariate,equation],\
150.98 + \ (SqRoot_,square_equation)) [bool_ e_, real_ v_, bool_ err_]))\
150.99 + \ else ((SubProblem (Isac_,[linear,univariate,equation],\
150.100 + \ (RatArith_,solve_linear)) [bool_ e_, real_ v_])))"
150.101 + )]);
150.102 +
150.103 +val fmz = ["equality (1+2*x=0)","solveFor x","errorBound (eps=0)",
150.104 + "solutions L"];
150.105 +val (dI',pI',mI') =
150.106 + ("Isac.thy",["approximate","univariate","equation","test"],
150.107 + ("Isac.thy","solve_univar_err"));
150.108 +val p = e_pos'; val c = [];
150.109 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
150.110 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;
150.111 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.112 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.113 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.114 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.115 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.116 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.117 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.118 +(*val nxt = ("Apply_Method",Apply_Method ("Isac.thy","solve_univar_err"))*)
150.119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.120 +val (p,_,f,nxt,_,pt) = (me nxt p [1] pt) handle e => print_exn_G e;
150.121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.122 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.124 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.126 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.127 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.128 +(*val nxt = ("Apply_Method",Apply_Method ("RatArith.thy","solve_linear"))*)
150.129 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.130 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.131 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.132 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.133 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.134 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"[x = -1 / 2]"))
150.135 + andalso nxt = ("End_Proof'",End_Proof') then ()
150.136 +else raise error "new behaviour in testexample rationals2.sml 1+2*x=0";
150.137 +
150.138 +(*---------------------------------*)
150.139 +"-------------- is_rootequ_in - SubProblem -------------------------";
150.140 +"-------------- is_rootequ_in - SubProblem -------------------------";
150.141 +"-------------- is_rootequ_in - SubProblem -------------------------";
150.142 +val fmz = ["equality (sqrt(x) - 1 = 0)","solveFor x","errorBound (eps=0)",
150.143 + "solutions L"];
150.144 +val (dI',pI',mI') =
150.145 + ("Isac.thy",["approximate","univariate","equation","test"],
150.146 + ("Isac.thy","solve_univar_err"));
150.147 +val p = e_pos'; val c = [];
150.148 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
150.149 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;
150.150 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.151 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.152 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.153 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.154 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.155 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.156 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.157 +(*val nxt = ("Apply_Method",Apply_Method ("Isac.thy","solve_univar_err"))*)
150.158 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.159 +val (p,_,f,nxt,_,pt) = (me nxt p [1] pt) handle e => print_exn_G e;
150.160 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.161 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.162 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.163 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.164 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.165 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.166 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.167 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.168 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
150.169 +if p = ([1,1],Frm) andalso
150.170 + f = Form' (FormKF (~1,EdUndef,2,Nundef,"sqrt x - 1 = 0")) andalso
150.171 + nxt = ("Empty_Tac",Empty_Tac) (*script ist noch 'helpless'*) then ()
150.172 +else raise error "new behaviour in testexample rationals2.sml sqrt(x) - 1 = 0";
151.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
151.2 +++ b/src/Pure/isac/smltest/OLDTESTS/scriptnew.sml Wed Jul 21 13:53:39 2010 +0200
151.3 @@ -0,0 +1,501 @@
151.4 +(* use"../systest/scriptnew.sml";
151.5 + use"systest/scriptnew.sml";
151.6 + use"scriptnew.sml";
151.7 + *)
151.8 +
151.9 +(*contents*)
151.10 +" --- test 30.4.02 Testterm: Repeat Repeat Or ------------------ ";
151.11 +" --- test 9.5.02 Testeq: While Try Repeat @@ ------------------ ";
151.12 +" --- test 11.5.02 Testeq: let e_ =... in [e_] ------------------ ";
151.13 +" _________________ me + nxt_step from script ___________________ ";
151.14 +" _________________ me + sqrt-equ-test: 1.norm_equation ________ ";
151.15 +" _________________ equation with x =(-12)/5, but L ={} ------- ";
151.16 +"------------------ script with Map, Subst (biquadr.equ.)---------";
151.17 +(*contents*)
151.18 +
151.19 +
151.20 +
151.21 +
151.22 +" --- test 30.4.02 Testterm: Repeat Repeat Or ------------------ ";
151.23 +" --- test 30.4.02 Testterm: Repeat Repeat Or ------------------ ";
151.24 +" --- test 30.4.02 Testterm: Repeat Repeat Or ------------------ ";
151.25 +store_pbt
151.26 + (prep_pbt Test.thy "pbl_testss" [] e_pblID
151.27 + (["tests"],
151.28 + []:(string * string list) list,
151.29 + e_rls, None, []));
151.30 +store_pbt
151.31 + (prep_pbt Test.thy "pbl_testss_term" [] e_pblID
151.32 + (["met_testterm","tests"],
151.33 + [("#Given" ,["realTestGiven g_"]),
151.34 + ("#Find" ,["realTestFind f_"])
151.35 + ],
151.36 + e_rls, None, []));
151.37 +store_met
151.38 + (prep_met Test.thy "met_test_simp" [] e_metID
151.39 + (*test for simplification*)
151.40 + (["Test","met_testterm"]:metID,
151.41 + [("#Given" ,["realTestGiven g_"]),
151.42 + ("#Find" ,["realTestFind f_"])
151.43 + ],
151.44 + {rew_ord'="tless_true",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
151.45 + crls=tval_rls, nrls=e_rls(*,
151.46 + asm_rls=[],asm_thm=[]*)},
151.47 + "Script Testterm (g_::real) = \
151.48 + \Repeat\
151.49 + \ ((Repeat (Rewrite rmult_1 False)) Or\
151.50 + \ (Repeat (Rewrite rmult_0 False)) Or\
151.51 + \ (Repeat (Rewrite radd_0 False))) g_"
151.52 + ));
151.53 +val fmz = ["realTestGiven ((0+0)*(1*(1*a)))","realTestFind F"];
151.54 +val (dI',pI',mI') = ("Test.thy",["met_testterm","tests"],
151.55 + ["Test","met_testterm"]);
151.56 +(*val p = e_pos'; val c = [];
151.57 +val nxt = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
151.58 +val (p,_,f,nxt,_,pt) = me nxt p c EmptyPtree;*)
151.59 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
151.60 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.61 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.62 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.63 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.64 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.65 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.66 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","met_testterm"))*)
151.67 +(*----script 111 ------------------------------------------------*)
151.68 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.69 +(*"(#0 + #0) * (#1 * (#1 * a))" nxt= Rewrite ("rmult_1",*)
151.70 +(*----script 222 ------------------------------------------------*)
151.71 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.72 +(*"(#0 + #0) * (#1 * a)" nxt= Rewrite ("rmult_1",*)
151.73 +(*----script 333 ------------------------------------------------*)
151.74 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.75 +(*"(#0 + #0) * a" nxt= Rewrite ("radd_0",*)
151.76 +(*----script 444 ------------------------------------------------*)
151.77 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.78 +(*"#0 * a"*)
151.79 +(*----script 555 ------------------------------------------------*)
151.80 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.81 +(*"#0"*)
151.82 +if p=([4],Res) then ()
151.83 +else raise error ("new behaviour in 30.4.02 Testterm: p="^(pos'2str p));
151.84 +(*----script 666 ------------------------------------------------*)
151.85 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.86 +(*"#0"*)
151.87 +if nxt=("End_Proof'",End_Proof') then ()
151.88 +else raise error "new behaviour in 30.4.02 Testterm: End_Proof";
151.89 +
151.90 +
151.91 +
151.92 +
151.93 +
151.94 +" --- test 9.5.02 Testeq: While Try Repeat @@ ------------------ ";
151.95 +" --- test 9.5.02 Testeq: While Try Repeat @@ ------------------ ";
151.96 +" --- test 9.5.02 Testeq: While Try Repeat @@ ------------------ ";
151.97 +store_pbt
151.98 + (prep_pbt Test.thy "pbl_testss_eq" [] e_pblID
151.99 + (["met_testeq","tests"],
151.100 + [("#Given" ,["boolTestGiven e_"]),
151.101 + ("#Find" ,["boolTestFind v_i_"])
151.102 + ],
151.103 + e_rls, None, []));
151.104 +
151.105 +store_met
151.106 + (prep_met Test.thy "met_test_eq1" [] e_metID
151.107 + (["Test","testeq1"]:metID,
151.108 + [("#Given",["boolTestGiven e_"]),
151.109 + ("#Where" ,[]),
151.110 + ("#Find" ,["boolTestFind v_i_"])
151.111 + ],
151.112 + {rew_ord'="tless_true",rls'=tval_rls,
151.113 + srls=append_rls "testeq1_srls" e_rls
151.114 + [Calc ("Test.contains'_root", eval_contains_root"")],
151.115 + prls=e_rls,calc=[], crls=tval_rls, nrls=e_rls
151.116 + (*,asm_rls=[],asm_thm=[("square_equation_left","")]*)},
151.117 + "Script Testeq (e_::bool) = \
151.118 + \(While (contains_root e_) Do \
151.119 + \((Try (Repeat (Rewrite rroot_square_inv False))) @@ \
151.120 + \ (Try (Repeat (Rewrite square_equation_left True))) @@ \
151.121 + \ (Try (Repeat (Rewrite radd_0 False)))))\
151.122 + \ e_"
151.123 + ));
151.124 +
151.125 +val fmz = ["boolTestGiven (0+(sqrt(sqrt(sqrt a))^^^2)^^^2=0)",
151.126 + "boolTestFind v_i_"];
151.127 +val (dI',pI',mI') = ("Test.thy",["met_testeq","tests"],
151.128 + ["Test","testeq1"]);
151.129 +val Script sc = (#scr o get_met) ["Test","testeq1"];
151.130 +atomt sc;
151.131 +(*val p = e_pos'; val c = [];
151.132 +val nxt = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
151.133 +val (p,_,f,nxt,_,pt) = me nxt p c EmptyPtree;*)
151.134 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
151.135 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.136 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.137 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.138 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.139 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.140 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.141 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","testeq1")) *)
151.142 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.143 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.144 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.145 +(*val f = Form' (FormKF (~1,EdUndef,1,Nundef,"#0 + sqrt a = #0"))
151.146 +val nxt = ("Rewrite",Rewrite ("radd_0","#0 + ?k = ?k"))*)
151.147 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.148 +
151.149 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.150 +(*** No such constant: "Test.contains'_root" *)
151.151 +
151.152 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.153 +if f=(Form' (FormKF (~1,EdUndef,0,Nundef,"a = 0 ^^^ 2"))) andalso
151.154 + nxt=("End_Proof'",End_Proof') then ()
151.155 +else raise error "different behaviour test 9.5.02 Testeq: While Try Repeat @@";
151.156 +
151.157 +
151.158 +
151.159 +
151.160 +" --- test 11.5.02 Testeq: let e_ =... in [e_] --------- ";
151.161 +" --- test 11.5.02 Testeq: let e_ =... in [e_] --------- ";
151.162 +" --- test 11.5.02 Testeq: let e_ =... in [e_] --------- ";
151.163 +store_met
151.164 + (prep_met Test.thy "met_test_let" [] e_metID
151.165 + (["Test","testlet"]:metID,
151.166 + [("#Given",["boolTestGiven e_"]),
151.167 + ("#Where" ,[]),
151.168 + ("#Find" ,["boolTestFind v_i_"])
151.169 + ],
151.170 + {rew_ord'="tless_true",rls'=tval_rls,
151.171 + srls=append_rls "testlet_srls" e_rls
151.172 + [Calc ("Test.contains'_root",eval_contains_root"")],
151.173 + prls=e_rls,calc=[], crls=tval_rls, nrls=e_rls
151.174 + (*,asm_rls=[],asm_thm=[("square_equation_left","")]*)},
151.175 + "Script Testeq2 (e_::bool) = \
151.176 + \(let e_ =\
151.177 + \ ((While (contains_root e_) Do \
151.178 + \ (Rewrite square_equation_left True))\
151.179 + \ e_)\
151.180 + \in [e_::bool])"
151.181 + ));
151.182 +val Script sc = (#scr o get_met) ["Test","testlet"];
151.183 +writeln(term2str sc);
151.184 +val fmz = ["boolTestGiven (sqrt a = 0)",
151.185 + "boolTestFind v_i_"];
151.186 +val (dI',pI',mI') = ("Test.thy",["met_testeq","tests"],
151.187 + ["Test","testlet"]);
151.188 +(*val p = e_pos'; val c = [];
151.189 +val nxt = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
151.190 +val (p,_,f,nxt,_,pt) = me nxt p c EmptyPtree;*)
151.191 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
151.192 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.193 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.194 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.195 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.196 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.197 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.198 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","testlet"))*)
151.199 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.200 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.201 +val (p,_,f,nxt,_,pt) = (me nxt p c pt) handle e => print_exn e;
151.202 +if f=(Form' (FormKF (~1,EdUndef,0,Nundef,"[a = 0 ^^^ 2]"))) andalso
151.203 + nxt=("End_Proof'",End_Proof') then ()
151.204 +else raise error "different behaviour in test 11.5.02 Testeq: let e_ =... in [e_]";
151.205 +
151.206 +
151.207 +
151.208 +
151.209 +" _________________ me + nxt_step from script _________________ ";
151.210 +" _________________ me + nxt_step from script _________________ ";
151.211 +" _________________ me + nxt_step from script _________________ ";
151.212 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
151.213 + "solveFor x","solutions L"];
151.214 +val (dI',pI',mI') =
151.215 + ("Test.thy",["sqroot-test","univariate","equation","test"],
151.216 + ["Test","sqrt-equ-test"]);
151.217 +val Script sc = (#scr o get_met) ["Test","sqrt-equ-test"];
151.218 +writeln(term2str sc);
151.219 +
151.220 +"--- s1 ---";
151.221 +(*val p = e_pos'; val c = [];
151.222 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
151.223 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
151.224 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
151.225 +"--- s2 ---";
151.226 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.227 +(* val nxt =
151.228 + ("Add_Given",
151.229 + Add_Given "equality (sqrt (#9 + #4 * x) = sqrt x + sqrt (#5 + x))");*)
151.230 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.231 +"--- s3 ---";
151.232 +(* val nxt = ("Add_Given",Add_Given "solveFor x");*)
151.233 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.234 +"--- s4 ---";
151.235 +(* val nxt = ("Add_Given",Add_Given "errorBound (eps = #0)");*)
151.236 +"--- s5 ---";
151.237 +(* val nxt = ("Add_Find",Add_Find "solutions L");*)
151.238 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.239 +"--- s6 ---";
151.240 +(* val nxt = ("Specify_Theory",Specify_Theory "Test.thy");*)
151.241 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.242 +"--- s7 ---";
151.243 +(* val nxt =
151.244 + ("Specify_Problem",
151.245 + Specify_Problem ["sqroot-test","univariate","equation","test"]);*)
151.246 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.247 +"--- s8 ---";
151.248 +(* val nxt = ("Specify_Method",Specify_Method ("Test.thy","sqrt-equ-test"));*)
151.249 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.250 +"--- s9 ---";
151.251 +(* val nxt = ("Apply_Method",Apply_Method ("Test.thy","sqrt-equ-test"));*)
151.252 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.253 +"--- 1 ---";
151.254 +(* val nxt = ("Rewrite",Rewrite ("square_equation_left",""));*)
151.255 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.256 +"--- 2 ---";
151.257 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.258 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.259 +"--- 3 ---";
151.260 +(* val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");*)
151.261 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.262 +"--- 4 ---";
151.263 +(* val nxt = ("Rewrite_Set",Rewrite_Set "isolate_root");*)
151.264 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.265 +"--- 5 ---";
151.266 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.267 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.268 +"--- 6 ---";
151.269 +(* val nxt = ("Rewrite",Rewrite ("square_equation_left",""));*)
151.270 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.271 +"--- 7 ---";
151.272 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.273 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.274 +"--- 8<> ---";
151.275 +(* val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");*)
151.276 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.277 +"--- 9<> ---";
151.278 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.279 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.280 +"--- 10<> ---";
151.281 +(* val nxt = ("Rewrite_Set",Rewrite_Set "norm_equation");*)
151.282 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.283 +"--- 11<> ---";
151.284 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.285 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.286 +"--- 12<> ---.";
151.287 +(* val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv"));*)
151.288 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.289 +"--- 13<> ---";
151.290 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.291 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.292 +"--- 14<> ---";
151.293 +(* nxt = ("Check_Postcond",Check_Postcond ("Test.thy","sqrt-equ-test"));*)
151.294 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.295 +if f<>(Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4]")))
151.296 +then raise error "scriptnew.sml 1: me + tacs from script: new behaviour"
151.297 +else ();
151.298 +"--- 15<> ---";
151.299 +(* val nxt = ("End_Proof'",End_Proof');*)
151.300 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.301 +
151.302 +writeln (pr_ptree pr_short pt);
151.303 +writeln("result: "^((term2str o fst o (get_obj g_result pt)) [])^
151.304 +"\n=============================================================");
151.305 +(*get_obj g_asm pt [];
151.306 +val it = [("#0 <= sqrt x + sqrt (#5 + x)",[1]),("#0 <= #9 + #4 * x",[1]),...*)
151.307 +
151.308 +
151.309 +
151.310 +
151.311 +
151.312 +" _________________ me + sqrt-equ-test: 1.norm_equation _________________ ";
151.313 +" _________________ me + sqrt-equ-test: 1.norm_equation _________________ ";
151.314 +" _________________ me + sqrt-equ-test: 1.norm_equation _________________ ";
151.315 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
151.316 + "solveFor x","errorBound (eps=0)",
151.317 + "solutions L"];
151.318 +val (dI',pI',mI') =
151.319 + ("Test.thy",["sqroot-test","univariate","equation","test"],
151.320 + ["Test","sqrt-equ-test"]);
151.321 + val Script sc = (#scr o get_met) ["Test","sqrt-equ-test"];
151.322 + (writeln o term2str) sc;
151.323 +"--- s1 ---";
151.324 +(*val p = e_pos'; val c = [];
151.325 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
151.326 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
151.327 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
151.328 +"--- s2 ---";
151.329 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.330 +(* val nxt = ("Add_Given",
151.331 + Add_Given "equality (sqrt (#9 + #4 * x) = sqrt x + sqrt (#5 + x))");*)
151.332 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.333 +"--- s3 ---";
151.334 +(* val nxt = ("Add_Given",Add_Given "solveFor x");*)
151.335 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.336 +"--- s4 ---";
151.337 +(* val nxt = ("Add_Given",Add_Given "errorBound (eps = #0)");*)
151.338 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;*)
151.339 +"--- s5 ---";
151.340 +(* val nxt = ("Add_Find",Add_Find "solutions L");*)
151.341 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.342 +"--- s6 ---";
151.343 +(* val nxt = ("Specify_Theory",Specify_Theory "Test.thy");*)
151.344 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.345 +"--- s7 ---";
151.346 +(* val nxt = ("Specify_Problem",
151.347 + Specify_Problem ["sqroot-test","univariate","equation","test"]);*)
151.348 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.349 +"--- s8 ---";
151.350 +(* val nxt = ("Specify_Method",Specify_Method ("Test.thy","sqrt-equ-test"));*)
151.351 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.352 +"--- s9 ---";
151.353 +(* val nxt = ("Apply_Method",Apply_Method ("Test.thy","sqrt-equ-test"));*)
151.354 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.355 +(*"sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x)"*)
151.356 +"--- !!! x1 --- 1.norm_equation";
151.357 +(*###*)val nxt = ("Rewrite_Set",Rewrite_Set "norm_equation");
151.358 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.359 +"--- !!! x2 --- 1.norm_equation";
151.360 +(*meNEW: "9 + 4 * x = (sqrt x + sqrt (5 + x)) ^^^ 2" -- NICHT norm_equation!!*)
151.361 +(*meOLD: "sqrt (9 + 4 * x) + -1 * (sqrt x + sqrt (5 + x)) = 0"*)
151.362 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.363 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.364 +(*"-1 * sqrt x + (-1 * sqrt (5 + x) + sqrt (9 + 4 * x)) = 0"*)
151.365 +(*(me nxt p [1] pt) handle e => print_exn_G e;*)
151.366 +"--- !!! x3 --- 1.norm_equation";
151.367 +(*val nxt = ("Empty_Tac",Empty_Tac) ### helpless*)
151.368 +(*###*)val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
151.369 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.370 +"--- !!! x4 --- 1.norm_equation";
151.371 +(*"-1 * sqrt x + -1 * sqrt (5 + x) + sqrt (9 + 4 * x) = 0"*)
151.372 +(*val nxt = ("Rewrite_Set",Rewrite_Set "isolate_root")*)
151.373 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.374 +"--- !!! x5 --- 1.norm_equation";
151.375 +(*"sqrt (9 + 4 * x) = 0 + -1 * (-1 * sqrt x + -1 * sqrt (5 + x))"*)
151.376 +(* val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");*)
151.377 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.378 +
151.379 +(*FIXXXXXXXXXXXXXXXXXXXXXXXME reestablish check:
151.380 +if f= Form'(FormKF(~1,EdUndef,1,Nundef,"sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x)"))
151.381 +then() else raise error "new behaviour in test-example 1.norm sqrt-equ-test";
151.382 +#################################################*)
151.383 +
151.384 +(* use"../tests/scriptnew.sml";
151.385 + *)
151.386 +
151.387 +" _________________ equation with x =(-12)/5, but L ={} ------- ";
151.388 +
151.389 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(-3+x))",
151.390 + "solveFor x","errorBound (eps=0)",
151.391 + "solutions L"];
151.392 +val (dI',pI',mI') =
151.393 + ("Test.thy",["sqroot-test","univariate","equation","test"],
151.394 + ["Test","square_equation"]);
151.395 +
151.396 +(*val p = e_pos'; val c = [];
151.397 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
151.398 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
151.399 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
151.400 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
151.401 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.402 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.403 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.404 +(*val nxt = ("Apply_Method",Apply_Method ["Test","square_equation"])*)
151.405 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.406 +(*val nxt = "square_equation_left",
151.407 + "[| 0 <= ?a; 0 <= ?b |] ==> (sqrt ?a = ?b) = (?a = ?b ^^^ 2)"))*)
151.408 +get_assumptions_ pt p;
151.409 +(*it = [] : string list;*)
151.410 +trace_rewrite:=true;
151.411 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.412 +trace_rewrite:=false;
151.413 +val asms = get_assumptions_ pt p;
151.414 +if asms = [(str2term "0 <= 9 + 4 * x",[1]),
151.415 + (str2term "0 <= x",[1]),
151.416 + (str2term "0 <= -3 + x",[1])] then ()
151.417 +else raise error "scriptnew.sml diff.behav. in sqrt assumptions 1";
151.418 +
151.419 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.420 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.421 +(*val nxt = Rewrite ("square_equation_left", *)
151.422 +val asms = get_assumptions_ pt p;
151.423 +[("0 <= 9 + 4 * x",[1]),("0 <= x",[1]),("0 <= -3 + x",[1])];
151.424 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.425 +val asms = get_assumptions_ pt p;
151.426 +if asms = [(str2term "0 <= 9 + 4 * x",[1]),
151.427 + (str2term "0 <= x",[1]),
151.428 + (str2term "0 <= -3 + x",[1]),
151.429 + (str2term "0 <= x ^^^ 2 + -3 * x",[6]),
151.430 + (str2term "0 <= 6 + x",[6])] then ()
151.431 +else raise error "scriptnew.sml diff.behav. in sqrt assumptions 2";
151.432 +
151.433 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.434 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.435 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.436 +(*val nxt = Subproblem ("Test.thy",["linear","univariate","equation","test"*)
151.437 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.438 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.439 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.440 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.441 +(*val nxt = ("Apply_Method",Apply_Method ["Test","solve_linear"])*)
151.442 +val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.443 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.444 +(*val nxt =
151.445 + ("Check_Postcond",Check_Postcond ["linear","univariate","equation","test"])*)
151.446 +val asms = get_assumptions_ pt p;
151.447 +if asms = [] then ()
151.448 +else raise error "scriptnew.sml diff.behav. in sqrt assumptions 3";
151.449 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.450 +(*val nxt = ("Check_elementwise",Check_elementwise "Assumptions")*)
151.451 +
151.452 +val asms = get_assumptions_ pt p;
151.453 +if asms = [(str2term "0 <= 9 + 4 * x",[1]),
151.454 + (str2term "0 <= x",[1]),
151.455 + (str2term "0 <= -3 + x",[1]),
151.456 + (str2term "0 <= x ^^^ 2 + -3 * x",[6]),
151.457 + (str2term "0 <= 6 + x",[6])] then ()
151.458 +else raise
151.459 + error "scriptnew.sml: diff.behav. at Check_elementwise [x = -12 / 5]";
151.460 +
151.461 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.462 +(*val nxt = Check_Postcond ["sqroot-test","univariate","equation","test"])*)
151.463 +val asms = get_assumptions_ pt p;
151.464 +[("0 <= 9 + 4 * x",[1]),("0 <= x",[1]),("0 <= -3 + x",[1]),
151.465 + ("0 <= x ^^^ 2 + -3 * x",[6]),("0 <= 6 + x",[6]),
151.466 + ("0 <= 6 + -12 / 5 &\n0 <= (-12 / 5) ^^^ 2 + -3 * (-12 / 5) &\n0 <= -3 + -12 / 5 & 0 <= -12 / 5 & 0 <= 9 + 4 * (-12 / 5)",
151.467 + [13])];
151.468 +
151.469 +
151.470 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
151.471 +val Form' (FormKF (_,_,_,_,ff)) = f;
151.472 +if ff="[x = -12 / 5]"
151.473 +then writeln("there should be L = []\nthere should be L = []\nthere should be L = []\nthere should be L = []\nthere should be L = []\n")
151.474 +else raise error "diff.behav. in scriptnew.sml; root-eq: L = []";
151.475 +
151.476 +val asms = get_assumptions_ pt p;
151.477 +if asms = [(str2term "0 <= 9 + 4 * (-12 / 5)",[]),
151.478 + (str2term "0 <= -12 / 5", []),
151.479 + (str2term "0 <= -3 + -12 / 5", []),
151.480 + (str2term "0 <= (-12 / 5) ^^^ 2 + -3 * (-12 / 5)", []),
151.481 + (str2term "0 <= 6 + -12 / 5", [])] then ()
151.482 +else raise error "scriptnew.sml diff.behav. in sqrt assumptions 4";
151.483 +
151.484 +
151.485 +"------------------ script with Map, Subst (biquadr.equ.)---------";
151.486 +"------------------ script with Map, Subst (biquadr.equ.)---------";
151.487 +"------------------ script with Map, Subst (biquadr.equ.)---------";
151.488 +
151.489 +
151.490 +(*GoOn.5.03. script with Map, Subst (biquadr.equ.)
151.491 +val scr = Script (((inst_abs thy) o term_of o the o (parse thy))
151.492 + "Script Biquadrat_poly (e_::bool) (v_::real) = \
151.493 + \(let e_ = Substitute [(v_^^^4, v_0_^^^2),(v_^^^2, v_0_)] e_; \
151.494 + \ L_0_ = (SubProblem (PolyEq_,[univariate,equation], [no_met]) \
151.495 + \ [bool_ e_, real_ v_0_]); \
151.496 + \ L_i_ = Map (((Substitute [(v_0_, v_^^^2)]) @@ \
151.497 + \ ((Rewrite real_root_positive False) Or \
151.498 + \ (Rewrite real_root_negative False)) @@ \
151.499 + \ OrToList) L_0_ \
151.500 + \ in (flat ....))"
151.501 +);
151.502 +
151.503 +*)
151.504 +
152.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
152.2 +++ b/src/Pure/isac/smltest/OLDTESTS/subp-rooteq.sml Wed Jul 21 13:53:39 2010 +0200
152.3 @@ -0,0 +1,541 @@
152.4 +(* use"systest/subp-rooteq.sml";
152.5 + use"subp-rooteq.sml";
152.6 + *)
152.7 +val c = [];
152.8 +
152.9 +"---------------- miniscript with mini-subpbl -------------";
152.10 +"---------------- solve_linear as rootpbl -----------------";
152.11 +"---------------- solve_plain_square as rootpbl -----------";
152.12 +"---------------- root-eq + subpbl: solve_linear ----------";
152.13 +"---------------- root-eq + subpbl: solve_plain_square ----";
152.14 +"---------------- root-eq + subpbl: no_met: linear --------";
152.15 +"---------------- root-eq + subpbl: no_met: square --------";
152.16 +"---------------- no_met in rootpbl -> linear -------------";
152.17 +"==========================================================";
152.18 +
152.19 +
152.20 +
152.21 +
152.22 +"---------------- miniscript with mini-subpbl -------------";
152.23 +"---------------- miniscript with mini-subpbl -------------";
152.24 +"---------------- miniscript with mini-subpbl -------------";
152.25 +(*###########################################################
152.26 + ## 12.03 next_tac repariert (gab keine Value zurueck ###
152.27 + ###########################################################*)
152.28 +val fmz = ["equality (x+1=2)",
152.29 + "solveFor x","solutions L"];
152.30 +val (dI',pI',mI') =
152.31 + ("Test.thy",["sqroot-test","univariate","equation","test"],
152.32 + ["Test","squ-equ-test-subpbl1"]);
152.33 +
152.34 + val Script sc = (#scr o get_met) ["Test","squ-equ-test-subpbl1"];
152.35 + (writeln o term2str) sc;
152.36 +
152.37 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.38 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.39 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.40 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.41 +(*val nxt = ("Add_Find",Add_Find "solutions L") : string * tac*)
152.42 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.43 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy") : string * tac*)
152.44 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.45 +(*("Specify_Problem",Specify_Problem ["sqroot-test","univariate","equation"]*)
152.46 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.47 +(*("Specify_Method",Specify_Method ("Test.thy","squ-equ-test-subpbl1"))*)
152.48 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.49 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","squ-equ-test-subpbl1"*)
152.50 +(*---vvv--- nxt_ here = loc_ below ------------------vvv-------------------*)
152.51 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.52 +(*val f = "x + 1 = 2"; val nxt = Rewrite_Set "norm_equation"*)
152.53 +(*### solve Apply_Method: is = ### nxt_solv1 Apply_Method: store is
152.54 +ScrState (["
152.55 +(e_, x + 1 = 2)","
152.56 +(v_, x)"],
152.57 + [], None,
152.58 + ??.empty, Safe, true) ########## OK*)
152.59 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.60 +(*val f = "x + 1 + -1 * 2 = 0"; val nxt = Rewrite_Set "Test_simplify"*)
152.61 +(*### locate_gen----------: is= ### next_tac----------------:E =
152.62 +ScrState (["
152.63 +(e_, x + 1 = 2)","
152.64 +(v_, x)"],
152.65 + [], None,
152.66 + ??.empty, Safe, true) ########## OK von loc_ uebernommen
152.67 +### solve, after locate_gen: is= ### nxt_solv4 Apply_Method: stored is =
152.68 +ScrState (["
152.69 +(e_, x + 1 = 2)","
152.70 +(v_, x)"],
152.71 + [R,L,R,L,L,R,R], Some e_,
152.72 + x + 1 + -1 * 2 = 0, Safe, true) ########## OK*)
152.73 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.74 +
152.75 +
152.76 +(*val f = "-1 + x = 0"; val nxt = Subproblem ("Test.thy",[#,#,#])
152.77 + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
152.78 +(*### locate_gen-----------: is= ### next_tac-----------------: E=
152.79 +ScrState (["
152.80 +(e_, x + 1 = 2)","
152.81 +(v_, x)"],
152.82 + [R,L,R,L,L,R,R], Some e_,
152.83 + x + 1 + -1 * 2 = 0, Safe, true) ########## OK von loc_ uebernommen
152.84 +### solve, after locate_gen: is= ### nxt_solv4 Apply_Method: stored is =
152.85 +ScrState (["
152.86 +(e_, x + 1 = 2)","
152.87 +(v_, x)"],
152.88 + [R,L,R,L,R,R], Some e_,
152.89 + -1 + x = 0, Safe, false) ########## OK*)
152.90 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.91 +(*### locate_gen------------: is= ### next_tac-----------------: E=
152.92 +ScrState (["
152.93 +(e_, x + 1 = 2)","
152.94 +(v_, x)"],
152.95 + [R,L,R,L,R,R], Some e_,
152.96 + -1 + x = 0, Safe, false) ########## OK von loc_ uebernommen
152.97 +### solve, after locate_gen: is= ### nxt_solv4 Apply_Method: stored is =
152.98 +ScrState (["
152.99 +(e_, -1 + x = 0)","
152.100 +(v_, x)"],
152.101 + [R,R,D,L,R], Some e_,
152.102 + Subproblem (Test.thy, [linear, univariate, equation, test]), Safe, true)
152.103 + ########## OK*)
152.104 + p;
152.105 + writeln(istate2str (get_istate pt ([3],Frm)));
152.106 +(*val nxt = ("Model_Problem",Model_Problem ["linear","univariate","equation"]*)
152.107 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.108 +(*val nxt = ("Add_Given",Add_Given "equality (-1 + x = 0)") *)
152.109 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.110 +(*val nxt = ("Add_Given",Add_Given "solveFor x") : string * tac*)
152.111 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.112 +(*val nxt = ("Add_Find",Add_Find "solutions x_i") : string * tac*)
152.113 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.114 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy")*)
152.115 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.116 +(*("Specify_Problem",Specify_Problem ["linear","univariate","equation"])*)
152.117 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.118 +(*val nxt = ("Specify_Method",Specify_Method ("Test.thy","solve_linear"))*)
152.119 + val Script sc = (#scr o get_met) ["Test","solve_linear"];
152.120 + (writeln o term2str) sc;
152.121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.122 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","solve_linear"))*)
152.123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.124 +(*val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst ([#],"isolate_bdv"))*)
152.125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.126 +(*val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify")*)
152.127 +
152.128 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.129 +(*val nxt = ("Check_Postcond",Check_Postcond ["linear","univariate","eq*)
152.130 +
152.131 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.132 + p;
152.133 + writeln(istate2str (get_istate pt ([3],Res)));
152.134 +(*val nxt = ("Check_elementwise",Check_elementwise "Assumptions")*)
152.135 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.136 +
152.137 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.138 +val Form' (FormKF (_,EdUndef,0,Nundef,res)) = f;
152.139 +if (snd nxt)=End_Proof' andalso res="[x = 1]" then ()
152.140 +else raise error "subp-rooteq.sml: new.behav. in miniscript with mini-subpbl";
152.141 +
152.142 +
152.143 +"---------------- solve_linear as rootpbl -----------------";
152.144 +"---------------- solve_linear as rootpbl -----------------";
152.145 +"---------------- solve_linear as rootpbl -----------------";
152.146 +val fmz = ["equality (1+-1*2+x=0)",
152.147 + "solveFor x","solutions L"];
152.148 +val (dI',pI',mI') =
152.149 + ("Test.thy",["linear","univariate","equation","test"],
152.150 + ["Test","solve_linear"]);
152.151 +
152.152 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.153 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.154 +(*val nxt = ("Add_Given",Add_Given "equality (x + #1 + #-1 * #2 = #0)")*)
152.155 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.156 +(*val nxt = ("Add_Given",Add_Given "solveFor x") : string * tac*)
152.157 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.158 +(*val nxt = ("Add_Find",Add_Find "solutions L") : string * tac*)
152.159 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.160 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy") : string * tac*)
152.161 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.162 +(*val nxt = ("Specify_Problem",Specify_Problem ["univariate","equation"])*)
152.163 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.164 +(*val nxt = ("Specify_Method",Specify_Method ("Test.thy","solve_linear"))*)
152.165 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.166 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","solve_linear"))*)
152.167 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.168 +(*val f = Form' (FormKF (~1,EdUndef,1,Nundef,"#1 + #-1 * #2 + x = #0"))
152.169 + val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst ([#],"isolate_bdv"))*)
152.170 +
152.171 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.172 +(*val f = Form' (FormKF (~1,EdUndef,1,Nundef,"x = #0 + #-1 * (#1 + #-1 * #2)"))
152.173 + val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify") : string * tac*)
152.174 +
152.175 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.176 +(*val f = Form' (FormKF (~1,EdUndef,1,Nundef,"x = #1")) : mout val nxt = ("Check_Postcond",Check_Postcond ["univariate","equation"])*)
152.177 +
152.178 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.179 +(*val f = Form' (FormKF (~1,EdUndef,0,Nundef,"[x = #1]")) : mout
152.180 + val nxt = ("End_Proof'",End_Proof') : string * tac*)
152.181 +val Form' (FormKF (_,EdUndef,0,Nundef,res)) = f;
152.182 +if (snd nxt)=End_Proof' andalso res="[x = 1]" then ()
152.183 +else raise error "subp-rooteq.sml: new.behav. in solve_linear as rootpbl";
152.184 +
152.185 +
152.186 +"---------------- solve_plain_square as rootpbl -----------";
152.187 +"---------------- solve_plain_square as rootpbl -----------";
152.188 +"---------------- solve_plain_square as rootpbl -----------";
152.189 +val fmz = ["equality (9 + -1 * x ^^^ 2 = 0)","solveFor x",
152.190 + "solutions L"];
152.191 +val (dI',pI',mI') =
152.192 + ("Test.thy",["plain_square","univariate","equation","test"],
152.193 + ["Test","solve_plain_square"]);
152.194 +(*val p = e_pos'; val c = [];
152.195 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
152.196 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
152.197 +
152.198 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.199 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.200 +
152.201 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.202 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.203 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.204 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.205 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.206 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.207 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.208 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.209 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.210 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.211 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.212 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.213 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.214 +val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
152.215 +if snd nxt=End_Proof' andalso res="[x = -3, x = 3]" then ()
152.216 +else raise error "subp-rooteq.sml: new.behav. in solve_plain_square as rootpbl";
152.217 +
152.218 +
152.219 +
152.220 +
152.221 +"---------------- root-eq + subpbl: solve_linear ----------";
152.222 +"---------------- root-eq + subpbl: solve_linear ----------";
152.223 +"---------------- root-eq + subpbl: solve_linear ----------";
152.224 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
152.225 + "solveFor x","solutions L"];
152.226 +val (dI',pI',mI') =
152.227 + ("Test.thy",["sqroot-test","univariate","equation","test"],
152.228 + ["Test","square_equation1"]);
152.229 +(*val p = e_pos'; val c = [];
152.230 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
152.231 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
152.232 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.233 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.234 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.235 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.236 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.237 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.238 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.239 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.240 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.241 +(*"sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x)"
152.242 +square_equation_left*)
152.243 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.244 +(*"9 + 4 * x = (sqrt x + sqrt (5 + x)) ^^^ 2"
152.245 +Test_simplify*)
152.246 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.247 +(*"9 + 4 * x = 5 + (2 * x + 2 * sqrt (x ^^^ 2 + 5 * x))"
152.248 +rearrange_assoc*)
152.249 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.250 +(*"9 + 4 * x = 5 + 2 * x + 2 * sqrt (x ^^^ 2 + 5 * x)"
152.251 +isolate_root*)
152.252 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.253 +(*"sqrt (x ^^^ 2 + 5 * x) = (5 + 2 * x + -1 * (9 + 4 * x)) / (-1 * 2)"
152.254 +Test_simplify*)
152.255 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.256 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.257 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.258 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.259 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.260 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.261 +(*"x ^^^ 2 + 5 * x + -1 * (4 + (x ^^^ 2 + 4 * x)) = 0"*)
152.262 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.263 +(*"-4 + x = 0"
152.264 + val nxt =("Subproblem",Subproblem ("Test.thy",["linear","univariate"...*)
152.265 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.266 +(*val nxt =("Model_Problem",Model_Problem ["linear","univariate"...*)
152.267 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.268 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.269 +
152.270 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.271 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.272 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy")*)
152.273 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.274 +(*("Specify_Problem",Specify_Problem ["linear","univariate","equation"])*)
152.275 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.276 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.277 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.278 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.279 +(*"x = 0 + -1 * -4", nxt Test_simplify*)
152.280 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.281 +(*"x = 4", nxt Check_Postcond ["linear","univariate","equation","test"]*)
152.282 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.283 +(*"[x = 4]", nxt Check_elementwise "Assumptions"*)
152.284 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.285 +(*"[]", nxt Check_Postcond ["sqroot-test","univariate","equation","test"]*)
152.286 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.287 +val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
152.288 +if (snd nxt)=End_Proof' andalso res="[x = 4]" then ()
152.289 +else raise error "subp-rooteq.sml: new.behav. in root-eq + subpbl: solve_linear";
152.290 +
152.291 +
152.292 +
152.293 +"---------------- root-eq + subpbl: solve_plain_square ----";
152.294 +"---------------- root-eq + subpbl: solve_plain_square ----";
152.295 +"---------------- root-eq + subpbl: solve_plain_square ----";
152.296 +val fmz = ["equality (sqrt(5+x)+sqrt(5-x)=sqrt 18)",
152.297 + "solveFor x","solutions L"];
152.298 +val (dI',pI',mI') =
152.299 + ("Test.thy",["sqroot-test","univariate","equation","test"],
152.300 + ["Test","square_equation2"]);
152.301 +val Script sc = (#scr o get_met) ["Test","square_equation2"];
152.302 +(writeln o term2str) sc;
152.303 +
152.304 +(*val p = e_pos'; val c = [];
152.305 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
152.306 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
152.307 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.308 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.309 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.310 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.311 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.312 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.313 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.314 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.315 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","square_equation1"))*)
152.316 +val (p,_,f,nxt,_,pt) =
152.317 +
152.318 +me nxt p [1] pt;
152.319 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.320 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.321 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.322 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.323 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.324 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.325 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.326 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.327 +(*"9 + -1 * x ^^^ 2 = 0"
152.328 + Subproblem ("Test.thy",["plain_square","univariate","equation"]))*)
152.329 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.330 +(*Model_Problem ["plain_square","univariate","equation"]*)
152.331 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.332 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.333 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.334 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.335 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy")*)
152.336 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.337 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.338 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.339 +(*Apply_Method ("Test.thy","solve_plain_square")*)
152.340 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.341 +(*"9 + -1 * x ^^^ 2 = 0", nxt Rewrite_Set "isolate_bdv"*)
152.342 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.343 +(*"x ^^^ 2 = (0 + -1 * 9) / -1", nxt Rewrite_Set "Test_simplify"*)
152.344 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.345 +(*"x ^^^ 2 = 9", nxt Rewrite ("square_equality"*)
152.346 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.347 +(*"x = sqrt 9 | x = -1 * sqrt 9", nxt Rewrite_Set "tval_rls"*)
152.348 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.349 +(*"x = -3 | x = 3", nxt Or_to_List*)
152.350 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.351 +(*"[x = -3, x = 3]",
152.352 + nxt Check_Postcond ["plain_square","univariate","equation","test"]*)
152.353 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.354 +
152.355 +
152.356 +
152.357 +(*"[x = -3, x = 3]", nxt Check_elementwise "Assumptions"*)
152.358 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.359 +(*"[]", nxt Check_Postcond ["sqroot-test","univariate","equation","test"]*)
152.360 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.361 +val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
152.362 +if (snd nxt)=End_Proof' andalso res="[x = -3, x = 3]" then ()
152.363 +else raise error "subp-rooteq.sml: new.behav. in root-eq + subpbl: solve_plain_square";
152.364 +
152.365 +
152.366 +writeln (pr_ptree pr_short pt);
152.367 +
152.368 +
152.369 +
152.370 +val Script s = (#scr o get_met) ["Test","square_equation"];
152.371 +atomt s;
152.372 +
152.373 +
152.374 +
152.375 +
152.376 +"---------------- root-eq + subpbl: no_met: linear ----";
152.377 +"---------------- root-eq + subpbl: no_met: linear ----";
152.378 +"---------------- root-eq + subpbl: no_met: linear ----";
152.379 +val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
152.380 + "solveFor x","solutions L"];
152.381 +val (dI',pI',mI') =
152.382 + ("Test.thy",["squareroot","univariate","equation","test"],
152.383 + ["Test","square_equation"]);
152.384 +(*val p = e_pos'; val c = [];
152.385 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
152.386 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
152.387 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.388 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.389 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.390 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.391 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.392 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.393 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.394 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.395 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.396 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.397 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.398 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.399 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.400 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.401 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.402 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.403 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.404 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.405 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.406 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.407 +(*"-4 + x = 0", nxt Subproblem ("Test.thy",["univariate","equation"]))*)
152.408 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.409 +(*val nxt =("Model_Problem",Model_Problem ["linear","univar...*)
152.410 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.411 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.412 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.413 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.414 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy")*)
152.415 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.416 +(*val nxt = ("Specify_Problem",Specify_Problem ["linear","univariate","equ*)
152.417 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.418 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.419 +(*Apply_Method ("Test.thy","norm_univar_equation")*)
152.420 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.421 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.422 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.423 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.424 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.425 +if p = ([13],Res) then ()
152.426 +else raise error ("subp-rooteq.sml: new.behav. in \
152.427 + \root-eq + subpbl: solve_linear, p ="^(pos'2str p));
152.428 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.429 +val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
152.430 +if (snd nxt)=End_Proof' andalso res="[x = 4]" then ()
152.431 +else raise error "subp-rooteq.sml: new.behav. in root-eq + subpbl: solve_plain_square";
152.432 +
152.433 +
152.434 +
152.435 +
152.436 +"---------------- root-eq + subpbl: no_met: square ----";
152.437 +"---------------- root-eq + subpbl: no_met: square ----";
152.438 +"---------------- root-eq + subpbl: no_met: square ----";
152.439 +val fmz = ["equality (sqrt(5+x)+sqrt(5-x)=sqrt 18)",
152.440 + "solveFor x","solutions L"];
152.441 +val (dI',pI',mI') =
152.442 + ("Test.thy",["squareroot","univariate","equation","test"],
152.443 + ["Test","square_equation"]);
152.444 + val Script sc = (#scr o get_met) ["Test","square_equation"];
152.445 + (writeln o term2str) sc;
152.446 +
152.447 +(*val p = e_pos'; val c = [];
152.448 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
152.449 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
152.450 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.451 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.452 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.453 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.454 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.455 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.456 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.457 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.458 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","square_equation1"))*)
152.459 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.460 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.461 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.462 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.463 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.464 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.465 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.466 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.467 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.468 +(*Subproblem ("Test.thy",["univariate","equation"]))*)
152.469 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.470 +(*Model_Problem ["plain_square","univariate","equation"]*)
152.471 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.472 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.473 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.474 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.475 +(*val nxt = ("Specify_Theory",Specify_Theory "Test.thy")*)
152.476 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.477 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.478 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.479 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.480 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.481 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.482 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.483 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.484 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.485 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.486 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.487 +(*val nxt = ("Check_Postcond",Check_Postcond ["squareroot","univariate","equ*)
152.488 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
152.489 +val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
152.490 +if (snd nxt)=End_Proof' andalso res="[x = -3, x = 3]" then ()
152.491 +else raise error "subp-rooteq.sml: new.behav. in root-eq + subpbl: no_met: square";
152.492 +
152.493 +
152.494 +
152.495 +"---------------- no_met in rootpbl -> linear --------------";
152.496 +"---------------- no_met in rootpbl -> linear --------------";
152.497 +"---------------- no_met in rootpbl -> linear --------------";
152.498 +val fmz = ["equality (1+2*x+3=4*x- 6)",
152.499 + "solveFor x","solutions L"];
152.500 +val (dI',pI',mI') =
152.501 + ("Test.thy",["univariate","equation","test"],
152.502 + ["no_met"]);
152.503 +(*val p = e_pos'; val c = [];
152.504 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
152.505 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
152.506 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
152.507 +(*val nxt = ("Model_Problem",Model_Problem ["normalize","univariate","equati*)
152.508 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.509 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.510 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.511 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.512 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.513 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.514 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.515 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","norm_univar_equation"*)
152.516 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.517 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.518 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.519 +(*val nxt = ("Subproblem",Subproblem ("Test.thy",["univariate","equation"])*)
152.520 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.521 +(*val nxt = ("Model_Problem",Model_Problem ["linear","univariate","equation"]*)
152.522 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.523 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.524 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.525 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.526 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.527 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.528 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.529 +(*val nxt = ("Apply_Method",Apply_Method ("Test.thy","solve_linear"))*)
152.530 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.531 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.532 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.533 +(*val nxt = ("Check_Postcond",Check_Postcond ["linear","univariate","equatio*)
152.534 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
152.535 +(*val nxt = ("Check_Postcond",Check_Postcond ["normalize","univariate","equa*)
152.536 +val (p,_,Form' (FormKF (_,_,_,_,f)),nxt,_,_) =
152.537 + me nxt p c pt;
152.538 +if f="[x = 5]" andalso nxt=("End_Proof'",End_Proof') then ()
152.539 +else raise error "subp-rooteq.sml: new.behav. in no_met in rootpbl -> linear ---";
152.540 +
152.541 +
152.542 +refine fmz ["univariate","equation","test"];
152.543 +match_pbl fmz (get_pbt ["polynomial","univariate","equation","test"]);
152.544 +
153.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
153.2 +++ b/src/Pure/isac/smltest/OLDTESTS/tacis.sml Wed Jul 21 13:53:39 2010 +0200
153.3 @@ -0,0 +1,163 @@
153.4 +(*
153.5 + use"systest/tacis.sml";
153.6 + use"tacis.sml";
153.7 + *)
153.8 +"=================================================================";
153.9 +"------ fetchProposedTactic -> autoCalculate (Step1 ) ------------";
153.10 +"------ setNextTactic -> autoCalculate (Step1 ) ------------------";
153.11 +"=================================================================";
153.12 +
153.13 +
153.14 +
153.15 +"------ fetchProposedTactic -> autoCalculate (Step1 ) ------------";
153.16 +"------ fetchProposedTactic -> autoCalculate (Step1 ) ------------";
153.17 +"------ fetchProposedTactic -> autoCalculate (Step1 ) ------------";
153.18 + states:=[];
153.19 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
153.20 + ("Test.thy",
153.21 + ["sqroot-test","univariate","equation","test"],
153.22 + ["Test","squ-equ-test-subpbl1"]))];
153.23 + Iterator 1; moveActiveRoot 1;
153.24 + autoCalculate 1 CompleteCalcHead;
153.25 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x + 1 = 2*);
153.26 +
153.27 + fetchProposedTactic 1 (*'Rewrite_Set norm_equation' in tacis*);
153.28 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x + 1 + -1 * 2 = 0*);
153.29 +
153.30 + fetchProposedTactic 1 (*'Rewrite_Set Test_simplify' in tacis*);
153.31 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*-1 + x = 0*);
153.32 + val ((pt,_),_) = get_calc 1;
153.33 + val str = pr_ptree pr_short pt;
153.34 + writeln str;
153.35 +
153.36 + fetchProposedTactic 1 (*'Subproblem ...' in tacis*);
153.37 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*solve (-1 + x = 0,x)*);
153.38 +
153.39 + fetchProposedTactic 1 (*'Model_Problem' in tacis*);
153.40 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*equality ///*);
153.41 +(*----- WN060222 since complete_mod_ case cas of Some headline -----
153.42 + fetchProposedTactic 1 (*'Add_Given equality (-1 + x = 0)' in tacis*);
153.43 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*equality (-1 + x =0)*);
153.44 +---------------------------------------------------------------------*)
153.45 +
153.46 + fetchProposedTactic 1 (*'Add_Given solveFor x' in tacis*);
153.47 +(*----- WN060222 since complete_mod_ case cas of Some headline:
153.48 + (*Specify_Theory Test.thy*)
153.49 +---------------------------------------------------------------------*)
153.50 + autoCalculate 1 CompleteCalcHead; refFormula 1 (get_pos 1 1) (*OK*);
153.51 + (*###########################################autoCalculate 1 (Step 1);*)
153.52 + fetchProposedTactic 1 (*'Apply_Method Test solve_linear' in tacis*);
153.53 + (* there was the only error ^^^^^^^^^ in step/nxt_solv ..Apply_Method..
153.54 + val (str', (tacis', (pt',p'))) = step ip (ptp, tacis);
153.55 + writeln (tacis2str tacis');
153.56 + ######################################################################*)
153.57 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*-1 + x = 0*);
153.58 +
153.59 + fetchProposedTactic 1 (*'Rewrite_Set_Inst isolate_bdv' in tacis*);
153.60 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x = 0 + -1 * -1*);
153.61 +
153.62 + fetchProposedTactic 1 (*'Rewrite_Set Test_simplify' in tacis*);
153.63 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x = 1*);
153.64 + val ((pt,_),_) = get_calc 1;
153.65 + val str = pr_ptree pr_short pt;
153.66 + writeln str;
153.67 +
153.68 + fetchProposedTactic 1 (*'Check_Postcond linear...' in tacis*);
153.69 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*[x = 1]*);
153.70 +
153.71 + fetchProposedTactic 1 (*'Check_elementwise Assumptions' in tacis*);
153.72 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*[x = 1]*);
153.73 +
153.74 + fetchProposedTactic 1 (*'Check_Postcond sqroot-test...' in tacis*);
153.75 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*[x = 1]*);
153.76 +
153.77 + fetchProposedTactic 1 (*'' in tacis*);
153.78 + val ((pt,p),tacis) = get_calc 1;
153.79 + val ip = get_pos 1 1;
153.80 + val (Form f, tac, asms) = pt_extract (pt, p);
153.81 + if term2str f = "[x = 1]"andalso p = ([],Res) andalso ip = ([],Res)then()else
153.82 + raise error "tacis.sml: diff.behav. in fetchProposedTactic autoCalculate";
153.83 +
153.84 +
153.85 +
153.86 +"------ setNextTactic -> autoCalculate (Step1 ) ------------------";
153.87 +"------ setNextTactic -> autoCalculate (Step1 ) ------------------";
153.88 +"------ setNextTactic -> autoCalculate (Step1 ) ------------------";
153.89 + states:=[];
153.90 + CalcTree [(["equality (x+1=2)", "solveFor x","solutions L"],
153.91 + ("Test.thy",
153.92 + ["sqroot-test","univariate","equation","test"],
153.93 + ["Test","squ-equ-test-subpbl1"]))];
153.94 + Iterator 1; moveActiveRoot 1;
153.95 + autoCalculate 1 CompleteCalcHead;
153.96 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x + 1 = 2*);
153.97 +
153.98 + setNextTactic 1 (Rewrite_Set "norm_equation");
153.99 + val (_, tacis) = get_calc 1;
153.100 + case tacis of [(Rewrite_Set "norm_equation",_,(([1], Res), _))] => () | _ =>
153.101 + raise error "tacis.sml: diff.behav. in setNextTactic -> autoCalculate (1)";
153.102 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x + 1 + -1 * 2 = 0*);
153.103 +
153.104 + setNextTactic 1 (Rewrite_Set "Test_simplify");
153.105 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*-1 + x = 0*);
153.106 + val ((pt,_),_) = get_calc 1;
153.107 + val str = pr_ptree pr_short pt;
153.108 + writeln str;
153.109 +
153.110 + setNextTactic 1 (Subproblem ("Test.thy",["linear","univariate",
153.111 + "equation","test"]));
153.112 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*solve (-1 + x = 0, x)*);
153.113 + val ((pt,_),_) = get_calc 1;
153.114 + val str = pr_ptree pr_short pt;
153.115 + writeln str;
153.116 +
153.117 + setNextTactic 1 (Model_Problem (*["linear","univariate","equation","test"]*));
153.118 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*equality ///*);
153.119 +
153.120 + setNextTactic 1 (Add_Given "equality (-1 + x = 0)");
153.121 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*equality (-1 + x = 0)*);
153.122 +
153.123 + setNextTactic 1 (Add_Given "solveFor x");
153.124 + autoCalculate 1 CompleteCalcHead; refFormula 1 (get_pos 1 1) (*OK*);
153.125 +
153.126 + setNextTactic 1 (Apply_Method ["Test", "solve_linear"]);
153.127 + val (_, tacis) = get_calc 1;
153.128 + case tacis of
153.129 + [((Apply_Method ["Test","solve_linear"],_,(([3,1], Frm), _)))] =>() | _ =>
153.130 + raise error "tacis.sml: diff.behav. in setNextTactic -> autoCalculate (2)";
153.131 + (*#######################################################################*)
153.132 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*-1 + x = 0*);
153.133 +
153.134 + setNextTactic 1 (Rewrite_Set_Inst (["(bdv,x)"], "isolate_bdv"));
153.135 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x = 0 + -1 * -1*);
153.136 +
153.137 + setNextTactic 1 (Rewrite_Set "Test_simplify");
153.138 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x = 1*);
153.139 +
153.140 + setNextTactic 1 (Check_Postcond ["linear","univariate","equation","test"]);
153.141 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*[x = 1]*);
153.142 +
153.143 + setNextTactic 1 (Check_elementwise "Assumptions");
153.144 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*[x = 1]*);
153.145 + val ((pt,_),_) = get_calc 1;
153.146 + val str = pr_ptree pr_short pt;
153.147 + writeln str;
153.148 +
153.149 + setNextTactic 1 (Check_Postcond
153.150 + ["sqroot-test","univariate","equation","test"]);
153.151 + val (_, tacis) = get_calc 1;
153.152 +
153.153 + (*case tacis of 040609 suddenly ???!
153.154 + [((Check_Postcond _, _,(([], Res), _)))] =>() | _ =>
153.155 + raise error "tacis.sml: diff.behav. in setNextTactic -> autoCalculate (3)";
153.156 + #######################################################################*)
153.157 + autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*[x = 1]*);
153.158 +
153.159 + val ((pt,p),tacis) = get_calc 1;
153.160 + val ip = get_pos 1 1;
153.161 + val (Form f, tac, asms) = pt_extract (pt, p);
153.162 + if term2str f = "[x = 1]"andalso p = ([],Res) andalso ip = ([],Res)then()else
153.163 + raise error "tacis.sml: diff.behav. in setNextTactic -> autoCalculate (4)";
153.164 +
153.165 +
153.166 +
154.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
154.2 +++ b/src/Pure/isac/smltest/QUESTIONS_1003 Wed Jul 21 13:53:39 2010 +0200
154.3 @@ -0,0 +1,6 @@
154.4 +(*HOL.thy;
154.5 + .. is known, but these are unknown ?!? ...
154.6 + Real.thy;
154.7 + Complex.thy;
154.8 + HOL_Complex.thy;
154.9 + Complex_Main.thy;*)
155.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
155.2 +++ b/src/Pure/isac/smltest/Scripts/calculate-float.sml Wed Jul 21 13:53:39 2010 +0200
155.3 @@ -0,0 +1,147 @@
155.4 +(* (c) Stefan Rath 2005
155.5 + tests for sml/Scripts/calculate.sml
155.6 +
155.7 + use"~/proto2/isac/src/smltest/Scripts/calculate-float.sml";
155.8 + use"calculate-float.sml";
155.9 + *)
155.10 +
155.11 +
155.12 +(*WN.28.3.03 fuer Matthias*)
155.13 +(*Floatingpointnumbers, direkte Darstellung der abstrakten Syntax:*)
155.14 + val thy = Float.thy;
155.15 + val t = str2term "Float ((1,2),(0,0))";
155.16 + atomt t;
155.17 + val t = (term_of o the o (parse thy))
155.18 + "Float ((1,2),(0,0)) + Float ((3,4),(0,0)) * \
155.19 + \Float ((5,6),(0,0)) / Float ((7,8),(0,0))";
155.20 + atomt t;
155.21 +(*die konkrete Syntax wird noch verschoenert*)
155.22 +
155.23 + val thy = "Test.thy";
155.24 + val op_ = "divide_";
155.25 + val ct = "-6 / 3";
155.26 + val Some (ct,_) = calculate thy (the (assoc (calclist, op_))) ct;
155.27 +
155.28 +(*-----WN050315------------------------------------------------------*)
155.29 +(*..*)
155.30 +val t = str2term "Float ((1,2),(0,0))";
155.31 +atomty t;
155.32 +val Const ("Float.Float",_) $
155.33 + (Const ("Pair",_) $
155.34 + (Const ("Pair",_) $ Free (i1,_) $ Free (i2,_)) $ _) = t;
155.35 +
155.36 +val t = str2term "Float ((1,2),(0,0)) + Float ((3,4),(0,0))";
155.37 +atomty t;
155.38 +(*-----WN050315------------------------------------------------------*)
155.39 +
155.40 +
155.41 +val thy = Float.thy;
155.42 +
155.43 +(*.calculate the value of a pair of floats.*)
155.44 +val ((a,b),(c,d)) = calc "op +" ((~1,0),(0,0)) ((2,0),(0,0));
155.45 +
155.46 +
155.47 +(*.build the term.*)
155.48 +term_of_float HOLogic.realT ((~1,0),(0,0));
155.49 +term_of_float HOLogic.realT ((~1,11),(0,0));
155.50 +
155.51 +(*--18.3.05-------------------------*)
155.52 +val t = Free ("sdfsdfsdf", HOLogic.realT);
155.53 +val t = Free ("-123,456", HOLogic.realT);
155.54 +val t = Free ("0,123456", HOLogic.realT);
155.55 +term2str t;
155.56 +(*----(1)------------------------------*)
155.57 +val t = str2term "IFloat (1, 2, 3)";
155.58 +val t = str2term "CFloat (1, 2)";
155.59 +atomt t;
155.60 +atomty t;
155.61 +val Some ct = parse Float.thy "IFloat (1, 2, 3)";
155.62 +val Some ct = parse Float.thy "CFloat (1, 2)";
155.63 +atomt (term_of ct);
155.64 +atomty (term_of ct);
155.65 +(*----(2)------------------------------*)
155.66 +val Some ct = parse Float.thy "IFloat (-1, 2, 3)";
155.67 +val t = (term_of ct);
155.68 +atomty t;
155.69 +(*#######################################################################3
155.70 +val Const
155.71 + ("Float.IFloat", _) $
155.72 + (Const
155.73 + ("Pair", _) $
155.74 + Free (no, _) $
155.75 + (Const
155.76 + ("Pair", _) $
155.77 + Free (commas, _) $ Free (exp, _))) = t;
155.78 +
155.79 +fun IFloat2CFloat
155.80 + (Const
155.81 + ("Float.IFloat", _) $
155.82 + (Const
155.83 + ("Pair", _) $
155.84 + Free (no, _) $
155.85 + (Const
155.86 + ("Pair", _) $
155.87 + Free (commas, _) $ Free (exp, _)))) =
155.88 + Const ("Float.CFloat", HOLogic.realT(*wrong type*)) $
155.89 + (Const
155.90 + ("Pair", HOLogic.realT(*wrong type*)) $
155.91 + Free (no^"."^commas, HOLogic.realT)
155.92 + $ Free ("accuracy", HOLogic.realT))
155.93 +
155.94 + | IFloat2CFloat t =
155.95 + raise error ("IFloat2CFloat: invalid argument "^term2str t);
155.96 +
155.97 +val cf = IFloat2CFloat t;
155.98 +term2str cf;
155.99 +
155.100 +(*in IsacKnowledge/Float.ML: fun pairt -> Pair-term*)
155.101 +
155.102 +fun CFloat2Free (Const ("Float.CFloat", _) $
155.103 + (Const ("Pair", _) $ Free (no_commas, _) $ _)) =
155.104 + Free (no_commas, HOLogic.realT);
155.105 +
155.106 +val t' = CFloat2Free cf;
155.107 +term2str t';
155.108 +
155.109 +fun CFloat2sml (Const ("Float.CFloat", _) $
155.110 + (Const ("Pair", _) $ Free (float, _) $ _(**))) =
155.111 + float;
155.112 +CFloat2sml cf;
155.113 +
155.114 +(*--18.3.05-------------------------*)
155.115 +
155.116 +
155.117 +(*.the function evaluating a binary operator.*)
155.118 +val t = str2term "Float ((1,2),(0,0)) + Float ((3,4),(0,0))";
155.119 +val Some (thmid, t) = eval_binop "#add_" "op +" t thy;
155.120 +term2str t;
155.121 +
155.122 +
155.123 +(*.scan a term for a pair of floats.*)
155.124 + val Some (thmid,t') = get_pair thy op_ eval_fn t;
155.125 +
155.126 +
155.127 +(*.use 'calculate' explicitly.*)
155.128 + val thy = Test.thy;
155.129 + val op_ = "divide_";
155.130 + val t = str2term "sqrt (x ^^^ 2 + -3 * x) =\
155.131 + \Float ((5,6),(0,0)) / Float ((7,8),(0,0))";
155.132 + val Some (t',_) = calculate_ thy (the (assoc (calclist, op_))) t;
155.133 + term2str t';
155.134 +
155.135 +
155.136 +(*.rewrite with ruleset TEST...simplify (calling calculate internally.*)
155.137 +val t = str2term "a + Float ((1,2),(0,0)) + a + Float ((3,4),(0,0)) * \
155.138 + \Float ((5,6),(0,0)) / Float ((7,8),(0,0))";
155.139 +val Some (t',_) = rewrite_set_ thy false norm_Rational(*///*) t; term2str t';
155.140 +(*Float ((...,...) + 2*a*)
155.141 +
155.142 +
155.143 +(*. parse a float as seen by the user .*)
155.144 +val Some t = parse Float.thy "123.456";
155.145 +val Some t = parse Float.thy "-123.456";
155.146 +val Some t = parse Float.thy "123.456 E6789";
155.147 +val Some t = parse Float.thy "123.456 E-6789";
155.148 +val Some t = parse Float.thy "-123.456 E-6789";
155.149 +
155.150 +################################################################*)
156.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
156.2 +++ b/src/Pure/isac/smltest/Scripts/calculate.sml Wed Jul 21 13:53:39 2010 +0200
156.3 @@ -0,0 +1,471 @@
156.4 +(* test calculation of values for function constants
156.5 + (c) Walther Neuper 2000
156.6 +
156.7 +use"../smltest/Scripts/calculate.sml";
156.8 +use"calculate.sml";
156.9 +*)
156.10 +
156.11 +" ================= calculate.sml: calculate_ ======================== ";
156.12 +" ================= calculate.sml: aus script ======================== ";
156.13 +" ================= calculate.sml: 2.8.02 check test-root-equ ======== ";
156.14 +"--------------(4): check bottom up: ---------------------------";
156.15 +" ================= calculate.sml:10.8.02 2002:///->/ ======== ";
156.16 +" ================= calculate.sml: calculate_ 2002 =================== ";
156.17 +"----------- get_pair with 3 args --------------------------------";
156.18 +" ================= eval_binop Float =================== ";
156.19 +"------------------ 3.6.03 (2 * x is_const) ---------------------------";
156.20 +
156.21 +(* [("Vars",("Tools.Vars",fn)),("Length",("Tools.Length",fn)),
156.22 + ("Nth",("Tools.Nth",fn)),
156.23 + ("power_",("Atools.pow",fn)),("plus",("op +",fn)),("times",("op *",fn)),
156.24 + ("is_const",("Atools.is'_const",fn)),
156.25 + ("le",("op <",fn)),("leq",("op <=",fn)),
156.26 + ("ident",("Atools.ident",fn))] *)
156.27 +
156.28 +val thy' = "Isac.thy";
156.29 +
156.30 +" ================= calculate.sml: calculate_ ======================== ";
156.31 +" ================= calculate.sml: calculate_ ======================== ";
156.32 +" ================= calculate.sml: calculate_ ======================== ";
156.33 +
156.34 +
156.35 +val thy = Test.thy;
156.36 +val t = (term_of o the o (parse thy)) "1+2";
156.37 +val Some (thmID,thm) = get_calculation_ thy (the(assoc(calclist,"plus"))) t;
156.38 +
156.39 +val t = (term_of o the o (parse thy)) "((1+2)*4/3)^^^2";
156.40 +val Some (thmID,thm) = get_calculation_ thy (the(assoc(calclist,"plus"))) t;
156.41 +val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.42 +Sign.string_of_term (sign_of thy) t;
156.43 +(*val it = "(#3 * #4 // #3) ^^^ #2" : string*)
156.44 +val Some (thmID,thm) = get_calculation_ thy (the(assoc(calclist,"times"))) t;
156.45 +val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.46 +Sign.string_of_term (sign_of thy) t;
156.47 +(*val it = "(#12 // #3) ^^^ #2" : string*)
156.48 +val Some (thmID,thm) = get_calculation_ thy(the(assoc(calclist,"divide_")))t;
156.49 +val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.50 +Sign.string_of_term (sign_of thy) t;
156.51 +(*it = "#4 ^^^ #2" : string*)
156.52 +val Some (thmID,thm) = get_calculation_ thy(the(assoc(calclist,"power_")))t;
156.53 +val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.54 +Sign.string_of_term (sign_of thy) t;
156.55 +(*val it = "#16" : string*)
156.56 +if it <> "16" then raise error "calculate.sml: new behaviour in calculate_"
156.57 +else ();
156.58 +
156.59 +" ================= calculate.sml: aus script ======================== ";
156.60 +" ================= calculate.sml: aus script ======================== ";
156.61 +" ================= calculate.sml: aus script ======================== ";
156.62 +
156.63 +store_pbt
156.64 + (prep_pbt Test.thy "pbl_ttest" [] e_pblID
156.65 + (["test"],
156.66 + [],
156.67 + e_rls, None, []));
156.68 +store_pbt
156.69 + (prep_pbt Test.thy "pbl_ttest_calc" [] e_pblID
156.70 + (["calculate","test"],
156.71 + [("#Given" ,["realTestGiven t_"]),
156.72 + ("#Find" ,["realTestFind s_"])
156.73 + ],
156.74 + e_rls, None, [["Test","test_calculate"]]));
156.75 +
156.76 +store_met
156.77 + (prep_met Test.thy "met_testcal" [] e_metID
156.78 + (["Test","test_calculate"]:metID,
156.79 + [("#Given" ,["realTestGiven t_"]),
156.80 + ("#Find" ,["realTestFind s_"])
156.81 + ],
156.82 + {rew_ord'="sqrt_right",rls'=tval_rls,srls=e_rls,prls=e_rls,
156.83 + calc=[("plus" ,("op +" ,eval_binop "#add_")),
156.84 + ("times" ,("op *" ,eval_binop "#mult_")),
156.85 + ("divide_" ,("HOL.divide" ,eval_cancel "#divide_")),
156.86 + ("power_" ,("Atools.pow" ,eval_binop "#power_"))],
156.87 + crls=tval_rls, nrls=e_rls(*,
156.88 + asm_rls=[],asm_thm=[]*)},
156.89 + "Script STest_simplify (t_::real) = \
156.90 + \(Repeat \
156.91 + \ ((Try (Repeat (Calculate plus))) @@ \
156.92 + \ (Try (Repeat (Calculate times))) @@ \
156.93 + \ (Try (Repeat (Calculate divide_))) @@ \
156.94 + \ (Try (Repeat (Calculate power_))))) t_"
156.95 + ));
156.96 +
156.97 +val fmz = ["realTestGiven (((1+2)*4/3)^^^2)","realTestFind s"];
156.98 +val (dI',pI',mI') =
156.99 + ("Test.thy",["calculate","test"],["Test","test_calculate"]);
156.100 +(*val p = e_pos'; val c = [];
156.101 +val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
156.102 +val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
156.103 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
156.104 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.105 +(*nxt =("Add_Given",Add_Given "realTestGiven (((#1 + #2) * #4 // #3) ^^^#2)")*)
156.106 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.107 +(*nxt = ("Add_Find",Add_Find "realTestFind s") : string * tac*)
156.108 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.109 +(*nxt = ("Specify_Theory",Specify_Theory "Test.thy") : string * tac*)
156.110 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.111 +(*nxt = ("Specify_Problem",Specify_Problem ["calculate","test"])*)
156.112 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.113 +(*nxt = ("Specify_Method",Specify_Method ("Test.thy","test_calculate"))*)
156.114 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.115 +(*nxt = ("Apply_Method",Apply_Method ("Test.thy","test_calculate"))*)
156.116 +
156.117 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.118 +(*nxt = ("Calculate",Calculate "plus")*)
156.119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.120 +(*nxt = ("Calculate",Calculate "times")*)
156.121 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.122 +(*nxt = ("Calculate",Calculate "divide_")*)
156.123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.124 +(*nxt = ("Calculate",Calculate "power_")*)
156.125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.126 +(*nxt = ("Check_Postcond",Check_Postcond ["calculate","test"])*)
156.127 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
156.128 +(*nxt = ("End_Proof'",End_Proof')*)
156.129 +if f = Form' (FormKF (~1,EdUndef,0,Nundef,"16")) then ()
156.130 +else raise error "calculate.sml: script test_calculate changed behaviour";
156.131 +
156.132 +
156.133 +
156.134 +
156.135 +" ================= calculate.sml: 2.8.02 check test-root-equ ======== ";
156.136 +" ================= calculate.sml: 2.8.02 check test-root-equ ======== ";
156.137 +" ================= calculate.sml: 2.8.02 check test-root-equ ======== ";
156.138 +(*(1): 2nd Test_simplify didn't work:
156.139 +val ct =
156.140 + "sqrt (x ^^^ 2 + -3 * x) = (-3 + 2 * x + -1 * (9 + 4 * x)) / (-1 * 2)"
156.141 +> val rls = ("Test_simplify");
156.142 +> val (ct,_) = the (rewrite_set thy' ("tval_rls") false rls ct);
156.143 +val ct = "sqrt (x ^^^ 2 + -3 * x) =
156.144 +(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))";
156.145 +ie. cancel does not work properly
156.146 +*)
156.147 + val thy = "Test.thy";
156.148 + val op_ = "divide_";
156.149 + val ct = "sqrt (x ^^^ 2 + -3 * x) =\
156.150 + \(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))";
156.151 + val Some (ct,_) = calculate thy (the(assoc(calclist,op_))) ct;
156.152 + writeln ct;
156.153 +(*
156.154 + sqrt (x ^^^ 2 + -3 * x) =\
156.155 + \(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))
156.156 +............... does not work *)
156.157 +
156.158 +(*--------------(2): does divide work in Test_simplify ?: ------*)
156.159 + val thy = Test.thy;
156.160 + val t = (term_of o the o (parse thy)) "6 / 2";
156.161 + val rls = Test_simplify;
156.162 + val (t,_) = the (rewrite_set_ thy false rls t);
156.163 +(*val t = Free ("3","RealDef.real") : term*)
156.164 +
156.165 + val thy = "Test.thy";
156.166 + val t = "6 / 2";
156.167 + val rls = "Test_simplify";
156.168 + val (t,_) = the (rewrite_set thy false rls t);
156.169 +(*val t = "3" : string
156.170 + ....... works, thus: which rule in SqRoot_simplify works differently ?*)
156.171 +
156.172 +
156.173 +(*--------------(3): is_const works ?: -------------------------------------*)
156.174 + val t = (term_of o the o (parse Test.thy)) "2 is_const";
156.175 + atomty t;
156.176 + rewrite_set_ Test.thy false tval_rls t;
156.177 +(*val it = Some (Const ("True","bool"),[]) ... works*)
156.178 +
156.179 + val t = str2term "2 * x is_const";
156.180 + val Some (str,t') = eval_const "" "" t Isac.thy;
156.181 + term2str t';
156.182 +
156.183 +
156.184 +
156.185 +
156.186 +"--------------(4): check bottom up: ---------------------------";
156.187 +(*-------------- eval_cancel works: *)
156.188 + trace_rewrite:=true;
156.189 + val thy = Test.thy;
156.190 + val t = (term_of o the o (parse thy)) "(-4) / 2";
156.191 + val Some (_,t) = eval_cancel "xxx" "HOL.divide" t thy;
156.192 + term2str t;
156.193 +"-4 / 2 = (-2)";
156.194 +(*-------------- but ... *)
156.195 + val ct = "x + (-4) / 2";
156.196 + val (ct,_) = the (rewrite_set thy' false rls ct);
156.197 +"(-2) + x";
156.198 +(*-------------- while ... *)
156.199 + val ct = "(-4) / 2";
156.200 + val (ct,_) = the (rewrite_set thy' false rls ct);
156.201 +"-2";
156.202 +
156.203 +(*--------------(5): reproduce (1) with simpler term: ------------*)
156.204 + val thy = "Test.thy";
156.205 + val t = "(3+5)/2";
156.206 + val (t,_) = the (rewrite_set thy false rls t);
156.207 +(*val t = "4" ... works*)
156.208 +
156.209 + val t = "(3+1+2*x)/2";
156.210 + val (t,_) = the (rewrite_set thy false rls t);
156.211 +(*val t = "2 + x" ... works*)
156.212 +
156.213 + trace_rewrite:=true; (*3.6.03*)
156.214 + val thy = "Test.thy";
156.215 + val rls = "Test_simplify";
156.216 + val t = "(3+(1+2*x))/2";
156.217 + val (t,_) = the (rewrite_set thy false rls t);
156.218 +(*val t = "2 + x" ... works: give up----------------------------------------*)
156.219 + trace_rewrite:=false;
156.220 +
156.221 + trace_rewrite:=true; (*3.6.03*)
156.222 + val thy = Test.thy;
156.223 + val rls = Test_simplify;
156.224 + val t = str2term "(3+(1+2*x))/2";
156.225 + val Some (t',asm) = rewrite_set_ thy false rls t;
156.226 + term2str t';
156.227 +(*val t = "2 + x" ... works: give up----------------------------------------*)
156.228 + trace_rewrite:=false;
156.229 +
156.230 +
156.231 +
156.232 +
156.233 +(*--- trace_rewrite before correction of ... --------------------
156.234 + val ct = "(-3 + 2 * x + -1) / 2";
156.235 + val (ct,_) = the (rewrite_set thy' false rls ct);
156.236 +:
156.237 +### trying thm 'root_ge0_2'
156.238 +### rewrite_set_: x + (-1 + -3) / 2
156.239 +### trying thm 'radd_real_const_eq'
156.240 +### trying thm 'radd_real_const'
156.241 +### rewrite_set_: x + (-4) / 2
156.242 +### trying thm 'rcollect_right'
156.243 +:
156.244 +"x + (-4) / 2"
156.245 +-------------------------------------while before Isabelle20002:
156.246 + val ct = "(#-3 + #2 * x + #-1) // #2";
156.247 + val (ct,_) = the (rewrite_set thy' false rls ct);
156.248 +:
156.249 +### trying thm 'root_ge0_2'
156.250 +### rewrite_set_: x + (#-1 + #-3) // #2
156.251 +### trying thm 'radd_real_const_eq'
156.252 +### trying thm 'radd_real_const'
156.253 +### rewrite_set_: x + #-4 // #2
156.254 +### rewrite_set_: x + #-2
156.255 +### trying thm 'rcollect_right'
156.256 +:
156.257 +"#-2 + x"
156.258 +-----------------------------------------------------------------*)
156.259 +
156.260 +
156.261 + toggle trace_rewrite;
156.262 +(*===================*)
156.263 + trace_rewrite:=true;
156.264 + val thy' = "Test.thy";
156.265 + val rls = "Test_simplify";
156.266 + val ct = "x + (-1 + -3) / 2";
156.267 + val (ct,_) = the (rewrite_set thy' false rls ct);
156.268 +"x + (-4) / 2";
156.269 +(*
156.270 +### trying calc. 'cancel'
156.271 +@@@ get_pair: binop, t = x + (-4) / 2
156.272 +@@@ get_pair: t else
156.273 +@@@ get_pair: t else -> None
156.274 +@@@ get_pair: binop, t = (-4) / 2
156.275 +@@@ get_pair: then 1
156.276 +@@@ get_pair: t -> None
156.277 +@@@ get_pair: t1 -> None
156.278 +@@@ get_calculation: None
156.279 +### trying calc. 'pow'
156.280 +*)
156.281 +
156.282 + trace_rewrite:=true;
156.283 + val thy' = "Test.thy";
156.284 + val rls = "Test_simplify";
156.285 + val ct = "x + (-4) / 2";
156.286 + val (ct,_) = the (rewrite_set thy' false rls ct);
156.287 +"(-2) + x";
156.288 +(*
156.289 +### trying calc. 'cancel'
156.290 +@@@ get_pair: binop, t = x + -4 / 2
156.291 +@@@ get_pair: t else
156.292 +@@@ get_pair: t else -> None
156.293 +@@@ get_pair: binop, t = -4 / 2
156.294 +@@@ get_pair: then 1
156.295 +@@@ get_calculation: Some #cancel_-4_2
156.296 +### calc. to: x + (-2)
156.297 +### trying calc. 'cancel'
156.298 +*)
156.299 + trace_rewrite:=false;
156.300 +
156.301 +" ================= calculate.sml:10.8.02 2002:///->/ ======== ";
156.302 +" ================= calculate.sml:10.8.02 2002:///->/ ======== ";
156.303 +" ================= calculate.sml:10.8.02 2002:///->/ ======== ";
156.304 +" ----------------- rewriting works ? -----------------------";
156.305 + val thy = Isac.thy;
156.306 + val prop = (#prop o rep_thm) real_divide_1;
156.307 + atomty prop;
156.308 +(*** -------------
156.309 +*** Const ( Trueprop, bool => prop)
156.310 +*** . Const ( op =, [real, real] => bool)
156.311 +*** . . Const ( HOL.divide, [real, real] => real)
156.312 +*** . . . Var ((x, 0), real)
156.313 +*** . . . Const ( 1, real)
156.314 +*** . . Var ((x, 0), real) *)
156.315 + val prop' = (#prop o rep_thm o num_str) real_divide_1;
156.316 + atomty prop';
156.317 +(*** -------------
156.318 +*** Const ( Trueprop, bool => prop)
156.319 +*** . Const ( op =, [real, real] => bool)
156.320 +*** . . Const ( HOL.divide, [real, real] => real)
156.321 +*** . . . Var ((x, 0), real)
156.322 +*** . . . Free ( 1, real) (*app_num_tr'*)
156.323 +*** . . Var ((x, 0), real)*)
156.324 + val t = (term_of o the o (parseold thy)) "aaa/1";
156.325 + atomty t;
156.326 +(*** -------------
156.327 +*** Const ( HOL.divide, ['a, 'a] => 'a)
156.328 +*** . Free ( aaa, 'a)
156.329 +*** . Free ( 1, 'a) *)
156.330 + val t = (term_of o the o (parse thy)) "aaa/1";
156.331 + atomty t;
156.332 +(*** -------------
156.333 +*** Const ( HOL.divide, [real, real] => real)
156.334 +*** . Free ( aaa, real)
156.335 +*** . Free ( 1, real) *)
156.336 + val thm = num_str real_divide_1;
156.337 + val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.338 +(*val t = Free ("aaa","RealDef.real") : term*)
156.339 +
156.340 +
156.341 + val prop = (#prop o rep_thm) realpow_eq_one;
156.342 + atomty prop;
156.343 +(*** -------------
156.344 +*** Const ( Trueprop, bool => prop)
156.345 +*** . Const ( op =, [real, real] => bool)
156.346 +*** . . Const ( Nat.power, [real, nat] => real)
156.347 +*** . . . Const ( 1, real)
156.348 +*** . . . Var ((n, 0), nat)
156.349 +*** . . Const ( 1, real) *)
156.350 + val prop' = (#prop o rep_thm o num_str) realpow_eq_one;
156.351 + atomty prop';
156.352 +(*** -------------
156.353 +*** Const ( Trueprop, bool => prop)
156.354 +*** . Const ( op =, [real, real] => bool)
156.355 +*** . . Const ( Nat.power, [real, nat] => real)
156.356 +*** . . . Free ( 1, real)
156.357 +*** . . . Var ((n, 0), nat)
156.358 +*** . . Free ( 1, real)*)
156.359 + val t = (term_of o the o (parseold thy)) "1 ^ aaa";
156.360 + atomty t;
156.361 +(*** -------------
156.362 +*** Const ( Nat.power, ['a, nat] => 'a)
156.363 +*** . Free ( 1, 'a)
156.364 +*** . Free ( aaa, nat) *)
156.365 + val t = (term_of o the o (parse thy)) "1 ^ aaa";
156.366 + atomty t;
156.367 +(*** -------------
156.368 +*** Const ( Nat.power, [real, nat] => real)
156.369 +*** . Free ( 1, real)
156.370 +*** . Free ( aaa, nat) .......................... nat !!! *)
156.371 + val thm = num_str realpow_eq_one;
156.372 + val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.373 +(*val t = Free ("1","RealDef.real") : term*)
156.374 +
156.375 +" ================= calculate.sml: calculate_ 2002 =================== ";
156.376 +" ================= calculate.sml: calculate_ 2002 =================== ";
156.377 +" ================= calculate.sml: calculate_ 2002 =================== ";
156.378 +
156.379 +val thy = Test.thy;
156.380 +val t = (term_of o the o (parse thy)) "12 / 3";
156.381 +val Some (thmID,thm) = get_calculation_ thy(the(assoc(calclist,"divide_")))t;
156.382 +val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.383 +"12 / 3 = 4";
156.384 +val thy = Test.thy;
156.385 +val t = (term_of o the o (parse thy)) "4 ^^^ 2";
156.386 +val Some (thmID,thm) = get_calculation_ thy(the(assoc(calclist,"power_"))) t;
156.387 +val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.388 +"4 ^ 2 = 16";
156.389 +
156.390 + val t = (term_of o the o (parse thy)) "((1 + 2) * 4 / 3) ^^^ 2";
156.391 + val Some (thmID,thm) = get_calculation_ thy (the(assoc(calclist,"plus"))) t;
156.392 +"1 + 2 = 3";
156.393 + val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.394 + Sign.string_of_term (sign_of thy) t;
156.395 +"(3 * 4 / 3) ^^^ 2";
156.396 + val Some (thmID,thm) = get_calculation_ thy (the(assoc(calclist,"times")))t;
156.397 +"3 * 4 = 12";
156.398 + val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.399 + Sign.string_of_term (sign_of thy) t;
156.400 +"(12 / 3) ^^^ 2";
156.401 + val Some (thmID,thm) =get_calculation_ thy(the(assoc(calclist,"divide_")))t;
156.402 +"12 / 3 = 4";
156.403 + val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.404 + Sign.string_of_term (sign_of thy) t;
156.405 +"4 ^^^ 2";
156.406 + val Some (thmID,thm) = get_calculation_ thy(the(assoc(calclist,"power_")))t;
156.407 +"4 ^^^ 2 = 16";
156.408 + val Some (t,_) = rewrite_ thy tless_true tval_rls true thm t;
156.409 + Sign.string_of_term (sign_of thy) t;
156.410 +"16";
156.411 + if it <> "16" then raise error "calculate.sml: new behaviour in calculate_"
156.412 + else ();
156.413 +
156.414 +(*13.9.02 *** calc: operator = pow not defined*)
156.415 + val t = (term_of o the o (parse thy)) "3^^^2";
156.416 + val Some (thmID,thm) =
156.417 + get_calculation_ thy (the(assoc(calclist,"power_"))) t;
156.418 +(*** calc: operator = pow not defined*)
156.419 +
156.420 + val (op_, eval_fn) = the (assoc(calclist,"power_"));
156.421 + (*
156.422 +val op_ = "Atools.pow" : string
156.423 +val eval_fn = fn : string -> term -> theory -> (string * term) option*)
156.424 +
156.425 + val Some (thmid,t') = get_pair thy op_ eval_fn t;
156.426 +(*** calc: operator = pow not defined*)
156.427 +
156.428 + val Some (id,t') = eval_fn op_ t thy;
156.429 +(*** calc: operator = pow not defined*)
156.430 +
156.431 + val (thmid, (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) = (op_, t);
156.432 + val Some (id,t') = eval_binop thmid op_ t thy;
156.433 +(*** calc: operator = pow not defined*)
156.434 +
156.435 +
156.436 +"----------- get_pair with 3 args --------------------------------";
156.437 +"----------- get_pair with 3 args --------------------------------";
156.438 +"----------- get_pair with 3 args --------------------------------";
156.439 +val (thy, op_, ef, arg) =
156.440 + (thy, "EqSystem.occur'_exactly'_in",
156.441 + snd (the (assoc(!calclist',"occur_exactly_in"))),
156.442 + str2term
156.443 + "[] from_ [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) / 2"
156.444 + );
156.445 +val Some (str, simpl) = get_pair thy op_ ef arg;
156.446 +if str =
156.447 +"[] from_ [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) / 2 = True"
156.448 +then () else raise error "calculate.sml get_pair with 3 args:occur_exactly_in";
156.449 +
156.450 +
156.451 +
156.452 +" ================= eval_binop Float =================== ";
156.453 +val t = str2term "Float ((1,2),(0,0))";
156.454 +atomty t;
156.455 +val Const ("Float.Float",_) $
156.456 + (Const ("Pair",_) $
156.457 + (Const ("Pair",_) $ Free (i1,_) $ Free (i2,_)) $ _) = t;
156.458 +
156.459 +val t = str2term "Float ((1,2),(0,0)) * Float ((3,4),(0,0))";
156.460 +atomty t;
156.461 +(*WN.10.4.03 eval_binop Float *)
156.462 +
156.463 +
156.464 +"------------------ 3.6.03 (2 * x is_const) ---------------------------";
156.465 +"------------------ 3.6.03 (2 * x is_const) ---------------------------";
156.466 +"------------------ 3.6.03 (2 * x is_const) ---------------------------";
156.467 +val t = str2term "2 * x is_const";
156.468 +val Some (str, t') = eval_const "" "" t Test.thy;
156.469 +term2str t';
156.470 +"(2 * x is_const) = False";
156.471 +
156.472 +val Some (t',_) = rewrite_set_ Test.thy false tval_rls t;
156.473 +term2str t';
156.474 +"False";
157.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
157.2 +++ b/src/Pure/isac/smltest/Scripts/listg.sml Wed Jul 21 13:53:39 2010 +0200
157.3 @@ -0,0 +1,87 @@
157.4 +(* tests for ListG
157.5 + author: Walther Neuper 1.5.03
157.6 +
157.7 +use"../smltest/Scripts/listg.sml";
157.8 +use"listg.sml";
157.9 +*)
157.10 +
157.11 +
157.12 +
157.13 +"--------------------- nth_ ----------------------------------------------";
157.14 +"--------------------- nth_ ----------------------------------------------";
157.15 +"--------------------- nth_ ----------------------------------------------";
157.16 +val t = str2term "nth_ 3 [a,b,c,d,e]";
157.17 +atomty t;
157.18 +val thm = (#prop o rep_thm o num_str) nth_Cons_;
157.19 +atomty thm;
157.20 +val Some (t',_) = rewrite_ thy dummy_ord Poly_erls false (num_str nth_Cons_) t;
157.21 +if term2str t' = "nth_ (3 + - 1) [b, c, d, e]" then ()
157.22 +else raise error "list_rls.sml, nth_ (3 + - 1) [b, c, d, e]";
157.23 +
157.24 +val t = str2term "nth_ 1 [a,b,c,d,e]";
157.25 +atomty t;
157.26 +val thm = (#prop o rep_thm o num_str) nth_Nil_;
157.27 +atomty thm;
157.28 +val Some (t',_) = rewrite_ thy dummy_ord Poly_erls false (num_str nth_Nil_) t;
157.29 +term2str t';
157.30 +"a";
157.31 +
157.32 +val t = str2term "nth_ 3 [a,b,c,d,e]";
157.33 +atomty t;
157.34 +trace_rewrite:=true;
157.35 +val Some (t',_) = rewrite_set_ thy false list_rls t;
157.36 +trace_rewrite:=false;
157.37 +term2str t';
157.38 +"c";
157.39 +
157.40 +(*-------------------------------------------------------------------*)
157.41 +val Some (Thm (_,thm)) = rls_get_thm list_rls "nth_Nil_";
157.42 +val ttt = (#prop o rep_thm) thm;
157.43 +atomty ttt;
157.44 +(*Free ( 1, real) ...OK, Var ((x, 0), ?'a) OK*)
157.45 +
157.46 +
157.47 +
157.48 +"--------------------- length_ -------------------------------------------";
157.49 +"--------------------- length_ -------------------------------------------";
157.50 +"--------------------- length_ -------------------------------------------";
157.51 +val thy' = "ListG.thy";
157.52 +val ct = "length_ [1,1,1]";
157.53 +val thm = ("length_Cons_","");
157.54 +val (ct,asm) = the (rewrite thy' "tless_true" ("tval_rls") false thm ct);
157.55 +val (ct,asm) = the (rewrite thy' "tless_true" ("tval_rls") false thm ct);
157.56 +val (ct,asm) = the (rewrite thy' "tless_true" ("tval_rls") false thm ct);
157.57 +val thm = ("length_Nil_","");
157.58 +val (ct,asm) = the (rewrite thy' "tless_true" ("tval_rls") false thm ct);
157.59 +if ct="1 + (1 + (1 + 0))"then()
157.60 +else raise error ("list_rls.sml 1: behaviour of test-expl changed: "^ct);
157.61 +
157.62 +
157.63 +val ct = "length_ [1,1,1]";
157.64 +val rls = "list_rls";
157.65 +val (ct,asm) = the (rewrite_set thy' false rls ct);
157.66 +if ct="3"then()
157.67 +else raise error ("list_rls.sml 2: behaviour of test-expl changed: "^ct);
157.68 +
157.69 +
157.70 +val ct = "length_ [1,1,1]";
157.71 +val t = (term_of o the o (parse ListG.thy)) ct;
157.72 +val t = eval_listexpr_ ListG.thy list_rls t;
157.73 +case t of Free ("3",_) => ()
157.74 +| _ => raise error ("list-rls.sml 3: behaviour of test-expl changed: "^ct);
157.75 +
157.76 +
157.77 +"--------------------- 29.4.03: union ------------------------------------";
157.78 +"--------------------- 29.4.03: union ------------------------------------";
157.79 +"--------------------- 29.4.03: union ------------------------------------";
157.80 +
157.81 +fun ins_ x xs = if x mem xs then xs else x :: xs;
157.82 +fun union_ xs [] = xs
157.83 + | union_ [] ys = ys
157.84 + | union_ (x :: xs) ys = union_ xs (ins_ x ys);
157.85 +
157.86 +
157.87 +val t = (term_of o the o (parse ListG.thy)) "1 mem []";
157.88 +atomty t;
157.89 +
157.90 +
158.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
158.2 +++ b/src/Pure/isac/smltest/Scripts/rewrite.sml Wed Jul 21 13:53:39 2010 +0200
158.3 @@ -0,0 +1,201 @@
158.4 +(* tests for ME/rewrite.sml
158.5 + TODO.WN0509 collect typical tests from systest here !!!!!
158.6 + author: Walther Neuper 050908
158.7 + (c) copyright due to lincense terms.
158.8 +
158.9 +use"../smltest/Scripts/rewrite.sml";
158.10 +use"rewrite.sml";
158.11 +*)
158.12 +
158.13 +"-----------------------------------------------------------------";
158.14 +"table of contents -----------------------------------------------";
158.15 +"-----------------------------------------------------------------";
158.16 +"----------- assemble rewrite ------------------------------------";
158.17 +"----------- test rewriting without Isac's thys ------------------";
158.18 +"----------- conditional rewriting without Isac's thys -----------";
158.19 +"----------- rewrite_terms_ -------------------------------------";
158.20 +"----------- rewrite_inst_ bdvs ----------------------------------";
158.21 +"-----------------------------------------------------------------";
158.22 +"-----------------------------------------------------------------";
158.23 +"-----------------------------------------------------------------";
158.24 +
158.25 +"----------- assemble rewrite ------------------------------------";
158.26 +"----------- assemble rewrite ------------------------------------";
158.27 +"----------- assemble rewrite ------------------------------------";
158.28 +(*ML {**)
158.29 +"===== rewriting by thm with 'a";
158.30 +show_types := true;
158.31 +val thy = @{theory Complex_Main};
158.32 +val ctxt = @{context};
158.33 +val thm = @{thm add_commute};
158.34 +val t = (term_of o the) (parse thy "((r + u) + t) + s");
158.35 +"----- from old: fun rewrite__";
158.36 +val bdv = [];
158.37 +val r = (((inst_bdv bdv) o norm o #prop o rep_thm) thm);
158.38 +"----- from old: and rew_sub";
158.39 +val (lhs,rhs) = (dest_equals' o strip_trueprop
158.40 + o Logic.strip_imp_concl) r;
158.41 +(* old
158.42 +val insts = Pattern.match thy (lhs,t) (Vartab.empty, Vartab.empty);*)
158.43 +"----- fun match_rew in Pure/pattern.ML";
158.44 +val rtm = the_default rhs (Term.rename_abs lhs t rhs);
158.45 +
158.46 +tracing(Syntax.string_of_term ctxt rtm);
158.47 +tracing(Syntax.string_of_term ctxt lhs);
158.48 +tracing(Syntax.string_of_term ctxt t);
158.49 +
158.50 +(Pattern.match thy (lhs, t) (Vartab.empty, Vartab.empty));
158.51 +val (rew, rhs) = (Envir.subst_term
158.52 + (Pattern.match thy (lhs, t) (Vartab.empty, Vartab.empty)) rtm, rtm);
158.53 +(*lookup in isabelle?trace?response...*)
158.54 +writeln(Syntax.string_of_term ctxt rew);
158.55 +writeln(Syntax.string_of_term ctxt rhs);
158.56 +(*}
158.57 +ML {*)
158.58 +"===== rewriting: prep insertion into rew_sub";
158.59 +val thy = @{theory Complex_Main};
158.60 +val ctxt = @{context};
158.61 +val thm = @{thm nonzero_mult_divide_cancel_right};
158.62 +val r = Thm.prop_of thm;
158.63 +val tm = @{term "x*2 / 2::real"};
158.64 +"----- and rew_sub";
158.65 +val (lhs, rhs) = (HOLogic.dest_eq o HOLogic.dest_Trueprop
158.66 + o Logic.strip_imp_concl) r;
158.67 +val r' = Envir.subst_term (Pattern.match thy (lhs, tm)
158.68 + (Vartab.empty, Vartab.empty)) r;
158.69 +val p' = (fst o Logic.strip_prems) (Logic.count_prems r', [], r');
158.70 +val t' = (snd o HOLogic.dest_eq o HOLogic.dest_Trueprop
158.71 + o Logic.strip_imp_concl) r';
158.72 +
158.73 +(*is displayed on top of <response> buffer...*)
158.74 +Pretty.writeln (ProofContext.pretty_term_abbrev @{context} r');
158.75 +Pretty.writeln (ProofContext.pretty_term_abbrev @{context} t');
158.76 +(*}*)
158.77 +
158.78 +"----------- test rewriting without Isac's thys ------------------";
158.79 +"----------- test rewriting without Isac's thys ------------------";
158.80 +"----------- test rewriting without Isac's thys ------------------";
158.81 +(*ML {*)
158.82 +"===== rewriting with Isabelle2009-1 only, i.e without isac-hacks";
158.83 +val thy = @{theory Complex_Main};
158.84 +val ctxt = @{context};
158.85 +val thm = @{thm add_commute};
158.86 +val tm = @{term "x + y*z::real"};
158.87 +
158.88 +val SOME (r,_) = (rewrite_ thy dummy_ord e_rls false thm tm)
158.89 + handle _ => error "rewrite.sml diff.behav. in rewriting with Isabelle2009-1 only";
158.90 +(*is displayed on _TOP_ of <response> buffer...*)
158.91 +Pretty.writeln (ProofContext.pretty_term_abbrev @{context} r);
158.92 +
158.93 +"----- rewriting a subterm";
158.94 +val tm = @{term "w*(x + y*z)::real"};
158.95 +
158.96 +val SOME (r,_) = (rewrite_ thy dummy_ord e_rls false thm tm)
158.97 + handle _ => error "rewrite.sml diff.behav. in rew_sub with Isabelle2009-1 only";
158.98 +
158.99 +"----- ordered rewriting";
158.100 +fun tord (_:subst) pp = TermOrd.termless pp;
158.101 +if tord [] (@{term "x + y*z::real"}, @{term "y*z + x::real"}) then ()
158.102 +else error "rewrite.sml diff.behav. in ord.rewr. with Isabelle2009-1 only";
158.103 +
158.104 +val NONE = (rewrite_ thy tord e_rls false thm tm)
158.105 + handle _ => error "rewrite.sml diff.behav. in rewriting with Isabelle2009-1 only";
158.106 +(*is displayed on _TOP_ of <response> buffer...*)
158.107 +Pretty.writeln (ProofContext.pretty_term_abbrev @{context} r);
158.108 +
158.109 +val tm = @{term "x*y + z::real"};
158.110 +val SOME (r,_) = (rewrite_ thy tord e_rls false thm tm)
158.111 + handle _ => error "rewrite.sml diff.behav. in rewriting with Isabelle2009-1 only";
158.112 +
158.113 +
158.114 +(*}*)
158.115 +
158.116 +"----------- conditional rewriting without Isac's thys -----------";
158.117 +"----------- conditional rewriting without Isac's thys -----------";
158.118 +"----------- conditional rewriting without Isac's thys -----------";
158.119 +(*ML {*)
158.120 +"===== prepr cond.rew. with Pattern.match";
158.121 +val thy = @{theory Complex_Main};
158.122 +val ctxt = @{context};
158.123 +val thm = @{thm nonzero_mult_divide_cancel_right};
158.124 +val rule = Thm.prop_of thm;
158.125 +val tm = @{term "x*2 / 2::real"};
158.126 +
158.127 +val prem = Logic.strip_imp_prems rule;
158.128 +val nps = Logic.count_prems rule;
158.129 +val prems = Logic.strip_prems (nps, [], rule);
158.130 +
158.131 +val eq = Logic.strip_imp_concl rule;
158.132 +val (lhs, rhs) = (HOLogic.dest_eq o HOLogic.dest_Trueprop) eq;
158.133 +
158.134 +val mtcs = Pattern.match thy (lhs, tm) (Vartab.empty, Vartab.empty);
158.135 +val rule' = Envir.subst_term mtcs rule;
158.136 +
158.137 +val prems' = (fst o Logic.strip_prems)
158.138 + (Logic.count_prems rule', [], rule');
158.139 +val rhs' = (snd o HOLogic.dest_eq o HOLogic.dest_Trueprop
158.140 + o Logic.strip_imp_concl) rule';
158.141 +
158.142 +"----- conditional rewriting creating an assumption";
158.143 +"----- conditional rewriting creating an assumption";
158.144 +val tm = @{term "x*y / y::real"};
158.145 +val SOME (rew,asm) = (rewrite_ thy dummy_ord e_rls false thm tm)
158.146 + handle _ => error "rewrite.sml diff.behav. in cond.rew. with Isabelle2009-1 only a";
158.147 +
158.148 +if rew = @{term "x::real"} then ()
158.149 +else error "rewrite.sml diff.behav. in cond.rew. with Isabelle2009-1 only b";
158.150 +
158.151 +if HOLogic.dest_Trueprop (hd asm) = @{term "~ y = (0::real)"} then ()
158.152 +else error "rewrite.sml diff.behav. in cond.rew. with Isabelle2009-1 only c";
158.153 +
158.154 +"----- conditional rewriting immediately: can only be done with Isabelle numerals\
158.155 +\because erls cannot handle them yet.";
158.156 +(*}*)
158.157 +
158.158 +
158.159 +"----------- rewrite_terms_ -------------------------------------";
158.160 +"----------- rewrite_terms_ -------------------------------------";
158.161 +"----------- rewrite_terms_ -------------------------------------";
158.162 +val subte = [str2term"x = 0"];
158.163 +val t = str2term"M_b x = -1 * q_0 * x ^^^ 2 / 2 + x * c + c_2";
158.164 +val Some (t',_) = rewrite_terms_ thy dummy_ord Erls subte t;
158.165 +if term2str t' = "M_b 0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2" then ()
158.166 +else raise error "rewrite.sml rewrite_terms_ [x = 0]";
158.167 +
158.168 +val subte = [str2term"M_b 0 = 0"];
158.169 +val t = str2term"M_b 0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2";
158.170 +val Some (t',_) = rewrite_terms_ thy dummy_ord Erls subte t;
158.171 +if term2str t' = "0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2" then ()
158.172 +else raise error "rewrite.sml rewrite_terms_ [M_b 0 = 0]";
158.173 +
158.174 +val subte = [str2term"x = 0", str2term"M_b 0 = 0"];
158.175 +val t = str2term"M_b x = -1 * q_0 * x ^^^ 2 / 2 + x * c + c_2";
158.176 +val Some (t',_) = rewrite_terms_ thy dummy_ord Erls subte t;
158.177 +if term2str t' = "0 = -1 * q_0 * 0 ^^^ 2 / 2 + 0 * c + c_2" then ()
158.178 +else raise error "rewrite.sml rewrite_terms_ [x = 0, M_b 0 = 0]";
158.179 +
158.180 +
158.181 +"----------- rewrite_inst_ bdvs ----------------------------------";
158.182 +"----------- rewrite_inst_ bdvs ----------------------------------";
158.183 +"----------- rewrite_inst_ bdvs ----------------------------------";
158.184 +(*see smltest/Scripts/term_G.sml: inst_bdv 2*)
158.185 +val t = str2term"-1 * (q_0 * L ^^^ 2) / 2 + (L * c_3 + c_4) = 0";
158.186 +val bdvs = [(str2term"bdv_1",str2term"c"),
158.187 + (str2term"bdv_2",str2term"c_2"),
158.188 + (str2term"bdv_3",str2term"c_3"),
158.189 + (str2term"bdv_4",str2term"c_4")];
158.190 +(*------------ outcommented WN071210, after inclusion into ROOT.ML
158.191 +val Some (t,_) =
158.192 + rewrite_inst_ thy e_rew_ord
158.193 + (append_rls "erls_isolate_bdvs" e_rls
158.194 + [(Calc ("EqSystem.occur'_exactly'_in",
158.195 + eval_occur_exactly_in
158.196 + "#eval_occur_exactly_in_"))
158.197 + ])
158.198 + false bdvs (num_str separate_bdvs_add) t;
158.199 +(writeln o term2str) t;
158.200 +if term2str t = "L * c_3 + c_4 = 0 + -1 * (-1 * (q_0 * L ^^^ 2) / 2)"
158.201 +then () else raise error "rewrite.sml rewrite_inst_ bdvs";
158.202 +trace_rewrite:=true;
158.203 +trace_rewrite:=false;--------------------------------------------*)
158.204 +
159.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
159.2 +++ b/src/Pure/isac/smltest/Scripts/scrtools.sml Wed Jul 21 13:53:39 2010 +0200
159.3 @@ -0,0 +1,193 @@
159.4 +(* tests on tools for scripts
159.5 + author: Walther Neuper
159.6 + 060605,
159.7 + (c) due to copyright terms
159.8 +
159.9 +use"../smltest/Scripts/scrtools.sml";
159.10 +use"scrtools.sml";
159.11 +*)
159.12 +"-----------------------------------------------------------------";
159.13 +"table of contents -----------------------------------------------";
159.14 +"-----------------------------------------------------------------";
159.15 +"-------- test auto-generated script '(Repeat (Calculate times))'-";
159.16 +"-------- test the same called by interSteps norm_Poly -----------";
159.17 +"-------- test the same called by interSteps norm_Rational -------";
159.18 +"-------- check auto-gen.script for Rewrite_Set_Inst -------------";
159.19 +"-----------------------------------------------------------------";
159.20 +"-----------------------------------------------------------------";
159.21 +"-----------------------------------------------------------------";
159.22 +
159.23 +
159.24 +"-------- test auto-generated script '(Repeat (Calculate times))'-";
159.25 +"-------- test auto-generated script '(Repeat (Calculate times))'-";
159.26 +"-------- test auto-generated script '(Repeat (Calculate times))'-";
159.27 +val Seq {scr = Script auto_script,...} = assoc_rls "norm_Poly";
159.28 +writeln(term2str auto_script);
159.29 +atomty auto_script;
159.30 +
159.31 +store_met
159.32 + (prep_met Test.thy "met_testinter" [] e_metID
159.33 + (["Test","test_interSteps_1"]:metID,
159.34 + [("#Given" ,["term t_"]),
159.35 + ("#Find" ,["normalform n_"])
159.36 + ],
159.37 + {rew_ord'="dummy_ord",rls'=tval_rls,calc=[],srls=e_rls,prls=e_rls,
159.38 + crls=tval_rls, nrls=e_rls},
159.39 +"Script Stepwise t_ = \
159.40 + \(Try (Rewrite_Set discard_minus_ False) @@ \
159.41 + \ Try (Rewrite_Set expand_poly_ False) @@ \
159.42 + \ Try (Repeat (Calculate times)) @@ \
159.43 + \ Try (Rewrite_Set order_mult_rls_ False) @@ \
159.44 + \ Try (Rewrite_Set simplify_power_ False) @@ \
159.45 + \ Try (Rewrite_Set calc_add_mult_pow_ False) @@\
159.46 + \ Try (Rewrite_Set reduce_012_mult_ False) @@ \
159.47 + \ Try (Rewrite_Set order_add_rls_ False) @@ \
159.48 + \ Try (Rewrite_Set collect_numerals_ False) @@ \
159.49 + \ Try (Rewrite_Set reduce_012_ False) @@ \
159.50 + \ Try (Rewrite_Set discard_parentheses_ False))\
159.51 + \ t_"
159.52 +(*presently this script cannot become equal in types to auto_script, because:
159.53 + this t_ must be either 'real' or 'bool' #1#,
159.54 + while the auto_script must be 'z and type-instantiated before usage*)
159.55 + ));
159.56 +show_mets();
159.57 +val {scr = Script parsed_script,...} = get_met ["Test","test_interSteps_1"];
159.58 +writeln(term2str parsed_script);
159.59 +atomty parsed_script;
159.60 +
159.61 +(*the structure of the auto-gen. script is interpreted correctly*)
159.62 +states:=[];
159.63 +CalcTree
159.64 +[(["term (b + a - b)",(*this is Schalk 299b*)
159.65 + "normalform N"],
159.66 + ("Poly.thy",["polynomial","simplification"],
159.67 + ["Test","test_interSteps_1"]))];
159.68 +Iterator 1;
159.69 +moveActiveRoot 1;
159.70 +autoCalculate 1 CompleteCalcHead;
159.71 +
159.72 +fetchProposedTactic 1 (*..Apply_Method*);
159.73 +autoCalculate 1 (Step 1);
159.74 +getTactic 1 ([1], Frm) (*still empty*);
159.75 +
159.76 +fetchProposedTactic 1 (*discard_minus_*);
159.77 +autoCalculate 1 (Step 1);
159.78 +
159.79 +fetchProposedTactic 1 (*order_add_rls_*);
159.80 +autoCalculate 1 (Step 1);
159.81 +
159.82 +fetchProposedTactic 1 (*collect_numerals_*);
159.83 +autoCalculate 1 (Step 1);
159.84 +
159.85 +autoCalculate 1 CompleteCalc;
159.86 +
159.87 +val ((pt,p),_) = get_calc 1; show_pt pt;
159.88 +if existpt' ([1], Frm) pt then ()
159.89 +else raise error "scrtools.sml: test-script test_interSteps_1 doesnt work";
159.90 +
159.91 +
159.92 +"-------- test the same called by interSteps norm_Poly -----------";
159.93 +"-------- test the same called by interSteps norm_Poly -----------";
159.94 +"-------- test the same called by interSteps norm_Poly -----------";
159.95 +val Seq {scr = Script auto_script,...} = assoc_rls "norm_Poly";
159.96 +writeln(term2str auto_script);
159.97 +atomty auto_script;
159.98 +
159.99 +states:=[];
159.100 +CalcTree
159.101 +[(["term (b + a - b)", "normalform N"],
159.102 + ("Poly.thy",["polynomial","simplification"],
159.103 + ["simplification","for_polynomials"]))];
159.104 +Iterator 1;
159.105 +moveActiveRoot 1;
159.106 +autoCalculate 1 CompleteCalc;
159.107 +
159.108 +interSteps 1 ([], Res);
159.109 +val ((pt,p),_) = get_calc 1; show_pt pt;
159.110 +
159.111 +interSteps 1 ([1], Res);
159.112 +val ((pt,p),_) = get_calc 1; show_pt pt;
159.113 +if existpt' ([1,4], Res) pt then ()
159.114 +else raise error "scrtools.sml: auto-generated norm_Poly doesnt work";
159.115 +
159.116 +
159.117 +
159.118 +"-------- test the same called by interSteps norm_Rational -------";
159.119 +"-------- test the same called by interSteps norm_Rational -------";
159.120 +"-------- test the same called by interSteps norm_Rational -------";
159.121 +val Seq {scr = Script auto_script,...} = assoc_rls "norm_Rational";
159.122 +writeln(term2str auto_script);
159.123 +atomty auto_script;
159.124 +(***
159.125 +*** Const (Script.Stepwise, ['z, 'z] => 'z)
159.126 +*** . Free (t_, 'z)
159.127 +*** . Const (Script.Seq, ['a => 'a, 'a => 'a, 'a] => 'a)
159.128 +*** . . Const (Script.Try, ['a => 'a, 'a] => 'a)
159.129 +*** . . . Const (Script.Rewrite'_Set, [Script.ID, bool, 'a] => 'a)
159.130 +*** . . . . Free (discard_minus_, Script.ID)
159.131 +*** . . . . Const (False, bool)
159.132 +*** . . Const (Script.Seq, ['a => 'a, 'a => 'a, 'a] => 'a)
159.133 +*** . . . Const (Script.Try, ['a => 'a, 'a] => 'a)
159.134 +*** . . . . Const (Script.Rewrite'_Set, [Script.ID, bool, 'a] => 'a)
159.135 +*** . . . . . Free (rat_mult_poly, Script.ID)
159.136 +*** . . . . . Const (False, bool)
159.137 +*** . . . Const (Script.Seq, ['a => 'a, 'a => 'a, 'a] => 'a)
159.138 +*** . . . . Const (Script.Try, ['a => 'a, 'a] => 'a)
159.139 +*** . . . . . Const (Script.Rewrite'_Set, [Script.ID, bool, 'a] => 'a)
159.140 +*** . . . . . . Free (make_rat_poly_with_parentheses, Script.ID)
159.141 +*** . . . . . . Const (False, bool)
159.142 +*** . . . . Const (Script.Seq, ['a => 'a, 'a => 'a, 'a] => 'a)
159.143 +*** . . . . . Const (Script.Try, ['a => 'a, 'a] => 'a)
159.144 +*** . . . . . . Const (Script.Rewrite'_Set, [Script.ID, bool, 'a] => 'a)
159.145 +*** . . . . . . . Free (cancel_p_rls, Script.ID)
159.146 +*** . . . . . . . Const (False, bool)
159.147 +*** . . . . . Const (Script.Seq, ['a => 'a, 'a => 'a, 'a] => 'a)
159.148 +*** . . . . . . Const (Script.Try, ['a => 'a, 'a] => 'a)
159.149 +*** . . . . . . . Const (Script.Rewrite'_Set, [Script.ID, bool, 'a] => 'a)
159.150 +*** . . . . . . . . Free (norm_Rational_rls, Script.ID)
159.151 +*** . . . . . . . . Const (False, bool)
159.152 +*** . . . . . . Const (Script.Try, ['a => 'a, 'a] => 'a)
159.153 +*** . . . . . . . Const (Script.Rewrite'_Set, [Script.ID, bool, 'a] => 'a)
159.154 +*** . . . . . . . . Free (discard_parentheses_, Script.ID)
159.155 +*** . . . . . . . . Const (False, bool)
159.156 +*** . . Free (t_, 'a)
159.157 +***)
159.158 +states:=[];
159.159 +CalcTree
159.160 +[(["term (b + a - b)", "normalform N"],
159.161 + ("Poly.thy",["polynomial","simplification"],
159.162 + ["simplification","of_rationals"]))];
159.163 +Iterator 1;
159.164 +moveActiveRoot 1;
159.165 +autoCalculate 1 CompleteCalc;
159.166 +
159.167 +interSteps 1 ([], Res);
159.168 +val ((pt,p),_) = get_calc 1; show_pt pt;
159.169 +
159.170 +interSteps 1 ([1], Res);
159.171 +val ((pt,p),_) = get_calc 1; show_pt pt;
159.172 +
159.173 +(*with "Script SimplifyScript (t_::real) = \
159.174 + \ ((Rewrite_Set norm_Rational False) t_)"
159.175 +val (Form form, Some tac, asm) = pt_extract (pt, ([1], Res));
159.176 +*)
159.177 +val (Form form, Some tac, asm) = pt_extract (pt, ([2], Res));
159.178 +case (term2str form, tac, terms2strs asm) of
159.179 + ("a", Check_Postcond ["polynomial", "simplification"], []) => ()
159.180 + | _ => raise error "scrtools.sml: auto-generated norm_Rational doesnt work";
159.181 +
159.182 +
159.183 +
159.184 +"-------- check auto-gen.script for Rewrite_Set_Inst -------------";
159.185 +"-------- check auto-gen.script for Rewrite_Set_Inst -------------";
159.186 +"-------- check auto-gen.script for Rewrite_Set_Inst -------------";
159.187 +val rls = assoc_rls "integration";
159.188 +val Seq {scr = Script auto_script,...} = rls;
159.189 +writeln(term2str auto_script);
159.190 +
159.191 +if contain_bdv (get_rules rls) then ()
159.192 +else raise error "scrtools.sml: contain_bdv doesnt work for 'integration'";
159.193 +
159.194 +two_scr_arg auto_script;
159.195 +init_istate (Rewrite_Set_Inst (["(bdv, x)"], "integration_rules"))
159.196 + (str2term "someTermWithBdv");
160.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
160.2 +++ b/src/Pure/isac/smltest/Scripts/term_G.sml Wed Jul 21 13:53:39 2010 +0200
160.3 @@ -0,0 +1,168 @@
160.4 +(* tests on Scripts/term_G.sml
160.5 + author: Walther Neuper
160.6 + 051006,
160.7 + (c) due to copyright terms
160.8 +
160.9 +use"../smltest/Scripts/term_G.sml";
160.10 +use"term_G.sml";
160.11 +*)
160.12 +
160.13 +"-----------------------------------------------------------------";
160.14 +"table of contents -----------------------------------------------";
160.15 +"-----------------------------------------------------------------";
160.16 +"----------- inst_bdv --------------------------------------------";
160.17 +"----------- subst_atomic_all ------------------------------------";
160.18 +"----------- Pattern.match ---------------------------------------";
160.19 +"----------- fun matches -----------------------------------------";
160.20 +"------------parse------------------------------------------------";
160.21 +"----------- uminus_to_string ------------------------------------";
160.22 +"-----------------------------------------------------------------";
160.23 +"-----------------------------------------------------------------";
160.24 +
160.25 +
160.26 +"----------- inst_bdv --------------------------------------------";
160.27 +"----------- inst_bdv --------------------------------------------";
160.28 +"----------- inst_bdv --------------------------------------------";
160.29 +if string_of_thm (num_str d1_isolate_add2) =
160.30 + "\"~ ?bdv occurs_in ?a ==> (?a + ?bdv = 0) = (?bdv = -1 * ?a)\"" then ()
160.31 +else raise error "term_G.sml d1_isolate_add2";
160.32 +val subst = [(str2term "bdv", str2term "x")];
160.33 +val t = (norm o #prop o rep_thm) (num_str d1_isolate_add2);
160.34 +val t' = inst_bdv subst t;
160.35 +if term2str t' = "~ x occurs_in ?a ==> (?a + x = 0) = (x = -1 * ?a)" then ()
160.36 +else raise error "term_G.sml inst_bdv 1";
160.37 +
160.38 +if string_of_thm (num_str separate_bdvs_add) =
160.39 + "\"[] from_ [?bdv_1.0, ?bdv_2.0, ?bdv_3.0, ?bdv_4.0] occur_exactly_in ?a\n\
160.40 + \ ==> (?a + ?b = ?c) = (?b = ?c + -1 * ?a)\"" then ()
160.41 +else raise error "term_G.sml separate_bdvs_add";
160.42 +val subst = [(str2term"bdv_1",str2term"c"),
160.43 + (str2term"bdv_2",str2term"c_2"),
160.44 + (str2term"bdv_3",str2term"c_3"),
160.45 + (str2term"bdv_4",str2term"c_4")];
160.46 +val t = (norm o #prop o rep_thm) (num_str separate_bdvs_add);
160.47 +val t' = inst_bdv subst t;
160.48 +if term2str t' = "[] from_ [c, c_2, c_3, c_4] occur_exactly_in ?a\n\
160.49 + \==> (?a + ?b = ?c) = (?b = ?c + -1 * ?a)" then ()
160.50 +else raise error "term_G.sml inst_bdv 2";
160.51 +
160.52 +
160.53 +"----------- subst_atomic_all ------------------------------------";
160.54 +"----------- subst_atomic_all ------------------------------------";
160.55 +"----------- subst_atomic_all ------------------------------------";
160.56 +val t = str2term"(tl vs_) from_ vs_ occur_exactly_in (nth_ 1(es_::bool list))";
160.57 +val env = [(str2term"vs_::real list",str2term"[c, c_2]"),
160.58 + (str2term"es_::bool list",str2term"[c_2=0, c+c_2=1]")];
160.59 +val (all_Free_subst, t') = subst_atomic_all env t;
160.60 +if all_Free_subst andalso
160.61 + term2str t' = "tl [c, c_2] from_ [c, c_2] occur_exactly_in nth_ 1 [c_2 = 0, c + c_2 = 1]" then ()
160.62 +else raise error "term_G.sml subst_atomic_all should be 'true'";
160.63 +
160.64 +
160.65 +val (all_Free_subst, t') = subst_atomic_all (tl env) t;
160.66 +if not all_Free_subst andalso
160.67 + term2str t' = "tl vs_ from_ vs_ occur_exactly_in nth_ 1 [c_2 = 0, c + c_2 = 1]" then ()
160.68 +else raise error "term_G.sml subst_atomic_all should be 'false'";
160.69 +
160.70 +
160.71 +"----------- Pattern.match ---------------------------------------";
160.72 +"----------- Pattern.match ---------------------------------------";
160.73 +"----------- Pattern.match ---------------------------------------";
160.74 +val t = (term_of o the o (parse thy)) "3 * x^^^2 = 1";
160.75 +val pat = (free2var o term_of o the o (parse thy)) "a * b^^^2 = c";
160.76 +(* !^^^^^^^^!... necessary for Pattern.match*)
160.77 +val insts = Pattern.match (Sign.tsig_of (sign_of thy)) (pat, t);
160.78 +(*val insts =
160.79 + ([],
160.80 + [(("c",0),Free ("1","RealDef.real")),(("b",0),Free ("x","RealDef.real")),
160.81 + (("a",0),Free ("3","RealDef.real"))])
160.82 + : (indexname * typ) list * (indexname * term) list*)
160.83 +
160.84 +"----- throws exn MATCH...";
160.85 +val t = str2term "x";
160.86 +(Pattern.match (Sign.tsig_of (sign_of thy)) (pat, t))
160.87 +handle MATCH => ([(* (Term.indexname * Term.typ) *)],
160.88 + [(* (Term.indexname * Term.term) *)]);
160.89 +Pattern.MATCH;
160.90 +
160.91 +(*ML {**)
160.92 +val thy = @{theory Complex_Main};
160.93 +val PARSE = Syntax.read_term_global thy;
160.94 +val (pa, tm) = (PARSE "a + b::real", PARSE "x + 2*z::real");
160.95 +"-------";
160.96 +val (tye, tme) =
160.97 + (Vartab.empty : Type.tyenv, Vartab.empty : Envir.tenv);
160.98 +"-------";
160.99 +val (tye, tme) = Pattern.match thy (Logic.varify pa, tm) (Vartab.empty,
160.100 + Vartab.empty);
160.101 +"-------";
160.102 +val (tyenv, tenv) = Pattern.match thy (Logic.varify pa, tm)
160.103 + (Vartab.empty, Vartab.empty);
160.104 +Vartab.dest tenv;
160.105 +match thy tm (Logic.varify pa);
160.106 +
160.107 +(**}*)
160.108 +
160.109 +"----------- fun matches -----------------------------------------";
160.110 +"----------- fun matches -----------------------------------------";
160.111 +"----------- fun matches -----------------------------------------";
160.112 +(*smltest/IsacKnowledge/polyeq.sml:
160.113 + Where=[Correct "matches (?a = 0) (-8 - 2 * x + x ^^^ 2 = 0)"*)
160.114 +(*smltest/ME/ptyps.sml:
160.115 + |\nmatches (?a + ?b * x = #0) ((x + #1) * (x + #2) = x ^^^ #2 + #8)"],*)
160.116 +(*ML {**)
160.117 +val thy = @{theory Complex_Main};
160.118 +"----- test 1";
160.119 +val pa = Logic.varify @{term "a = (0::real)"};
160.120 +"----- test 1 true";
160.121 +val tm = @{term "-8 - 2 * x + x ^ 2 = (0::real)"};
160.122 +if matches thy tm pa then ()
160.123 + else error "term_G.sml diff.behav. in matches true";
160.124 +"----- test 2 false";
160.125 +val tm = @{term "-8 - 2 * x + x ^ 2 = (3::real)"};
160.126 +if matches thy tm pa then error "term_G.sml diff.behav. in matches false"
160.127 + else ();
160.128 +(**}*)
160.129 +
160.130 +"------------parse------------------------------------------------";
160.131 +"------------parse------------------------------------------------";
160.132 +"------------parse------------------------------------------------";
160.133 +(*ML {**)
160.134 +Toplevel.debug := true;
160.135 +(* literal types:
160.136 +PolyML.addPrettyPrinter
160.137 + (fn _ => fn _ => ml_pretty o Pretty.to_ML o raw_pp_typ);
160.138 +*)(* pretty types:
160.139 +PolyML.addPrettyPrinter
160.140 + (fn _ => fn _ => ml_pretty o Pretty.to_ML o Proof_Display.pp_typ Pure.thy);
160.141 +print_depth 99;
160.142 +*)
160.143 +val thy = @{theory Complex_Main};
160.144 +val str = "x + z";
160.145 +parse thy str;
160.146 +"---------------";
160.147 +val str = "x + 2*z";
160.148 +val t = (Syntax.read_term_global thy str);
160.149 +val t = numbers_to_string (Syntax.read_term_global thy str);
160.150 +val t = (typ_a2real o numbers_to_string) (Syntax.read_term_global thy str);
160.151 +cterm_of thy t;
160.152 +val t = (the (parse thy str)) handle _ => error "term_G.sml parsing 'x + 2*z' failed";
160.153 +(**}*)
160.154 +(*Makarius.1003
160.155 +ML {* @{term "2::int"} *}
160.156 +
160.157 +term "(1.24444) :: real"
160.158 +
160.159 +ML {* numbers_to_string @{term "%x. (-9993::int) + x + 1"} *}
160.160 +*)
160.161 +
160.162 +
160.163 +"----------- uminus_to_string ------------------------------------";
160.164 +"----------- uminus_to_string ------------------------------------";
160.165 +"----------- uminus_to_string ------------------------------------";
160.166 +(*ML {*)
160.167 +val t1 = numbers_to_string @{term "-2::real"};
160.168 +val t2 = numbers_to_string @{term "- 2::real"};
160.169 +if uminus_to_string t2 = t1 then ()
160.170 +else error "term_G.sml diff.behav. in uminus_to_string";
160.171 +(*}*)
161.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
161.2 +++ b/src/Pure/isac/smltest/Scripts/tools.sml Wed Jul 21 13:53:39 2010 +0200
161.3 @@ -0,0 +1,27 @@
161.4 +(* tests on Tools
161.5 + author: Walther Neuper
161.6 + WN071229,
161.7 + (c) due to copyright terms
161.8 +
161.9 +use"../smltest/Scripts/tools.sml";
161.10 +use"tools.sml";
161.11 +*)
161.12 +val thy = Real.thy;
161.13 +
161.14 +"-----------------------------------------------------------------";
161.15 +"table of contents -----------------------------------------------";
161.16 +"-----------------------------------------------------------------";
161.17 +"----------- fun matchsub ----------------------------------------";
161.18 +"-----------------------------------------------------------------";
161.19 +"-----------------------------------------------------------------";
161.20 +"-----------------------------------------------------------------";
161.21 +
161.22 +
161.23 +"----------- fun matchsub ----------------------------------------";
161.24 +"----------- fun matchsub ----------------------------------------";
161.25 +"----------- fun matchsub ----------------------------------------";
161.26 +if matchsub thy (str2term "(a + (b + c))") (str2term "?x + (?y + ?z)")
161.27 +then () else raise error "tools.sml matchsub a + (b + c)";
161.28 +
161.29 +if matchsub thy (str2term "(a + (b + c)) + d") (str2term "?x + (?y + ?z)")
161.30 +then () else raise error "tools.sml matchsub (a + (b + c)) + d";
162.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
162.2 +++ b/src/Pure/isac/smltest/a-test-scope/Theory.ML Wed Jul 21 13:53:39 2010 +0200
162.3 @@ -0,0 +1,9 @@
162.4 +fun t_foo bar = bar
162.5 +
162.6 +structure TStruct =
162.7 +struct
162.8 +fun ts_foo bar = bar;
162.9 +end;
162.10 +
162.11 +@{thm refl};
162.12 +(*@{thm ta_foo}; *** (ta_foo) has not been declared*)
163.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
163.2 +++ b/src/Pure/isac/smltest/a-test-scope/Theory.thy Wed Jul 21 13:53:39 2010 +0200
163.3 @@ -0,0 +1,33 @@
163.4 +theory Theory
163.5 +imports Complex_Main
163.6 +uses ("c_code.sml") ("Theory.ML")
163.7 +begin
163.8 +
163.9 +global
163.10 +axioms
163.11 + ta_foo: "ta_foo"
163.12 +
163.13 +ML{* @{thm ta_foo} *}
163.14 +ML{* HOLogic.true_const *}(*KNOWN BECAUSE OF imports Complex_Main*)
163.15 +ML{* @{thm length_tl} *} (*KNOWN BECAUSE OF imports Complex_Main*)
163.16 +
163.17 +(*
163.18 +ML{*
163.19 +c_foo "is NOT known here";
163.20 +CStruct.cs_foo "is NOT known here";
163.21 +t_foo "is NOT known here";
163.22 +TStruct.ts_foo "is NOT known here";
163.23 +*}*)
163.24 +
163.25 +use "c_code.sml"
163.26 +ML{*
163.27 +c_foo "is known now";
163.28 +CStruct.cs_foo "is known now";
163.29 +*}
163.30 +
163.31 +use "Theory.ML"
163.32 +ML{*
163.33 +t_foo "is known now";
163.34 +TStruct.ts_foo "is known now";
163.35 +*}
163.36 +end
163.37 \ No newline at end of file
164.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
164.2 +++ b/src/Pure/isac/smltest/a-test-scope/boot.ML Wed Jul 21 13:53:39 2010 +0200
164.3 @@ -0,0 +1,3 @@
164.4 +use "file_2.sml"
164.5 +use_thy "file_3"
164.6 +use "file_4.ML"
164.7 \ No newline at end of file
165.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
165.2 +++ b/src/Pure/isac/smltest/a-test-scope/boot.thy Wed Jul 21 13:53:39 2010 +0200
165.3 @@ -0,0 +1,8 @@
165.4 +header {* test isac bootstrap *}
165.5 +theory boot imports Complex_Main
165.6 +begin
165.7 +use "c_code.sml"
165.8 +use_thy "Theory"
165.9 +use "Theory.ML"
165.10 +use "z_code.sml"
165.11 +end
166.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
166.2 +++ b/src/Pure/isac/smltest/a-test-scope/c_code.sml Wed Jul 21 13:53:39 2010 +0200
166.3 @@ -0,0 +1,7 @@
166.4 +(* some ML code *)
166.5 +fun c_foo bar = bar;
166.6 +
166.7 +structure CStruct =
166.8 +struct
166.9 +fun cs_foo bar = bar;
166.10 +end;
167.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
167.2 +++ b/src/Pure/isac/smltest/a-test-scope/z_code.sml Wed Jul 21 13:53:39 2010 +0200
167.3 @@ -0,0 +1,8 @@
167.4 +c_foo "c_foo is known without struct";
167.5 +CStruct.cs_foo "CStruct.cs_foo is known here";
167.6 +
167.7 +@{thm refl};
167.8 +(*@{thm ta_foo}; *** Unknown fact "ta_foo"*)
167.9 +
167.10 +t_foo "t_foo is known without struct";
167.11 +TStruct.ts_foo "TStruct.ts_foo is known here";
168.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
168.2 +++ b/src/Pure/isac/smltest/calcelems.sml Wed Jul 21 13:53:39 2010 +0200
168.3 @@ -0,0 +1,7 @@
168.4 +(* tests for sml/calcelems.sml
168.5 + author: Walther Neuper 060113
168.6 + (c) isac-team 2006
168.7 +
168.8 +use"../smltest/calcelems.sml";
168.9 +use"calcelems.sml";
168.10 +*)
169.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
169.2 +++ b/src/Pure/isac/smltest/library.sml Wed Jul 21 13:53:39 2010 +0200
169.3 @@ -0,0 +1,12 @@
169.4 +{*
169.5 +"--- Pure/General/ord_list.ML";
169.6 +union;
169.7 +union (op =) [1,2,3] [3,4,5];
169.8 +(*val it = [2, 1, 3, 4, 5] : int list*)
169.9 +"--- Pure/library.ML";
169.10 +(*> grep -R 'val' /usr/local/Isabelle2009-1/src/ | grep ':' | \
169.11 + grep merge | grep ' list$' | less*)
169.12 +merge;
169.13 +merge (op =) ([1,2,3], [3,4,5]);
169.14 +(*val it = [4, 5, 1, 2, 3] : int list*)
169.15 +*}
170.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
170.2 +++ b/src/Pure/isac/smltest/xmlsrc/datatypes.sml Wed Jul 21 13:53:39 2010 +0200
170.3 @@ -0,0 +1,49 @@
170.4 +(* test for sml/xmlsrc/datatypes.sml
170.5 + authors: Walther Neuper 2003
170.6 + (c) due to copyright terms
170.7 +
170.8 +use"../smltest/xmlsrc/datatypes.sml";
170.9 +use"datatypes.sml";
170.10 +*)
170.11 +
170.12 +"-----------------------------------------------------------------";
170.13 +"table of contents -----------------------------------------------";
170.14 +"-----------------------------------------------------------------";
170.15 +"----------- fun rules2xml ---------------------------------------";
170.16 +"----------- fun thm''2xml ---------------------------------------";
170.17 +"-----------------------------------------------------------------";
170.18 +"-----------------------------------------------------------------";
170.19 +"-----------------------------------------------------------------";
170.20 +
170.21 +
170.22 +
170.23 +"----------- fun rules2xml ---------------------------------------";
170.24 +"----------- fun rules2xml ---------------------------------------";
170.25 +"----------- fun rules2xml ---------------------------------------";
170.26 +show_thes();
170.27 +val thyID = "Test";
170.28 +val thydata = get_the ["IsacKnowledge", "Test", "Rulesets", "ac_plus_times"];
170.29 +val Hrls {thy_rls = (_,Rls {rules=rules as rule::_,...}),...} = thydata;
170.30 +
170.31 +(*for rule2xml...*)
170.32 +val (j, thyID, Thm (thmID, thm)) = (2, thyID, rule);
170.33 +val (isa, thyID') = thy_containing_thm thyID thmID;
170.34 +val guh = thm2guh (isa, thyID') thmID;
170.35 +writeln (rules2xml 2 "Test" rules);
170.36 +
170.37 +
170.38 +"----------- fun thm''2xml ---------------------------------------";
170.39 +"----------- fun thm''2xml ---------------------------------------";
170.40 +"----------- fun thm''2xml ---------------------------------------";
170.41 +show_thes();
170.42 +val theID = ["IsacKnowledge", "Diff", "Theorems", "frac_conv"];
170.43 +val thydata = get_the theID;
170.44 +val Hthm {guh=guh, thm=thm, mathauthors=ma, coursedesign=co} = thydata;
170.45 +writeln(thydata2xml (theID, thydata));
170.46 +"----- check 'manually' ...0 < ?n |] ==> ?a... -----";
170.47 +"----------------------------^^^---------^^^------------";
170.48 +
170.49 +
170.50 +
170.51 +(* use"../smltest/xmlsrc/datatypes.sml";
170.52 + *)
170.53 \ No newline at end of file
171.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
171.2 +++ b/src/Pure/isac/smltest/xmlsrc/mathml.sml Wed Jul 21 13:53:39 2010 +0200
171.3 @@ -0,0 +1,52 @@
171.4 +(* tests for mathml.sml
171.5 + author: Walther Neuper 060311
171.6 + (c) isac-team 2006
171.7 +
171.8 +use"../smltest/xmlsrc/mathml.sml";
171.9 +use"mathml.sml";
171.10 +*)
171.11 +"-----------------------------------------------------------------";
171.12 +"table of contents -----------------------------------------------";
171.13 +"-----------------------------------------------------------------";
171.14 +"within struct ---------------------------------------------------";
171.15 +"-----------------------------------------------------------------";
171.16 +"--------- encode ^^^ -> ^ ---------------------------------------";
171.17 +"--------- encode < -> < and > -> > --------------------------";
171.18 +"-----------------------------------------------------------------";
171.19 +"exported from struct --------------------------------------------";
171.20 +"-----------------------------------------------------------------";
171.21 +"--------- ... ---------------------------------------------------";
171.22 +"-----------------------------------------------------------------";
171.23 +
171.24 +
171.25 +
171.26 +"-----------------------------------------------------------------";
171.27 +"within struct ---------------------------------------------------";
171.28 +"-----------------------------------------------------------------";
171.29 +(*==================================================================*)
171.30 +
171.31 +
171.32 +"--------- encode ^^^ -> ^ ---------------------------------------";
171.33 +"--------- encode ^^^ -> ^ ---------------------------------------";
171.34 +"--------- encode ^^^ -> ^ ---------------------------------------";
171.35 +val str = "a^^^2+b^^^2=c^^^2";
171.36 +if decode str = "a^2+b^2=c^2" then ()
171.37 +else raise error "mathml.sml: diff.behav. in encode ^^^ -> ^";
171.38 +
171.39 +"--------- encode < -> < and > -> > --------------------------";
171.40 +"--------- encode < -> < and > -> > --------------------------";
171.41 +"--------- encode < -> < and > -> > --------------------------";
171.42 +val str = "?bdv occurs_in ?b; 0 < ?n |] ==> ?a / ?b ^ ?n = ?a * ?b ^ - ?n";
171.43 +if decode str =
171.44 + "?bdv occurs_in ?b; 0 < ?n |] ==> ?a / ?b ^ ?n = ?a * ?b ^ - ?n"
171.45 +then () else raise error "mathml.sml: diff.behav. in encode '<' and '>'";
171.46 +
171.47 +"----- check 'manually' the xml-output of calling functions ------";
171.48 +formula2xml 1 (str2term )
171.49 +
171.50 +(*==================================================================*)
171.51 +"-----------------------------------------------------------------";
171.52 +"exported from struct --------------------------------------------";
171.53 +"-----------------------------------------------------------------";
171.54 +
171.55 +
172.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
172.2 +++ b/src/Pure/isac/smltest/xmlsrc/pbl-met-hierarchy.sml Wed Jul 21 13:53:39 2010 +0200
172.3 @@ -0,0 +1,74 @@
172.4 +(* tests for sml/xmlsrc/pbl-met-hierarchy.sml
172.5 + author: Walther Neuper 060209
172.6 + (c) isac-team 2006
172.7 +
172.8 +use"../smltest/xmlsrc/pbl-met-hierarchy.sml";
172.9 +use"pbl-met-hierarchy.sml";
172.10 +
172.11 +CAUTION with testing *2file functions -- they are actually writing !!!
172.12 +*)
172.13 +
172.14 +val thy = Isac.thy;
172.15 +
172.16 +"-----------------------------------------------------------------";
172.17 +"table of contents -----------------------------------------------";
172.18 +"-----------------------------------------------------------------";
172.19 +"----------- pbl2xml ---------------------------------------------";
172.20 +"-----------------------------------------------------------------";
172.21 +"-----------------------------------------------------------------";
172.22 +"-----------------------------------------------------------------";
172.23 +
172.24 +
172.25 +
172.26 +"----------- pbl2xml ---------------------------------------------";
172.27 +"----------- pbl2xml ---------------------------------------------";
172.28 +"----------- pbl2xml ---------------------------------------------";
172.29 +(*what to do if from 'pbls2file "../../xmldata/pbl/";' you get the error
172.30 +
172.31 +### pbl2file: id = ["Biegelinie"]
172.32 +*** Type unification failed: Clash of types "fun" and "Script.ID".
172.33 +*** Type error in application: Incompatible operand type.
172.34 +***
172.35 +*** Operator: Problem :: ID * ID list => ??'a
172.36 +*** Operand: (Biegelinie, [Biegelinie]) ::
172.37 +*** ((real => real) => una) * ((real => real) => una) list
172.38 +***
172.39 +Exception- OPTION raised
172.40 +*)
172.41 +pbl2xml ["Biegelinien"] (get_pbt ["Biegelinien"]);
172.42 +(* val id = ["Biegelinie"];
172.43 + val {(*guh,*)cas,met,ppc,prls,thy,where_} = get_pbt ["Biegelinie"];
172.44 + AND STEP THROUGH pbl2xml ...
172.45 +
172.46 + term2xml i (pbl2term thy id);
172.47 + pbl2term thy id;
172.48 + *)
172.49 +(* val (thy, pblRD) = (thy, id);
172.50 + AND STEP THROUGH pbl2term...
172.51 +
172.52 + val str = ("Problem (" ^
172.53 + (get_thy o theory2domID) thy ^ ", " ^
172.54 + (strs2str' o rev) pblRD ^ ")");
172.55 + str2term str;
172.56 + str2term "Biegelinie";
172.57 + str2term "Biegelinien";
172.58 + *)
172.59 +(*Const
172.60 + ("Biegelinie.Biegelinie",
172.61 + "(RealDef.real => RealDef.real) => Tools.una") : Term.term
172.62 +..I.E. THE "Script.ID" _WAS_ ALREADY OCCUPIED BY A 'description'*)
172.63 +
172.64 +(*
172.65 +val path = "/home/neuper/proto2/isac/xmldata/";
172.66 +val path = "/home/neuper/tmp/";
172.67 +
172.68 +pbl_hierarchy2file (path ^ "pbl/");
172.69 +pbls2file (path ^ "pbl/");
172.70 +
172.71 +met_hierarchy2file (path ^ "met/");
172.72 +mets2file (path ^ "met/");
172.73 +
172.74 +thy_hierarchy2file (path ^ "thy/");
172.75 +thes2file (path ^ "thy/");
172.76 +*)
172.77 +
173.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
173.2 +++ b/src/Pure/isac/smltest/xmlsrc/thy-hierarchy.sml Wed Jul 21 13:53:39 2010 +0200
173.3 @@ -0,0 +1,266 @@
173.4 +(* tests for sml/xmlsrc/thy-hierarchy.sml
173.5 + authors: Walther Neuper 060113
173.6 + (c) due to copyright terms
173.7 +
173.8 +use"../smltest/xmlsrc/thy-hierarchy.sml";
173.9 +use"thy-hierarchy.sml";
173.10 +
173.11 +CAUTION with testing *2file functions -- they are actually writing to ~/tmp
173.12 +*)
173.13 +
173.14 +val thy = Isac.thy;
173.15 +
173.16 +"-----------------------------------------------------------------";
173.17 +"table of contents -----------------------------------------------";
173.18 +"-----------------------------------------------------------------";
173.19 +"----------- assoc_rls -------------------------------------------";
173.20 +"----------- thm_hier --------------------------------------------";
173.21 +"----------- fun thydata2xml -------------------------------------";
173.22 +"----------- write xml to tmp ------------------------------------";
173.23 +"----------- the_hier [] (collect_thyda.. NOT overwriting store_ -";
173.24 +"----------- ### thes2file ... Exception- Match raised -----------";
173.25 +"-----------------------------------------------------------------";
173.26 +"-----------------------------------------------------------------";
173.27 +"-----------------------------------------------------------------";
173.28 +
173.29 +
173.30 +"----------- assoc_rls -------------------------------------------";
173.31 +"----------- assoc_rls -------------------------------------------";
173.32 +"----------- assoc_rls -------------------------------------------";
173.33 +val al = [(1,11),(2,22),(3,33)];
173.34 +overwrite (al, (2,2222));
173.35 +(*val it = [(1, 11), (2, 2222), (3, 33)] : (int * int) list*)
173.36 +
173.37 +val al = [("e_rls",("Atools",e_rls)),("e_rrls",("Atools",e_rrls))];
173.38 +val bl = [("e_rls",e_rls),("e_rrls",e_rrls)];
173.39 +val b = ("e_rls",("Atools",e_rrls));
173.40 +overwrite (al, b);
173.41 +overwritelthy thy (al, bl);
173.42 +
173.43 +assoc' (!ruleset',"e_rls");
173.44 +assoc_rls "e_rls";
173.45 +
173.46 +
173.47 +"----------- thm_hier --------------------------------------------";
173.48 +"----------- thm_hier --------------------------------------------";
173.49 +"----------- thm_hier --------------------------------------------";
173.50 +(curry op:: "xxx") ["yyy","yyy","yyy"];
173.51 +map (curry op:: "xxx") [["yyy1"],["yyy2"],["yyy3"]];
173.52 +
173.53 +val thy' = "Integrate";
173.54 +val thy = assoc_thy (thyID2theory' thy');
173.55 +
173.56 +"collect_thms thy'------------------------------------------------";
173.57 +(thms_of thy);
173.58 +
173.59 +(apfst single) ("Integrate.integral_var", integral_var);
173.60 +
173.61 +(strip_thy o #1) ("Integrate.integral_var", integral_var);
173.62 +
173.63 +(*cannot get this as arg from arg ^^^^^^^^^^^^^^^^*)
173.64 + ("Integrate.integral_var", integral_var);
173.65 +(*thus new fun....*)
173.66 +
173.67 +makeHthm ("IsacKnowledge",thy') ("Integrate.integral_var", integral_var);
173.68 +(makeHthm ("IsacKnowledge",thy')) ("Integrate.integral_var", integral_var);
173.69 +map (makeHthm ("IsacKnowledge",thy')) (thms_of thy);
173.70 +collect_thms' ("IsacKnowledge",thy');
173.71 +
173.72 +"collect_rlss thy'------------------------------------------------";
173.73 +makeHrls "IsacKnowledge" ("integration_rules", (thy', integration_rules));
173.74 +
173.75 +val thy' = "Test";
173.76 +val rlss = filter ((curry op= thy') o
173.77 + ((#1 o #2):(rls' * (theory' * rls)) -> theory'))
173.78 + (!ruleset');
173.79 +collect_rlss ("IsacKnowledge",thy');
173.80 +
173.81 +"collect_thy thy-------------------------------------------------";
173.82 +val thy' = "ListG.thy";
173.83 +val thy = assoc_thy (thyID2theory' thy');
173.84 +((collect_thms' ("IsacKnowledge",thy')) @
173.85 + (collect_rlss ("IsacKnowledge",thy')) @
173.86 + (collect_cals ("IsacKnowledge",thy')) @
173.87 + (collect_ords ("IsacKnowledge",thy')));
173.88 +collect_thy "IsacKnowledge" thy';
173.89 +
173.90 +"collect_thydata -------------------------------------------------";
173.91 +(!isab_thm_thy);
173.92 +map rearrange_inv (!isab_thm_thy);
173.93 +(map ((apfst ((curry op:: "Isabelle") o single)) o rearrange_inv));
173.94 +(map ((apfst ((curry op:: "Isabelle") o single)) o rearrange_inv))
173.95 + (!isab_thm_thy);
173.96 +
173.97 +
173.98 +"thy_hierarchy ---------------------------------------------------";
173.99 +val theID = ["IsacScripts", "ListG", "Theorems", "append_Cons"]:theID;
173.100 +val thydat as (theID, thydata) =
173.101 + (theID, Hthm {guh=theID2guh theID, mathauthors=[],
173.102 + coursedesign=[], thm=append_Cons});
173.103 +
173.104 +val th = [] : thehier;
173.105 +val theID' = cut_theID th theID;
173.106 +val th = fill_parents th theID' theID;
173.107 +(* val th =
173.108 + [Ptyp ("IsacScripts",
173.109 + [Html {guh = "thy_ListG-thm-append_Cons", html = "", ...}],
173.110 + [Ptyp ("ListG", ...)])] : thehier *)
173.111 +(*show_thes*)(writeln o format_pblIDl o (scan [])) th;
173.112 +writeln (hierarchy_guh th);
173.113 +
173.114 +val th = [] : thehier;
173.115 +val thydats = collect_thydata ();
173.116 +val th1 = the_hier th thydats (**** insert: not found [".. from fill_parents*);
173.117 +(*show_thes*)(writeln o format_pblIDl o (scan [])) th1;
173.118 +
173.119 +writeln (hierarchy_guh th);
173.120 +writeln (hierarchy_guh th1);
173.121 +
173.122 +"thy_hierarchy2file ----------------------------------------------";
173.123 +show_thes();
173.124 +(*
173.125 +val path = "/home/neuper/tmp/";
173.126 +thy_hierarchy2file path;
173.127 +*)
173.128 +
173.129 +get_the ["IsacKnowledge"];
173.130 +get_the ["IsacKnowledge", "Test"];
173.131 +get_the ["IsacKnowledge", "Test", "Theorems"];
173.132 +get_the ["IsacKnowledge", "Test", "Theorems", "exp_pow"];
173.133 +
173.134 +get_the ["IsacKnowledge", "Test", "Rulesets"];
173.135 +
173.136 +(* FIXXXXXXXXXME.WN060713 guh -- theID
173.137 +case get_the ["IsacKnowledge", "Test", "Rulesets", "Test_simplify"] of
173.138 + Hrls {guh = "thy_Test-rls-Test_simplify",thy_rls = ("Test", _),
173.139 + mathauthors = _,coursedesign = _} => ()
173.140 + | _ => raise error "thy-hierarchy.sml: [IsacKnowledge,Test,Rulesets]";
173.141 +*)
173.142 +
173.143 +
173.144 +"----------- fun thydata2xml -------------------------------------";
173.145 +"----------- fun thydata2xml -------------------------------------";
173.146 +"----------- fun thydata2xml -------------------------------------";
173.147 +val theID = ["IsacScripts", "ListG", "Theorems", "append_Cons"];
173.148 +val thmdata = get_the theID;
173.149 +writeln(thydata2xml (theID, thmdata));
173.150 +
173.151 +val theID = ["IsacKnowledge", "Poly", "Rulesets", "norm_Poly"];
173.152 +val rlsdata = get_the theID;
173.153 +writeln(thydata2xml (theID, rlsdata));
173.154 +
173.155 +(*FIXXXXXXXME.WN060714 in rls make Calc : calc -> rule [add scriptop!]
173.156 + see sml/../datatypes.sml !
173.157 +val (thy', rls') = ("DiffApp.thy", "Tools.rhs");
173.158 +thy_containing_rls thy' rls';
173.159 +print_depth 99; map #1 startsearch; print_depth 3;
173.160 +*)
173.161 +
173.162 +(*
173.163 +val path = "/home/neuper/tmp/";
173.164 +thes2file path;
173.165 +*)
173.166 +
173.167 +"----------- write xml to tmp ------------------------------------";
173.168 +"----------- write xml to tmp ------------------------------------";
173.169 +"----------- write xml to tmp ------------------------------------";
173.170 +(*
173.171 +val path = "/home/neuper/tmp/";
173.172 +
173.173 +pbl_hierarchy2file (path ^ "pbl/");
173.174 +pbls2file (path ^ "pbl/");
173.175 +
173.176 +met_hierarchy2file (path ^ "met/");
173.177 +mets2file (path ^ "met/");
173.178 +
173.179 +thy_hierarchy2file (path ^ "thy/");
173.180 +thes2file (path ^ "thy/");
173.181 +*)
173.182 +
173.183 +
173.184 +"----------- the_hier [] (collect_thyda.. NOT overwriting store_ -";
173.185 +"----------- the_hier [] (collect_thyda.. NOT overwriting store_ -";
173.186 +"----------- the_hier [] (collect_thyda.. NOT overwriting store_ -";
173.187 +(*
173.188 +store_isa ["Isabelle"] ["THIS SHOULD not BE OBERWRITTEN below"];
173.189 +print_depth 99; get_the ["Isabelle"]; print_depth 3;
173.190 +print_depth 5; thehier; print_depth 3;
173.191 +
173.192 +thehier := the_hier (!thehier) (collect_thydata ());
173.193 +print_depth 99; get_the ["Isabelle"]; print_depth 3;
173.194 +print_depth 5; thehier; print_depth 3;
173.195 +*)
173.196 +
173.197 +case get_the ["IsacKnowledge", "Biegelinie", "Theorems"] of
173.198 + Html {mathauthors =
173.199 + ["Walther Neuper 2005 supported by a grant from NMI Austria"],...}=>()
173.200 + | _ => raise error "thy-hierarchy.sml: store_isa overwritten";
173.201 +
173.202 +case get_the ["IsacKnowledge","Biegelinie","Theorems","Belastung_Querkraft"] of
173.203 + Hthm {mathauthors =
173.204 + ["Walther Neuper 2005 supported by a grant from NMI Austria"],...}=>()
173.205 + | _ => raise error "thy-hierarchy.sml: store_isa overwritten";
173.206 +
173.207 +(*
173.208 +print_depth 7;
173.209 +get_the ["IsacKnowledge","Biegelinie","Theorems","Belastung_Querkraft"];
173.210 +print_depth 3;
173.211 +*)
173.212 +
173.213 +(*WN060728 strange behaviour:
173.214 +### fun the_hier reports these not overwritten ?!?...(stored twice ?!?) ...
173.215 +
173.216 +val it = () : unit
173.217 +*** insert: preserved ["Isabelle","RealDef","Theorems","real_mult_assoc"]
173.218 +*** insert: preserved ["Isabelle","RealDef","Theorems","real_add_assoc"]
173.219 +*** insert: preserved ["Isabelle","RealBin","Theorems","real_mult_minus1"]
173.220 +*** insert: preserved ["Isabelle","RealBin","Theorems","real_mult_2"]
173.221 +*** insert: preserved ["Isabelle","RealDef","Theorems","real_mult_assoc"]
173.222 +*** insert: preserved ["Isabelle","RealDef","Theorems","real_mult_minus_eq1"]
173.223 +*** insert: preserved ["Isabelle","RealDef","Theorems","real_add_assoc"]
173.224 +*** insert: preserved ["Isabelle","RealDef","Theorems","real_minus_divide_eq"]
173.225 +*** insert: preserved ["IsacScripts","ListG","Theorems","induct"]
173.226 +*** insert: preserved ["IsacScripts","ListG","Theorems","simps_1"]
173.227 +*** insert: preserved ["IsacScripts","ListG","Theorems","simps_2"]
173.228 +val it = () : unit
173.229 +
173.230 +### but those store_*d in Biegelinie.ML are NOT reported !?!?!?!?!?!?!
173.231 +### however, '*** insert: not found' is NOT reported below, too....
173.232 +
173.233 +----------------------------------
173.234 +*** insert: not found ... IS OK :
173.235 +comes from fill_parents
173.236 +----------------------------------
173.237 +
173.238 +val it = () : unit
173.239 +*** insert: not found ["Isabelle","NatDef","Theorems","le_refl"]
173.240 +*** insert: not found ["Isabelle","NatDef","Theorems","le_refl"]*)
173.241 +
173.242 +"----------- ### thes2file ... Exception- Match raised -----------";
173.243 +"----------- ### thes2file ... Exception- Match raised -----------";
173.244 +"----------- ### thes2file ... Exception- Match raised -----------";
173.245 +writeln "what to do when you get,e.g. \n\
173.246 +\### thes2file: id = [\"IsacKnowledge\",\"Integrate\",\"Rulesets\"]\n\
173.247 +\### thes2file: id = [\"IsacKnowledge\",\"Integrate\",\"Rulesets\",\"integration_rules\"]\n\
173.248 +\### thes2file: id = [\"IsacKnowledge\",\"Integrate\",\"Rulesets\",\"add_new_c\"]\n\
173.249 +\Exception- Match raised";
173.250 +
173.251 +val ptyp = hd (!thehier);
173.252 +val theID = ["IsacKnowledge","Integrate","Rulesets","add_new_c"];
173.253 +val thydata = get_the theID;
173.254 +(* creates a file ...
173.255 +thydata2file "~/tmp/"[] theID thydata (*reports Exception- Match in question*);
173.256 +*)
173.257 +thydata2xml (theID, thydata) (*reports Exception- Match in question*);
173.258 +val (theID:theID, Hrls {guh, coursedesign, mathauthors, thy_rls}) =
173.259 + (theID, thydata);
173.260 +rls2xml i thy_rls (*reports Exception- Match in question*);
173.261 +val (j, (thyID, Seq data)) = (i, thy_rls);
173.262 +(* evaluate this local fun ...
173.263 +rls2xm j (thyID, "Seq", data) (*reports Exception- Match in question*);
173.264 +*)
173.265 +val (j, (thyID, seqrls, {id, preconds, rew_ord=(ord,_), erls,
173.266 + srls, calc, rules, scr})) =
173.267 + (j, (thyID, "Seq", data));
173.268 +rules2xml (j+2*i) thyID rules (*reports Exception- Match in question*);
173.269 +
174.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
174.2 +++ b/src/Pure/isac/xmlsrc/datatypes.sml Wed Jul 21 13:53:39 2010 +0200
174.3 @@ -0,0 +1,843 @@
174.4 +(* convert sml-datatypes to xml
174.5 + authors: Walther Neuper 2003
174.6 + (c) due to copyright terms
174.7 +
174.8 +use"xmlsrc/datatypes.sml";
174.9 +use"datatypes.sml";
174.10 +*)
174.11 +
174.12 +signature DATATYPES =
174.13 + sig
174.14 + val authors2xml : int -> string -> string list -> xml
174.15 + val calc2xml : int -> thyID * calc -> xml
174.16 + val calcrefs2xml : int -> thyID * calc list -> xml
174.17 + val contthy2xml : int -> contthy -> xml
174.18 + val extref2xml : int -> string -> string -> xml
174.19 + val filterpbl :
174.20 + ''a -> (''a * (Term.term * Term.term)) list -> Term.term list
174.21 + val formula2xml : int -> Term.term -> xml
174.22 + val formulae2xml : int -> Term.term list -> xml
174.23 + val i : int
174.24 + val id2xml : int -> string list -> string
174.25 + val ints2xml : int -> int list -> string
174.26 + val itm_2xml : int -> SpecifyTools.itm_ -> xml
174.27 + val itms2xml :
174.28 + int ->
174.29 + (int * SpecifyTools.vats * bool * string * SpecifyTools.itm_) list ->
174.30 + string
174.31 + val keref2xml : int -> ketype -> kestoreID -> xml
174.32 + val model2xml :
174.33 + int -> SpecifyTools.itm list -> (bool * Term.term) list -> xml
174.34 + val modspec2xml : int -> ocalhd -> xml
174.35 + val pattern2xml :
174.36 + int ->
174.37 + (string * (Term.term * Term.term)) list -> Term.term list -> string
174.38 + val pos'2xml : int -> string * (int list * pos_) -> string
174.39 + val pos'calchead2xml : int -> pos' * ocalhd -> xml
174.40 + val pos_2xml : int -> pos_ -> string
174.41 + val posform2xml : int -> pos' * Term.term -> xml
174.42 + val posformhead2xml : int -> pos' * ptform -> string
174.43 + val posformheads2xml : int -> (pos' * ptform) list -> xml
174.44 + val posforms2xml : int -> (pos' * Term.term) list -> xml
174.45 + val posterms2xml : int -> (pos' * term) list -> xml
174.46 + val precond2xml : int -> bool * Term.term -> xml
174.47 + val preconds2xml : int -> (bool * Term.term) list -> xml
174.48 + val rls2xml : int -> thyID * rls -> xml
174.49 + val rule2xml : int -> guh -> rule -> xml
174.50 + val rules2xml : int -> guh -> rule list -> xml
174.51 + val scr2xml : int -> scr -> xml
174.52 + val spec2xml : int -> spec -> xml
174.53 + val sub2xml : int -> Term.term * Term.term -> xml
174.54 + val subs2xml : int -> subs -> xml
174.55 + val subst2xml : int -> subst -> xml
174.56 + val tac2xml : int -> tac -> xml
174.57 + val tacs2xml : int -> tac list -> xml
174.58 + val theref2xml : int -> thyID -> string -> xstring -> string
174.59 + val thm'2xml : int -> thm' -> xml
174.60 + val thm''2xml : int -> thm -> xml
174.61 + val thmstr2xml : int -> string -> xml
174.62 + end
174.63 +
174.64 +
174.65 +
174.66 +(*------------------------------------------------------------------*)
174.67 +structure datatypes:DATATYPES =
174.68 +struct
174.69 +(*------------------------------------------------------------------*)
174.70 +
174.71 +val i = indentation;
174.72 +
174.73 +(** general types: lists, **)
174.74 +
174.75 +(*.handles string list like 'fun id2xml'.*)
174.76 +fun authors2xml j str auts =
174.77 + let fun autx _ [] = ""
174.78 + | autx j (s::ss) = (indt j) ^ "<STRING> " ^ s ^ " </STRING>\n" ^
174.79 + (autx j ss)
174.80 + in indt j ^ "<"^str^">\n" ^
174.81 + autx (j + i) auts ^
174.82 + indt j ^ "</"^str^">\n" : xml
174.83 + end;
174.84 +(* writeln(authors2xml 2 "MATHAUTHORS" []);
174.85 + writeln(authors2xml 2 "MATHAUTHORS"
174.86 + ["isac-team 2001", "Richard Lang 2003"]);
174.87 + *)
174.88 +
174.89 +fun id2xml j ids =
174.90 + let fun id2x _ [] = ""
174.91 + | id2x j (s::ss) = (indt j) ^ "<STRING> " ^ s ^ " </STRING>\n" ^
174.92 + (id2x j ss)
174.93 + in (indt j) ^ "<STRINGLIST>\n" ^
174.94 + (id2x (j + indentation) ids) ^
174.95 + (indt j) ^ "</STRINGLIST>\n" end;
174.96 +(* writeln(id2xml 8 ["linear","univariate","equation"]);
174.97 + <STRINGLIST>
174.98 + <STRING>linear</STRING>
174.99 + <STRING>univariate</STRING>
174.100 + <STRING>equation</STRING>
174.101 + </STRINGLIST>*)
174.102 +
174.103 +fun ints2xml j ids =
174.104 + let fun int2x _ [] = ""
174.105 + | int2x j (s::ss) = (indt j) ^"<INT> "^ string_of_int s ^" </INT>\n"^
174.106 + (int2x j ss)
174.107 + in (indt j) ^ "<INTLIST>\n" ^
174.108 + (int2x (j + i) ids) ^
174.109 + (indt j) ^ "</INTLIST>\n" end;
174.110 +(* writeln(ints2xml 3 [1,2,3]);
174.111 + *)
174.112 +
174.113 +
174.114 +(** isac datatypes **)
174.115 +
174.116 +fun pos_2xml j pos_ =
174.117 + (indt j) ^ "<POS> " ^ pos_2str pos_ ^ " </POS>\n";
174.118 +
174.119 +(*.due to specialties of isac/util/parser/XMLParseDigest.java
174.120 + pos' requires different tags.*)
174.121 +fun pos'2xml j (tag, (pos, pos_)) =
174.122 + indt (j) ^ "<" ^ tag ^ ">\n" ^
174.123 + ints2xml (j+i) pos ^
174.124 + pos_2xml (j+i) pos_ ^
174.125 + indt (j) ^ "</" ^ tag ^ ">\n";
174.126 +(* writeln(pos'2xml 3 ("POSITION", ([1,2,3], Pbl)));
174.127 + *)
174.128 +
174.129 +fun formula2xml j term = (*TODO.WN050211: use for _all_ <FORMULA>*)
174.130 + indt j ^ "<FORMULA>\n"^
174.131 + term2xml j term ^"\n"^
174.132 + indt j ^ "</FORMULA>\n" : xml;
174.133 +(* writeln(formula2xml 6 (str2term "1+1=2"));
174.134 + *)
174.135 +fun formulae2xml j [] = ("":xml)
174.136 + | formulae2xml j (r::rs) = formula2xml j r ^ formulae2xml j rs;
174.137 +(* writeln(formulae2xml 6 [str2term "1+1=2", str2term "1+1+1=3"]);
174.138 + *)
174.139 +
174.140 +(*WN0502 @see ME/ctree: type asms: illdesigned, thus not used*)
174.141 +fun posform2xml j (p:pos', term) =
174.142 + indt j ^ "<POSFORM>\n" ^
174.143 + pos'2xml (j+i) ("POSITION", p) ^
174.144 + indt (j+i) ^ "<FORMULA>\n"^
174.145 + term2xml (j+i) term ^"\n"^
174.146 + indt (j+i) ^ "</FORMULA>\n"^
174.147 + indt j ^ "</POSFORM>\n" : xml;
174.148 +(* writeln(posform2xml 6 (([1,2],Frm), str2term "1+1=2"));
174.149 + *)
174.150 +fun posforms2xml j [] = ("":xml)
174.151 + | posforms2xml j (r::rs) = posform2xml j r ^ posforms2xml j rs;
174.152 +(* writeln(posforms2xml 6 [(([1],Res), str2term "1+1=2"),(([2],Res), str2term "1+1+1=3")]);
174.153 + *)
174.154 +
174.155 +fun calcref2xml j (thyID:thyID, (scrop, (rewop, _)):calc) =
174.156 + indt j ^ "<CALCREF>\n" ^
174.157 + indt (j+i) ^ "<STRING> " ^ scrop ^ "</STRING>\n" ^
174.158 + indt (j+i) ^ "<GUH> " ^ cal2guh ("IsacKnowledge",
174.159 + thyID) scrop ^ " </GUH>\n" ^
174.160 + indt j ^ "</CALCREF>\n" : xml;
174.161 +fun calcrefs2xml _ (_,[]) = "":xml
174.162 + | calcrefs2xml j (thyID, cal::cs) =
174.163 + calcref2xml j (thyID, cal) ^ calcrefs2xml j (thyID, cs);
174.164 +
174.165 +fun calc2xml j (thyID:thyID, (scrop, (rewop, _)):calc) =
174.166 + indt j ^ "<CALC>\n" ^
174.167 + indt (j+i) ^ "<STRING>\n" ^ scrop ^ "</STRING>\n" ^
174.168 + indt (j+i) ^ "<GUH>\n" ^ cal2guh ("IsacKnowledge",
174.169 + thyID) scrop ^ "</GUH>\n" ^
174.170 + indt (j+i) ^ "<TERMOP>\n" ^ rewop ^ "</TERMOP>\n" ^
174.171 + indt j ^ "</CALC>\n" : xml;
174.172 +
174.173 +(*.for creating a href for a rule within an rls's rule list;
174.174 + the guh points to the thy of definition of the rule, NOT of use in rls.*)
174.175 +fun rule2xml j (thyID:thyID) Erule =
174.176 + raise error "rule2xml called with 'Erule'"
174.177 +(* val (j, thyID, Thm (thmID, thm)) = (j+i, thyID, nth 1 rules);
174.178 + val (j, thyID, Thm (thmID, thm)) = (j, thyID,r);
174.179 + *)
174.180 + | rule2xml j thyID (Thm (thmID, thm)) =
174.181 + indt j ^ "<RULE>\n" ^
174.182 + indt (j+i) ^ "<TAG> Theorem </TAG>\n" ^
174.183 + indt (j+i) ^ "<STRING> " ^ thmID ^ " </STRING>\n" ^
174.184 + indt (j+i) ^ "<GUH> " ^ thm2guh (thy_containing_thm thyID thmID)
174.185 + thmID ^ " </GUH>\n" ^
174.186 + indt j ^ "</RULE>\n" : xml
174.187 +(* val (j, thyID, Calc (termop, _)) = (j+i, thyID, nth 42 rules);
174.188 + val (j, thyID, Calc (termop, _)) = (j+i, thyID, nth 43 rules);
174.189 + *)
174.190 + | rule2xml j thyID (Calc (termop, _)) = ""
174.191 +(*FIXXXXXXXME.WN060714 in rls make Calc : calc -> rule [add scriptop!]
174.192 + see smltest/../datatypes.sml !
174.193 + indt j ^ "<RULE>\n" ^
174.194 + indt (j+i) ^ "<STRING> " ^ termop ^ " </STRING>\n" ^
174.195 + indt (j+i) ^ "<GUH> " ^ cal2guh (thy_containing_cal thyID termop)
174.196 + termop ^ " </GUH>\n" ^
174.197 + indt j ^ "</RULE>\n"
174.198 +*)
174.199 + | rule2xml j thyID (Cal1 (termop, _)) = ""
174.200 + | rule2xml j thyID (Rls_ rls) =
174.201 + let val rls' = (#id o rep_rls) rls
174.202 + in indt j ^ "<RULE>\n" ^
174.203 + indt (j+i) ^ "<TAG> Ruleset </TAG>\n" ^
174.204 + indt (j+i) ^ "<STRING> " ^ rls' ^ " </STRING>\n" ^
174.205 + indt (j+i) ^ "<GUH> " ^ rls2guh (thy_containing_rls thyID rls')
174.206 + rls' ^ " </GUH>\n" ^
174.207 + indt j ^ "</RULE>\n"
174.208 + end;
174.209 +(* val (j, thyID, r::rs) = (2, "Test", rules);
174.210 + *)
174.211 +fun rules2xml j thyID [] = ("":xml)
174.212 + | rules2xml j thyID (r::rs) = rule2xml j thyID r ^ rules2xml j thyID rs;
174.213 +
174.214 +fun filterpbl str =
174.215 + let fun filt [] = []
174.216 + | filt ((s, (t1, t2)) :: ps) =
174.217 + if str = s then (t1 $ t2) :: filt ps else filt ps
174.218 + in filt end;
174.219 +
174.220 +(*FIXME.WN040831 model2xml <--?--> pattern2xml*)
174.221 +(*WN.25.8.03: pattern2xml different output with TextIO | writeln !!!
174.222 + the version below is for TextIO: terms2xml makes \n !*)
174.223 +(* val (j, p, where_) = (i, ppc, where_);
174.224 + *)
174.225 +fun pattern2xml j p where_ =
174.226 + (case filterpbl "#Given" p of
174.227 + [] => (indt j) ^ "<GIVEN> </GIVEN>\n"
174.228 +(* val gis = filterpbl "#Given" p;
174.229 + *)
174.230 + | gis => (indt j) ^ "<GIVEN>\n" ^ terms2xml' j gis ^
174.231 + (indt j) ^ "</GIVEN>\n")
174.232 + ^
174.233 + (case where_ of
174.234 + [] => (indt j) ^ "<WHERE> </WHERE>\n"
174.235 + | whs => (indt j) ^ "<WHERE>\n" ^ terms2xml' j whs ^
174.236 + (indt j) ^ "</WHERE>\n")
174.237 + ^
174.238 + (case filterpbl "#Find" p of
174.239 + [] => (indt j) ^ "<FIND> </FIND>\n"
174.240 + | fis => (indt j) ^ "<FIND>\n" ^ terms2xml' j fis ^
174.241 + (indt j) ^ "</FIND>\n")
174.242 + ^
174.243 + (case filterpbl "#Relate" p of
174.244 + [] => (indt j) ^ "<RELATE> </RELATE>\n"
174.245 + | res => (indt j) ^ "<RELATE>\n" ^ terms2xml' j res ^
174.246 + (indt j) ^ "</RELATE>\n");
174.247 +(*
174.248 +writeln(pattern2xml 3 ((#ppc o get_pbt)
174.249 + ["squareroot","univariate","equation","test"]) []);
174.250 + *)
174.251 +
174.252 +(*see itm_2item*)
174.253 +fun itm_2xml j (Cor (dts,_))=
174.254 + (indt j ^"<ITEM status=\"correct\">\n"^
174.255 + term2xml (j) (comp_dts' dts)^"\n"^
174.256 + indt j ^"</ITEM>\n"):xml
174.257 + | itm_2xml j (Syn c) =
174.258 + indt j ^"<ITEM status=\"syntaxerror\">\n"^
174.259 + indt (j) ^c^
174.260 + indt j ^"</ITEM>\n"
174.261 + | itm_2xml j (Typ c) =
174.262 + indt j ^"<ITEM status=\"typeerror\">\n"^
174.263 + indt (j) ^c^
174.264 + indt j ^"</ITEM>\n"
174.265 + (*type item also has 'False of cterm' set in preconds2xml WN 050618*)
174.266 + | itm_2xml j (Inc (dts,_)) =
174.267 + indt j ^"<ITEM status=\"incomplete\">\n"^
174.268 + term2xml (j) (comp_dts' dts)^"\n"^
174.269 + indt j ^"</ITEM>\n"
174.270 + | itm_2xml j (Sup dts) =
174.271 + indt j ^"<ITEM status=\"superfluous\">\n"^
174.272 + term2xml (j) (comp_dts' dts)^"\n"^
174.273 + indt j ^"</ITEM>\n"
174.274 + | itm_2xml j (Mis (d,pid)) =
174.275 + indt j ^"<ITEM status=\"missing\">\n"^
174.276 + term2xml (j) (d $ pid)^"\n"^
174.277 + indt j ^"</ITEM>\n";
174.278 +
174.279 +(*see terms2xml' fpr \n*)
174.280 +fun itms2xml _ [] = ""
174.281 + | itms2xml j [(_,_,_,_,itm_)] = itm_2xml j itm_
174.282 + | itms2xml j (((_,_,_,_,itm_):itm)::itms) =
174.283 + itm_2xml j itm_ ^ itms2xml j itms;
174.284 +
174.285 +fun precond2xml j (true, term) =
174.286 + (indt j ^"<ITEM status=\"correct\">\n"^
174.287 + term2xml (j) term^"\n"^
174.288 + indt j ^"</ITEM>\n"):xml
174.289 + | precond2xml j (false, term) =
174.290 + indt j ^"<ITEM status=\"false\">\n"^
174.291 + term2xml (j+i) term^"\n"^
174.292 + indt j ^"</ITEM>\n";
174.293 +
174.294 +fun preconds2xml _ [] = ("":xml)
174.295 + | preconds2xml j (p::ps) = precond2xml j p ^ preconds2xml j ps;
174.296 +
174.297 +(*FIXME.WN040831 model2xml <--?--> pattern2xml*)
174.298 +fun model2xml j (itms:itm list) where_ =
174.299 + let fun eq4 str (_,_,_,field,_) = str = field
174.300 + in (indt j ^"<MODEL>\n"^
174.301 + (case filter (eq4 "#Given") itms of
174.302 + [] => (indt (j+i)) ^ "<GIVEN> </GIVEN>\n"
174.303 + | gis => (indt (j+i)) ^ "<GIVEN>\n" ^ itms2xml (j+2*i) gis ^
174.304 + (indt (j+i)) ^ "</GIVEN>\n")
174.305 + ^
174.306 + (case where_ of
174.307 + [] => (indt (j+i)) ^ "<WHERE> </WHERE>\n"
174.308 + | whs => (indt (j+i)) ^ "<WHERE>\n" ^ preconds2xml (j+2*i) whs ^
174.309 + (indt (j+i)) ^ "</WHERE>\n")
174.310 + ^
174.311 + (case filter (eq4 "#Find") itms of
174.312 + [] => (indt (j+i)) ^ "<FIND> </FIND>\n"
174.313 + | fis => (indt (j+i)) ^ "<FIND>\n" ^ itms2xml (j+2*i) fis ^
174.314 + (indt (j+i)) ^ "</FIND>\n")
174.315 + ^
174.316 + (case filter (eq4 "#Relate") itms of
174.317 + [] => (indt (j+i)) ^ "<RELATE> </RELATE>\n"
174.318 + | res => (indt (j+i)) ^ "<RELATE>\n" ^ itms2xml (j+2*i) res ^
174.319 + (indt (j+i)) ^ "</RELATE>\n")^
174.320 + indt j ^"</MODEL>\n"):xml
174.321 + end;
174.322 +(* writeln(model2xml 3 itms []);
174.323 + *)
174.324 +
174.325 +fun spec2xml j ((dI,pI,mI):spec) =
174.326 + (indt j ^"<SPECIFICATION>\n"^
174.327 + indt (j+i) ^"<THEORYID> "^ dI ^" </THEORYID>\n"^
174.328 + indt (j+i) ^"<PROBLEMID>\n"^
174.329 + id2xml (j+2*i) pI ^
174.330 + indt (j+i) ^"</PROBLEMID>\n"^
174.331 + indt (j+i) ^"<METHODID>\n"^
174.332 + id2xml (j+2*i) mI ^
174.333 + indt (j+i) ^"</METHODID>\n"^
174.334 + indt j ^"</SPECIFICATION>\n"):xml;
174.335 +
174.336 +fun modspec2xml j ((b, p_, head, gfr, pre, spec): ocalhd) =
174.337 + (indt j ^"<CALCHEAD status = "^
174.338 + quote (if b then "correct" else "incorrect")^">\n"^
174.339 + indt (j+i) ^"<HEAD>\n"^
174.340 + term2xml (j+i) head^"\n"^
174.341 + indt (j+i) ^"</HEAD>\n"^
174.342 + model2xml (j+i) gfr pre ^
174.343 + indt (j+i) ^"<BELONGSTO> "^(case p_ of Pbl => "Pbl"
174.344 + | Met => "Met"
174.345 + | _ => "Und")^" </BELONGSTO>\n"^
174.346 + spec2xml (j+i) spec ^
174.347 + indt j ^"</CALCHEAD>\n"):xml;
174.348 +(* writeln (modspec2xml 2 e_ocalhd);
174.349 + *)
174.350 +fun pos'calchead2xml j (p:pos', (b, p_, head, gfr, pre, spec): ocalhd) =
174.351 + (indt j ^"<CALCHEAD status = "^
174.352 + quote (if b then "correct" else "incorrect")^">\n"^
174.353 + pos'2xml (j+i) ("POSITION", p) ^
174.354 + indt (j+i) ^"<HEAD>\n"^
174.355 + term2xml (j+i) head^"\n"^
174.356 + indt (j+i) ^"</HEAD>\n"^
174.357 + model2xml (j+i) gfr pre ^
174.358 + indt (j+i) ^"<BELONGSTO> "^(case p_ of Pbl => "Pbl"
174.359 + | Met => "Met"
174.360 + | _ => "Und")^" </BELONGSTO>\n"^
174.361 + spec2xml (j+i) spec ^
174.362 + indt j ^"</CALCHEAD>\n"):xml;
174.363 +
174.364 +fun sub2xml j (id, value) =
174.365 + (indt j ^"<PAIR>\n"^
174.366 + indt j ^" <VARIABLE>\n"^
174.367 + term2xml (j+i) id ^ "\n" ^
174.368 + indt j ^" </VARIABLE>\n" ^
174.369 + indt j ^" <VALUE>\n"^
174.370 + term2xml (j+i) value ^ "\n" ^
174.371 + indt j ^" </VALUE>\n" ^
174.372 + indt j ^"</PAIR>\n"):xml;
174.373 +fun subs2xml j (subs:subs) =
174.374 + (indt j ^"<SUBSTITUTION>\n"^
174.375 + foldl op^ ("", map (sub2xml (j+i))
174.376 + (subs2subst (assoc_thy "Isac.thy") subs)) ^
174.377 + indt j ^"</SUBSTITUTION>\n"):xml;
174.378 +(* val subs = [(str2term "bdv", str2term "x")];
174.379 + val subs = ["(bdv, x)"];
174.380 + writeln(subs2xml 0 subs);
174.381 + *)
174.382 +fun subst2xml j (subst:subst) =
174.383 + (indt j ^"<SUBSTITUTION>\n"^
174.384 + foldl op^ ("", map (sub2xml (j+i)) subst) ^
174.385 + indt j ^"</SUBSTITUTION>\n"):xml;
174.386 +(* val subst = [(str2term "bdv", str2term "x")];
174.387 + writeln(subst2xml 0 subst);
174.388 + *)
174.389 +
174.390 +(* val (j, str) = ((j+i), form);
174.391 + *)
174.392 +fun thmstr2xml j str = ((((term2xml j) o str2term) str)^"\n"):xml;
174.393 +
174.394 +(* val (j, ((ID, form):thm')) = ((j+i), thm');
174.395 + *)
174.396 +fun thm'2xml j ((ID, form):thm') =
174.397 + (indt j ^"<THEOREM>\n"^
174.398 + indt (j+i) ^"<ID> "^ID^" </ID>\n"^
174.399 + indt (j+i) ^"<FORMULA>\n"^
174.400 + thmstr2xml (j+i) form^
174.401 + indt (j+i) ^"</FORMULA>\n"^
174.402 + indt j ^"</THEOREM>\n"):xml;
174.403 +
174.404 +(*WN060627 scope of thy's not considered ?!?*)
174.405 +fun thm''2xml j (thm:thm) =
174.406 + indt j ^"<THEOREM>\n"^
174.407 + indt (j+i) ^"<ID> "^ (strip_thy o Thm.name_of_thm) thm ^" </ID>\n"^
174.408 + term2xml j ((#prop o rep_thm) thm) ^ "\n" ^
174.409 + indt j ^"</THEOREM>\n":xml;
174.410 +
174.411 +
174.412 +fun scr2xml j EmptyScr =
174.413 + indt j ^"<SCRIPT> </SCRIPT>\n" : xml
174.414 + | scr2xml j (Script term) =
174.415 + if term = e_term
174.416 + then indt j ^"<SCRIPT> </SCRIPT>\n"
174.417 + else indt j ^"<SCRIPT>\n"^
174.418 + term2xml j (inst_abs (assoc_thy "Isac.thy") term) ^ "\n" ^
174.419 + indt j ^"</SCRIPT>\n"
174.420 + | scr2xml j (Rfuns _) =
174.421 + indt j ^"<REVERSREWRITE> reverse rewrite functions </REVERSREWRITE>\n";
174.422 +
174.423 +fun prepa12xml j (terms, term) =
174.424 + indt j ^"<PREPAT>\n"^
174.425 + indt (j+i) ^"<PRECONDS>\n"^
174.426 + terms2xml (j+2*i) terms ^
174.427 + indt (j+i) ^"</PRECONDS>\n"^
174.428 + indt (j+i) ^"<PATTERN>\n"^
174.429 + term2xml (j+2*i) term ^
174.430 + indt (j+i) ^"</PATTERN>\n"^
174.431 + indt j ^"</PREPAT>\n" : xml;
174.432 +
174.433 +fun prepat2xml j [] = ""
174.434 + | prepat2xml j (p::ps) = prepa12xml j p ^ prepat2xml j ps : xml;
174.435 +
174.436 +(* val (j, (thyID, seqrls, {id, preconds, rew_ord=(ord,_), erls,
174.437 + srls, calc, rules, scr})) =
174.438 + (j, (thyID, "Seq", data));
174.439 + *)
174.440 +fun rls2xm j (thyID, seqrls, {id, preconds, rew_ord=(ord,_), erls,
174.441 + srls, calc, rules, scr}) =
174.442 + indt j ^"<RULESET>\n"^
174.443 + indt (j+i) ^"<ID> "^ id ^" </ID>\n"^
174.444 + indt (j+i) ^"<TYPE> "^ seqrls ^" </TYPE>\n"^
174.445 + indt (j+i) ^"<RULES>\n" ^
174.446 + rules2xml (j+2*i) thyID rules ^
174.447 + indt (j+i) ^"</RULES>\n" ^
174.448 + indt (j+i) ^"<PRECONDS> " ^
174.449 + terms2xml' (j+2*i) preconds ^
174.450 + indt (j+i) ^"</PRECONDS>\n" ^
174.451 + indt (j+i) ^"<ORDER>\n" ^
174.452 + indt (j+2*i) ^ "<STRING> " ^ ord ^ " </STRING>\n" ^
174.453 +(*WN060714 thy_isac_*-ord-*.xml not yet generated ................
174.454 + indt (j+2*i) ^ "<GUH> " ^ ord2guh ("IsacKnowledge",
174.455 + thyID) ord ^ " </GUH>\n" ^
174.456 +..................................................................*)
174.457 + indt (j+i) ^"</ORDER>\n" ^
174.458 + indt (j+i) ^"<ERLS>\n" ^
174.459 + indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
174.460 + indt (j+2*i) ^ "<STRING> " ^ id_rls erls ^ " </STRING>\n" ^
174.461 + indt (j+2*i) ^ "<GUH> " ^ rls2guh ("IsacKnowledge", thyID)
174.462 + (id_rls erls) ^ " </GUH>\n" ^
174.463 + indt (j+i) ^"</ERLS>\n" ^
174.464 + indt (j+i) ^"<SRLS>\n" ^
174.465 + indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
174.466 + indt (j+2*i) ^ "<STRING> " ^ id_rls erls ^ " </STRING>\n" ^
174.467 + indt (j+2*i) ^ "<GUH> " ^ rls2guh ("IsacKnowledge", thyID)
174.468 + (id_rls srls) ^ " </GUH>\n" ^
174.469 + indt (j+i) ^"</SRLS>\n" ^
174.470 + calcrefs2xml (j+i) (thyID, calc) ^
174.471 + scr2xml (j+i) scr ^
174.472 + indt j ^"</RULESET>\n" : xml;
174.473 +
174.474 +fun rls2xml j (thyID, Erls) = rls2xml j (thyID, e_rls)
174.475 +(* rls2xml j (thyID, Rls {id=id, preconds=preconds, rew_ord=(ord,e_rew_ord),
174.476 + erls=erls,srls=srls,calc=calc,rules=rules,scr=scr});
174.477 + val (j, (thyID, Rls {id, preconds, rew_ord=(ord,_), erls,
174.478 + srls, calc, rules, scr})) = (i, thy_rls);
174.479 + val (j, (thyID, Seq data)) = (i, thy_rls);
174.480 + *)
174.481 + | rls2xml j (thyID, Rls data) = rls2xm j (thyID, "Rls", data)
174.482 +(* val (j, (thyID, Seq data)) = (i, thy_rls);
174.483 + *)
174.484 + | rls2xml j (thyID, Seq data) = rls2xm j (thyID, "Seq", data)
174.485 + | rls2xml j (thyID, Rrls {id, prepat, rew_ord=(ord,_), erls, calc, scr}) =
174.486 + indt j ^"<RULESET>\n"^
174.487 + indt (j+i) ^"<ID> "^ id ^" </ID>\n"^
174.488 + indt (j+i) ^"<TYPE> Rrls </TYPE>\n"^
174.489 + prepat2xml (j+i) prepat ^
174.490 + indt (j+i) ^"<ORDER> " ^
174.491 + indt (j+2*i) ^ "<TAG> Rewrite order </TAG>\n" ^
174.492 + indt (j+2*i) ^ "<STRING> " ^ ord ^ " </STRING>\n" ^
174.493 +(*WN060714 thy_isac_*-ord-*.xml not yet generated ................
174.494 + indt (j+2*i) ^ "<GUH> " ^ ord2guh ("IsacKnowledge",
174.495 + thyID) ord ^ " </GUH>\n" ^
174.496 +.................................................................*)
174.497 + indt (j+i) ^"</ORDER>\n" ^
174.498 + indt (j+i) ^"<ERLS> " ^
174.499 + indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
174.500 + indt (j+2*i) ^ "<STRING> " ^ id_rls erls ^ " </STRING>\n" ^
174.501 + indt (j+2*i) ^ "<GUH> " ^ rls2guh ("IsacKnowledge", thyID)
174.502 + (id_rls erls) ^ " </GUH>\n" ^
174.503 + indt (j+i) ^"</ERLS>\n" ^
174.504 + calcrefs2xml (j+i) (thyID, calc) ^
174.505 + indt (j+i) ^"<SCRIPT>\n"^
174.506 + scr2xml (j+2*i) scr ^
174.507 + indt (j+i) ^" </SCRIPT>\n"^
174.508 + indt j ^"</RULESET>\n" : xml;
174.509 +
174.510 +
174.511 +(*.convert a tactic into xml-format
174.512 + ATTENTION: WN060513 detected faulty 'cterm2xml's with 'string's as args.*)
174.513 +fun tac2xml j (Subproblem (dI, pI)) =
174.514 + (indt j ^"<SUBPROBLEMTACTIC name=\"Subproblem\">\n"^
174.515 + indt (j+i) ^"<THEORY> "^ dI ^" </THEORY>\n"^
174.516 + indt (j+i) ^"<PROBLEM>\n"^
174.517 + id2xml (j+2*i) pI^
174.518 + indt (j+i) ^"</PROBLEM>\n"^
174.519 + indt j ^"</SUBPROBLEMTACTIC>\n"):xml
174.520 + | tac2xml j Model_Problem =
174.521 + (indt j ^"<STRINGLISTTACTIC name=\"Model_Problem\">"^
174.522 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.523 + | tac2xml j (Refine_Tacitly pI) =
174.524 + (indt j ^"<STRINGLISTTACTIC name=\"Refine_Tacitly\">\n"^
174.525 + id2xml (j+i) pI^
174.526 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.527 +
174.528 + | tac2xml j (Add_Given ct) =
174.529 + (indt j ^"<SIMPLETACTIC name=\"Add_Given\">\n"^
174.530 + cterm2xml (j+i) ct^
174.531 + indt j ^"</SIMPLETACTIC>\n"):xml
174.532 + | tac2xml j (Add_Find ct) =
174.533 + (indt j ^"<SIMPLETACTIC name=\"Add_Find\">\n"^
174.534 + cterm2xml (j+i) ct^
174.535 + indt j ^"</SIMPLETACTIC>\n"):xml
174.536 + | tac2xml j (Add_Relation ct) =
174.537 + (indt j ^"<SIMPLETACTIC name=\"Add_Relation\">\n"^
174.538 + cterm2xml (j+i) ct^
174.539 + indt j ^"</SIMPLETACTIC>\n"):xml
174.540 +
174.541 + | tac2xml j (Specify_Theory ct) =
174.542 + (indt j ^"<SIMPLETACTIC name=\"Specify_Theory\">\n"^
174.543 + cterm2xml (j+i) ct^(*WN060513 Specify_Theory = fn : domID -> tac
174.544 +and domID is a string, not a cterm *)
174.545 + indt j ^"</SIMPLETACTIC>\n"):xml
174.546 + | tac2xml j (Specify_Problem ct) =
174.547 + (indt j ^"<STRINGLISTTACTIC name=\"Specify_Problem\">\n"^
174.548 + id2xml (j+i) ct^
174.549 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.550 + | tac2xml j (Specify_Method ct) =
174.551 + (indt j ^"<STRINGLISTTACTIC name=\"Specify_Method\">\n"^
174.552 + id2xml (j+i) ct^
174.553 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.554 + | tac2xml j (Apply_Method mI) =
174.555 + (indt j ^"<STRINGLISTTACTIC name=\"Apply_Method\">\n"^
174.556 + id2xml (j+i) mI^
174.557 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.558 +
174.559 + | tac2xml j (Take ct) =
174.560 + (indt j ^"<SIMPLETACTIC name=\"Take\">\n"^
174.561 + cterm2xml (j+i) ct^
174.562 + indt j ^"</SIMPLETACTIC>\n"):xml
174.563 + | tac2xml j (Calculate opstr) =
174.564 + (indt j ^"<SIMPLETACTIC name=\"Calculate\">\n"^
174.565 + cterm2xml (j+i) opstr^(*WN060513 Calculate = fn : string -> tac
174.566 + 'string', _NOT_ 'cterm' ..flaw from RG*)
174.567 + indt j ^"</SIMPLETACTIC>\n"):xml
174.568 +(* val (j, Rewrite thm') = (i, tac);
174.569 + *)
174.570 + | tac2xml j (Rewrite thm') =
174.571 + (indt j ^"<REWRITETACTIC name=\"Rewrite\">\n"^
174.572 + thm'2xml (j+i) thm'^
174.573 + indt j ^"</REWRITETACTIC>\n"):xml
174.574 +(* writeln (tac2xml 2 (Rewrite ("all_left",
174.575 + "~ ?b =!= 0 ==> (?a = ?b) = (?a - ?b = 0)")));
174.576 + val (j, (Rewrite_Inst (subs, thm'))) = (i, tac);
174.577 + *)
174.578 + | tac2xml j (Rewrite_Inst (subs, thm')) =
174.579 + (indt j ^"<REWRITEINSTTACTIC name=\"Rewrite_Inst\">\n"^
174.580 + subs2xml (j+i) subs^
174.581 + thm'2xml (j+i) thm'^
174.582 + indt j ^"</REWRITEINSTTACTIC>\n"):xml
174.583 +(* writeln (tac2xml 2 (Rewrite_Inst
174.584 + (["(bdv,x)"],
174.585 + ("all_left",
174.586 + "~ ?b =!= 0 ==> (?a = ?b) = (?a - ?b = 0)"))));
174.587 + *)
174.588 + | tac2xml j (Rewrite_Set rls') =
174.589 + (indt j ^"<REWRITESETTACTIC name=\"Rewrite_Set\">\n"^
174.590 + indt (j+i) ^"<RULESET> "^ rls' ^" </RULESET>\n"^
174.591 + indt j ^"</REWRITESETTACTIC>\n"):xml
174.592 + | tac2xml j (Rewrite_Set_Inst (subs, rls')) =
174.593 + (indt j ^"<REWRITESETINSTTACTIC name=\"Rewrite_Set_Inst\">\n"^
174.594 + indt (j+i) ^"<RULESET> "^ rls' ^" </RULESET>\n"^
174.595 + subs2xml (j+i) subs^
174.596 + indt j ^"</REWRITESETINSTTACTIC>\n"):xml
174.597 +
174.598 + | tac2xml j (Or_to_List) =
174.599 + (indt j ^"<STRINGLISTTACTIC name=\"Or_to_List\"> \
174.600 + \</STRINGLISTTACTIC>\n"):xml
174.601 + | tac2xml j (Check_elementwise ct) =
174.602 + (indt j ^"<SIMPLETACTIC name=\"Check_elementwise\">\n"^
174.603 + cterm2xml (j+i) ct ^ "\n"^
174.604 + indt j ^"</SIMPLETACTIC>\n"):xml
174.605 + (*WN0605 quick and dirty: cterms is _NOT_ a stringlist like pblID...*)
174.606 + | tac2xml j (Substitute cterms) =
174.607 + (indt j ^"<STRINGLISTTACTIC name=\"Substitute\">\n"^
174.608 + (*cterms2xml (j+i) cterms^ ....should be WN060514: TODO TERMLISTTACTIC?*)
174.609 + id2xml (j+i) cterms^
174.610 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.611 + | tac2xml j (Check_Postcond pI) =
174.612 + (indt j ^"<STRINGLISTTACTIC name=\"Check_Postcond\">\n"^
174.613 + id2xml (j+i) pI^
174.614 + indt j ^"</STRINGLISTTACTIC>\n"):xml
174.615 +
174.616 + | tac2xml j tac = raise error ("tac2xml: not impl. for "^tac2str tac);
174.617 +
174.618 +fun tacs2xml j [] = "":xml
174.619 + | tacs2xml j (t::ts) = tac2xml j t ^ tacs2xml j ts;
174.620 +
174.621 +
174.622 +fun posformhead2xml j (p:pos', Form f) =
174.623 + indt j ^"<CALCFORMULA>\n"^
174.624 + pos'2xml (j+i) ("POSITION", p) ^
174.625 + indt (j+i) ^"<FORMULA>\n"^
174.626 + term2xml (j+i) f^"\n"^
174.627 + indt (j+i) ^"</FORMULA>\n"^
174.628 + indt j ^"</CALCFORMULA>\n"
174.629 + | posformhead2xml j (p, ModSpec c) =
174.630 + pos'calchead2xml (j) (p, c);
174.631 +
174.632 +fun posformheads2xml j [] = ("":xml)
174.633 + | posformheads2xml j (r::rs) = posformhead2xml j r ^ posformheads2xml j rs;
174.634 +
174.635 +val e_pblterm = (term_of o the o (parse (assoc_thy "Script.thy")))
174.636 + ("Problem (" ^ e_domID ^ "," ^ strs2str' e_pblID ^ ")");
174.637 +
174.638 +(*WN051224 minimal adaption to exporting Formulae _only_ by getFormulaeFromTo*)
174.639 +fun posterm2xml j (p:pos', t) =
174.640 + indt j ^"<CALCFORMULA>\n"^
174.641 + pos'2xml (j+i) ("POSITION", p) ^
174.642 + indt (j+i) ^"<FORMULA>\n"^
174.643 + (if t = e_pblterm (*headline in pbl is e_ <- _root_pbl for CAS-command*)
174.644 + then cterm2xml (j+i) "________________________________________________"
174.645 + else term2xml (j+i) t)^"\n" ^
174.646 + indt (j+i) ^"</FORMULA>\n"^
174.647 + indt j ^"</CALCFORMULA>\n";
174.648 +
174.649 +fun posterms2xml j [] = ("":xml)
174.650 + | posterms2xml j (r::rs) = posterm2xml j r ^ posterms2xml j rs;
174.651 +
174.652 +fun asm_val2xml j (asm, vl) =
174.653 + indt j ^ "<ASMEVALUATED>\n" ^
174.654 + indt (j+i) ^ "<ASM>\n" ^
174.655 + term2xml (j+i) asm ^ "\n" ^
174.656 + indt (j+i) ^ "</ASM>\n" ^
174.657 + indt (j+i) ^ "<VALUE>\n" ^
174.658 + term2xml (j+i) vl ^ "\n" ^
174.659 + indt (j+i) ^ "</VALUE>\n" ^
174.660 + indt j ^ "</ASMEVALUATED>\n" : xml;
174.661 +
174.662 +fun asm_vals2xml j [] = ("":xml)
174.663 + | asm_vals2xml j (asm_val::avs) = asm_val2xml j asm_val ^
174.664 + asm_vals2xml j avs;
174.665 +
174.666 +(*.a reference to an element in the theory hierarchy;
174.667 + compare 'fun keref2xml'.*)
174.668 +(* val (j, thyID, typ, xstring) =
174.669 + (i+i, snd (thy_containing_rls thy' prls'), "Rulesets", prls');
174.670 + *)
174.671 +fun theref2xml j (thyID:thyID) typ (xstring:xstring) =
174.672 + let val guh = theID2guh ["IsacKnowledge", thyID, typ, xstring]
174.673 + val typ' = (implode o (drop_last_n 1) o explode) typ
174.674 + in indt j ^ "<KESTOREREF>\n" ^
174.675 + indt (j+i) ^ "<TAG> " ^ typ' ^ " </TAG>\n" ^
174.676 + indt (j+i) ^ "<ID> " ^ xstring ^ " </ID>\n" ^
174.677 + indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
174.678 + indt j ^ "</KESTOREREF>\n" : xml
174.679 + end;
174.680 +
174.681 +(*.a reference to an element in the kestore EXCEPT theory hierarchy;
174.682 + compare 'fun theref2xml'.*)
174.683 +(* val (j, typ, kestoreID) = (i+i, Met_, hd met);
174.684 + *)
174.685 +fun keref2xml j typ (kestoreID:kestoreID) =
174.686 + let val id = strs2str' kestoreID
174.687 + val guh = kestoreID2guh typ kestoreID
174.688 + in indt j ^ "<KESTOREREF>\n" ^
174.689 + indt (j+i) ^ "<TAG> " ^ ketype2str' typ ^ "</TAG>\n" ^
174.690 + indt (j+i) ^ "<ID> " ^ id ^ " </ID>\n" ^
174.691 + indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
174.692 + indt j ^ "</KESTOREREF>\n" : xml
174.693 + end;
174.694 +
174.695 +(*url to a source external to isac*)
174.696 +fun extref2xml j linktext url =
174.697 + indt j ^ "<EXTREF>\n" ^
174.698 + indt (j+i) ^ "<TEXT> " ^ linktext ^ " </TEXT>\n" ^
174.699 + indt (j+i) ^ "<URL> " ^ url ^ " </URL>\n" ^
174.700 + indt j ^ "</EXTREF>\n" : xml;
174.701 +
174.702 +
174.703 +(* val (ContThmInst{thyID, thm, bdvs, thminst, applto, applat, reword,
174.704 + asms, lhs, rhs, result, resasms, asmrls}) =
174.705 + (context_thy (pt,pos) tac);
174.706 +writeln (contthy2xml 2 (context_thy (pt,pos) tac));
174.707 + *)
174.708 +fun contthy2xml j EContThy =
174.709 + raise error "contthy2xml called with EContThy"
174.710 + | contthy2xml j (ContThm {thyID, thm, applto, applat, reword,
174.711 + asms,lhs, rhs, result, resasms, asmrls}) =
174.712 + indt j ^ "<GUH> " ^ thm ^ " </GUH>\n" ^
174.713 + indt j ^ "<APPLTO>\n" ^
174.714 + term2xml j applto ^ "\n" ^
174.715 + indt j ^ "</APPLTO>\n" ^
174.716 + indt j ^ "<APPLAT>\n" ^
174.717 + term2xml j applat ^ "\n" ^
174.718 + indt j ^ "</APPLAT>\n" ^
174.719 + indt j ^ "<ORDER>\n" ^ (*should be a theref2xml*)
174.720 + indt (j+i) ^"<ID> " ^ reword ^ " </ID>\n" ^
174.721 + indt j ^ "</ORDER>\n" ^
174.722 + indt j ^ "<ASMSEVAL>\n" ^
174.723 + asm_vals2xml (j+i) asms ^
174.724 + indt j ^ "</ASMSEVAL>\n" ^
174.725 + indt j ^ "<LHS>\n" ^
174.726 + term2xml j (fst lhs) ^ "\n" ^
174.727 + indt j ^ "</LHS>\n" ^
174.728 + indt j ^ "<LHSINST>\n" ^
174.729 + term2xml j (snd lhs) ^ "\n" ^
174.730 + indt j ^ "</LHSINST>\n" ^
174.731 + indt j ^ "<RHS>\n" ^
174.732 + term2xml j (fst rhs) ^ "\n" ^
174.733 + indt j ^ "</RHS>\n" ^
174.734 + indt j ^ "<RHSINST>\n" ^
174.735 + term2xml j (snd rhs) ^ "\n" ^
174.736 + indt j ^ "</RHSINST>\n" ^
174.737 + indt j ^ "<RESULT>\n" ^
174.738 + term2xml j result ^ "\n" ^
174.739 + indt j ^ "</RESULT>\n" ^
174.740 + indt j ^ "<ASSUMPTIONS>\n" ^
174.741 + terms2xml' j resasms ^
174.742 + indt j ^ "</ASSUMPTIONS>\n" ^
174.743 + indt j ^ "<EVALRLS>\n" ^
174.744 + theref2xml j thyID "Rulesets" asmrls ^
174.745 + indt j ^ "</EVALRLS>\n"
174.746 +
174.747 + | contthy2xml j (ContThmInst{thyID, thm, bdvs, thminst, applto, applat,
174.748 + reword, asms, lhs, rhs, result, resasms,
174.749 + asmrls}) =
174.750 + indt j ^ "<GUH> " ^ thm ^ " </GUH>\n" ^
174.751 + indt j ^ "<SUBSLIST>\n" ^ (*should be an environment = substitution*)
174.752 + indt (j+i) ^ "<MATHML>\n" ^
174.753 + indt (j+2*i) ^ "<ISA> " ^ subst2str' bdvs ^ " </ISA>\n" ^
174.754 + indt (j+i) ^ "</MATHML>\n" ^
174.755 + indt j ^ "</SUBSLIST>\n" ^
174.756 + indt j ^ "<INSTANTIATED>\n" ^
174.757 + term2xml j thminst ^ "\n" ^
174.758 + indt j ^ "</INSTANTIATED>\n" ^
174.759 + indt j ^ "<APPLTO>\n" ^
174.760 + term2xml j applto ^ "\n" ^
174.761 + indt j ^ "</APPLTO>\n" ^
174.762 + indt j ^ "<APPLAT>\n" ^
174.763 + term2xml j applat ^ "\n" ^
174.764 + indt j ^ "</APPLAT>\n" ^
174.765 + indt j ^ "<ORDER>\n" ^ (*should be a theref2xml*)
174.766 + indt (j+i) ^"<ID> " ^ reword ^ " </ID>\n" ^
174.767 + indt j ^ "</ORDER>\n" ^
174.768 + indt j ^ "<ASMSEVAL>\n" ^
174.769 + asm_vals2xml (j+i) asms ^
174.770 + indt j ^ "</ASMSEVAL>\n" ^
174.771 + indt j ^ "<LHS>\n" ^
174.772 + term2xml j (fst lhs) ^ "\n" ^
174.773 + indt j ^ "</LHS>\n" ^
174.774 + indt j ^ "<LHSINST>\n" ^
174.775 + term2xml j (snd lhs) ^ "\n" ^
174.776 + indt j ^ "</LHSINST>\n" ^
174.777 + indt j ^ "<RHS>\n" ^
174.778 + term2xml j (fst rhs) ^ "\n" ^
174.779 + indt j ^ "</RHS>\n" ^
174.780 + indt j ^ "<RHSINST>\n" ^
174.781 + term2xml j (snd rhs) ^ "\n" ^
174.782 + indt j ^ "</RHSINST>\n" ^
174.783 + indt j ^ "<RESULT>\n" ^
174.784 + term2xml j result ^ "\n" ^
174.785 + indt j ^ "</RESULT>\n" ^
174.786 + indt j ^ "<ASSUMPTOIONS>\n" ^
174.787 + terms2xml' j resasms ^
174.788 + indt j ^ "</ASSUMPTOIONS>\n" ^
174.789 + indt j ^ "<EVALRLS>\n" ^
174.790 + theref2xml j thyID "Rulesets" asmrls ^
174.791 + indt j ^ "</EVALRLS>\n"
174.792 +
174.793 + | contthy2xml j (ContRls {thyID, rls, applto, result, asms}) =
174.794 + indt j ^ "<GUH> " ^ rls ^ " </GUH>\n" ^
174.795 + indt j ^ "<APPLTO>\n" ^
174.796 + term2xml j applto ^ "\n" ^
174.797 + indt j ^ "</APPLTO>\n" ^
174.798 + indt j ^ "<RESULT>\n" ^
174.799 + term2xml j result ^ "\n" ^
174.800 + indt j ^ "</RESULT>\n" ^
174.801 + indt j ^ "<ASSUMPTOIONS>\n" ^
174.802 + terms2xml' j asms ^
174.803 + indt j ^ "</ASSUMPTOIONS>\n"
174.804 +
174.805 + | contthy2xml j (ContRlsInst {thyID, rls, bdvs, applto, result, asms}) =
174.806 + indt j ^ "<GUH> " ^ rls ^ " </GUH>\n" ^
174.807 + indt j ^ "<SUBSLIST>\n" ^ (*should be an environment = substitution*)
174.808 + indt (j+i) ^ "<MATHML>\n" ^
174.809 + indt (j+2*i) ^ "<ISA> " ^ subst2str' bdvs ^ " </ISA>\n" ^
174.810 + indt (j+i) ^ "</MATHML>\n" ^
174.811 + indt j ^ "</SUBSLIST>\n" ^
174.812 + indt j ^ "<APPLTO>\n" ^
174.813 + term2xml j applto ^ "\n" ^
174.814 + indt j ^ "</APPLTO>\n" ^
174.815 + indt j ^ "<RESULT>\n" ^
174.816 + term2xml j result ^ "\n" ^
174.817 + indt j ^ "</RESULT>\n" ^
174.818 + indt j ^ "<ASSUMPTOIONS>\n" ^
174.819 + terms2xml' j asms ^
174.820 + indt j ^ "</ASSUMPTOIONS>\n"
174.821 +
174.822 + | contthy2xml j (ContNOrew {thyID, thm_rls, applto}) =
174.823 + indt j ^ "<GUH> " ^ thm_rls ^ " </GUH>\n" ^
174.824 + indt j ^ "<APPLTO>\n" ^
174.825 + term2xml j applto ^ "\n" ^
174.826 + indt j ^ "</APPLTO>\n"
174.827 +
174.828 + | contthy2xml j (ContNOrewInst{thyID, thm_rls, bdvs, thminst, applto}) =
174.829 + indt j ^ "<GUH> " ^ thm_rls ^ " </GUH>\n" ^
174.830 + indt j ^ "<SUBSLIST>\n" ^ (*should be an environment = substitution*)
174.831 + indt (j+i) ^ "<MATHML>\n" ^
174.832 + indt (j+2*i) ^ "<ISA> " ^ subst2str' bdvs ^ " </ISA>\n" ^
174.833 + indt (j+i) ^ "</MATHML>\n" ^
174.834 + indt j ^ "</SUBSLIST>\n" ^
174.835 + indt j ^ "<INSTANTIATED>\n" ^
174.836 + term2xml j thminst ^ "\n" ^
174.837 + indt j ^ "</INSTANTIATED>\n" ^
174.838 + indt j ^ "<APPLTO>\n" ^
174.839 + term2xml j applto ^ "\n" ^
174.840 + indt j ^ "</APPLTO>\n" : xml;
174.841 +
174.842 +
174.843 +(*------------------------------------------------------------------*)
174.844 +end
174.845 +open datatypes;
174.846 +(*------------------------------------------------------------------*)
175.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
175.2 +++ b/src/Pure/isac/xmlsrc/interface-xml.sml Wed Jul 21 13:53:39 2010 +0200
175.3 @@ -0,0 +1,342 @@
175.4 +(* interface between isac math engine and java:
175.5 + java -> sml: strings on stdin
175.6 + sml -> java: xml on stdout
175.7 +
175.8 + WN071004 The xml still reflects the insecurity during the first
175.9 + implementation phase, how the communication via stdin/out could
175.10 + correctly relate multiple sml-calculations and java-calculations.
175.11 +
175.12 + Since this insecurity turned out unjustified, the xml can be
175.13 + simplified in several ways:
175.14 + # omit the CALCID; the relation is done by
175.15 + "@@@@@begin@@@@@\n "^string_of_int uI
175.16 + # omit the distinctions APPENDFORMULA, REPLACEFORMULA, ...
175.17 + WN071004 these 2 simplifications are begun with CALCMESSAGE
175.18 +
175.19 + use"xmlsrc/interface-xml.sml";
175.20 + use"interface-xml.sml";
175.21 + *)
175.22 +
175.23 +type iterID = int;
175.24 +type calcID = int;
175.25 +
175.26 +
175.27 +
175.28 +(** add and delete users -----------------------------------------------
175.29 + FIXXME.8.03 addUser: clear code, because only CalcTrees distinguished**)
175.30 +fun adduserOK2xml (cI:calcID) (uI:iterID) =
175.31 + writeln ("@@@@@begin@@@@@\n "^string_of_int uI^" \n\
175.32 + \<ADDUSER>\n\
175.33 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.34 + \ <USERID> "^string_of_int uI^" </USERID>\n\
175.35 + \</ADDUSER>\n\
175.36 + \@@@@@end@@@@@");
175.37 +fun deluserOK2xml (cI:calcID) (uI:iterID) =
175.38 + writeln ("@@@@@begin@@@@@\n "^string_of_int uI^" \n\
175.39 + \<DELUSER>\n\
175.40 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.41 + \ <USERID> "^string_of_int uI^" </USERID>\n\
175.42 + \</DELUSER>\n\
175.43 + \@@@@@end@@@@@");
175.44 +(*---------------------------------------------------------------------*)
175.45 +
175.46 +fun calctreeOK2xml (*uI:iterID*) (cI:calcID) =
175.47 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.48 + \<CALCTREE>\n\
175.49 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.50 + \</CALCTREE>\n\
175.51 + \@@@@@end@@@@@");
175.52 +fun deconstructcalctreeOK2xml (*uI:userID*) (cI:calcID) =
175.53 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.54 + \<DELCALC>\n\
175.55 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.56 + \</DELCALC>\n\
175.57 + \@@@@@end@@@@@");
175.58 +
175.59 +fun iteratorOK2xml (cI:calcID) (p:pos')=
175.60 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.61 + \<CALCITERATOR>\n\
175.62 + \ <CALCID> "^string_of_int cI^" </CALCID>\n" ^
175.63 + pos'2xml i ("POSITION", p) ^
175.64 + "</CALCITERATOR>\n\
175.65 + \@@@@@end@@@@@");
175.66 +fun iteratorERROR2xml (cI:calcID) =
175.67 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.68 + \<CALCITERATOR>\n\
175.69 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.70 + \ <ERROR> pos does not exist </ERROR>\n\
175.71 + \</CALCITERATOR>\n\
175.72 + \@@@@@end@@@@@");
175.73 +
175.74 +fun sysERROR2xml (cI:calcID) "" =
175.75 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.76 + \<SYSERROR>\n\
175.77 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.78 + \ <ERROR> in kernel </ERROR>\n\
175.79 + \</SYSERROR>\n\
175.80 + \@@@@@end@@@@@")
175.81 + | sysERROR2xml (cI:calcID) str =
175.82 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.83 + \<SYSERROR>\n\
175.84 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.85 + \ <ERROR> "^str^" </ERROR>\n\
175.86 + \</SYSERROR>\n\
175.87 + \@@@@@end@@@@@");
175.88 +
175.89 +fun refformulaOK2xml (cI:calcID) p (Form t) =
175.90 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.91 + \<REFFORMULA>\n\
175.92 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.93 + \ <CALCFORMULA>\n"^
175.94 + pos'2xml (2*i) ("POSITION", p) ^
175.95 + " <FORMULA>"^
175.96 + term2xml (2*i) t ^"\n"^
175.97 + " </FORMULA>\n\
175.98 + \ </CALCFORMULA>\n\
175.99 + \</REFFORMULA>\n\
175.100 + \@@@@@end@@@@@")
175.101 + | refformulaOK2xml (cI:calcID) p (ModSpec modspec) =
175.102 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.103 + \<REFFORMULA>\n\
175.104 + \ <CALCID> "^string_of_int cI^" </CALCID>\n"^
175.105 + pos'calchead2xml i (p, modspec)^
175.106 + "</REFFORMULA>\n\
175.107 + \@@@@@end@@@@@");
175.108 +
175.109 +fun refformulaERROR2xml (cI:calcID) = (*FIXME.WN.29.8.03 unused*)
175.110 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.111 + \<REFFORMULA>\n\
175.112 + \ <ERROR> object is not a formula </ERROR>\n\
175.113 + \</REFFORMULA>\n\
175.114 + \@@@@@end@@@@@");
175.115 +
175.116 +(* val (cI, tac) = (cI, ta);
175.117 + *)
175.118 +fun gettacticOK2xml (cI:calcID) tac =
175.119 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.120 + \<GETTACTIC>\n\
175.121 + \ <CALCID> "^string_of_int cI^" </CALCID>\n"^
175.122 + tac2xml i tac^
175.123 + "</GETTACTIC>\n\
175.124 + \@@@@@end@@@@@");
175.125 +fun gettacticERROR2xml (cI:calcID) str =
175.126 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.127 + \<GETTACTIC>\n\
175.128 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.129 + \ <ERROR> "^str^" </ERROR>\n\
175.130 + \</GETTACTIC>\n\
175.131 + \@@@@@end@@@@@");
175.132 +
175.133 +fun applicabletacticsOK cI tacs =
175.134 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.135 + \<APPLICABLETACTICS>\n\
175.136 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.137 + \ <TACLIST>\n"^
175.138 + tacs2xml (2*i) tacs^
175.139 + " </TACLIST>\n\
175.140 + \</APPLICABLETACTICS>\n\
175.141 + \@@@@@end@@@@@");
175.142 +
175.143 +fun getasmsOK2xml (cI:calcID) terms =
175.144 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.145 + \<GETASSUMPTIONS>\n\
175.146 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.147 + \ <ASMLIST>\n"^
175.148 + formulae2xml (i+i) terms ^
175.149 + " </ASMLIST>\n\
175.150 + \</GETASSUMPTIONS>\n\
175.151 + \@@@@@end@@@@@");
175.152 +(* getasmsOK2xml 333 [str2term "1+1=2", str2term "1+1+1=3"];
175.153 + *)
175.154 +
175.155 +(*WN0502 @see ME/ctree: type asms: illdesigned, thus not used*)
175.156 +fun getaccuasmsOK2xml cI asms =
175.157 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.158 + \<GETACCUMULATEDASMS>\n\
175.159 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.160 + \ <ASMLIST>\n"^
175.161 + formulae2xml (i+i) asms^
175.162 + " </ASMLIST>\n\
175.163 + \</GETACCUMULATEDASMS>\n\
175.164 + \@@@@@end@@@@@");
175.165 +(* getaccuasmsOK2xml 333 [(([1],Res), str2term "1+1=2"),
175.166 + (([2],Res), str2term "1+1+1=3")];
175.167 + getaccuasmsOK2xml 333 [str2term "1+1=2", str2term "1+1+1=3"];
175.168 + *)
175.169 +
175.170 +fun getintervalOK (cI:calcID) fs =
175.171 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.172 + \<GETELEMENTSFROMTO>\n\
175.173 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.174 + \ <FORMHEADS>\n"^
175.175 + posterms2xml (2*i) fs^
175.176 + " </FORMHEADS>\n\
175.177 + \</GETELEMENTSFROMTO>\n\
175.178 + \@@@@@end@@@@@");
175.179 +
175.180 +
175.181 +fun matchpbl2xml (cI:calcID) (model_ok, pI, hdl, pbl, pre) =
175.182 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n" ^
175.183 + "<CONTEXTPBL>\n" ^
175.184 + " <GUH> " ^ pblID2guh pI ^ " </GUH>\n" ^
175.185 + " <STATUS> " ^ (if model_ok
175.186 + then "correct"
175.187 + else "incorrect") ^ " </STATUS>\n" ^
175.188 + " <HEAD>\n" ^
175.189 + term2xml i hdl ^ "\n" ^
175.190 + " </HEAD>\n" ^
175.191 + model2xml i pbl pre ^
175.192 + "</CONTEXTPBL>\n\
175.193 + \@@@@@end@@@@@");
175.194 +
175.195 +fun matchmet2xml (cI:calcID) (model_ok, pI, scr, pbl, pre) =
175.196 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n" ^
175.197 + "<CONTEXTMET>\n" ^
175.198 + " <GUH> " ^ metID2guh pI ^ " </GUH>\n" ^
175.199 + " <STATUS> " ^ (if model_ok
175.200 + then "correct"
175.201 + else "incorrect") ^ " </STATUS>\n" ^
175.202 + scr2xml i scr ^
175.203 + model2xml i pbl pre ^
175.204 + "</CONTEXTMET>\n\
175.205 + \@@@@@end@@@@@");
175.206 +
175.207 +
175.208 +fun tryrefineOK2xml (cI:calcID) (ModSpec modspec) =
175.209 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.210 + \<TRYREFINE>\n\
175.211 + \ <CALCID> "^string_of_int cI^" </CALCID>\n"^
175.212 + modspec2xml i modspec^
175.213 + "</TRYREFINE>\n\
175.214 + \@@@@@end@@@@@");
175.215 +
175.216 +fun appendformulaOK2xml (cI:calcID) (old:pos') (del:pos') (new:pos') =
175.217 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.218 + \<APPENDFORMULA>\n\
175.219 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.220 + \ <CALCCHANGED>\n" ^
175.221 + pos'2xml (2*i) ("UNCHANGED", old) ^
175.222 + pos'2xml (2*i) ("DELETED", del) ^
175.223 + pos'2xml (2*i) ("GENERATED", new) ^
175.224 + " </CALCCHANGED>\n\
175.225 + \</APPENDFORMULA>\n\
175.226 + \@@@@@end@@@@@");
175.227 +(* appendformulaOK2xml 1 ([2],Frm) ([3],Pbl) ([4],Res);
175.228 + *)
175.229 +fun appendformulaERROR2xml (cI:calcID) msg =
175.230 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.231 + \<CALCMESSAGE> "^ msg ^" </CALCMESSAGE>\n\
175.232 + \@@@@@end@@@@@");
175.233 +
175.234 +fun replaceformulaOK2xml (cI:calcID) (old:pos') (del:pos') (new:pos') =
175.235 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.236 + \<REPLACEFORMULA>\n\
175.237 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.238 + \ <CALCCHANGED>\n" ^
175.239 + pos'2xml (2*i) ("UNCHANGED", old) ^
175.240 + pos'2xml (2*i) ("DELETED", del) ^
175.241 + pos'2xml (2*i) ("GENERATED", new) ^
175.242 + " </CALCCHANGED>\n\
175.243 + \</REPLACEFORMULA>\n\
175.244 + \@@@@@end@@@@@");
175.245 +fun replaceformulaERROR2xml (cI:calcID) msg =
175.246 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.247 + \<CALCMESSAGE> "^ msg ^" </CALCMESSAGE>\n\
175.248 + \@@@@@end@@@@@");
175.249 +
175.250 +fun message2xml (cI:calcID) e =
175.251 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.252 + \<MESSAGE>\n\
175.253 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.254 + \ <STRING> "^e^" </STRING>\n\
175.255 + \</MESSAGE>\n\
175.256 + \@@@@@end@@@@@");
175.257 +
175.258 +fun setnexttactic2xml (*uI:iterID*) (cI:calcID) e =
175.259 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.260 + \<SETNEXTTACTIC>\n\
175.261 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.262 + \ <MESSAGE> "^e^" </MESSAGE>\n\
175.263 + \</SETNEXTTACTIC>\n\
175.264 + \@@@@@end@@@@@");
175.265 +
175.266 +fun fetchproposedtacticOK2xml (*uI:userID*) (cI:calcID) tac =
175.267 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.268 + \<NEXTTAC>\n\
175.269 + \ <CALCID> "^string_of_int cI^" </CALCID>\n"^
175.270 + tac2xml i tac^
175.271 +(* ^(strs2xml o (map (tac2xml i))) tacs^*)
175.272 + "</NEXTTAC>\n\
175.273 + \@@@@@end@@@@@");
175.274 +(* fetchproposedtactic2xml 11 22 (Rewrite ("rmult_commute","?m *?n =?n *?m"));
175.275 + *)
175.276 +fun fetchproposedtacticERROR2xml (*uI:userID*) (cI:calcID) e =
175.277 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.278 + \<NEXTTAC>\n\
175.279 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.280 + \ <ERROR> "^ e ^" </ERROR>\n\
175.281 + \</NEXTTAC>\n\
175.282 + \@@@@@end@@@@@");
175.283 +
175.284 +(*. UNCHANGED: the pos' of the active formula autocalculate has been applied at
175.285 + DELETED: last pos' of the succesional sequence of formulae prob. deleted
175.286 + GENERATED: the pos' of the new active formula
175.287 +.*)
175.288 +fun autocalculateOK2xml (cI:calcID) (old:pos') (del:pos') (new:pos') =
175.289 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.290 + \<AUTOCALC>\n\
175.291 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.292 + \ <CALCCHANGED>\n" ^
175.293 + pos'2xml (2*i) ("UNCHANGED", old) ^
175.294 + pos'2xml (2*i) ("DELETED", del) ^
175.295 + pos'2xml (2*i) ("GENERATED", new) ^
175.296 + " </CALCCHANGED>\n\
175.297 + \</AUTOCALC>\n\
175.298 + \@@@@@end@@@@@");
175.299 +(* autocalculate2xml 11 22 (Rewrite ("rmult_commute","?m *?n =?n *?m"));
175.300 + *)
175.301 +fun autocalculateERROR2xml (cI:calcID) e =
175.302 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.303 + \<CALCMESSAGE> "^ e ^" </CALCMESSAGE>\n\
175.304 + \@@@@@end@@@@@");
175.305 +
175.306 +fun interStepsOK (cI:calcID) (*pos'forms*) (old:pos') (del:pos') (new:pos') =
175.307 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.308 + \<INTERSTEPS>\n\
175.309 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.310 + \ <CALCCHANGED>\n" ^
175.311 + pos'2xml (2*i) ("UNCHANGED", old) ^
175.312 + pos'2xml (2*i) ("DELETED", del) ^
175.313 + pos'2xml (2*i) ("GENERATED", new) ^
175.314 + " </CALCCHANGED>\n\
175.315 + \</INTERSTEPS>\n\
175.316 + \@@@@@end@@@@@");
175.317 +fun interStepsERROR (cI:calcID) e =
175.318 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.319 + \ <CALCMESSAGE> "^ e ^" </CALCMESSAGE>\n\
175.320 + \@@@@@end@@@@@");
175.321 +
175.322 +fun modifycalcheadOK2xml (cI:calcID) (chd as (complete,p_,_,_,_,_):ocalhd) =
175.323 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.324 + \<MODIFYCALCHEAD>\n\
175.325 + \ <CALCID> "^string_of_int cI^" </CALCID>\n\
175.326 + \ <STATUS> "^(if complete then "complete"
175.327 + else "incomplete")^ "</STATUS>\n"^
175.328 + modspec2xml i chd^
175.329 + "</MODIFYCALCHEAD>\n\
175.330 + \@@@@@end@@@@@");
175.331 +
175.332 +(* val (cI, contthy) = (cI, (context_thy (pt,pos) tac));
175.333 + *)
175.334 +fun contextthyOK2xml cI contthy =
175.335 + writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n\
175.336 + \<CONTEXTTHY>\n\
175.337 + \ <CALCID> "^string_of_int cI^" </CALCID>\n" ^
175.338 + contthy2xml i contthy ^
175.339 + "</CONTEXTTHY>\n\
175.340 + \@@@@@end@@@@@");
175.341 +
175.342 +(*
175.343 +fun contextthyNO2xml guh =
175.344 + writeln (datatypes.contextthyNO2xml 0 guh);
175.345 +*)
175.346 \ No newline at end of file
176.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
176.2 +++ b/src/Pure/isac/xmlsrc/mathml.sml Wed Jul 21 13:53:39 2010 +0200
176.3 @@ -0,0 +1,76 @@
176.4 +(* translate formulae from Isabelle-string format to xml-format.
176.5 + TODO implement MathML
176.6 + author: Walther Neuper 030701
176.7 + (c) isac-team 2003
176.8 +
176.9 +use"xmlsrc/mathml.sml";
176.10 +use"mathml.sml";
176.11 +*)
176.12 +
176.13 +(*.decode Isabelle-strings to the format as seen by the user (1)
176.14 + EXCEPT xml-coding issues (2).
176.15 + (2) have a _reverse_ method
176.16 + 'isac.util.parser.FormalizationDigest.decodeEntities'
176.17 + called within Formula#toSMLString in java
176.18 +
176.19 + ad(1) decode "^^^" ---> "^"; see IsacKnowledge/Atools.thy;
176.20 + ad(2) decode "<" ---> "<", decode ">" ---> ">"
176.21 + decode "&" ---> "&"
176.22 + called for term2xml; + see "fun encode" in FE-interface/interface.sml.*)
176.23 +fun decode (str:cterm') =
176.24 + let fun dec [] = []
176.25 + | dec ("^"::"^"::"^"::cs) = "^"::(dec cs)
176.26 + | dec ("&"::cs) = "&"::"a"::"m"::"p"::";"::(dec cs)
176.27 + | dec ("<"::cs) = "&"::"l"::"t"::";"::(dec cs)
176.28 + | dec (">"::cs) = "&"::"g"::"t"::";"::(dec cs)
176.29 + | dec (c::cs) = c::(dec cs)
176.30 + in (implode o dec o explode) str:cterm' end;
176.31 +
176.32 +
176.33 +fun strs2xml strs = foldl (op ^) ("", strs);
176.34 +(* writeln (strs2xml ["<XXX> xxx </XXX>\n","<YYY> yyy </YYY>\n"]);
176.35 +<XXX> xxx </XXX>
176.36 +<YYY> yyy </YYY>*)
176.37 +
176.38 +val indentation = 2;
176.39 +val i = indentation;
176.40 +
176.41 +(*WN071016 checked that _all_ FE-interface/interface.sml uses this*)
176.42 +fun term2xml j t =
176.43 + indt (j+i) ^ "<MATHML>\n" ^
176.44 + indt (j+2*i) ^ "<ISA> " ^ (decode o term2str) t ^ " </ISA>\n" ^
176.45 + indt (j+i) ^ "</MATHML>";
176.46 +(*val t = str2term "equality e_";
176.47 + writeln (term2xml 8 t);
176.48 + <MATHML>
176.49 + <ISA> equality e_ </ISA>
176.50 + <MATHML> *)
176.51 +
176.52 +(*version for TextIO*)
176.53 +fun terms2xml j [] = ""
176.54 + | terms2xml j (t::ts) = term2xml j t ^ terms2xml j ts;
176.55 +(*version for writeln: extra \n*)
176.56 +fun terms2xml' j [] = ""
176.57 + | terms2xml' j [t] = term2xml j t
176.58 + | terms2xml' j (t::ts) = term2xml j t ^"\n"^ terms2xml' j ts;
176.59 +
176.60 +(*WN060513 'cterm' means the Isabelle-type*)
176.61 +fun cterm2xml j ct =
176.62 + indt (j+i) ^ "<MATHML>\n" ^
176.63 + indt (j+2*i) ^ "<ISA> " ^ ct ^ " </ISA>\n" ^
176.64 + indt (j+i) ^ "</MATHML>\n";
176.65 +(*version for TextIO*)
176.66 +fun cterms2xml j [] = ""
176.67 + | cterms2xml j (t::ts) = cterm2xml j t ^ cterms2xml j ts;
176.68 +(*version for writeln: extra \n*)
176.69 +fun cterms2xml' j [] = ""
176.70 + | cterms2xml' j (t::ts) = cterm2xml j t ^"\n"^ cterms2xml j ts;
176.71 +
176.72 +(* writeln(cterms2xml 5 ["cterm1", "cterm2"]);
176.73 + <MATHML>
176.74 + <ISA> cterm1 </ISA>
176.75 + </MATHML>
176.76 + <MATHML>
176.77 + <ISA> cterm2 </ISA>
176.78 + </MATHML>
176.79 +*)
176.80 \ No newline at end of file
177.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
177.2 +++ b/src/Pure/isac/xmlsrc/pbl-met-hierarchy.sml Wed Jul 21 13:53:39 2010 +0200
177.3 @@ -0,0 +1,329 @@
177.4 +(* export problem-data and method-data to xml
177.5 + author: Walther Neuper
177.6 + (c) isac-team
177.7 +
177.8 +use"xmlsrc/pbl-met-hierarchy.sml";
177.9 +use"pbl-met-hierarchy.sml";
177.10 +*)
177.11 +
177.12 +fun str2file (fnm:filename) (str:string) =
177.13 + let val file = TextIO.openOut fnm
177.14 + in (TextIO.output (file, str);
177.15 + TextIO.flushOut file;
177.16 + TextIO.closeOut file) end;
177.17 +fun pos2filename [] = raise error "pos2filename called with []"
177.18 + | pos2filename [i] = "_" ^ string_of_int i ^ ".xml"
177.19 + | pos2filename (i::is) = "_" ^ string_of_int i ^ pos2filename is;
177.20 +(* pos2filename [1,22,3];
177.21 +val it = "_1_22_3.xml" : string
177.22 +*)
177.23 +fun id2filename [] = raise error "id2filename called with []"
177.24 + | id2filename [s] = s ^ ".xml"
177.25 + | id2filename (s::ss) = s ^ "_" ^ id2filename ss;
177.26 +(* id2filename ["linear","univariate","equation"];
177.27 +val it = "linear_univariate_equation.xml" : string
177.28 +*)
177.29 +
177.30 +
177.31 +
177.32 +(*ad DTD: a NODE contains an ID and zero or more NODEs*)
177.33 +(*old version with pos2filename*)
177.34 +fun hierarchy pm(*"pbl" | "met"*) h =
177.35 + let val j = indentation
177.36 + fun nd i p (Ptyp (id,_,ns)) =
177.37 + let val p' = lev_on p
177.38 + in (indt i) ^ "<NODE>\n" ^
177.39 + (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
177.40 + (indt (i+j)) ^ "<NO> " (*on this level*) ^
177.41 + (string_of_int o last_elem) p' ^ " </NO>\n" ^
177.42 + (indt (i+j)) ^ "<CONTENTREF> " ^ pm ^ pos2filename p' ^
177.43 + " </CONTENTREF>\n" ^
177.44 + (nds (i+j) (lev_dn p') ns) ^
177.45 + (indt i) ^ "</NODE>\n"
177.46 + end
177.47 + and nds _ _ [] = ""
177.48 + | nds i p (n::ns) = (nd i p n) ^ (nds i (lev_on p) ns);
177.49 + in nds j [0] h end;
177.50 +(*.create a hierarchy with references to the guh's.*)
177.51 +fun hierarchy_pbl h =
177.52 + let val j = indentation
177.53 + fun nd i p (Ptyp (id,[n as {guh,...} : pbt],ns)) =
177.54 + let val p' = lev_on p
177.55 + in (indt i) ^ "<NODE>\n" ^
177.56 + (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
177.57 + (indt (i+j)) ^ "<NO> " (*on this level*) ^
177.58 + (string_of_int o last_elem) p' ^ " </NO>\n" ^
177.59 + (indt (i+j)) ^ "<CONTENTREF> " ^ guh ^
177.60 + " </CONTENTREF>\n" ^
177.61 + (nds (i+j) (lev_dn p') ns) ^
177.62 + (indt i) ^ "</NODE>\n"
177.63 + end
177.64 + and nds _ _ [] = ""
177.65 + | nds i p (n::ns) = (nd i p n) ^ (nds i (lev_on p) ns);
177.66 + in nds j [0] h : xml end;
177.67 +fun hierarchy_met h =
177.68 + let val j = indentation
177.69 + fun nd i p (Ptyp (id,[n as {guh,...} : met],ns)) =
177.70 + let val p' = lev_on p
177.71 + in (indt i) ^ "<NODE>\n" ^
177.72 + (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
177.73 + (indt (i+j)) ^ "<NO> " (*on this level*) ^
177.74 + (string_of_int o last_elem) p' ^ " </NO>\n" ^
177.75 + (indt (i+j)) ^ "<CONTENTREF> " ^ guh ^
177.76 + " </CONTENTREF>\n" ^
177.77 + (nds (i+j) (lev_dn p') ns) ^
177.78 + (indt i) ^ "</NODE>\n"
177.79 + end
177.80 + and nds _ _ [] = ""
177.81 + | nds i p (n::ns) = (nd i p n) ^ (nds i (lev_on p) ns);
177.82 + in nds j [0] h : xml end;
177.83 +(* (writeln o hierarchy_pbl) (!ptyps);
177.84 + *)
177.85 +
177.86 +fun pbl_hierarchy2file (path:path) =
177.87 + str2file (path ^ "pbl_hierarchy.xml")
177.88 + ("<NODE>\n" ^
177.89 + " <ID> problem hierarchy </ID>\n" ^
177.90 + " <NO> 1 </NO>\n" ^
177.91 + " <CONTENTREF> pbl_ROOT </CONTENTREF>\n" ^
177.92 + (hierarchy_pbl (!ptyps)) ^
177.93 + "</NODE>");
177.94 +
177.95 +fun met_hierarchy2file (path:path) =
177.96 + str2file (path ^ "met_hierarchy.xml")
177.97 + ("<NODE>\n" ^
177.98 + " <ID> method hierarchy </ID>\n" ^
177.99 + " <NO> 1 </NO>\n" ^
177.100 + " <CONTENTREF> met_ROOT </CONTENTREF>\n" ^
177.101 + (hierarchy_met (!mets)) ^
177.102 + "</NODE>");
177.103 +
177.104 +
177.105 +
177.106 +(**.create the xml-files for the pbls, mets from the hierarchy.**)
177.107 +
177.108 +val i = indentation;
177.109 +
177.110 +fun pbl2term thy (pblRD:pblRD) =
177.111 + str2term ("Problem (" ^
177.112 + (get_thy o theory2domID) thy ^ "_, " ^
177.113 + (strs2str' o rev) pblRD ^ ")");
177.114 +(* term2str (pbl2term Isac.thy ["equations","univariate","normalize"]);
177.115 +val it = "Problem (Isac, [normalize, univariate, equations])" : string
177.116 +*)
177.117 +
177.118 +
177.119 +(*.format a problem in xml for presentation on the problem browser;
177.120 + new version with <KESTOREREF>s -- not used because linking
177.121 + requires elements (rls, calc, ...) to be reorganized.*)
177.122 +(*######## ATTENTION: THIS IS not THE ACTUAL VERSION ################*)
177.123 +fun pbl2xml (id:(*pblRD*)pblID) ({guh,mathauthors,init,cas,met,ppc,prls,
177.124 + thy,where_}:pbt) =
177.125 + let val thy' = theory2theory' thy
177.126 + val prls' = (#id o rep_rls) prls
177.127 + in "<NODECONTENT>\n" ^
177.128 + indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
177.129 + (((id2xml i)(* o rev*)) id) ^
177.130 + indt i ^ "<META> </META>\n" ^
177.131 + (*--------------- begin display ------------------------------*)
177.132 + indt i ^ "<HEADLINE>\n" ^
177.133 + (case cas of None => term2xml i (pbl2term thy id)
177.134 + | Some t => term2xml i t) ^ "\n" ^
177.135 + indt i ^ "</HEADLINE>\n" ^
177.136 + (*--------------- hline --------------------------------------*)
177.137 + pattern2xml i ppc where_ ^
177.138 + (*--------------- hline --------------------------------------*)
177.139 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n"
177.140 + (*--------------- end display --------------------------------*)
177.141 + ^
177.142 + indt i ^ "<THEORY>\n" ^
177.143 + theref2xml (i+i) thy' "Theorems" "" ^
177.144 + indt i ^ "</THEORY>\n" ^
177.145 + (case met of [] => (indt i) ^ "<METHODS> </METHODS>\n"
177.146 + | _ => (indt i) ^ "<METHODS>\n" ^
177.147 + foldl op^ ("", map (keref2xml (i+i) Met_) met) ^
177.148 + (indt i) ^ "</METHODS>\n") ^
177.149 + indt i ^ "<EVALPRECOND>\n" ^
177.150 + theref2xml (i+i) (snd (thy_containing_rls thy' prls')) "Rulesets" prls'^
177.151 + indt i ^ "</EVALPRECOND>\n" ^
177.152 + authors2xml i "MATHAUTHORS" mathauthors ^
177.153 + authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
177.154 + "</NODECONTENT>" : xml
177.155 + end;
177.156 +
177.157 +(*.format a problem in xml for presentation on the problem browser;
177.158 + old version with 'dead' strings for rls, calc, ....*)
177.159 +(*
177.160 +val pblID = ["linear","univariate","equation"];
177.161 +val pblID = ["degree_4","polynomial","univariate","equation"];
177.162 +val pblID = rev ["tool","find_values"];
177.163 +val (id, {guh,mathauthors,init,cas,met,ppc,prls,thy,where_}:pbt) =
177.164 + (pblID, get_pbt pblID);
177.165 + *)
177.166 +fun pbl2xml (id:(*pblRD*)pblID) ({guh,mathauthors,init,cas,met,ppc,prls,
177.167 + thy,where_}:pbt) =
177.168 + "<NODECONTENT>\n" ^
177.169 + indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
177.170 + (((id2xml i)(* o rev*)) id) ^
177.171 + indt i ^ "<META> </META>\n" ^
177.172 + (*--------------- begin display ------------------------------*)
177.173 + indt i ^ "<HEADLINE>\n" ^
177.174 + (case cas of None => term2xml i (pbl2term thy id)
177.175 + | Some t => term2xml i t) ^ "\n" ^
177.176 + indt i ^ "</HEADLINE>\n" ^
177.177 + (*--------------- hline --------------------------------------*)
177.178 + pattern2xml i ppc where_ ^
177.179 + (*--------------- hline --------------------------------------*)
177.180 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n"
177.181 + (*--------------- end display --------------------------------*)
177.182 + ^
177.183 + indt i ^ "<THEORY>\n" ^
177.184 + theref2xml (i+i) (theory2theory' thy) "Theorems" "" ^
177.185 + indt i ^ "</THEORY>\n" ^
177.186 + (case met of [] => (indt i) ^ "<METHODS> </METHODS>\n"
177.187 + | _ => (indt i) ^ "<METHODS>\n" ^
177.188 + foldl op^ ("", map (keref2xml (i+i) Met_) met) ^
177.189 + (indt i) ^ "</METHODS>\n") ^
177.190 + indt i ^ "<EVALPRECOND> " ^ (#id o rep_rls)
177.191 + prls ^ " </EVALPRECOND>\n" ^
177.192 + authors2xml i "MATHAUTHORS" mathauthors ^
177.193 + authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
177.194 + "</NODECONTENT>" : xml;
177.195 +(*
177.196 +val pblID = ["linear","univariate","equation"];
177.197 +val pblID = ["degree_4","polynomial","univariate","equation"];
177.198 +writeln (pbl2xml pblID (get_pbt pblID));
177.199 +*)
177.200 +
177.201 +(*replace by 'fun calc2xml' as developed for thy in 0607*)
177.202 +fun calc2xmlOLD j ((scr_op, (isa_op, _)):calc) =
177.203 + indt i ^ "<CALCULATE> (" ^ scr_op ^ ", (" ^ isa_op ^ ")) </CALCULATE>\n";
177.204 +fun calcs2xmlOLD j [] = ("":xml) (*TODO replace with 'strs2xml'*)
177.205 + | calcs2xmlOLD j (r::rs) = calc2xmlOLD j r ^ calcs2xmlOLD j rs;
177.206 +
177.207 +(* val (id, {guh,mathauthors,init,ppc,pre,scr,calc,
177.208 + crls,erls,nrls,prls,srls,rew_ord'}) =
177.209 + (["Test", "solve_linear"],
177.210 + get_met ["Test", "solve_linear"]);
177.211 + *)
177.212 +
177.213 +(*.format a method in xml for presentation on the method browser;
177.214 + new version with <KESTOREREF>s -- not used because linking
177.215 + requires elements (rls, calc, ...) to be reorganized.*)
177.216 +(*######## ATTENTION: THIS IS not THE ACTUAL VERSION ################*)
177.217 +fun met2xml (id:metID) ({guh,mathauthors,init,ppc,pre,scr,calc,
177.218 + crls,erls,nrls,prls,srls,rew_ord'}:met) =
177.219 + let val thy' = "Isac.thy" (*FIXME.WN0607 get thy from met ?!?*)
177.220 + val crls' = (#id o rep_rls) crls
177.221 + val erls' = (#id o rep_rls) erls
177.222 + val nrls' = (#id o rep_rls) nrls
177.223 + val prls' = (#id o rep_rls) prls
177.224 + val srls' = (#id o rep_rls) srls
177.225 + in "<NODECONTENT>\n" ^
177.226 + indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
177.227 + id2xml i id ^
177.228 + indt i ^ "<META> </META>\n" ^
177.229 + scr2xml i scr ^
177.230 + pattern2xml i ppc pre ^
177.231 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
177.232 + indt i ^ "<EVALPRECOND>\n" ^
177.233 + theref2xml (i+i) (snd (thy_containing_rls thy' prls')) "Rulesets" prls'^
177.234 + indt i ^ "</EVALPRECOND>\n" ^
177.235 + indt i ^ "<EVALCOND>\n" ^
177.236 + theref2xml (i+i) (snd (thy_containing_rls thy' erls')) "Rulesets" erls'^
177.237 + indt i ^ "</EVALCOND>\n" ^
177.238 + indt i ^ "<EVALLISTEXPR>\n"^
177.239 + theref2xml (i+i) (snd (thy_containing_rls thy' srls')) "Rulesets" srls'^
177.240 + indt i ^ "</EVALLISTEXPR>\n" ^
177.241 + indt i ^ "<CHECKELEMENTWISE>\n" ^
177.242 + theref2xml (i+i) (snd (thy_containing_rls thy' crls')) "Rulesets" crls'^
177.243 + indt i ^ "</CHECKELEMENTWISE>\n" ^
177.244 + indt i ^ "<NORMALFORM>\n" ^
177.245 + theref2xml (i+i) (snd (thy_containing_rls thy' nrls')) "Rulesets" nrls'^
177.246 + indt i ^ "</NORMALFORM>\n" ^
177.247 + indt i ^ "<REWORDER> " ^ rew_ord' ^ " </REWORDER>\n" ^
177.248 + calcs2xmlOLD i calc ^
177.249 + authors2xml i "MATHAUTHORS" mathauthors ^
177.250 + authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
177.251 + "</NODECONTENT>" : xml
177.252 + end;
177.253 +(*.format a method in xml for presentation on the method browser;
177.254 + old version with 'dead' strings for rls, calc, ....*)
177.255 +fun met2xml (id:metID) ({guh,mathauthors,init,ppc,pre,scr,calc,
177.256 + crls,erls,nrls,prls,srls,rew_ord'}:met) =
177.257 + "<NODECONTENT>\n" ^
177.258 + indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
177.259 + id2xml i id ^
177.260 + indt i ^ "<META> </META>\n" ^
177.261 + scr2xml i scr ^
177.262 + pattern2xml i ppc pre ^
177.263 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
177.264 + indt i ^ "<EVALPRECOND> " ^ (#id o rep_rls) prls ^ " </EVALPRECOND>\n" ^
177.265 + indt i ^ "<EVALCOND> " ^ (#id o rep_rls) erls ^ " </EVALCOND>\n" ^
177.266 + indt i ^ "<EVALLISTEXPR> "^ (#id o rep_rls) srls ^ " </EVALLISTEXPR>\n" ^
177.267 + indt i ^ "<CHECKELEMENTWISE> " ^ (#id o rep_rls)
177.268 + crls ^ " </CHECKELEMENTWISE>\n" ^
177.269 + indt i ^ "<NORMALFORM> " ^ (#id o rep_rls) nrls ^ " </NORMALFORM>\n" ^
177.270 + indt i ^ "<REWORDER> " ^ rew_ord' ^ " </REWORDER>\n" ^
177.271 + calcs2xmlOLD i calc ^
177.272 + authors2xml i "MATHAUTHORS" mathauthors ^
177.273 + authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
177.274 + "</NODECONTENT>" : xml;
177.275 +
177.276 +(* writeln (met2xml ["Test", "solve_linear"]
177.277 + (get_met ["Test", "solve_linear"]));
177.278 + *)
177.279 +
177.280 +(**. write pbls from hierarchy to files.**)
177.281 +
177.282 +(*.write the files using an int-key (pos') as filename.*)
177.283 +fun pbl2file (path:path) (pos:pos) (id:metID) (pbl as {guh,...}) =
177.284 + (writeln ("### pbl2file: id = " ^ strs2str id);
177.285 + ((str2file (path ^ pos2filename pos)) o (pbl2xml id)) pbl
177.286 + );
177.287 +
177.288 +(*.write the files using the guh as filename.*)
177.289 +(* *)
177.290 +fun pbl2file (path:path) (pos:pos) (id:metID) (pbl as {guh,...}) =
177.291 + (writeln ("### pbl2file: id = " ^ strs2str id ^ ", pos = " ^ pos2str pos);
177.292 + ((str2file (path ^ guh2filename guh)) o (pbl2xml id)) pbl
177.293 + );
177.294 +
177.295 +(**. write mets from hierarchy to files.**)
177.296 +
177.297 +(*.write the files using an int-key (pos') as filename.*)
177.298 +fun met2file (path:path) (pos:pos) (id:metID) met =
177.299 + (writeln ("### met2file: id = " ^ strs2str id);
177.300 + ((str2file (path ^ "met" ^ pos2filename pos)) o (met2xml id)) met);
177.301 +
177.302 +(*.write the files using the guh as filename.*)
177.303 +fun met2file (path:path) (pos:pos) (id:metID) (met as {guh,...}) =
177.304 + (writeln ("### met2file: id = " ^ strs2str id);
177.305 + ((str2file (path ^ guh2filename guh)) o (met2xml id)) met);
177.306 +
177.307 +
177.308 +(*.scan the mtree Ptyp and and print the nodes using wfn.*)
177.309 +fun node (pa:path) ids po wfn (Ptyp (id,[n],ns)) =
177.310 + let val po' = lev_on po
177.311 + in wfn pa po' (ids@[id]) n;
177.312 + nodes pa (ids@[id]) ((lev_dn po'):pos) wfn ns end
177.313 +and nodes _ _ _ _ [] = ()
177.314 + | nodes pa ids po wfn (n::ns) = (node pa ids po wfn n;
177.315 + nodes pa ids (lev_on po) wfn ns);
177.316 +
177.317 +
177.318 +fun pbls2file (p:path) = nodes p [] [0] pbl2file (!ptyps);
177.319 +fun mets2file (p:path) = nodes p [] [0] met2file (!mets);
177.320 +(*
177.321 +val path = "/home/neuper/proto2/isac/xmldata/";
177.322 +val path = "/home/neuper/tmp/";
177.323 +
177.324 +pbl_hierarchy2file (path ^ "pbl/");
177.325 +pbls2file (path ^ "pbl/");
177.326 +
177.327 +met_hierarchy2file (path ^ "met/");
177.328 +mets2file (path ^ "met/");
177.329 +
177.330 +thy_hierarchy2file (path ^ "thy/");
177.331 +thes2file (path ^ "thy/");
177.332 +*)
177.333 \ No newline at end of file
178.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
178.2 +++ b/src/Pure/isac/xmlsrc/thy-hierarchy.sml Wed Jul 21 13:53:39 2010 +0200
178.3 @@ -0,0 +1,361 @@
178.4 +(*.export theory-data to xml
178.5 + author: Walther Neuper 0601
178.6 + (c) isac-team
178.7 +
178.8 + FIXME.WN0602: re-engineer this file for analogy to pbl-met-hierarchy
178.9 + as follows:
178.10 + # 'fun collect_thydata': unit -> string list * thydata list
178.11 + ^^^^^^^^^^^ hierarchy-key
178.12 + # 'fun thys2file': from this ^^^ datastructure (^^^^^^^^^^^ for free!)
178.13 + # map 'fun store_pbt' (NEW!) over ^^^ into 'thy_data ptyp'
178.14 + # from 'thy_data ptyp' create 'thy_hierarchy'
178.15 +
178.16 +use"xmlsrc/thy-hierarchy.sml";
178.17 +use"thy-hierarchy.sml";
178.18 +.*)
178.19 +
178.20 +
178.21 +(**.collect data and build intermediate structure for hierarchy:
178.22 + theorems, rulesets and Calc's, (TODO rew_ord's etc) defined in isac
178.23 + and Isabelle-thms used in rulesets;
178.24 + this code binds ref-var's and must be after IsacKnowledge .**)
178.25 +
178.26 +(*.collect all theorems defined in in a theory and insert the guh.*)
178.27 +fun makeHthm (part:string, thyID:thyID) (thmID:thmID, thm:thm) =
178.28 + let val theID = [part, thyID, "Theorems"] @ [strip_thy thmID] : theID
178.29 + in (theID, Hthm {guh = theID2guh theID, coursedesign = [],
178.30 + mathauthors = ["isac-team"], thm = thm})
178.31 + end;
178.32 +fun makeHrls (part:string) (rls':rls', thy_rls as (thyID, rls): thyID * rls) =
178.33 + let val theID = [part, thyID,"Rulesets"] @ [rls'] : theID
178.34 + in (theID, Hrls {guh = theID2guh theID, coursedesign=[],
178.35 + mathauthors=["isac-team"], thy_rls = thy_rls})
178.36 + end;
178.37 +fun makeHcal (part:string, thyID:thyID) (calID, cal) =
178.38 + let val theID = [part, thyID,"Operations"] @ [calID] : theID
178.39 + in (theID, Hcal {guh = theID2guh theID, coursedesign=[],
178.40 + mathauthors=["isac-team"], calc = cal})
178.41 + end;
178.42 +fun makeHord (part:string, thyID:thyID) (ordID, ord) =
178.43 + let val theID = [part, thyID,"TODO-Orders"] @ [ordID] : theID
178.44 + in (theID, Hord {guh = theID2guh theID, coursedesign=[],
178.45 + mathauthors=["isac-team"], ord = ord})
178.46 + end;
178.47 +
178.48 +
178.49 +fun collect_thms' (part, thy') =
178.50 + let val thy = assoc_thy (thyID2theory' thy')
178.51 + in map (makeHthm (part, thy')) (thms_of thy) end;
178.52 +
178.53 +(*.collect all rulesets defined in in a theory and insert the guh.*)
178.54 +fun collect_rlss (part, thy') =
178.55 + let val rlss = filter ((curry op= thy') o
178.56 + ((#1 o #2):(rls' * (theory' * rls)) -> theory'))
178.57 + (!ruleset')
178.58 + in map (makeHrls part) rlss end;
178.59 +
178.60 +(*.collect all calcs defined in in a theory.*)
178.61 +fun collect_cals (part, thy') =
178.62 + let val cals = [] (*FIXXXXXXXXXXME.WN060713 add thyID: (thyID, cal)*)
178.63 + in map (makeHcal (part, thy')) cals end;
178.64 +
178.65 +
178.66 +(*.collect all rew_ord's defined in in a theory.*)
178.67 +fun collect_ords (part, thy') =
178.68 + let val thy = assoc_thy (thyID2theory' thy')
178.69 + in [(*TODO.WN060120 rew_ord, Calc*)]:(theID * thydata) list end;
178.70 +
178.71 +(*.collect all data for a thy TODO.WN060120 rew_ord, Calc.*)
178.72 +(* val thy' = nth 1 scri_thys;
178.73 + *)
178.74 +fun collect_thy part(*IsacScripts|IsacKnowledge*) (thy': theory') =
178.75 + ((collect_thms' (part, thy')) @ (collect_rlss (part, thy')) @
178.76 + (collect_cals (part, thy')) @ (collect_ords (part, thy')))
178.77 + : (theID * thydata) list;
178.78 +
178.79 +(*.collect theorems defined in Isabelle (before Isac is evaluated above).*)
178.80 +fun collect_isab isa (thyID, (thmID, thm)) =
178.81 + let val theID = [isa, thyID, "Theorems", thmID]
178.82 + in (theID:theID, Hthm {guh = theID2guh theID,
178.83 + mathauthors = ["Isabelle team, TU Munich"],
178.84 + coursedesign = [],
178.85 + thm = thm}) end;
178.86 +
178.87 +val isabelle_page = (["Isabelle"] : theID,
178.88 + Html {guh = theID2guh ["Isabelle"],
178.89 + html = "",
178.90 + mathauthors = ["Isabelle team, TU Munich"],
178.91 + coursedesign = []});
178.92 +
178.93 +(*.create a list with all thydata=thyelements=the;
178.94 + this list is used by 'fun the_hier' to create the hierarchy .*)
178.95 +fun collect_thydata () =
178.96 + let val isab_thms = map rearrange_inv (!isab_thm_thy)
178.97 + val scri_thys = (map (get_thy o #1) (!script_thys))
178.98 + \\ ["e_domID"]
178.99 + val isac_thys = (map (get_thy o #1)
178.100 + (!theory')) \\ scri_thys \\ ["e_domID"]
178.101 + in [isabelle_page] @
178.102 + (map (collect_isab "Isabelle") isab_thms) @
178.103 + ((flat o (map (collect_thy "IsacScripts"))) scri_thys) @
178.104 + ((flat o (map (collect_thy "IsacKnowledge"))) isac_thys)
178.105 + : (theID * thydata) list
178.106 + end;
178.107 +
178.108 +fun show_thes () = (writeln o format_pblIDl o (scan [])) (!thehier);
178.109 +
178.110 +
178.111 +
178.112 +(***.create the xml-format for the hierarchy.***)
178.113 +
178.114 +(**.make a hierarchy from (theID * thydata) list created by 'fun collect_thy';
178.115 + use the same mechanism as for pbl_hierarchy and met_hierarchy;
178.116 + but check, if a thydata is already there (for auto-gen. Isabelle).**)
178.117 +
178.118 +(*.for preserving elements created by 'fun store_thy'.*)
178.119 +fun exist_the (theID:theID) (thy_hie:thehier) =
178.120 + let fun node theID ids (Ptyp (id,_,ns)) =
178.121 + if theID = ids @ [id] then true
178.122 + else nodes theID (ids @ [id]) ns
178.123 + and nodes _ _ [] = false
178.124 + | nodes theID ids (n::ns) = if node theID ids n then true
178.125 + else nodes theID ids ns
178.126 + in nodes theID [] thy_hie end;
178.127 +
178.128 +(*.insrt requires a parent; see 'fun fill_parents'.*)
178.129 +fun can_insert (theID:theID) (thy_hie:thehier) =
178.130 + (insrt theID e_thydata theID thy_hie; true)
178.131 + handle _ => false;
178.132 +
178.133 +(*.cut 'theID', the ID of theory elements from tail to head
178.134 + until insertion into the hierarchy of theory elements 'th' is possible
178.135 + (the hierarchy requires the parentnode to exist for insertion).*)
178.136 +fun cut_theID th ([]:theID) =
178.137 + raise error "could not insert into thy-hierarchy"
178.138 + | cut_theID th theID =
178.139 + if can_insert theID th
178.140 + then theID else cut_theID th (drop_last theID);
178.141 +
178.142 +(*.insert empty parents 'Html' into the hierarchy of theory elements 'th'
178.143 + until the actual node can be inserted with key 'theID'.*)
178.144 +(* val (th, cutID, theID) = (th, theID, theID);
178.145 + val (th, cutID, theID) = (th', cutID_, theID);
178.146 + *)
178.147 +fun fill_parents th cutID theID =
178.148 + let val cutID' = cut_theID th cutID
178.149 + in if cutID' = theID
178.150 + then th
178.151 + else let val th' = insrt cutID' (Html {guh=theID2guh theID,
178.152 + coursedesign=["isac team 2006"],
178.153 + mathauthors=[],
178.154 + html=""}) cutID' th
178.155 + val cutID_ = cutID' @ [nth ((length cutID') + 1) theID]
178.156 + in fill_parents th' cutID_ theID end
178.157 + end;
178.158 +
178.159 +(*.create the hierarchy from a list (generated automatically);
178.160 + thus, missing parents of list-elems are inserted
178.161 + (causing msgs '*** insert: not found');
178.162 + elemes already store_*d in some *.ML are NOT overwritten.*)
178.163 +fun the_hier th ([]: (theID * thydata) list) = th
178.164 +(* val (th, (theID, thydata)::ths) = (!thehier, collect_thydata ());
178.165 + *)
178.166 + | the_hier th ((theID, thydata)::ths) =
178.167 + if can_insert theID th
178.168 + then let val th' = if exist_the theID th
178.169 + then (writeln ("*** insert: preserved "^strs2str theID);
178.170 + th)
178.171 + else insrt theID thydata theID th
178.172 + in the_hier th' ths end
178.173 + else let val th' = fill_parents th theID theID (*..*** insert: not found*)
178.174 + val th' = insrt theID thydata theID th'
178.175 + in the_hier th' ths end;
178.176 +
178.177 +
178.178 +(*these files shall contain 'invisible' html
178.179 +val thydatafilename = "thy_datafile.xml"; (*for "Theorems"|...*)
178.180 +fun partfilename str = "thy_" ^ str ^ ".xml"; (*for "Isabelle"|...*)*)
178.181 +
178.182 +(*.create an xml-hierarchy where the filname is created from the guh.*)
178.183 +(*ad DTD: a NODE contains an ID and zero or more NODEs*)
178.184 +fun hierarchy_guh h =
178.185 + let val i = indentation
178.186 + val j = indentation
178.187 + fun node i p theID (Ptyp (id,_,ns)) =
178.188 + let val p' = lev_on p
178.189 + val theID' = theID @ [id]
178.190 + in (indt i) ^ "<NODE>\n" ^
178.191 + (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
178.192 + (indt (i+j)) ^ "<NO> " (*on this level*) ^
178.193 + (string_of_int o last_elem) p' ^ " </NO>\n" ^
178.194 + (indt (i+j)) ^ "<CONTENTREF> " ^ theID2guh theID' ^
178.195 + " </CONTENTREF>\n" ^
178.196 + (nodes (i+j) (lev_dn p') theID' ns) ^
178.197 + (indt i) ^ "</NODE>\n"
178.198 + end
178.199 + and nodes _ _ _ [] = ""
178.200 + | nodes i p theID (n::ns) = (node i p theID n)
178.201 + ^ (nodes i (lev_on p) theID ns);
178.202 + in nodes j [0] [] h end;
178.203 +
178.204 +fun thy_hierarchy2file (path:path) =
178.205 + str2file (path ^ "thy_hierarchy.xml")
178.206 + ("<NODE>\n" ^
178.207 + " <ID> theory hierarchy </ID>\n" ^
178.208 + " <NO> 1 </NO>\n" ^
178.209 + " <CONTENTREF> thy_ROOT </CONTENTREF>\n" ^
178.210 + (hierarchy_guh (!thehier)) ^
178.211 + "</NODE>");
178.212 +
178.213 +
178.214 +(**.create the xml-files for the theory-data from the hierarchy.**)
178.215 +
178.216 +val i = indentation;
178.217 +(*.analoguous to 'fun met2xml'.*)
178.218 +fun thydata2xml (theID:theID, Html {guh, coursedesign, mathauthors, html}) =
178.219 + "<HTMLDATA>\n" ^
178.220 + indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
178.221 + id2xml i theID ^
178.222 + indt i ^ "<EXPLANATIONS> " ^ html ^ "</EXPLANATIONS>\n" ^
178.223 + authors2xml i "MATHAUTHORS" mathauthors ^
178.224 + authors2xml i "COURSEDESIGNS" coursedesign ^
178.225 + "</HTMLDATA>\n" : xml
178.226 + | thydata2xml (theID:theID, Hthm {guh, coursedesign, mathauthors, thm}) =
178.227 + "<THEOREMDATA>\n" ^
178.228 + indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
178.229 + id2xml i theID ^
178.230 + thm''2xml i thm ^
178.231 + indt i ^ "<PROOF>\n" ^
178.232 + extref2xml (i+i) "Proof of the theorem"
178.233 + ("http://www.ist.tugraz.at/projects/isac/www/\
178.234 + \kbase/thy/browser_info/HOL/HOL-Real/Isac/" ^
178.235 + nth 2 theID ^ ".html") ^
178.236 + indt i ^ "</PROOF>\n" ^
178.237 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
178.238 + authors2xml i "MATHAUTHORS" mathauthors ^
178.239 + authors2xml i "COURSEDESIGNS" coursedesign ^
178.240 + "</THEOREMDATA>\n"
178.241 +(* val (theID:theID, Hrls {guh, coursedesign, mathauthors, thy_rls}) =
178.242 + (theID, thydata);
178.243 + *)
178.244 + | thydata2xml (theID, Hrls {guh, coursedesign, mathauthors, thy_rls}) =
178.245 + "<RULESETDATA>\n" ^
178.246 + indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
178.247 + id2xml i theID ^
178.248 + rls2xml i thy_rls ^
178.249 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
178.250 + authors2xml i "MATHAUTHORS" mathauthors ^
178.251 + authors2xml i "COURSEDESIGNS" coursedesign ^
178.252 + "</RULESETDATA>\n"
178.253 +(* val (theID:theID, Hcal {guh, coursedesign, mathauthors, calc}) =
178.254 + (theID, rlsdata);
178.255 + *)
178.256 + | thydata2xml (theID, Hcal {guh, coursedesign, mathauthors, calc}) =
178.257 + "<RULESETDATA>\n" ^
178.258 + indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
178.259 + id2xml i theID ^
178.260 + calc2xml i (theID2thyID theID, calc) ^
178.261 + indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
178.262 + authors2xml i "MATHAUTHORS" mathauthors ^
178.263 + authors2xml i "COURSEDESIGNS" coursedesign ^
178.264 + "</RULESETDATA>\n"
178.265 + | thydata2xml (theID, _) =
178.266 + raise error ("thydata2xml: not implemented for "^ strs2str' theID);
178.267 +
178.268 +(*.analoguous to 'fun met2file'.*)
178.269 +fun thydata2file (xmldata:path) (pos:pos) (theID:theID) thydata =
178.270 + (writeln ("### thes2file: id = " ^ strs2str theID);
178.271 + str2file (xmldata ^ theID2filename theID)
178.272 + (thydata2xml (theID:theID, thydata)));
178.273 +
178.274 +(*.analoguous to 'fun node'; here we scan ??????????.*)
178.275 +(* val (pa, ids, po, wfn, (Ptyp (id,[n],ns))) =
178.276 + (pa, ids, po, wfn, n);
178.277 + *)
178.278 +fun thenode (pa:path) ids po wfn (Ptyp (id,[n],ns)) =
178.279 + let val po' = lev_on po
178.280 + in wfn pa po' (ids@[id]) n;
178.281 + thenodes pa (ids@[id]) ((lev_dn po'):pos) wfn ns end
178.282 +(* val (pa, ids, po, wfn, (n::ns)) =
178.283 + (path, []:string list, [0], thydata2file, (!thehier));
178.284 + *)
178.285 +and thenodes _ _ _ _ [] = ()
178.286 + | thenodes pa ids po wfn (n::ns) = (thenode pa ids po wfn n;
178.287 + thenodes pa ids (lev_on po) wfn ns);
178.288 +
178.289 +(*..analoguous to 'fun mets2file'*)
178.290 +fun thes2file (p : path) =
178.291 + thenodes p [] [0] thydata2file (!thehier);
178.292 +
178.293 +
178.294 +(***.store a single theory element in the hierarchy.***)
178.295 +
178.296 +(*.for mathauthors only, other html is added to xml exported from here.*)
178.297 +(* val (theID, mathauthors) =
178.298 + (["IsacKnowledge", theory2thyID Biegelinie.thy, "Theorems"],
178.299 + ["Walther Neuper 2005 supported by a grant from NMI Austria"]);
178.300 + *)
178.301 +fun store_isa (theID : theID) (mathauthors : authors) =
178.302 + let val guh = case theID of
178.303 + [part] => part2guh theID
178.304 + | [part, thyID, thypart] => thypart2guh theID
178.305 + val theID = guh2theID guh
178.306 + val the = Html {guh = guh,
178.307 + coursedesign = [],
178.308 + mathauthors = mathauthors,
178.309 + html = ""}
178.310 + in (*needs no (!check_guhs_unique) because guh is generated automatically*)
178.311 + thehier := insrt theID the theID (!thehier) end;
178.312 +
178.313 +fun store_thy thy (mathauthors : authors) =
178.314 + let val guh = thy2guh ["IsacKnowledge", theory2thyID thy]
178.315 + val theID = guh2theID guh
178.316 + val the = Html {guh = guh,
178.317 + coursedesign = [],
178.318 + mathauthors = mathauthors,
178.319 + html = ""}
178.320 + in (*needs no (!check_guhs_unique) because guh is generated automatically*)
178.321 + thehier := insrt theID the theID (!thehier) end;
178.322 +
178.323 +fun store_thm thy (thmID : thmID, thm) (mathauthors : authors) =
178.324 + let val guh = thm2guh ("IsacKnowledge", theory2thyID thy) thmID
178.325 + val theID = guh2theID guh
178.326 + val the = Hthm {guh = guh,
178.327 + coursedesign = [], (*done at xml exported from here*)
178.328 + mathauthors=mathauthors,
178.329 + thm = thm}
178.330 + in (*needs no (!check_guhs_unique) because guh is generated automatically*)
178.331 + thehier := insrt theID the theID (!thehier) end;
178.332 +
178.333 +fun store_rls thy rls (mathauthors : authors) =
178.334 + let val guh = rls2guh ("IsacKnowledge", theory2thyID thy)
178.335 + ((#id o rep_rls) rls)
178.336 + val theID = guh2theID guh
178.337 + val the = Hrls {guh = guh,
178.338 + coursedesign = [],
178.339 + mathauthors = mathauthors,
178.340 + thy_rls=(theory2thyID thy, rls)}
178.341 + in (*needs no (!check_guhs_unique) because guh is generated automatically*)
178.342 + thehier := insrt theID the theID (!thehier) end;
178.343 +
178.344 +fun store_cal thy cal (mathauthors : authors) =
178.345 + let val guh = cal2guh ("IsacKnowledge", theory2thyID thy)
178.346 + ("TODO store_cal")
178.347 + val theID = guh2theID guh
178.348 + val the = Hcal {guh = guh,
178.349 + coursedesign = [],
178.350 + mathauthors = mathauthors,
178.351 + calc = cal}
178.352 + in (*needs no (!check_guhs_unique) because guh is generated automatically*)
178.353 + thehier := insrt theID the theID (!thehier) end;
178.354 +
178.355 +fun store_ord thy ord (mathauthors : authors) =
178.356 + let val guh = ord2guh ("IsacKnowledge", theory2thyID thy)
178.357 + ("TODO store_ord")
178.358 + val theID = guh2theID guh
178.359 + val the = Hord {guh = guh,
178.360 + coursedesign = [],
178.361 + mathauthors = mathauthors,
178.362 + ord = ord}
178.363 + in (*needs no (!check_guhs_unique) because guh is generated automatically*)
178.364 + thehier := insrt theID the theID (!thehier) end;
179.1 --- a/src/Pure/thm.ML Wed Jul 21 09:59:35 2010 +0200
179.2 +++ b/src/Pure/thm.ML Wed Jul 21 13:53:39 2010 +0200
179.3 @@ -48,6 +48,16 @@
179.4 hyps: term OrdList.T,
179.5 tpairs: (term * term) list,
179.6 prop: term}
179.7 +type deriv (*WN*)
179.8 + val rep_thm_G:(*WN*) thm ->
179.9 + deriv *
179.10 + {thy_ref: theory_ref, (*new since 2002*)
179.11 + tags: Properties.T, (*new since 2002*)
179.12 + maxidx: int,
179.13 + shyps: sort OrdList.T,
179.14 + hyps: term OrdList.T,
179.15 + tpairs: (term * term) list,(*new since 2002*)
179.16 + prop: term}
179.17 val crep_thm: thm ->
179.18 {thy_ref: theory_ref,
179.19 tags: Properties.T,
179.20 @@ -72,6 +82,16 @@
179.21
179.22 (*meta rules*)
179.23 val assume: cterm -> thm
179.24 + val make_thm:(*WN*) cterm -> thm
179.25 + val assbl_thm:(*WN*) deriv ->
179.26 + theory_ref ->
179.27 + Properties.T ->
179.28 + int ->
179.29 + sort OrdList.T ->
179.30 + term OrdList.T ->
179.31 + (term * term) list ->
179.32 + term ->
179.33 + thm
179.34 val implies_intr: cterm -> thm -> thm
179.35 val implies_elim: thm -> thm -> thm
179.36 val forall_intr: cterm -> thm -> thm
179.37 @@ -358,6 +378,7 @@
179.38 exception THM of string * int * thm list;
179.39
179.40 fun rep_thm (Thm (_, args)) = args;
179.41 +fun rep_thm_G (Thm (deriv , args)) = (deriv, args); (*WN*)
179.42
179.43 fun crep_thm (Thm (_, {thy_ref, tags, maxidx, shyps, hyps, tpairs, prop})) =
179.44 let fun cterm max t = Cterm {thy_ref = thy_ref, t = t, T = propT, maxidx = max, sorts = shyps} in
179.45 @@ -672,6 +693,24 @@
179.46 tpairs = [],
179.47 prop = prop})
179.48 end;
179.49 +fun make_thm raw_ct = (*WN ---vvv *)
179.50 + let val Cterm {thy_ref, t = prop, T, maxidx, sorts} = adjust_maxidx_cterm ~1 raw_ct in
179.51 + if T <> propT then
179.52 + raise THM ("assume: prop", 0, [])
179.53 + (*else if maxidx <> ~1 then (*WN true with matches (?b * v_ = 0)..*)
179.54 + raise THM ("assume: variables", maxidx, [])*)
179.55 + else Thm (deriv_rule0 (Proofterm.Hyp prop),
179.56 + {thy_ref = thy_ref,
179.57 + tags = [],
179.58 + maxidx = ~1,
179.59 + shyps = sorts,
179.60 + hyps = [prop],
179.61 + tpairs = [],
179.62 + prop = prop})
179.63 + end; (*WN ---^^^ *)
179.64 +fun assbl_thm deriv thy_ref tags maxidx shyps hyps tpairs prop = (*WN*)
179.65 + Thm (deriv, {thy_ref=thy_ref, tags=tags, maxidx=maxidx,
179.66 + shyps=shyps, hyps=hyps, tpairs=tpairs, prop=prop});
179.67
179.68 (*Implication introduction
179.69 [A]