src/sml/systest/script.sml
author neuper
Fri, 09 May 2003 23:16:32 +0200
changeset 710 afa379bfb2c6
parent 338 90390fecbe74
child 750 3923c33ced32
permissions -rw-r--r--
*** empty log message ***
agriesma@338
     1
(* use"test-script.sml";
agriesma@338
     2
   WN.13.3.00
agriesma@338
     3
  *)
agriesma@338
     4
agriesma@338
     5
"         scripts: Variante 'funktional'               ";
agriesma@338
     6
"############## Make_fun_by_new_variable ##############";
agriesma@338
     7
"############## Make_fun_by_explicit ##############";
agriesma@338
     8
"################ Solve_root_equation #################";
agriesma@338
     9
"------- Notlocatable: Free_Solve -------";
agriesma@338
    10
agriesma@338
    11
"  --- test100:  nxt_tac order------------------------------------ ";
agriesma@338
    12
"  --- test100:  order 1 3 1 2 ----------------------------------- ";
agriesma@338
    13
" --- test200: nxt_tac order ------------------------------------- ";
agriesma@338
    14
" --- test200: order 3 1 1 2 --------------------------------- ";
agriesma@338
    15
agriesma@338
    16
"  --- root-equation:  nxt_tac order------------------------------ ";
agriesma@338
    17
"  --- root-equation:  1.norm_equation ------------------------------ ";
agriesma@338
    18
(* --- test200: calculate -----------------------------------------*)
agriesma@338
    19
"  --- check_elementwise ------------------------------ ";
agriesma@338
    20
agriesma@338
    21
"  --- test 30.4.02 Testterm:  Repeat Repeat Or ------------------ ";
agriesma@338
    22
"  --- test 9.5.02 Testeq: While Try Repeat @@ ------------------ ";
agriesma@338
    23
agriesma@338
    24
agriesma@338
    25
agriesma@338
    26
agriesma@338
    27
agriesma@338
    28
neuper@710
    29
" #################################################### 6.5.03";
neuper@710
    30
"         scripts: Variante 'funktional'               6.5.03";
neuper@710
    31
" #################################################### 6.5.03 ";
agriesma@338
    32
agriesma@338
    33
val c = (the o (parse DiffApp.thy)) 
agriesma@338
    34
  "Script Maximum_value(fix_::bool list)(m_::real) (rs_::bool list)\
agriesma@338
    35
   \      (v_::real) (itv_::real set) (err_::bool) =          \ 
neuper@710
    36
   \ (let e_ = (hd o (filterVar m_)) rs_;              \
neuper@710
    37
   \      t_ = (if 1 < length_ rs_                            \
neuper@710
    38
   \           then (SubProblem (Reals_,[make,function],[no_met])\
agriesma@338
    39
   \                     [real_ m_, real_ v_, bool_list_ rs_])\
agriesma@338
    40
   \           else (hd rs_));                                \
agriesma@338
    41
   \      (mx_::real) = SubProblem (Reals_,[on_interval,max_of,function], \
neuper@710
    42
   \                                [Isac,maximum_on_interval])\
agriesma@338
    43
   \                               [bool_ t_, real_ v_, real_set_ itv_]\
neuper@710
    44
   \ in ((SubProblem (Reals_,[find_values,tool],[Isac,find_values])   \
agriesma@338
    45
   \      [real_ mx_, real_ (Rhs t_), real_ v_, real_ m_,     \
agriesma@338
    46
   \       bool_list_ (dropWhile (ident e_) rs_)])::bool list))";
agriesma@338
    47
agriesma@338
    48
neuper@710
    49
"###################################################### 6.5.03";
neuper@710
    50
"############## Make_fun_by_new_variable ############## 6.5.03";
neuper@710
    51
"###################################################### 6.5.03";
agriesma@338
    52
agriesma@338
    53
val sc = (the o (parse DiffApp.thy)) (*start interpretieren*)
agriesma@338
    54
  "Script Make_fun_by_new_variable (f_::real) (v_::real)     \
agriesma@338
    55
   \      (eqs_::bool list) =                                 \
