test/Tools/isac/Knowledge/algein.sml
author Walther Neuper <neuper@ist.tugraz.at>
Fri, 06 May 2011 11:18:07 +0200
branchdecompose-isar
changeset 41977 a3ce4017f41d
parent 41943 f33f6959948b
child 42166 911c49949ba9
permissions -rw-r--r--
intermed. ctxt ..: cleanup before start with Add_Given

uncommenting in src/../calchead.sm 2x "update_env" after "prep_ori"
marked with GOON.WN110506
causes errors in most test/../*, all with CalcTreeTEST; me; ..
neuper@37906
     1
(* tests on AlgEin, Algebra Einf"uhrung, , Unterrichtsversuch IMST-Projekt
neuper@37906
     2
   author: Walther Neuper 2007
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
neuper@37906
     5
use"../smltest/IsacKnowledge/algein.sml";
neuper@37906
     6
use"algein.sml";
neuper@37906
     7
*)
neuper@37906
     8
neuper@37906
     9
"-----------------------------------------------------------------";
neuper@37906
    10
"table of contents -----------------------------------------------";
neuper@37906
    11
"-----------------------------------------------------------------";
neuper@37906
    12
"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
neuper@37906
    13
"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
neuper@37906
    14
"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
neuper@37906
    15
"----------- Widerspruch 3 = 777 ---------------------------------";
neuper@37906
    16
"-----------------------------------------------------------------";
neuper@37906
    17
"-----------------------------------------------------------------";
neuper@37906
    18
"-----------------------------------------------------------------";
neuper@37906
    19
neuper@41943
    20
(*=== inhibit exn ?=============================================================
neuper@41943
    21
val thy = AlgEin.thy;
neuper@37906
    22
neuper@37906
    23
neuper@37906
    24
(* use"../smltest/IsacKnowledge/algein.sml";
neuper@37906
    25
   *)
neuper@37906
    26
neuper@37906
    27
"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
neuper@37906
    28
"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
neuper@37906
    29
"----------- build method 'Berechnung' 'erstSymbolisch' ----------";
neuper@37906
    30
val str =
neuper@37906
    31
"Script RechnenSymbolScript (k_::bool) (q__::bool) \
neuper@37906
    32
\(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =\
neuper@37906
    33
\ (let t_ = (l_ = 1)\
neuper@37906
    34
\ in t_)"
neuper@37906
    35
;
neuper@37906
    36
val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    37
(*---^^^-OK-----------------------------------------------------------------*)
neuper@37906
    38
val str =
neuper@37906
    39
"Script RechnenSymbolScript (k_::bool) (q__::bool)           \
neuper@37906
    40
\(u_::bool list) (s_::bool list) (o_::bool list) (l_::real) =\
neuper@37906
    41
\ (let t_ = Take (l_ = Oben + Senkrecht + Unten);            \
neuper@37906
    42
\      sum_ = boollist2sum o_;\
neuper@37906
    43
\      t_ = Substitute [Oben = sum_] t_;\
neuper@37906
    44
\      t_ = Substitute o_ t_;\
neuper@37906
    45
\      t_ = Substitute [k_, q__] t_;\
neuper@37906
    46
\      t_ = Repeat (Try (Rewrite_Set norm_Poly False)) t_\
neuper@37906
    47
\ in t_)"
neuper@37906
    48
;
neuper@37906
    49
val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    50
(*---vvv-NOTok--------------------------------------------------------------*)
neuper@37906
    51
neuper@37906
    52
neuper@37906
    53
neuper@37906
    54
atomty sc;
neuper@37906
    55
atomt sc;
neuper@37906
    56
neuper@37906
    57
neuper@37906
    58
"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
neuper@37906
    59
"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
neuper@37906
    60
"----------- me 'Berechnung' 'erstNumerisch' ---------------------";
neuper@37906
    61
val fmz = 
neuper@37906
    62
    ["KantenLaenge (k=10)","Querschnitt (q=1)",
neuper@37906
    63
     "KantenUnten [b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q ]", 
neuper@37906
    64
     "KantenSenkrecht [v1 = k, v2 = k, v3 = k, v4 = k]", 
neuper@37906
    65
     "KantenOben  [t1 = k - 2*q, t2 = k - 2*q, t3 = k - 2*q, t4 = k - 2*q ]",
neuper@37906
    66
     "GesamtLaenge L"];
neuper@37906
    67
val (dI',pI',mI') =
neuper@37991
    68
  ("Isac",["numerischSymbolische", "Berechnung"],
neuper@37906
    69
   ["Berechnung","erstNumerisch"]);
neuper@37906
    70
val p = e_pos'; val c = [];
neuper@37906
    71
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))](*nxt = ("Model_Pr*);
neuper@37906
    72
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenLaenge (k = 10)"*);
neuper@37906
    73
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "Querschnitt (q = 1)"*);
neuper@37906
    74
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenUnten [b1 = k - 2*q]"*);
neuper@37906
    75
val (p,_,f,nxt,_,pt) = me nxt p c pt(*..KantenUnten [b2 = k - 2 * q, b3=..b4*);
neuper@37906
    76
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenSenkrecht [v1 = k]"*);
neuper@37906
    77
val (p,_,f,nxt,_,pt) = me nxt p c pt(*..KantenSenkrecht [v2 = k, v3 = k, v4]*);
neuper@37906
    78
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Given "KantenOben [b1 = k - 2 *q])*);
neuper@37906
    79
val (p,_,f,nxt,_,pt) = me nxt p c pt(*..KantenOben [b2 = k - 2 * q, b3 =, b4*);
neuper@37906
    80
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Add_Find "GesamtLaenge L"*);
neuper@37991
    81
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Specify_Theory "AlgEin"*);
neuper@37906
    82
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Specify_Problem ["numerischSymbolis,Be*);
neuper@37906
    83
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Specify_Method ["Berechnung", "erstSym*);
neuper@37906
    84
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Apply_Method*);
neuper@37906
    85
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Substitute["Oben = boollist2sum [b1 =*);
neuper@37906
    86
f2str f;
neuper@37906
    87
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Substitute ["t1 = k - 2 * q", *);f2str f;
neuper@37906
    88
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Substitute ["k = 10", "q = 1"]*);f2str f;
neuper@37906
    89
val (p,_,f,nxt,_,pt) = me nxt p c pt(*Rewrite_Set "norm_Rational"*);f2str f;
neuper@37906
    90
val (p,_,f,nxt,_,pt) = me nxt p c pt(**);
neuper@37906
    91
if f2str f = "L = 32 + senkrecht + unten" then ()
neuper@38031
    92
else error "algein.sml diff.behav. in erstSymbolisch 1";
neuper@37906
    93
val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
neuper@37906
    94
val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
neuper@37906
    95
val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
neuper@37906
    96
val (p,_,f,nxt,_,pt) = me nxt p c pt;val(p,_,f,nxt,_,pt)=me nxt p c pt;f2str f;
neuper@37906
    97
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    98
if f2str f = "L = 104" andalso nxt = ("End_Proof'", End_Proof') then ()
neuper@38031
    99
else error "algein.sml diff.behav. in erstSymbolisch 99";
neuper@37906
   100
neuper@37906
   101
neuper@37906
   102
"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
neuper@37906
   103
"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
neuper@37906
   104
"----------- auto 'Berechnung' 'erstSymbolisch' ------------------";
neuper@37906
   105
states:=[];
neuper@37906
   106
CalcTree
neuper@37906
   107
[(["KantenLaenge (k=10)","Querschnitt (q=1)",
neuper@37906
   108
   "KantenUnten [b1 = k - 2*q, b2 = k - 2*q, b3 = k - 2*q, b4 = k - 2*q ]", 
neuper@37906
   109
   "KantenSenkrecht [v1 = k, v2 = k, v3 = k, v4 = k]", 
neuper@37906
   110
   "KantenOben  [t1 = k - 2*q, t2 = k - 2*q, t3 = k - 2*q, t4 = k - 2*q ]",
neuper@37906
   111
   "GesamtLaenge L"], 
neuper@37991
   112
  ("Isac",["numerischSymbolische", "Berechnung"],
neuper@37906
   113
   ["Berechnung","erstSymbolisch"]))];
neuper@37906
   114
Iterator 1;
neuper@37906
   115
moveActiveRoot 1;
neuper@37906
   116
autoCalculate 1 CompleteCalc;
neuper@37906
   117
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   118
if p = ([], Res) andalso term2str (get_obj g_res pt (fst p)) = "L = 104" then()
neuper@38031
   119
else error "algein.sml: 'Berechnung' 'erstSymbolisch' changed";
neuper@37906
   120
neuper@37906
   121
(*
neuper@37906
   122
show_pt pt;
neuper@37906
   123
trace_rewrite:=true;
neuper@37906
   124
trace_rewrite:=false;
neuper@37906
   125
trace_script:=true;
neuper@37906
   126
trace_script:=false;
neuper@37906
   127
*)
neuper@37906
   128
neuper@37906
   129
"----------- Widerspruch 3 = 777 ---------------------------------";
neuper@37906
   130
"----------- Widerspruch 3 = 777 ---------------------------------";
neuper@37906
   131
"----------- Widerspruch 3 = 777 ---------------------------------";
neuper@38050
   132
val thy = (theory "Isac"); 
neuper@37906
   133
val rew_ord = dummy_ord;
neuper@37906
   134
val erls = Erls;
neuper@37906
   135
neuper@37906
   136
val thm = assoc_thm' thy ("sym_real_mult_0_right","");
neuper@37906
   137
val t = str2term "0 = 0";
neuper@37926
   138
val SOME (t',_) = rewrite_ thy rew_ord erls false thm t;
neuper@37906
   139
term2str t';
neuper@37906
   140
(********"0 = ?z1 * 0"*)
neuper@37906
   141
neuper@37906
   142
(*testing code in ME/appl.sml*)
neuper@37906
   143
val sube = ["?z1 = 3"];
neuper@37906
   144
val subte = sube2subte sube;
neuper@37906
   145
val subst = sube2subst thy sube;
neuper@37906
   146
foldl and_ (true, map contains_Var subte);
neuper@37906
   147
neuper@37906
   148
val t'' = subst_atomic subst t';
neuper@37906
   149
term2str t'';
neuper@37906
   150
(********"0 = 3 * 0"*)
neuper@37906
   151
neuper@37906
   152
val thm = assoc_thm' thy ("sym","");
neuper@41977
   153
(*----- STOPPED.WN0x?: Widerspruch 3 = 777: sym contains "==>" instead of "=" !!!
neuper@37926
   154
val SOME (t''',_) = rewrite_ thy rew_ord erls false thm t'';
neuper@37906
   155
*)
neuper@37906
   156
neuper@37906
   157
(* use"../smltest/IsacKnowledge/algein.sml";
neuper@37906
   158
   *)
neuper@37906
   159
neuper@41943
   160
===== inhibit exn ?===========================================================*)