test/Tools/isac/OLDTESTS/script.sml
author wneuper <Walther.Neuper@jku.at>
Wed, 11 Jan 2023 11:38:01 +0100
changeset 60650 06ec8abfd3bc
parent 60608 5dabcc1c9235
child 60660 c4b24621077e
permissions -rw-r--r--
eliminate use of Thy_Info 12: TermC partially
neuper@37906
     1
(* tests for ME/script.sml
neuper@37906
     2
   WN.13.3.00
neuper@37906
     3
neuper@37906
     4
   WN050908 OLD FILE, MERGE WITH smltest/ME/script.sml
neuper@37906
     5
neuper@37906
     6
use"systest/script.sml";
neuper@37906
     7
use"script.sml";
neuper@37906
     8
*)
neuper@37906
     9
neuper@37906
    10
neuper@37906
    11
"         scripts: Variante 'funktional'               ";
neuper@37906
    12
"############## Make_fun_by_new_variable ##############";
neuper@37906
    13
"############## Make_fun_by_explicit ##############";
neuper@37906
    14
"################ Solve_root_equation #################";
neuper@37906
    15
"------- Notlocatable: Free_Solve -------";
neuper@37906
    16
neuper@37906
    17
"  --- test100:  nxt_tac order------------------------------------ ";
neuper@37906
    18
"  --- test100:  order 1 3 1 2 ----------------------------------- ";
neuper@37906
    19
" --- test200: nxt_tac order ------------------------------------- ";
neuper@37906
    20
" --- test200: order 3 1 1 2 --------------------------------- ";
neuper@37906
    21
neuper@37906
    22
"  --- root-equation:  nxt_tac order------------------------------ ";
neuper@37906
    23
"  --- root-equation:  1.norm_equation ------------------------------ ";
neuper@37906
    24
(* --- test200: calculate -----------------------------------------*)
neuper@37906
    25
"  --- check_elementwise ------------------------------ ";
neuper@37906
    26
neuper@37906
    27
"  --- test 30.4.02 Testterm:  Repeat Repeat Or ------------------ ";
walther@59637
    28
"  --- test 9.5.02 Testeq: While Try Repeat #> ------------------ ";
neuper@37906
    29
walther@59823
    30
"--------- from_prog ---------------------------------------------";
neuper@37906
    31
"-----------------------------------------------------------------";
neuper@37906
    32
neuper@37906
    33
neuper@37906
    34
neuper@37906
    35
neuper@37906
    36
neuper@37906
    37
" ################################################# 6.5.03";
neuper@37906
    38
"         scripts: Variante 'funktional'            6.5.03";
neuper@37906
    39
" ################################################# 6.5.03 ";
neuper@37906
    40
Walther@60458
    41
val c = (the o (TermC.parse Diff_App.thy)) 
wneuper@59585
    42
  "Program Maximum_value(fix_::bool list)(m_::real) (rs_::bool list)\
neuper@37906
    43
   \      (v_::real) (itv_::real set) (err_::bool) =          \ 
neuper@37981
    44
   \ (let e_e = (hd o (filterVar m_)) rs_;              \
neuper@37906
    45
   \      t_ = (if 1 < length_ rs_                            \
wneuper@59476
    46
   \           then (SubProblem (Reals_s,[make,function],[no_met])\
neuper@37984
    47
   \                     [REAL m_, REAL v_v, BOOL_LIST rs_])\
neuper@37906
    48
   \           else (hd rs_));                                \
wneuper@59476
    49
   \      (mx_::real) = SubProblem (Reals_s,[on_interval,max_of,function], \
neuper@37906
    50
   \                                [Isac,maximum_on_interval])\
neuper@37984
    51
   \                               [BOOL t_, REAL v_v, REAL_SET itv_]\
wneuper@59476
    52
   \ in ((SubProblem (Reals_s,[find_values,tool],[Isac,find_values])   \
neuper@37984
    53
   \      [REAL mx_, REAL (Rhs t_), REAL v_v, REAL m_,     \
neuper@37984
    54
   \       BOOL_LIST (dropWhile (ident e_e) rs_)])::bool list))";
neuper@37906
    55
neuper@37906
    56
neuper@37906
    57
"################################################### 6.5.03";
neuper@37906
    58
"############## Make_fun_by_new_variable ########### 6.5.03";
neuper@37906
    59
"################################################### 6.5.03";
neuper@37906
    60
Walther@60458
    61