neuper@710
    56
   \(let h_ = (hd o (filterVar f_)) eqs_;             \
agriesma@338
    57
   \     es_ = dropWhile (ident h_) eqs_;                    \
neuper@710
    58
   \     vs_ = dropWhile (ident f_) (Vars h_);                \
neuper@710
    59
   \     v_1 = nth_ 1 vs_;                                   \
neuper@710
    60
   \     v_2 = nth_ 2 vs_;                                   \
neuper@710
    61
   \     e_1 = (hd o (filterVar v_1)) es_;            \
neuper@710
    62
   \     e_2 = (hd o (filterVar v_2)) es_;            \
neuper@710
    63
   \  (s_1::bool list) = (SubProblem (Reals_,[univar,equation],[no_met])\
neuper@710
    64
   \                    [bool_ e_1, real_ v_1]);\
neuper@710
    65
   \  (s_2::bool list) = (SubProblem (Reals_,[univar,equation],[no_met])\
neuper@710
    66
   \                    [bool_ e_2, real_ v_2])\
neuper@710
    67
   \in Substitute [(v_1, (rhs o hd) s_1),(v_2, (rhs o hd) s_2)] h_)";
neuper@710
    68
agriesma@338
    69
val ags = map (term_of o the o (parse DiffApp.thy)) 
agriesma@338
    70
  ["A::real", "alpha::real", 
agriesma@338
    71
   "[A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]"];
agriesma@338
    72
val ll = []:loc_;
agriesma@338
    73
(* problem with exn PTREE + eval_to -------------------------
agriesma@338
    74
"-------------- subproblem with empty formalizaton -------";
agriesma@338
    75
val (mI1,m1) = 
agriesma@338
    76
  ("Subproblem", mstep2mstep' pt p
agriesma@338
    77
   (Subproblem (("Reals",["univar","equation","test"],
agriesma@338
    78
		(""(*"ANDERN !!!!!!!*),"no_met")),[])));
agriesma@338
    79
val (mI2,m2) = (mI1,m1);
agriesma@338
    80
val (mI3,m3) = 
agriesma@338
    81
  ("Substitute", mstep2mstep' pt p
agriesma@338
    82
   (Substitute [("a","#2*r*sin alpha"),("b","#2*r*cos alpha")]));
agriesma@338
    83
"------- same_tacpbl + eval_to -------";
agriesma@338
    84
val Some(l1,t1) = same_tacpbl sc ll (mI1,m1);
agriesma@338
    85
loc_2str l1;
agriesma@338
    86
(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, L, R]"*)
agriesma@338
    87
Sign.string_of_term (sign_of DiffApp.thy) t1;
agriesma@338
    88
(*"solve_univar (Reals, [univar, equation], no_met) B.1 B.3 "?6 ?4 *)
agriesma@338
    89
agriesma@338
    90
val Some(l2,t2) = same_tacpbl sc l1 (mI2,m2);
agriesma@338
    91
loc_2str l2;
agriesma@338
    92
(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D, L, R]"*)
agriesma@338
    93
Sign.string_of_term (sign_of DiffApp.thy) t2;
agriesma@338
    94
(*"solve_univar (Reals, [univar, equation], no_met) B.1 B.3 "?7 ?3 *)
agriesma@338
    95
agriesma@338
    96
val Some(l3,t3) = same_tacpbl sc l2 (mI3,m3);
agriesma@338
    97
loc_2str l3;
agriesma@338
    98
(*"[R, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D, R, D]"*)
agriesma@338
    99
Sign.string_of_term (sign_of DiffApp.thy) t3;
agriesma@338
   100
(*"Substitute [(v_1, (Rhs o hd) B.1), (v_2, (Rhs o hd) B.0)] B.8"*)
agriesma@338
   101
agriesma@338
   102
agriesma@338
   103
"------- eq_tacIDs + eq_consts + eval_args -------";
agriesma@338
   104
val eq_ids = eq_tacIDs (*start-loc_*)[] sc (mI,m) [];
agriesma@338
   105
val eq_cons = filter (eq_consts m) eq_ids;
agriesma@338
   106
val Ready (l,(_,m)::_,_) = eval_args sc (mI,m) [(1,ags)] eq_cons;
agriesma@338
   107
"------- locate -------";
agriesma@338
   108
agriesma@338
   109
agriesma@338
   110
"-------------- subproblem with formalizaton -------";
agriesma@338
   111
val (mI,m) = 
agriesma@338
   112
  ("Subproblem", mstep2mstep' pt []
agriesma@338
   113
   (Subproblem (("Reals",["univar","equation","test"],
agriesma@338
   114
		(""(*"ANDERN !!!!!!!*),"no_met")),
agriesma@338
   115
	       ["a//#2=r*sin alpha","a"])));
agriesma@338
   116
"------- same_tacpbl + eval_to -------";
agriesma@338
   117
agriesma@338
   118
agriesma@338
   119
"------- eq_tacIDs + eq_consts + eval_args -------";
agriesma@338
   120
val eq_ids = eq_tacIDs [] sc (mI,m) [];
agriesma@338
   121
val eq_cons = filter (eq_consts m) eq_ids;
agriesma@338
   122
val Ready (l,(_,m)::_,_) = eval_args sc (mI,m) [(1,ags)] eq_cons;
agriesma@338
   123
agriesma@338
   124
agriesma@338
   125
"------- locate -------";
agriesma@338
   126
-------------------------------------------------------*)
agriesma@338
   127
(* use"ME/script.sml";
agriesma@338
   128
   use"test-script.sml";
agriesma@338
   129
   *)
agriesma@338
   130
agriesma@338
   131
agriesma@338
   132
neuper@710
   133
"############## Make_fun_by_explicit ############## 6.5.03";
neuper@710
   134
"############## Make_fun_by_explicit ############## 6.5.03";
neuper@710
   135
"############## Make_fun_by_explicit ############## 6.5.03";
agriesma@338
   136
val c = (the o (parse DiffApp.thy)) 
neuper@710
   137
   "Script Make_fun_by_explicit (f_::real) (v_::real)         \
agriesma@338
   138
   \      (eqs_::bool list) =                                 \
neuper@710
   139
   \ (let h_  = (hd o (filterVar f_)) eqs_;                   \
neuper@710
   140
   \      e_1 = hd (dropWhile (ident h_) eqs_);               \
neuper@710
   141
   \      vs_ = dropWhile (ident f_) (Vars h_);                \
neuper@710
   142
   \      v_1 = hd (dropWhile (ident v_) vs_);                \
neuper@710
   143
   \      (s_1::bool list)=(SubProblem(Reals_,[univar,equation],[no_met])\
neuper@710
   144
   \                          [bool_ e_1, real_ v_1])\
neuper@710
   145
   \ in Substitute [(v_1, (rhs o hd) s_1)] h_)";
agriesma@338
   146
agriesma@338
   147
agriesma@338
   148
(*#####################################################--------11.5.02
agriesma@338
   149
"################ Solve_root_equation #################";
agriesma@338
   150
(*#####################################################*)
agriesma@338
   151
val sc = (term_of o the o (parse Test.thy))
agriesma@338
   152
  "Script Solve_root_equation (eq_::bool) (v_::real) (err_::bool) =\
agriesma@338
   153
   \ (let e_ = Rewrite square_equation_left True eq_;     \
agriesma@338
   154
   \      e_ = Rewrite_Set Test_simplify False e_;          \
agriesma@338
   155
   \      e_ = Rewrite_Set rearrange_assoc False e_;          \
agriesma@338
   156
   \      e_ = Rewrite_Set isolate_root False e_;             \
agriesma@338
   157
   \      e_ = Rewrite_Set Test_simplify False e_;          \
agriesma@338
   158
agriesma@338
   159
   \      e_ = Rewrite square_equation_left True e_;        \
agriesma@338
   160
   \      e_ = Rewrite_Set Test_simplify False e_;          \
agriesma@338
   161
agriesma@338
   162
   \      e_ = Rewrite_Set norm_equation False e_;        \
agriesma@338
   163
   \      e_ = Rewrite_Set Test_simplify False e_;      \
agriesma@338
   164
   \      e_ = Rewrite_Set_Inst [(bdv,v_)] isolate_bdv False e_;\
agriesma@338
   165
   \      e_ = Rewrite_Set Test_simplify False e_       \
agriesma@338
   166
   \ in [e_::bool])";
agriesma@338
   167
val ags = map (term_of o the o (parse Test.thy)) 
agriesma@338
   168
  ["sqrt(#9+#4*x)=sqrt x + sqrt(#5+x)", "x::real","#0"];
agriesma@338
   169
val fmz = 
agriesma@338
   170
  ["equality (sqrt(#9+#4*x)=sqrt x + sqrt(#5+x))",
agriesma@338
   171
   "solveFor x","errorBound (eps = #0)","solutions v_i_"];
agriesma@338
   172
----------------------------------------------------------------11.5.02...*)
agriesma@338
   173
agriesma@338
   174
agriesma@338
   175
(*#####################################################*)
neuper@710
   176
"--------------------- Notlocatable: Free_Solve ---------------------";
neuper@710
   177
"--------------------- Notlocatable: Free_Solve ---------------------";
neuper@710
   178
"--------------------- Notlocatable: Free_Solve ---------------------";
agriesma@338
   179
val fmz = []; 
agriesma@338
   180
val (dI',pI',mI') =
agriesma@338
   181
  ("Test.thy",["sqroot-test","univariate","equation","test"],
neuper@710
   182
   ["Test","sqrt-equ-test"]);
agriesma@338
   183
val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
agriesma@338
   184
val (p,_,f,nxt,_,pt) = me (mI,m) e_pos'[1] EmptyPtree;
agriesma@338
   185
val nxt =
agriesma@338
   186
  ("Add_Given",
agriesma@338
   187
   Add_Given "equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))");
agriesma@338
   188
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
agriesma@338
   189
val nxt = ("Add_Given",Add_Given "solveFor x");
agriesma@338
   190
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
agriesma@338
   191
val nxt = ("Add_Given",Add_Given "errorBound (eps = 0)");
agriesma@338
   192
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
agriesma@338
   193
val nxt = ("Add_Find",Add_Find "solutions v_i_");
agriesma@338
   194
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
agriesma@338
   195
val nxt = ("Specify_Domain",Specify_Domain "Test.thy");
agriesma@338
   196
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
agriesma@338
   197
val nxt =
agriesma@338
   198
  ("Specify_Problem",Specify_Problem ["sqroot-test","univariate","equation","test"]);
agriesma@338
   199
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@710
   200
val nxt = ("Specify_Method",Specify_Method ["Test","sqrt-equ-test"]);
agriesma@338
   201
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
agriesma@338
   202
agriesma@338
   203
"--- -1 ---";
agriesma@338
   204
val nxt = ("Free_Solve",Free_Solve);  
agriesma@338
   205
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
agriesma@338
   206
agriesma@338
   207
"--- 0 ---";
agriesma@338
   208
val nxt = ("Take",Take "sqrt(9+4*x)=sqrt x + sqrt(5+x)");
agriesma@338
   209
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
agriesma@338
   210
(*me ("Begin_Trans" ////*)
agriesma@338
   211
agriesma@338
   212
"--- 1 ---";
agriesma@338
   213
val nxt = ("Rewrite_Asm",Rewrite_Asm ("square_equation_left",""));
agriesma@338
   214
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
agriesma@338
   215
agriesma@338
   216
"--- 2 ---";
agriesma@338
   217
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
agriesma@338
   218
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
agriesma@338
   219
agriesma@338
   220
"--- 3 ---";
agriesma@338
   221
val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
agriesma@338
   222
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
agriesma@338
   223
if f = Form'
agriesma@338
   224
    (FormKF
agriesma@338
   225
       (~1,EdUndef,1,Nundef,
agriesma@338
   226
        "9 + 4 * x = 5 + 2 * x + 2 * sqrt (x ^^^ 2 + 5 * x)"))
agriesma@338
   227
then () else raise error "behaviour in root-expl. Free_Solve changed";
agriesma@338
   228
writeln (pr_ptree pr_short pt);
agriesma@338
   229
agriesma@338
   230
agriesma@338
   231
agriesma@338
   232
val d = e_rls;
agriesma@338
   233
agriesma@338
   234
"  --- test100:  nxt_tac order------------------------------------ ";
agriesma@338
   235
"  --- test100:  nxt_tac order------------------------------------ ";
agriesma@338
   236
agriesma@338
   237
val scr as (Script sc) = Script (((inst_abs Test.thy) 
agriesma@338
   238
				  o term_of o the o (parse thy))
agriesma@338
   239
 "Script Testeq (e_::bool) =                                        \
agriesma@338
   240
   \(While (contains_root e_) Do                                     \
agriesma@338
   241
   \((Try (Repeat (Rewrite rroot_square_inv False))) @@    \
agriesma@338
   242
   \  (Try (Repeat (Rewrite square_equation_left True))) @@ \
agriesma@338
   243
   \  (Try (Repeat (Rewrite radd_0 False)))))\
agriesma@338
   244
   \ e_            ");
agriesma@338
   245
atomty thy sc;
agriesma@338
   246
val (dI',pI',mI') = ("Test.thy",e_pblID,
neuper@710
   247
		     ["Test","sqrt-equ-test"]);
agriesma@338
   248
val p = e_pos'; val c = []; 
agriesma@338
   249
val (mI,m) = ("Init_Proof",Init_Proof ([], (dI',pI',mI')));
agriesma@338
   250
val (p,_,_,_,_,pt) = me (mI,m) p c  EmptyPtree;
agriesma@338
   251
val nxt = ("Specify_Domain",Specify_Domain "Test.thy");
agriesma@338
   252
val (p,_,_,_,_,pt) = me nxt p c pt;
neuper@710
   253
val nxt = ("Specify_Method",Specify_Method ["Test","sqrt-equ-test"]); (*for asm in square_equation_left*)
agriesma@338
   254
val (p,_,_,_,_,pt) = me nxt p c pt;
agriesma@338
   255
val p = ([1],Res):pos';
agriesma@338
   256
val eq_ = (term_of o the o (parse thy))"e_::bool";
agriesma@338
   257
agriesma@338
   258
val ct =   "0+(sqrt(sqrt(sqrt a))^^^2)^^^2=0";
agriesma@338
   259
val ve0_= (term_of o the o (parse thy)) ct;
agriesma@338
   260
val ets0=[([],(Mstep'(Script.thy,"BS","",""),[(eq_,ve0_)],[(eq_,ve0_)],
agriesma@338
   261
	       e_term,e_term,Safe)),
agriesma@338
   262
	  ([],(User', [],                [],        e_term, e_term,Sundef))]:ets;
agriesma@338
   263
val l0 = [];
agriesma@338
   264
" --------------- 1. ---------------------------------------------";
neuper@710
   265
val (pt,_) = cappend_atomic pt[1]e_istate""(Rewrite("test",""))(ct,[])Complete;
agriesma@338
   266
val Appl m'=applicable_in p pt (Rewrite("rroot_square_inv",""));
agriesma@338
   267
agriesma@338
   268
agriesma@338
   269
agriesma@338
   270
val scr as (Script sc) = 
agriesma@338
   271
    Script (((inst_abs Test.thy)  o term_of o the o (parse thy)) 
neuper@710
   272
 "Script Testterm (g_::real) = (Calculate cancel g_)");
neuper@710
   273
(*
neuper@710
   274
val scr as (Script sc) = 
neuper@710
   275
    Script (((inst_abs Test.thy)  o term_of o the o (parse thy)) 
neuper@710
   276
 "Script Testterm (g_::real) = (Calculate power g_)");
neuper@710
   277
val scr as (Script sc) = 
neuper@710
   278
    Script (((inst_abs Test.thy)  o term_of o the o (parse thy)) 
neuper@710
   279
 "Script Testterm (g_::real) = (Calculate pow g_)");
neuper@710
   280
..............................................................*)
agriesma@338
   281
writeln
agriesma@338
   282
"%%%%%%%%%%TODO 7.9.00---vvvvvv--- conflicts with Isa-types \n\
agriesma@338
   283
\     (Repeat (Calculate cancel g_)) Or                     \n\
neuper@710
   284
\     (Repeat (Calculate power g_)) Or                        \n\
agriesma@338
   285
\%%%%%%%%%%%%%%%%%%%%%---^^^^^^--- conflicts with Isa-types \n\
agriesma@338
   286
\%%%%%%%%%%%%%%%%%%%%%TODO before Detail Rewrite_Set";