val sc = (the o (TermC.parse Diff_App.thy)) (*start interpretieren*)
wneuper@59585
    62
  "Program Make_fun_by_new_variable (f_::real) (v_::real)     \
neuper@37906
    63
   \      (eqs_::bool list) =                                 \
neuper@37906
    64
   \(let h_ = (hd o (filterVar f_)) eqs_;             \
neuper@37906
    65
   \     es_ = dropWhile (ident h_) eqs_;                    \
neuper@37906
    66
   \     vs_ = dropWhile (ident f_) (Vars h_);                \
neuper@37906
    67
   \     v_1 = nth_ 1 vs_;                                   \
neuper@37906
    68
   \     v_2 = nth_ 2 vs_;                                   \
neuper@37906
    69
   \     e_1 = (hd o (filterVar v_1)) es_;            \
neuper@37906
    70
   \     e_2 = (hd o (filterVar v_2)) es_;            \
wneuper@59476
    71
   \  (s_1::bool list) = (SubProblem (Reals_s,[univar,equation],[no_met])\
neuper@37984
    72
   \                    [BOOL e_1, REAL v_1]);\
wneuper@59476
    73
   \  (s_2::bool list) = (SubProblem (Reals_s,[univar,equation],[no_met])\
neuper@37984
    74
   \                    [BOOL e_2, REAL v_2])\
neuper@37906
    75
   \in Substitute [(v_1 = (rhs o hd) s_1),(v_2 = (rhs o hd) s_2)] h_)";
neuper@37906
    76
Walther@60458
    77
val ags = map (Thm.term_of o the o (TermC.parse Diff_App.thy)) 
neuper@37906
    78
  ["A::real", "alpha::real", 
wneuper@59582
    79
   "[A=a*b, a/2=r*sin alpha, b/2=r*cos (alpha::real)]"];
neuper@37906
    80
val ll = [](*:loc_*);
neuper@37906
    81
(* problem with exn PTREE + eval_to -------------------------
neuper@37906
    82
"-------------- subproblem with empty formalizaton -------";
neuper@37906
    83
val (mI1,m1) = 
neuper@37906
    84
  ("Subproblem", tac2tac_ pt p
walther@59997
    85
   (Subproblem (("Reals",["univar", "equation", "test"],
neuper@37906
    86
		(""(*"ANDERN !!!!!!!*),"no_met")),[])));
neuper@37906
    87
val (mI2,m2) = (mI1,m1);
neuper@37906
    88
val (mI3,m3) = 
neuper@37906
    89
  ("Substitute", tac2tac_ pt p
walther@59997
    90
   (Substitute [("a", "#2*r*sin alpha"),("b", "#2*r*cos alpha")]));
neuper@37906
    91
"------- same_tacpbl + eval_to -------";
neuper@37926
    92
val SOME(l1,t1) = same_tacpbl sc ll (mI1,m1);
neuper@37906
    93
loc_2str l1;
neuper@37906
    94
(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, L, R]"*)
Walther@60458
    95
Syntax.string_of_term (ThyC.id_to_ctxt "Diff_App") t1;
neuper@37906
    96
(*"solve_univar (Reals, [univar, equation], no_met) B.1 B.3 "?6 ?4 *)
neuper@37906
    97
neuper@37926
    98
val SOME(l2,t2) = same_tacpbl sc l1 (mI2,m2);
neuper@37906
    99
loc_2str l2;
neuper@37906
   100
(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D, L, R]"*)
Walther@60458
   101
Syntax.string_of_term (ThyC.id_to_ctxt "Diff_App") t2;
neuper@37906
   102
(*"solve_univar (Reals, [univar, equation], no_met) B.1 B.3 "?7 ?3 *)
neuper@37906
   103
neuper@37926
   104
val SOME(l3,t3) = same_tacpbl sc l2 (mI3,m3);
neuper@37906
   105
loc_2str l3;
neuper@37906
   106
(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D]"*)
Walther@60458
   107
Syntax.string_of_term (ThyC.id_to_ctxt "Diff_App") t3;
neuper@37906
   108
(*"Substitute [(v_1, (Rhs o hd) B.1), (v_2, (Rhs o hd) B.0)] B.8"*)
neuper@37906
   109
neuper@37906
   110
neuper@37906
   111
"------- eq_tacIDs + eq_consts + eval_args -------";
neuper@37906
   112
val eq_ids = eq_tacIDs (*start-loc_*)[] sc (mI,m) [];
neuper@37906
   113
val eq_cons = filter (eq_consts m) eq_ids;
neuper@37906
   114
val Ready (l,(_,m)::_,_) = eval_args sc (mI,m) [(1,ags)] eq_cons;
neuper@37906
   115
"------- locate -------";
neuper@37906
   116
neuper@37906
   117
neuper@37906
   118
"-------------- subproblem with formalizaton -------";
neuper@37906
   119
val (mI,m) = 
neuper@37906
   120
  ("Subproblem", tac2tac_ pt []
walther@59997
   121
   (Subproblem (("Reals",["univar", "equation", "test"],
neuper@37906
   122
		(""(*"ANDERN !!!!!!!*),"no_met")),
walther@59997
   123
	       ["a//#2=r*sin alpha", "a"])));
neuper@37906
   124
"------- same_tacpbl + eval_to -------";
neuper@37906
   125
neuper@37906
   126
neuper@37906
   127
"------- eq_tacIDs + eq_consts + eval_args -------";
neuper@37906
   128
val eq_ids = eq_tacIDs [] sc (mI,m) [];
neuper@37906
   129
val eq_cons = filter (eq_consts m) eq_ids;
neuper@37906
   130
val Ready (l,(_,m)::_,_) = eval_args sc (mI,m) [(1,ags)] eq_cons;
neuper@37906
   131
neuper@37906
   132
neuper@37906
   133
"------- locate -------";
neuper@37906
   134
-------------------------------------------------------*)
neuper@37906
   135
(* use"ME/script.sml";
neuper@37906
   136
   use"test-script.sml";
neuper@37906
   137
   *)
neuper@37906
   138
neuper@37906
   139
neuper@37906
   140
neuper@37906
   141
"############## Make_fun_by_explicit ############## 6.5.03";
neuper@37906
   142
"############## Make_fun_by_explicit ############## 6.5.03";
neuper@37906
   143
"############## Make_fun_by_explicit ############## 6.5.03";
Walther@60458
   144
val c = (the o (TermC.parse Diff_App.thy)) 
wneuper@59585
   145
   "Program Make_fun_by_explicit (f_::real) (v_::real)         \
neuper@37906
   146
   \      (eqs_::bool list) =                                 \
neuper@37906
   147
   \ (let h_  = (hd o (filterVar f_)) eqs_;                   \
neuper@37906
   148
   \      e_1 = hd (dropWhile (ident h_) eqs_);               \
neuper@37906
   149
   \      vs_ = dropWhile (ident f_) (Vars h_);                \
neuper@37981
   150
   \      v_1 = hd (dropWhile (ident v_v) vs_);                \
wneuper@59476
   151
   \      (s_1::bool list)=(SubProblem(Reals_s,[univar,equation],[no_met])\
neuper@37984
   152
   \                          [BOOL e_1, REAL v_1])\
neuper@37906
   153
   \ in Substitute [(v_1 = (rhs o hd) s_1)] h_)";
neuper@37906
   154
neuper@37906
   155
neuper@37906
   156
(*#####################################################--------11.5.02
neuper@37906
   157
"################ Solve_root_equation #################";
neuper@37906
   158
(*#####################################################*)
walther@60230
   159
val sc = (Thm.term_of o the o (TermC.parse Test.thy))
wneuper@59585
   160
  "Program Solve_root_equation (eq_::bool) (v_::real) (err_::bool) =\
neuper@37981
   161
   \ (let e_e = Rewrite square_equation_left True eq_;     \
neuper@37981
   162
   \      e_e = Rewrite_Set Test_simplify False e_;          \
neuper@37981
   163
   \      e_e = Rewrite_Set rearrange_assoc False e_;          \
neuper@37981
   164
   \      e_e = Rewrite_Set isolate_root False e_;             \
neuper@37981
   165
   \      e_e = Rewrite_Set Test_simplify False e_;          \
neuper@37906
   166
neuper@37981
   167
   \      e_e = Rewrite square_equation_left True e_;        \
neuper@37981
   168
   \      e_e = Rewrite_Set Test_simplify False e_;          \
neuper@37906
   169
neuper@37981
   170
   \      e_e = Rewrite_Set norm_equation False e_;        \
neuper@37981
   171
   \      e_e = Rewrite_Set Test_simplify False e_;      \
wneuper@59497
   172
   \      e_e = Rewrite_Set_Inst [(''bdv'',v_)] isolate_bdv False e_;\
neuper@37981
   173
   \      e_e = Rewrite_Set Test_simplify False e_e       \
neuper@37906
   174
   \ in [e_::bool])";
walther@60230
   175
val ags = map (Thm.term_of o the o (TermC.parse Test.thy)) 
walther@59997
   176
  ["sqrt(#9+#4*x)=sqrt x + sqrt(#5+x)", "x::real", "#0"];
neuper@37906
   177
val fmz = 
neuper@37906
   178
  ["equality (sqrt(#9+#4*x)=sqrt x + sqrt(#5+x))",
walther@59997
   179
   "solveFor x", "errorBound (eps = #0)", "solutions v_i_"];
neuper@37906
   180
----------------------------------------------------------------11.5.02...*)
neuper@37906
   181
neuper@37906
   182
walther@59814
   183
(*################################# me raises exception with not-locatable
neuper@37906
   184
"--------------------- Notlocatable: Free_Solve ---------------------";
neuper@37906
   185
"--------------------- Notlocatable: Free_Solve ---------------------";
neuper@37906
   186
"--------------------- Notlocatable: Free_Solve ---------------------";
neuper@37906
   187
val fmz = []; 
neuper@37906
   188
val (dI',pI',mI') =
walther@59997
   189
  ("Test",["sqroot-test", "univariate", "equation", "test"],
walther@59997
   190
   ["Test", "sqrt-equ-test"]);
Walther@60571
   191
val (p,_,f,nxt,_,pt) = Test_Code.init_calc @{context} [(fmz, (dI',pI',mI'))];
neuper@37906
   192
val nxt = ("Model_Problem",
walther@59997
   193
	   Model_Problem ["sqroot-test", "univariate", "equation", "test"]);
neuper@37906
   194
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   195
val nxt =
neuper@37906
   196
  ("Add_Given",
neuper@37906
   197
   Add_Given "equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))");
neuper@37906
   198
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   199
val nxt = ("Add_Given",Add_Given "solveFor x");
neuper@37906
   200
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   201
val nxt = ("Add_Given",Add_Given "errorBound (eps = 0)");
neuper@37906
   202
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   203
val nxt = ("Add_Find",Add_Find "solutions v_i_");
neuper@37906
   204
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38058
   205
val nxt = ("Specify_Theory",Specify_Theory "Test");
neuper@37906
   206
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   207
val nxt =
walther@59997
   208
  ("Specify_Problem",Specify_Problem ["sqroot-test", "univariate", "equation", "test"]);
neuper@37906
   209
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
walther@59997
   210
val nxt = ("Specify_Method",Specify_Method ["Test", "sqrt-equ-test"]);
neuper@37906
   211
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   212
neuper@37906
   213
"--- -1 ---";
neuper@37906
   214
val nxt = ("Free_Solve",Free_Solve);  
neuper@37906
   215
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   216
neuper@37906
   217
"--- 0 ---";
neuper@37906
   218
val nxt = ("Take",Take "sqrt(9+4*x)=sqrt x + sqrt(5+x)");
neuper@37906
   219
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   220
(*me ("Begin_Trans" ////*)
neuper@37906
   221
neuper@37906
   222
"--- 1 ---";
walther@59997
   223
val nxt = ("Rewrite_Asm",Rewrite_Asm ("square_equation_left", ""));
neuper@37906
   224
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   225
neuper@37906
   226
"--- 2 ---";
neuper@37906
   227
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   228
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   229
neuper@37906
   230
"--- 3 ---";
neuper@37906
   231
val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
neuper@37906
   232
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   233
if f = Form'
walther@59959
   234
    (Test_Out.FormKF
neuper@37906
   235
       (~1,EdUndef,1,Nundef,
walther@60242
   236
        "9 + 4 * x = 5 + 2 * x + 2 * sqrt (x \<up> 2 + 5 * x)"))
neuper@38031
   237
then () else error "behaviour in root-expl. Free_Solve changed";
Walther@60608
   238
writeln (pr_ctree ctxt pr_short pt);
walther@59814
   239
---------------------------------me raises exception with not-locatable*)
neuper@37906
   240
neuper@37906
   241
walther@59852
   242
val d = Rule_Set.empty;
neuper@37906
   243
neuper@37906
   244
"  --- test100:  nxt_tac order------------------------------------ ";
neuper@37906
   245
"  --- test100:  nxt_tac order------------------------------------ ";
neuper@37906
   246
Walther@60586
   247
val program as (Prog sc) = Prog (((inst_abs Test.thy) 
walther@60230
   248
				  o Thm.term_of o the o (TermC.parse thy))
wneuper@59585
   249
 "Program Testeq (e_e::bool) =                                        \
neuper@37981
   250
   \(While (contains_root e_e) Do                                     \
walther@59637
   251
   \((Try (Repeat (Rewrite rroot_square_inv))) #>    \
walther@59637
   252
   \  (Try (Repeat (Rewrite square_equation_left))) #> \
walther@59635
   253
   \  (Try (Repeat (Rewrite radd_0)))))\
neuper@37981
   254
   \ e_e            ");
Walther@60650
   255
TermC.atom_trace_detail @{context} sc;
walther@59997
   256
val (dI',pI',mI') = ("Test",["sqroot-test", "univariate", "equation", "test"],
walther@59997
   257
		     ["Test", "sqrt-equ-test"]);
walther@59926
   258
val c = []; 
Walther@60571
   259
val (p,_,_,_,_,pt) = Test_Code.init_calc @{context} [([], (dI',pI',mI')))];
neuper@38058
   260
val nxt = ("Specify_Theory",Specify_Theory "Test");
neuper@37906
   261
val (p,_,_,_,_,pt) = me nxt p c pt;
walther@59997
   262
val nxt = ("Specify_Method",Specify_Method ["Test", "sqrt-equ-test"]); (*for asm in square_equation_left*)
neuper@37906
   263
val (p,_,_,_,_,pt) = me nxt p c pt;
neuper@37906
   264
val p = ([1],Res):pos';
walther@60230
   265
val eq_ = (Thm.term_of o the o (TermC.parse thy))"e_::bool";
neuper@37906
   266
walther@60242
   267
val ct =   "0+(sqrt(sqrt(sqrt a)) \<up> 2) \<up> 2=0";
walther@60340
   268
val ve0_= (Thm.term_of o the o (TermC.parse thy)) ct;
walther@59997
   269
val ets0=[([],(Tac_(Program.thy,"BS", "", ""),[(eq_,ve0_)],[(eq_,ve0_)],
walther@59861
   270
	       TermC.empty,TermC.empty,Safe)),
walther@59861
   271
	  ([],(User', [],                [],        TermC.empty, TermC.empty,Sundef))]:ets;
neuper@37906
   272
val l0 = [];
neuper@37906
   273
" --------------- 1. ---------------------------------------------";
Walther@60565
   274
val (pt,_) = cappend_atomic pt[1]Istate.empty TermC.empty(Rewrite("test", ""))(TermC.parse_test @{context} ct,[])Complete;
neuper@37906
   275
(*12.10.03:*** Unknown theorem(s) "rroot_square_inv"
walther@59997
   276
val Applicable.Yes m' = Step.check (Rewrite("rroot_square_inv", "")) (pt, p);
neuper@37906
   277
*)
neuper@37906
   278
neuper@37906
   279
Walther@60586
   280
val program as (Prog sc) = 
walther@60230
   281
    Prog (((inst_abs Test.thy)  o Thm.term_of o the o (TermC.parse thy)) 
wneuper@59585
   282
 "Program Testterm (g_::real) = (Calculate cancel g_)");
neuper@37906
   283
(*
Walther@60586
   284
val program as (Prog sc) = 
walther@60230
   285
    Prog (((inst_abs Test.thy)  o Thm.term_of o the o (TermC.parse thy)) 
wneuper@59585
   286
 "Program Testterm (g_::real) = (Calculate power g_)");
Walther@60586
   287
val program as (Prog sc) = 
walther@60230
   288
    Prog (((inst_abs Test.thy)  o Thm.term_of o the o (TermC.parse thy)) 
wneuper@59585
   289
 "Program Testterm (g_::real) = (Calculate pow g_)");
neuper@37906
   290
..............................................................*)
neuper@37906
   291
writeln
neuper@37906
   292
"%%%%%%%%%%TODO 7.9.00---vvvvvv--- conflicts with Isa-types \n\
neuper@37906
   293
\     (Repeat (Calculate cancel g_)) Or                     \n\
neuper@37906
   294
\     (Repeat (Calculate power g_)) Or                        \n\
walther@60242
   295
\%%%%%%%%%%%%%%%%%%%%%--- \<up>  \<up> --- conflicts with Isa-types \n\
neuper@37906
   296
\%%%%%%%%%%%%%%%%%%%%%TODO before Detail Rewrite_Set";
neuper@37906
   297
neuper@37906
   298
walther@59823
   299
"--------- from_prog ---------------------------------------------";
walther@59823
   300
"--------- from_prog ---------------------------------------------";
walther@59823
   301
"--------- from_prog ---------------------------------------------";
neuper@42438
   302
(* mv test/../script.sml: -----> *)
walther@59823
   303
"----------- fun from_prog ---------------------------------------"
neuper@37906
   304