test/Tools/isac/Interpret/calchead.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Thu, 22 Dec 2016 11:36:20 +0100
changeset 59279 255c853ea2f0
parent 59267 aab874fdd910
child 59306 a2baef20c741
permissions -rw-r--r--
renamed Ctree.ptree --> Ctree.ctree
akargl@42108
     1
  (* Title: tests on calchead.sml
neuper@38036
     2
   Author: Walther Neuper 051013,
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
neuper@38011
     5
12345678901234567890123456789012345678901234567890123456789012345678901234567890
neuper@38011
     6
        10        20        30        40        50        60        70        80
neuper@37906
     7
*)
neuper@37906
     8
neuper@38010
     9
"--------------------------------------------------------";
neuper@38010
    10
"table of contents --------------------------------------";
neuper@38010
    11
"--------------------------------------------------------";
neuper@38010
    12
"--------- get_interval after replace} other 2 ----------";
neuper@38010
    13
"--------- maximum example with 'specify' ---------------";
neuper@38010
    14
"--------- maximum example with 'specify', fmz <> [] ----";
neuper@38010
    15
"--------- maximum example with 'specify', fmz = [] -----";
neuper@38010
    16
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@38010
    17
"--------- regression test fun is_copy_named ------------";
neuper@38011
    18
"--------- regr.test fun cpy_nam ------------------------";
neuper@38051
    19
"--------- check specify phase --------------------------";
neuper@42279
    20
"--------- check: fmz matches pbt -----------------------";
wneuper@59265
    21
"--------- fun typeless ---------------------------------";
wneuper@59265
    22
"--------- fun variants_in ------------------------------";
wneuper@59265
    23
"--------- fun is_list_type -----------------------------";
wneuper@59265
    24
"--------- fun has_list_type ----------------------------";
wneuper@59265
    25
"--------- fun tag_form ---------------------------------";
wneuper@59265
    26
"--------- fun foldr1, foldl1 ---------------------------";
neuper@38010
    27
"--------------------------------------------------------";
neuper@38010
    28
"--------------------------------------------------------";
neuper@38010
    29
"--------------------------------------------------------";
neuper@38009
    30
akargl@42108
    31
neuper@38011
    32
"--------- get_interval after replace} other 2 ----------";
neuper@38011
    33
"--------- get_interval after replace} other 2 ----------";
neuper@38011
    34
"--------- get_interval after replace} other 2 ----------";
s1210629013@55445
    35
reset_states ();
neuper@41970
    36
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
    37
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
    38
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
    39
 Iterator 1;
neuper@37906
    40
 moveActiveRoot 1;
wneuper@59248
    41
 autoCalculate 1 CompleteCalc;
neuper@37906
    42
 moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
neuper@37906
    43
 replaceFormula 1 "x = 1"; 
neuper@37906
    44
 (*... returns calcChangedEvent with ...*)
neuper@37906
    45
 val (unc, del, gen) = (([1],Res), ([4],Res), ([3,2],Res));
neuper@37906
    46
 val ((pt,_),_) = get_calc 1;
neuper@37906
    47
wneuper@59111
    48
default_print_depth 99;map fst (get_interval ([],Pbl) ([],Res) 9999 pt);default_print_depth 3;
neuper@37906
    49
if map fst (get_interval ([],Pbl) ([],Res) 9999 pt) = 
neuper@37906
    50
    [([], Pbl), ([1], Frm),([1], Res), ([2], Res), ([3], Pbl), ([3, 1], Frm), 
neuper@37906
    51
     ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
neuper@37906
    52
      ([3, 2], Res)] then () else
neuper@38031
    53
error "calchead.sml: diff.behav. get_interval after replace} other 2 a";
neuper@37906
    54
wneuper@59111
    55
default_print_depth 99;map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt); default_print_depth 3;
neuper@37906
    56
if map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt) = 
neuper@37906
    57
    [([3, 2, 1], Res), ([3, 2, 2], Res), ([3, 2], Res)] then () else
neuper@38031
    58
error "modspec.sml: diff.behav. get_interval after replace} other 2 b";
neuper@37906
    59
neuper@37906
    60
"--------- maximum example with 'specify' ------------------------";
neuper@37906
    61
"--------- maximum example with 'specify' ------------------------";
neuper@37906
    62
"--------- maximum example with 'specify' ------------------------";
neuper@37906
    63
(*"              Specify_Problem (match_itms_oris)       ";*)
neuper@37906
    64
val fmz =
neuper@37906
    65
    ["fixedValues [r=Arbfix]","maximum A",
neuper@48894
    66
     "valuesFor [a,b::real]",
neuper@48894
    67
     "relations [A=a*(b::real), (a/2)^^^2 + (b/2)^^^2 = (r::real)^^^2]",
neuper@48894
    68
     "relations [A=a*(b::real), (a/2)^^^2 + (b/2)^^^2 = (r::real)^^^2]",
neuper@48894
    69
     "relations [A=a*(b::real), a/2=r*sin alpha, b/2 = (r::real)*cos alpha]",
neuper@37906
    70
neuper@37906
    71
     "boundVariable a","boundVariable b","boundVariable alpha",
neuper@37906
    72
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
    73
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
    74
     "interval {x::real. 0 <= x & x <= pi}",
neuper@37906
    75
     "errorBound (eps=(0::real))"];
neuper@37906
    76
val (dI',pI',mI') =
neuper@38058
    77
  ("DiffApp",["maximum_of","function"],
neuper@37906
    78
   ["DiffApp","max_by_calculus"]);
neuper@37906
    79
val c = []:cid;
neuper@37906
    80
neuper@37906
    81
val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
    82
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
    83
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
    84
(*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
neuper@37906
    85
neuper@37906
    86
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
    87
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
    88
(**)
neuper@37906
    89
neuper@37906
    90
val nxt = tac2tac_ pt p (Add_Find "valuesFor [(a::real)]"); 
wneuper@59267
    91
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
    92
if ppc<>(Problem [],  
neuper@37906
    93
         {Find=[Incompl "maximum",Incompl "valuesFor [a]"],
neuper@37906
    94
	  Given=[Correct "fixedValues [r = Arbfix]"],
neuper@48894
    95
	  Relate=[Incompl "relations"], Where=[],With=[]})
neuper@38031
    96
then error "test-maximum.sml: model stepwise - different behaviour" 
neuper@48894
    97
else ();
neuper@37906
    98
neuper@48894
    99
val nxt = tac2tac_ pt p (Add_Given "boundVariable (a::real)"); 
neuper@48894
   100
(* WN1130630 THE maximum example WORKS IN isabisac09-2; 
neuper@48894
   101
  MOST LIKELY IT IS BROKEN BY INTRODUCING  ctxt. 
neuper@48894
   102
  Some tests have been broken much earlier, 
neuper@48894
   103
  see test/../calchead.sml "inhibit exn 010830". *)
neuper@48894
   104
(*========== inhibit exn WN1130630 maximum example broken =========================
wneuper@59267
   105
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@48894
   106
============ inhibit exn WN1130630 maximum example broken =======================*)
neuper@48894
   107
neuper@48894
   108
val nxt = tac2tac_ pt p (Add_Given "boundVariable a+"); 
neuper@48894
   109
(*========== inhibit exn WN1130630 maximum example broken =========================
akargl@42181
   110
(* ERROR: Exception Bind raised *)
wneuper@59267
   111
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@48894
   112
============ inhibit exn WN1130630 maximum example broken =======================*)
neuper@37906
   113
neuper@37906
   114
val m = Specify_Problem ["maximum_of","function"];
neuper@37906
   115
val nxt = tac2tac_ pt p m; 
wneuper@59267
   116
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@48894
   117
(*========== inhibit exn WN1130630 maximum example broken =========================
neuper@37906
   118
if ppc<>(Problem ["maximum_of","function"],  
neuper@37906
   119
         {Find=[Incompl "maximum",Incompl "valuesFor"],
neuper@37906
   120
	  Given=[Correct "fixedValues [r = Arbfix]"],
neuper@37906
   121
	  Relate=[Incompl "relations []"], Where=[],With=[]})
neuper@38031
   122
then error "diffappl.sml: Specify_Problem different behaviour" 
neuper@37906
   123
else ();
neuper@37906
   124
(* WN.3.9.03 (#391) Model_Specify did init_pbl newly 
neuper@37906
   125
if ppc<>(Problem ["maximum_of","function"],
neuper@37906
   126
   {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
neuper@37906
   127
    Given=[Correct "fixedValues [r = Arbfix]"],
neuper@37906
   128
    Relate=[Missing "relations rs_"],Where=[],With=[]})
neuper@38031
   129
then error "diffappl.sml: Specify_Problem different behaviour" 
neuper@37906
   130
else ();*)
neuper@48894
   131
============ inhibit exn WN1130630 maximum example broken =======================*)
neuper@37906
   132
neuper@37906
   133
val nxt = tac2tac_ pt p(Specify_Method ["DiffApp","max_by_calculus"]);
wneuper@59267
   134
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@48894
   135
(*========== inhibit exn WN1130630 maximum example broken =========================
neuper@37906
   136
if ppc<>(Method ["DiffApp","max_by_calculus"],
neuper@37906
   137
	 {Find=[Incompl "maximum",Incompl "valuesFor"],
neuper@37981
   138
	  Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_v",
neuper@37906
   139
		 Missing "interval itv_",Missing "errorBound err_"],
neuper@37906
   140
	  Relate=[Incompl "relations []"],Where=[],With=[]})
neuper@38031
   141
then error "diffappl.sml: Specify_Method different behaviour" 
neuper@37906
   142
else ();
neuper@37906
   143
(* WN.3.9.03 (#391) Model_Specify did init_pbl newly 
neuper@37906
   144
if ppc<>(Method ["DiffApp","max_by_calculus"],
neuper@37906
   145
   {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
neuper@37981
   146
    Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_v",
neuper@37906
   147
           Missing "interval itv_",Missing "errorBound err_"],
neuper@37906
   148
    Relate=[Missing "relations rs_"],Where=[],With=[]})
neuper@38031
   149
then error "diffappl.sml: Specify_Method different behaviour" 
neuper@37906
   150
else ();*)
neuper@48894
   151
============ inhibit exn WN1130630 maximum example broken =======================*)
neuper@37906
   152
neuper@37906
   153
"--------- maximum example with 'specify', fmz <> [] -------------";
neuper@37906
   154
"--------- maximum example with 'specify', fmz <> [] -------------";
neuper@37906
   155
"--------- maximum example with 'specify', fmz <> [] -------------";
neuper@37906
   156
val fmz =
neuper@37906
   157
    ["fixedValues [r=Arbfix]","maximum A",
neuper@37906
   158
     "valuesFor [a,b]",
neuper@37906
   159
     "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
   160
     "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
   161
     "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
neuper@37906
   162
neuper@37906
   163
     "boundVariable a","boundVariable b","boundVariable alpha",
neuper@37906
   164
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
   165
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
   166
     "interval {x::real. 0 <= x & x <= pi}",
neuper@37906
   167
     "errorBound (eps=(0::real))"];
neuper@37906
   168
val (dI',pI',mI') =
neuper@38058
   169
  ("DiffApp",["maximum_of","function"],
neuper@37906
   170
   ["DiffApp","max_by_calculus"]);
neuper@37906
   171
val c = []:cid;
neuper@37906
   172
(*val nxt = Init_Proof' (fmz,(dI',pI',mI'));*)
neuper@37906
   173
val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   174
neuper@37906
   175
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   176
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt e_pos' [] pt;
neuper@37906
   177
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   178
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   179
(*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
neuper@37906
   180
neuper@37906
   181
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   182
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   183
(*val nxt = Add_Find "maximum (A::bool)" : tac*)
neuper@37906
   184
neuper@37906
   185
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   186
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   187
(*val nxt = Add_Find "valuesFor [(a::real)]" : tac*)
neuper@37906
   188
neuper@37906
   189
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   190
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   191
(*val nxt = Add_Find "valuesFor [(b::real)]" : tac*)
neuper@37906
   192
neuper@37906
   193
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   194
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   195
(*val nxt = Add_Relation "relations [A = a * b]" *)
neuper@37906
   196
neuper@37906
   197
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   198
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   199
(*Add_Relation "relations\n [((a::real) // (#2::real)) ..."*)
neuper@37906
   200
neuper@37906
   201
(*---------------------------- FIXXXXME.meNEW !!! partial Add-Relation !!!
neuper@37906
   202
  nxt_specif <> specify ?!
neuper@37906
   203
neuper@37906
   204
if nxt<>(Add_Relation 
neuper@37906
   205
 "relations [(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]")
neuper@38031
   206
then error "test specify, fmz <> []: nxt <> Add_Relation (a/2)^2.." else (); (*different with show_types !!!*)
neuper@37906
   207
neuper@37906
   208
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   209
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   210
------------------------------ FIXXXXME.meNEW !!! ---*)
neuper@37906
   211
neuper@38058
   212
(*val nxt = Specify_Theory "DiffApp" : tac*)
neuper@37906
   213
neuper@37924
   214
val itms = get_obj g_pbl pt (fst p);writeln(itms2str_ ctxt itms);
neuper@37906
   215
neuper@37906
   216
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   217
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   218
(*val nxt = Specify_Problem ["maximum_of","function"]*)
neuper@37906
   219
neuper@37906
   220
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   221
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@38058
   222
(*val nxt = Specify_Method ("DiffApp","max_by_calculus")*)
neuper@37906
   223
neuper@37906
   224
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   225
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   226
(*val nxt = Add_Given "boundVariable a" : tac*)
neuper@37906
   227
neuper@37906
   228
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   229
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   230
(*val nxt = Add_Given "interval {x. #0 <= x & x <= #2 * r}" : *)
neuper@37906
   231
neuper@37906
   232
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   233
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   234
(*val nxt = Add_Given "errorBound (eps = #0)" : tac*)
neuper@37906
   235
neuper@37906
   236
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   237
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@38058
   238
(*val nxt = Apply_Method ("DiffApp","max_by_calculus") *)
wneuper@59253
   239
case nxt of (Apply_Method ["DiffApp","max_by_calculus"]) => ()
wneuper@59253
   240
| _ => error "test specify, fmz <> []: nxt <> Apply_Method max_by_calculus";
neuper@37906
   241
neuper@37906
   242
neuper@37906
   243
"--------- maximum example with 'specify', fmz = [] --------------";
neuper@37906
   244
"--------- maximum example with 'specify', fmz = [] --------------";
neuper@37906
   245
"--------- maximum example with 'specify', fmz = [] --------------";
neuper@37906
   246
val fmz = [];
neuper@37906
   247
val (dI',pI',mI') = empty_spec;
neuper@37906
   248
val c = []:cid;
neuper@37906
   249
neuper@37906
   250
val nxt = Init_Proof' (fmz,(dI',pI',mI'));(*!!!!!!!!*)
neuper@37906
   251
(*val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))]; !!!*)
wneuper@59267
   252
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt e_pos' [] 
neuper@37906
   253
  EmptyPtree;
neuper@37906
   254
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   255
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   256
(*val nxt = Specify_Theory "e_domID" : tac*)
neuper@37906
   257
neuper@38058
   258
val nxt = Specify_Theory "DiffApp";
neuper@37906
   259
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   260
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   261
(*val nxt = Specify_Problem ["e_pblID"] : tac*)
neuper@37906
   262
neuper@37906
   263
val nxt = Specify_Problem ["maximum_of","function"];
neuper@37906
   264
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   265
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   266
(*val nxt = Add_Given "fixedValues" : tac*)
neuper@37906
   267
neuper@37906
   268
val nxt = Add_Given "fixedValues [r=Arbfix]";
neuper@37906
   269
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   270
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   271
(*val nxt = Add_Find "maximum" : tac*)
neuper@37906
   272
neuper@37906
   273
val nxt = Add_Find "maximum A";
neuper@37906
   274
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   275
neuper@37906
   276
wneuper@59267
   277
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   278
(*val nxt = Add_Find "valuesFor" : tac*)
neuper@37906
   279
neuper@37906
   280
val nxt = Add_Find "valuesFor [a]";
neuper@37906
   281
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   282
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   283
(*val nxt = Add_Relation "relations" --- 
neuper@37906
   284
  --- [b=Arbfix] KANN NICHT VERLANGT WERDEN !!!!*)
neuper@37906
   285
akargl@42181
   286
(*========== inhibit exn 010830 =======================================================*)
neuper@37906
   287
(*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
neuper@37906
   288
if nxt<>(Add_Relation "relations []")
neuper@38031
   289
then error "test specify, fmz <> []: nxt <> Add_Relation.." 
neuper@37906
   290
else (); (*different with show_types !!!*)
neuper@37906
   291
*)
akargl@42181
   292
(*========== inhibit exn 010830 =======================================================*)
neuper@37906
   293
neuper@37906
   294
val nxt = Add_Relation "relations [(A=a+b)]";
neuper@37906
   295
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   296
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   297
(*val nxt = Specify_Method ("e_domID","e_metID") : tac*)
neuper@37906
   298
neuper@37906
   299
val nxt = Specify_Method ["DiffApp","max_by_calculus"];
neuper@37906
   300
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   301
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   302
(*val nxt = Add_Given "boundVariable" : tac*)
neuper@37906
   303
neuper@37906
   304
val nxt = Add_Given "boundVariable alpha";
neuper@37906
   305
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   306
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   307
(*val nxt = Add_Given "interval" : tac*)
neuper@37906
   308
neuper@37906
   309
val nxt = Add_Given "interval {x. 2 <= x & x <= 3}";
neuper@37906
   310
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   311
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   312
(*val nxt = Add_Given "errorBound" : tac*)
neuper@37906
   313
neuper@37906
   314
val nxt = Add_Given "errorBound (eps=999)";
neuper@37906
   315
val nxt = tac2tac_ pt p nxt; 
wneuper@59267
   316
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   317
(*val nxt = Apply_Method ("DiffApp","max_by_calculus") *)
akargl@42108
   318
neuper@37906
   319
(*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
neuper@38058
   320
if nxt<>(Apply_Method ("DiffApp","max_by_calculus"))
neuper@38031
   321
then error "test specify, fmz <> []: nxt <> Add_Relation.." 
neuper@37906
   322
else ();
neuper@37906
   323
*)
neuper@37906
   324
(* 2.4.00 nach Transfer specify -> hard_gen
neuper@38058
   325
val nxt = Apply_Method ("DiffApp","max_by_calculus");
wneuper@59267
   326
val(p,_, PpcKF ppc, nxt,_,pt) = specify nxt p [] pt; *)
neuper@37906
   327
(*val nxt = Empty_Tac : tac*)
neuper@38051
   328
neuper@38011
   329
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@38011
   330
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@38011
   331
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@37906
   332
val Const ("Script.SubProblem",_) $
neuper@41972
   333
	  (Const ("Product_Type.Pair",_) $
neuper@37906
   334
		 Free (dI',_) $ 
neuper@41972
   335
		 (Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   336
    (*...copied from stac2tac_*)
neuper@38011
   337
    str2term (
neuper@55279
   338
	"SubProblem (EqSystem', [LINEAR, system], [no_met])         " ^
neuper@38011
   339
        "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
neuper@38011
   340
        "      REAL_LIST [c, c_2]]");
neuper@37906
   341
val ags = isalist2list ags';
neuper@55279
   342
val pI = ["LINEAR","system"];
neuper@37906
   343
val pats = (#ppc o get_pbt) pI;
neuper@38011
   344
"-a1-----------------------------------------------------";
neuper@38011
   345
(*match_ags = fn : theory -> pat list -> term list -> ori list*)
neuper@48894
   346
val xxx = match_ags @{theory "EqSystem"} pats ags;
neuper@38011
   347
"-a2-----------------------------------------------------";
neuper@48894
   348
case match_ags @{theory  "Isac"} pats ags of 
neuper@37906
   349
    [(1, [1], "#Given", Const ("Descript.equalities", _), _),
neuper@37906
   350
     (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
neuper@37906
   351
      [ _ $ Free ("c", _) $ _, _ $ Free ("c_2", _) $ _]),
neuper@38011
   352
     (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])] 
neuper@37906
   353
    =>()
neuper@38031
   354
  | _ => error "calchead.sml match_ags 2 args Nok ----------------";
neuper@37906
   355
neuper@38011
   356
"-b------------------------------------------------------";
neuper@37906
   357
val Const ("Script.SubProblem",_) $
neuper@41972
   358
	  (Const ("Product_Type.Pair",_) $
neuper@37906
   359
		 Free (dI',_) $ 
neuper@41972
   360
		 (Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   361
    (*...copied from stac2tac_*)
neuper@38011
   362
    str2term (
neuper@55279
   363
	"SubProblem (EqSystem', [LINEAR, system], [no_met])         " ^
neuper@38011
   364
        "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
neuper@38011
   365
        "      REAL_LIST [c, c_2], BOOL_LIST ss''']");
neuper@37906
   366
val ags = isalist2list ags';
neuper@55279
   367
val pI = ["LINEAR","system"];
neuper@37906
   368
val pats = (#ppc o get_pbt) pI;
neuper@38011
   369
"-b1-----------------------------------------------------";
neuper@48894
   370
val xxx = match_ags @{theory  "Isac"} pats ags;
neuper@38011
   371
"-b2-----------------------------------------------------";
neuper@48894
   372
case match_ags @{theory "EqSystem"} pats ags of 
neuper@37906
   373
    [(1, [1], "#Given", Const ("Descript.equalities", _), _),
neuper@37906
   374
     (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
neuper@37906
   375
         [_ $ Free ("c", _) $ _,
neuper@37906
   376
          _ $ Free ("c_2", _) $ _]),
neuper@38011
   377
     (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])]
neuper@38011
   378
    (*         type of Find:            [Free ("ss'''", "bool List.list")]*)
neuper@37906
   379
    =>()
neuper@38031
   380
  | _ => error "calchead.sml match_ags copy-named dropped --------";
neuper@37906
   381
neuper@38011
   382
"-c---ERROR case: stac is missing #Given equalities e_s--";
neuper@37906
   383
val stac as Const ("Script.SubProblem",_) $
neuper@41972
   384
	 (Const ("Product_Type.Pair",_) $
neuper@37906
   385
		Free (dI',_) $ 
neuper@41972
   386
		(Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   387
    (*...copied from stac2tac_*)
neuper@38011
   388
    str2term (
neuper@55279
   389
	"SubProblem (EqSystem', [LINEAR, system], [no_met]) " ^
neuper@38011
   390
        "     [REAL_LIST [c, c_2]]");
neuper@38011
   391
val ags = isalist2list ags'; 
neuper@55279
   392
val pI = ["LINEAR","system"];
neuper@37906
   393
val pats = (#ppc o get_pbt) pI;
neuper@48895
   394
(*============ inhibit exn AK110726 ==============================================
neuper@38051
   395
val xxx - match_ags (theory "EqSystem") pats ags;
neuper@48895
   396
============ inhibit exn AK110726 ==============================================*)
neuper@38011
   397
"-c1-----------------------------------------------------";
neuper@38011
   398
"--------------------------step through code match_ags---";
neuper@48894
   399
val (thy, pbt:pat list, ags) = (@{theory "EqSystem"}, pats, ags);
neuper@38011
   400
fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
neuper@38011
   401
	val pbt' = filter_out is_copy_named pbt; (*=equalities, solveForVars*)
neuper@38011
   402
	val cy = filter is_copy_named pbt;       (*=solution*)
neuper@48895
   403
(*============ inhibit exn AK110726 ==============================================
neuper@38051
   404
	val oris' - matc thy pbt' ags [];
neuper@48895
   405
============ inhibit exn AK110726 ==============================================*)
neuper@38011
   406
"-------------------------------step through code matc---";
neuper@38011
   407
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
neuper@38011
   408
(is_copy_named_idstr o free2str) t;
neuper@38011
   409
"---if False:...";
neuper@48895
   410
(*============ inhibit exn AK110726 ==============================================
neuper@38051
   411
val opt - mtc thy p a;
neuper@48895
   412
============ inhibit exn AK110726 ==============================================*)
neuper@38011
   413
"--------------------------------step through code mtc---";
neuper@48894
   414
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
wneuper@59188
   415
Thm.global_cterm_of;
neuper@48894
   416
val ttt = (dsc $ var);
neuper@48895
   417
(*============ inhibit exn AK110726 ==============================================
wneuper@59188
   418
Thm.global_cterm_of thy (dsc $ var);
neuper@48895
   419
============ inhibit exn AK110726 ==============================================*)
neuper@48894
   420
neuper@48894
   421
"-------------------------------------step through end---";
neuper@48894
   422
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@48894
   423
val Const ("Script.SubProblem",_) $
neuper@48894
   424
	  (Const ("Product_Type.Pair",_) $
neuper@48894
   425
		 Free (dI',_) $ 
neuper@48894
   426
		 (Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@48894
   427
    (*...copied from stac2tac_*)
neuper@48894
   428
    str2term (
neuper@55279
   429
	"SubProblem (EqSystem', [LINEAR, system], [no_met])         " ^
neuper@48894
   430
        "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
neuper@48894
   431
        "      REAL_LIST [c, c_2]]");
neuper@48894
   432
val ags = isalist2list ags';
neuper@55279
   433
val pI = ["LINEAR","system"];
neuper@48894
   434
val pats = (#ppc o get_pbt) pI;
neuper@48894
   435
"-a1-----------------------------------------------------";
neuper@48894
   436
(*match_ags = fn : theory -> pat list -> term list -> ori list*)
neuper@48894
   437
val xxx = match_ags @{theory "EqSystem"} pats ags;
neuper@48894
   438
"-a2-----------------------------------------------------";
neuper@48894
   439
case match_ags @{theory  "Isac"} pats ags of 
neuper@48894
   440
    [(1, [1], "#Given", Const ("Descript.equalities", _), _),
neuper@48894
   441
     (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
neuper@48894
   442
      [ _ $ Free ("c", _) $ _, _ $ Free ("c_2", _) $ _]),
neuper@48894
   443
     (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])] 
neuper@48894
   444
    =>()
neuper@48894
   445
  | _ => error "calchead.sml match_ags 2 args Nok ----------------";
neuper@48894
   446
neuper@48894
   447
"-b------------------------------------------------------";
neuper@48894
   448
val Const ("Script.SubProblem",_) $
neuper@48894
   449
	  (Const ("Product_Type.Pair",_) $
neuper@48894
   450
		 Free (dI',_) $ 
neuper@48894
   451
		 (Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@48894
   452
    (*...copied from stac2tac_*)
neuper@48894
   453
    str2term (
neuper@55279
   454
	"SubProblem (EqSystem', [LINEAR, system], [no_met])         " ^
neuper@48894
   455
        "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
neuper@48894
   456
        "      REAL_LIST [c, c_2], BOOL_LIST ss''']");
neuper@48894
   457
val ags = isalist2list ags';
neuper@55279
   458
val pI = ["LINEAR","system"];
neuper@48894
   459
val pats = (#ppc o get_pbt) pI;
neuper@48894
   460
"-b1-----------------------------------------------------";
neuper@48894
   461
val xxx = match_ags @{theory  "Isac"} pats ags;
neuper@48894
   462
"-b2-----------------------------------------------------";
neuper@48894
   463
case match_ags @{theory "EqSystem"} pats ags of 
neuper@48894
   464
    [(1, [1], "#Given", Const ("Descript.equalities", _), _),
neuper@48894
   465
     (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
neuper@48894
   466
         [_ $ Free ("c", _) $ _,
neuper@48894
   467
          _ $ Free ("c_2", _) $ _]),
neuper@48894
   468
     (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])]
neuper@48894
   469
    (*         type of Find:            [Free ("ss'''", "bool List.list")]*)
neuper@48894
   470
    =>()
neuper@48894
   471
  | _ => error "calchead.sml match_ags copy-named dropped --------";
neuper@48894
   472
neuper@48894
   473
"-c---ERROR case: stac is missing #Given equalities e_s--";
neuper@48894
   474
val stac as Const ("Script.SubProblem",_) $
neuper@48894
   475
	 (Const ("Product_Type.Pair",_) $
neuper@48894
   476
		Free (dI',_) $ 
neuper@48894
   477
		(Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@48894
   478
    (*...copied from stac2tac_*)
neuper@48894
   479
    str2term (
neuper@55279
   480
	"SubProblem (EqSystem', [LINEAR, system], [no_met]) " ^
neuper@48894
   481
        "     [REAL_LIST [c, c_2]]");
neuper@48894
   482
val ags = isalist2list ags'; 
neuper@55279
   483
val pI = ["LINEAR","system"];
neuper@48894
   484
val pats = (#ppc o get_pbt) pI;
neuper@48895
   485
(*============ inhibit exn AK110726 ==============================================
neuper@48894
   486
val xxx - match_ags (theory "EqSystem") pats ags;
neuper@48894
   487
-------------------------------------------------------------------*)
neuper@48894
   488
"-c1-----------------------------------------------------";
neuper@48894
   489
"--------------------------step through code match_ags---";
neuper@48894
   490
val (thy, pbt:pat list, ags) = (@{theory "EqSystem"}, pats, ags);
neuper@48894
   491
fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
neuper@48894
   492
	val pbt' = filter_out is_copy_named pbt; (*=equalities, solveForVars*)
neuper@48894
   493
	val cy = filter is_copy_named pbt;       (*=solution*)
neuper@48895
   494
(*============ inhibit exn AK110726 ==============================================
neuper@48894
   495
	val oris' - matc thy pbt' ags [];
neuper@48894
   496
-------------------------------------------------------------------*)
neuper@48894
   497
"-------------------------------step through code matc---";
neuper@48894
   498
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
neuper@48894
   499
(is_copy_named_idstr o free2str) t;
neuper@48894
   500
"---if False:...";
neuper@48895
   501
(*============ inhibit exn AK110726 ==============================================
neuper@48894
   502
val opt - mtc thy p a;
neuper@48894
   503
-------------------------------------------------------------------*)
neuper@48894
   504
"--------------------------------step through code mtc---";
neuper@48894
   505
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
wneuper@59188
   506
Thm.global_cterm_of;
neuper@48894
   507
val ttt = (dsc $ var);
neuper@48895
   508
(*============ inhibit exn AK110726 ==============================================
wneuper@59188
   509
Thm.global_cterm_of thy (dsc $ var);
neuper@38051
   510
-------------------------------------------------------------------*)
neuper@38011
   511
"-------------------------------------step through end---";
neuper@38011
   512
neuper@48894
   513
case ((match_ags @{theory "EqSystem"} pats ags)
neuper@38011
   514
      handle ERROR _ => []) of (*why not TYPE ?WN100920*)
neuper@37906
   515
    [] => match_ags_msg pI stac ags
neuper@38031
   516
  | _ => error "calchead.sml match_ags 1st arg missing --------";
neuper@37906
   517
neuper@48894
   518
"-d------------------------------------------------------";
neuper@48894
   519
val stac as Const ("Script.SubProblem",_) $
neuper@48894
   520
	 (Const ("Product_Type.Pair",_) $
neuper@48894
   521
		Free (dI',_) $ 
neuper@48894
   522
		(Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@48894
   523
    (*...copied from stac2tac_*)
neuper@48894
   524
    str2term (
neuper@48894
   525
	"SubProblem (Test',[univariate,equation,test]," ^
neuper@48894
   526
        "             [no_met]) [BOOL (x+1=2), REAL x]");
neuper@48894
   527
val AGS = isalist2list ags';
neuper@48894
   528
val pI = ["univariate","equation","test"];
neuper@48894
   529
neuper@48894
   530
neuper@48894
   531
case ((match_ags @{theory "EqSystem"} pats ags)
neuper@48894
   532
      handle ERROR _ => []) of (*why not TYPE ?WN100920*)
neuper@48894
   533
    [] => match_ags_msg pI stac ags
neuper@48894
   534
  | _ => error "calchead.sml match_ags 1st arg missing --------";
neuper@37906
   535
neuper@38011
   536
"-d------------------------------------------------------";
neuper@37906
   537
val stac as Const ("Script.SubProblem",_) $
neuper@41972
   538
	 (Const ("Product_Type.Pair",_) $
neuper@37906
   539
		Free (dI',_) $ 
neuper@41972
   540
		(Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   541
    (*...copied from stac2tac_*)
neuper@38011
   542
    str2term (
neuper@38011
   543
	"SubProblem (Test',[univariate,equation,test]," ^
neuper@38011
   544
        "             [no_met]) [BOOL (x+1=2), REAL x]");
neuper@38011
   545
val AGS = isalist2list ags';
neuper@37906
   546
val pI = ["univariate","equation","test"];
neuper@38011
   547
val PATS = (#ppc o get_pbt) pI;
neuper@38011
   548
"-d1-----------------------------------------------------";
neuper@38011
   549
"--------------------------step through code match_ags---";
neuper@48894
   550
val (thy, pbt:pat list, ags) = (@{theory "Test"}, PATS, AGS);
neuper@38011
   551
fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
neuper@38011
   552
	val pbt' = filter_out is_copy_named pbt; 
neuper@38011
   553
	val cy = filter is_copy_named pbt;       
neuper@38011
   554
	val oris' = matc thy pbt' ags [];
neuper@38011
   555
"-------------------------------step through code matc---";
neuper@38011
   556
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
neuper@38011
   557
(is_copy_named_idstr o free2str) t;
neuper@38011
   558
"---if False:...";
neuper@38011
   559
val opt = mtc thy p a;
neuper@38011
   560
"--------------------------------step through code mtc---";
neuper@38011
   561
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
neuper@38011
   562
val ttt = (dsc $ var);
wneuper@59188
   563
Thm.global_cterm_of thy (dsc $ var);
neuper@38011
   564
val ori = ((([1], str, dsc, (*[var]*) split_dts' (dsc, var))): preori);
neuper@38011
   565
neuper@38011
   566
"-d2-----------------------------------------------------";
neuper@38011
   567
pbt = [];  (*false*)
neuper@38011
   568
"-------------------------------step through code matc---";
neuper@38011
   569
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt, ags, oris @ [ori]);
neuper@38011
   570
(is_copy_named_idstr o free2str) t;
neuper@38011
   571
"---if False:...";
neuper@38011
   572
val opt = mtc thy p a;
neuper@38011
   573
"--------------------------------step through code mtc---";
neuper@38011
   574
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
neuper@38011
   575
val ttt = (dsc $ var);
wneuper@59188
   576
Thm.global_cterm_of thy (dsc $ var);
neuper@38011
   577
val ori = ((([1], str, dsc, (*[var]*) split_dts' (dsc, var))): preori);
neuper@38011
   578
"-d3-----------------------------------------------------";
neuper@38011
   579
pbt = [];  (*true, base case*)
neuper@38011
   580
"-----------------continue step through code match_ags---";
neuper@38011
   581
	val oris' = oris @ [ori]; (*result 2 oris, cpy_nam added later*)
neuper@38011
   582
"--------------------------------step through cpy_nam----";
neuper@38011
   583
val (pbt, oris, p as (field, (dsc, t)):pat) = (pbt', oris', hd cy);
neuper@38011
   584
(*t = "v_v'i'" : term             OLD: t = "v_i_"*)
neuper@38011
   585
"--------------------------------------------------------";
neuper@38011
   586
fun is_copy_named_generating_idstr str =
neuper@38011
   587
    if is_copy_named_idstr str
neuper@48894
   588
    then case (rev o Symbol.explode) str of
neuper@38011
   589
      (*"_"::"_"::"_"::_ => false*)
neuper@38011
   590
	"'"::"'"::"'"::_ => false
neuper@38011
   591
      | _ => true
neuper@38011
   592
    else false;
neuper@38011
   593
fun is_copy_named_generating (_, (_, t)) = 
neuper@38011
   594
    (is_copy_named_generating_idstr o free2str) t;
neuper@38011
   595
"--------------------------------------------------------";
neuper@38011
   596
is_copy_named_generating p (*true*);
neuper@38011
   597
           fun sel (_,_,d,ts) = comp_ts (d, ts);
neuper@48894
   598
	   val cy' = (implode o (drop_last_n 3) o Symbol.explode o free2str) t;
neuper@38011
   599
               (*"v_v"             OLD: "v_"*)
neuper@48894
   600
	   val ext = (last_elem o drop_last o Symbol.explode o free2str) t;
neuper@38011
   601
               (*"i"               OLD: "i"*)
neuper@38011
   602
	   val vars' = map (free2str o snd o snd) pbt(*cpy-nam filtered_out*);
neuper@38011
   603
               (*["e_e", "v_v"]    OLD: ["e_", "v_"]*)
neuper@38011
   604
	   val vals = map sel oris;
neuper@38011
   605
               (*[x+1=2, x]        OLD: [x+1=2, x] : term list*)
neuper@38011
   606
vars' ~~ vals;
neuper@38011
   607
(*[("e_e", [x+1=2), ("v_v", x)]    OLD: [("e_", [x+1=2), ("v_", x)]*)
neuper@38011
   608
(assoc (vars'~~vals, cy'));
neuper@55279
   609
(*SOME (Free ("x", "Real.real")) : term option*)
neuper@38011
   610
	   val cy_ext = (free2str o the) (assoc (vars'~~vals, cy'))^"_"^ext;
neuper@38011
   611
               (*x_i*)
neuper@38011
   612
"-----------------continue step through code match_ags---";
neuper@38011
   613
	val cy' = map (cpy_nam pbt' oris') cy;
neuper@38011
   614
               (*[([1], "#Find", "solutions, [x_i"] (*as terms*) )]*)
neuper@38011
   615
"-------------------------------------step through end---";
neuper@38011
   616
neuper@38011
   617
case match_ags thy PATS AGS of
neuper@38011
   618
[(1, [1], "#Given", Const ("Descript.equality", _),
neuper@41922
   619
  [Const ("HOL.eq", _) $ (Const ("Groups.plus_class.plus", _) $
neuper@38011
   620
		Free ("x", _) $ Free ("1", _)) $ Free ("2", _)]),
neuper@38011
   621
 (2, [1], "#Given", Const ("Descript.solveFor", _), [Free ("x", _)]),
neuper@38011
   622
 (3, [1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)])]
neuper@37906
   623
    => ()
neuper@38031
   624
  | _ => error "calchead.sml match_ags [univariate,equation,test]--";
neuper@38009
   625
neuper@38010
   626
"--------- regression test fun is_copy_named ------------";
neuper@38010
   627
"--------- regression test fun is_copy_named ------------";
neuper@38010
   628
"--------- regression test fun is_copy_named ------------";
neuper@38010
   629
val trm = (1, (2, @{term "v'i'"}));
neuper@38031
   630
if is_copy_named trm then () else error "regr. is_copy_named 1";
neuper@38010
   631
val trm = (1, (2, @{term "e_e"}));
neuper@38031
   632
if is_copy_named trm then error "regr. is_copy_named 2" else ();
neuper@38010
   633
val trm = (1, (2, @{term "L'''"}));
neuper@38031
   634
if is_copy_named trm then () else error "regr. is_copy_named 3";
neuper@38010
   635
neuper@38010
   636
(* out-comment 'structure CalcHead'...
neuper@38010
   637
val trm = (1, (2, @{term "v'i'"}));
neuper@38031
   638
if is_copy_named_generating trm then () else error "regr. is_copy_named";
neuper@38010
   639
val trm = (1, (2, @{term "L'''"}));
neuper@38031
   640
if is_copy_named_generating trm then error "regr. is_copy_named" else ();
neuper@38010
   641
*)
neuper@38011
   642
neuper@38011
   643
"--------- regr.test fun cpy_nam ------------------------";
neuper@38011
   644
"--------- regr.test fun cpy_nam ------------------------";
neuper@38011
   645
"--------- regr.test fun cpy_nam ------------------------";
neuper@38011
   646
(*data from above - match_ags, is_cp, cpy_nam +with EqSystem (!)-:*)
neuper@38011
   647
(*the model-pattern, is_copy_named are filter_out*)
neuper@38011
   648
pbt = [("#Given", (@{term "equality"}, @{term "e_e :: bool"})),
neuper@38011
   649
       ("#Given", (@{term "solveFor"}, @{term "v_v :: real"} ))];
neuper@38011
   650
(*the model specific for an example*)
neuper@38011
   651
oris = [([1], "#Given", @{term "equality"} , [str2term "x+1= 2"]),
neuper@38011
   652
	([1], "#Given", @{term "solveFor"} , [@{term "x :: real"} ])];
neuper@38011
   653
cy = [("#Find", (@{term "solutions"}, @{term "v_v'i' :: bool list"}))];
neuper@38011
   654
(*...all must be true*)
neuper@38011
   655
neuper@38011
   656
case cpy_nam pbt oris (hd cy) of 
neuper@38011
   657
    ([1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)]) => ()
neuper@38031
   658
  | _ => error "calchead.sml regr.test cpy_nam-1-";
neuper@38011
   659
neuper@38011
   660
(*new data: cpy_nam without changing the name*)
neuper@38011
   661
@{term "equalities"}; type_of @{term "[x_1+1=2,x_2=0]"};
neuper@38011
   662
@{term "solveForVars"}; type_of @{term "[x_1,x_2]::real list"};
neuper@38011
   663
@{term "solution"}; type_of @{term "ss''' :: bool list"};
neuper@55279
   664
(*the model-pattern for ["LINEAR", "system"], is_copy_named are filter_out*)
neuper@38011
   665
val pbt = [("#Given", (@{term "equalities"}, @{term "e_s :: bool list"})),
neuper@38011
   666
       ("#Given", (@{term "solveForVars v_s"}, @{term "v_s :: bool list"} ))];
neuper@38011
   667
(*the model specific for an example*)
neuper@38011
   668
val oris = [([1], "#Given", @{term "equalities"} ,[str2term "[x_1+1=2,x_2=0]"]),
neuper@38011
   669
    ([1], "#Given", @{term "solveForVars"} , [@{term "[x_1,x_2]::real list"}])];
neuper@38011
   670
val cy = [("#Find", (@{term "solution"}, @{term "ss''' :: bool list"}))
neuper@38011
   671
        (*could be more than 1*)];
neuper@38011
   672
neuper@38011
   673
case cpy_nam pbt oris (hd cy) of
neuper@38011
   674
    ([1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)]) => ()
neuper@38031
   675
  | _ => error "calchead.sml regr.test cpy_nam-2-";
neuper@38051
   676
neuper@38051
   677
"--------- check specify phase --------------------------";
neuper@38051
   678
"--------- check specify phase --------------------------";
neuper@38051
   679
"--------- check specify phase --------------------------";
neuper@38051
   680
(*val fmz = ["functionTerm (x^^^2 + 1)",*)
neuper@38051
   681
val fmz = ["functionTerm (x + 1)", 
neuper@38051
   682
	   "integrateBy x","antiDerivative FF"];
neuper@38051
   683
val (dI',pI',mI') =
neuper@38051
   684
  ("Integrate",["integrate","function"],
neuper@38051
   685
   ["diff","integration"]);
neuper@38051
   686
val p = e_pos'; val c = [];
neuper@38051
   687
"--- step 1 --";
neuper@38051
   688
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@38051
   689
(*> val it = "--- step 1 --" : string
neuper@38051
   690
val f =
neuper@38051
   691
  Form'
neuper@38051
   692
   (PpcKF
neuper@38051
   693
    (0, EdUndef, 0, Nundef,
neuper@38051
   694
     (Problem [],
neuper@38051
   695
	      {Find = [], With = [], Given = [], Where = [], Relate = []})))
neuper@38051
   696
: mout
neuper@38051
   697
val nxt = ("Model_Problem", Model_Problem) : string * tac
neuper@38051
   698
val p = ([], Pbl) : pos'
neuper@38051
   699
val pt =
neuper@38051
   700
   Nd (PblObj
neuper@38051
   701
       {env = None, fmz =
neuper@38051
   702
       (["functionTerm (x^^^2 + 1)", "integrateBy x",
neuper@38051
   703
	 "antiDerivative FF"],
neuper@38058
   704
	("Integrate", ["integrate", "function"],
neuper@38051
   705
	 ["diff", "integration"])),
neuper@38051
   706
       loc =
neuper@38051
   707
       (Some (ScrState ([], [], None, Const ("empty", "'a"), Sundef, false)),
neuper@38051
   708
	None),
neuper@38051
   709
       cell = None, meth = [], spec = ("e_domID", ["e_pblID"], ["e_metID"]),
neuper@38051
   710
       probl = [], branch = TransitiveB,
neuper@38051
   711
       origin =
neuper@38051
   712
       ([(1, [1], "#Given",
neuper@55279
   713
	     Const ("Descript.functionTerm", "Real.real => Tools.una"),
neuper@38051
   714
	     [Const ("op +", 
neuper@55279
   715
		     "["Real.real, "Real.real] => "Real.real") $
neuper@38051
   716
		     (Const ("Atools.pow",
neuper@55279
   717
			     "["Real.real, "Real.real] => "Real.real") $
neuper@55279
   718
		     Free ("x", "Real.real") $ Free ("2", "Real.real")) $
neuper@55279
   719
		     Free ("1", "Real.real")]),
neuper@38051
   720
	 (2, [1], "#Given",
neuper@55279
   721
	     Const ("Integrate.integrateBy", "Real.real => Tools.una"),
neuper@55279
   722
	     [Free ("x", "Real.real")]),
neuper@38051
   723
	 (3, [1], "#Find",
neuper@55279
   724
	     Const ("Integrate.antiDerivative", "Real.real => Tools.una"),
neuper@55279
   725
	     [Free ("FF", "Real.real")])],
neuper@38058
   726
	("Integrate", ["integrate", "function"], ["diff", "integration"]),
neuper@38051
   727
	Const ("Integrate.Integrate",
neuper@55279
   728
	       "("Real.real, "Real.real) * => "Real.real") $
neuper@41972
   729
	       (Const ("Product_Type.Pair",
neuper@55279
   730
		       "["Real.real, "Real.real]
neuper@55279
   731
                                  => ("Real.real, "Real.real) *") $
neuper@38051
   732
		 (Const ("op +",
neuper@55279
   733
			 "["Real.real, "Real.real] => "Real.real") $
neuper@38051
   734
		     (Const ("Atools.pow",
neuper@55279
   735
			     "["Real.real, "Real.real] => "Real.real") $
neuper@55279
   736
		      Free ("x", "Real.real") $ Free ("2", "Real.real")) $
neuper@55279
   737
		     Free ("1", "Real.real")) $
neuper@55279
   738
		    Free ("x", "Real.real"))),
neuper@38051
   739
       ostate = Incomplete, result = (Const ("empty", "'a"), [])},
wneuper@59279
   740
       []) : ctree*)
neuper@38051
   741
"----- WN101007 worked until here (checked same as isac2002) ---";
wneuper@59253
   742
case nxt of ("Model_Problem", Model_Problem) => ()
wneuper@59253
   743
| _ => error "clchead.sml: check specify phase step 1";
neuper@38051
   744
"--- step 2 --";
neuper@38051
   745
val (p,_,f,nxt,_,pt) = me nxt p c pt; (*Florian: see response buffer, top*)
neuper@38051
   746
(*val it = "--- step 2 --" : string
neuper@38051
   747
val p = ([], Pbl) : pos'
neuper@38051
   748
val f =
neuper@38051
   749
   Form'
neuper@38051
   750
      (PpcKF
neuper@38051
   751
         (0, EdUndef, 0, Nundef,
neuper@38051
   752
            (Problem [],
neuper@38051
   753
               {Find = [Incompl "Integrate.antiDerivative"],
neuper@38051
   754
                  With = [],
neuper@38051
   755
                  Given = [Incompl "functionTerm", Incompl "integrateBy"],
neuper@38051
   756
                  Where = [],
neuper@38051
   757
                  Relate = []}))) : mout
neuper@38051
   758
val nxt = ("Add_Given", Add_Given "functionTerm (x ^^^ 2 + 1)") : tac'_
neuper@38051
   759
val pt =
neuper@38051
   760
   Nd (PblObj
neuper@38051
   761
       {env = None, fmz =
neuper@38051
   762
       (["functionTerm (x^^^2 + 1)", "integrateBy x",
neuper@38051
   763
	 "antiDerivative FF"],
neuper@38058
   764
	("Integrate", ["integrate", "function"],
neuper@38051
   765
	 ["diff", "integration"])),
neuper@38051
   766
       loc =
neuper@38051
   767
       (Some
neuper@38051
   768
	(ScrState ([], [], None, Const ("empty", "'a"), Sundef, false)),
neuper@38051
   769
	None),
neuper@38051
   770
       cell = None, meth = [], spec = 
neuper@38051
   771
       ("e_domID", ["e_pblID"], ["e_metID"]), probl =
neuper@38051
   772
       [(0, [], false, "#Given",
neuper@38051
   773
	    Inc ((Const ("Descript.functionTerm",
neuper@55279
   774
			 "Real.real => Tools.una"),[]),
neuper@38051
   775
		 (Const ("empty", "'a"), []))),
neuper@38051
   776
	(0, [], false, "#Given",
neuper@38051
   777
	    Inc ((Const ("Integrate.integrateBy",
neuper@55279
   778
			 "Real.real => Tools.una"),[]),
neuper@38051
   779
		 (Const ("empty", "'a"), []))),
neuper@38051
   780
	(0, [], false, "#Find",
neuper@38051
   781
	    Inc ((Const ("Integrate.antiDerivative",
neuper@55279
   782
			 "Real.real => Tools.una"),[]),
neuper@38051
   783
		 (Const ("empty", "'a"), [])))],
neuper@38051
   784
       branch = TransitiveB, origin =
neuper@38051
   785
       ([(1, [1], "#Given",
neuper@55279
   786
	     Const ("Descript.functionTerm", "Real.real => Tools.una"),
neuper@38051
   787
	     [Const ("op +",
neuper@55279
   788
		     "["Real.real, "Real.real] => "Real.real") $
neuper@38051
   789
	       (Const ("Atools.pow",
neuper@55279
   790
		       "["Real.real, "Real.real] => "Real.real") $
neuper@55279
   791
		      Free ("x", "Real.real") $ Free ("2", "Real.real")) $
neuper@55279
   792
		     Free ("1", "Real.real")]),
neuper@38051
   793
	 (2, [1], "#Given",
neuper@55279
   794
	     Const ("Integrate.integrateBy", "Real.real => Tools.una"),
neuper@55279
   795
	     [Free ("x", "Real.real")]),
neuper@38051
   796
	 (3, [1], "#Find",
neuper@55279
   797
	     Const ("Integrate.antiDerivative", "Real.real => Tools.una"),
neuper@55279
   798
	     [Free ("FF", "Real.real")])],
neuper@38058
   799
	("Integrate", ["integrate", "function"], ["diff", "integration"]),
neuper@38051
   800
	Const ("Integrate.Integrate",
neuper@55279
   801
	       "("Real.real, "Real.real) * => "Real.real") $
neuper@41972
   802
	   (Const ("Product_Type.Pair",
neuper@55279
   803
		   "["Real.real, "Real.real]
neuper@55279
   804
                         => ("Real.real, "Real.real) *") $
neuper@38051
   805
	     (Const ("op +",
neuper@55279
   806
		     "["Real.real, "Real.real] => "Real.real") $
neuper@38051
   807
		     (Const ("Atools.pow",
neuper@55279
   808
			     "["Real.real, "Real.real] => "Real.real") $
neuper@55279
   809
		     Free ("x", "Real.real") $ Free ("2", "Real.real")) $
neuper@55279
   810
		   Free ("1", "Real.real")) $
neuper@55279
   811
                        Free ("x", "Real.real"))),
neuper@38051
   812
       ostate = Incomplete, result = (Const ("empty", "'a"), [])},
wneuper@59279
   813
       []) : ctree*)
wneuper@59279
   814
"----- WN101007 ctree checked same as isac2002, diff. in nxt --- REPAIRED";
wneuper@59253
   815
case nxt of ("Add_Given", Add_Given "functionTerm (x + 1)") => ()
wneuper@59253
   816
| _ => error "clchead.sml: check specify phase step 2";
neuper@38051
   817
"--- step 3 --";
neuper@38051
   818
val (p,_,f,nxt,_,pt) = me nxt p c pt;
wneuper@59279
   819
"----- WN101008 ctree checked same as isac2002, diff. in nxt --- REPAIRED";
wneuper@59253
   820
case nxt of ("Add_Given", Add_Given "integrateBy x") => ()
wneuper@59253
   821
| _ => error "clchead.sml: check specify phase step 2";
neuper@42279
   822
neuper@42279
   823
"--------- check: fmz matches pbt -----------------------";
neuper@42279
   824
"--------- check: fmz matches pbt -----------------------";
neuper@42279
   825
"--------- check: fmz matches pbt -----------------------";
neuper@42279
   826
"101230 error *** nxt_add: EX itm. not(dat(itm)<=dat(ori))";
neuper@42279
   827
"the following fmz caused the above error";
neuper@42279
   828
val fmz = ["TERM (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)","normalform N"];
neuper@42279
   829
val pI = ["plus_minus","polynom","vereinfachen"];
neuper@42279
   830
neuper@42279
   831
"----- this fmz is transformed to this internal format (TERM --> Pure.term):";
neuper@42279
   832
val ([(1, [1], "#undef", _, [Const ("Pure.term", _ (*"'a \<Rightarrow> prop"*)) $ _]),
neuper@42279
   833
      (*#############################^^^^^^^^^ defined by Isabelle*)
neuper@55279
   834
      (2, [1], "#Find", Const ("Simplify.normalform", _ (*"Real.real \<Rightarrow> Tools.una"*)),
neuper@55279
   835
                            [Free ("N", _ (*"Real.real"*))])],
neuper@42279
   836
     _ ) = prep_ori fmz thy ((#ppc o get_pbt) pI);
neuper@42279
   837
"#undef means: the element with description TERM in fmz did not match ";
neuper@42279
   838
"with any element of pbl (fetched by pI), because there we have Simplify.Term";
neuper@42279
   839
"defined in Simplify.thy";
neuper@42279
   840
neuper@42279
   841
"So we try out how to create Simplify.Term:";
neuper@42279
   842
"----- trial 1";
neuper@42279
   843
val Const ("Pure.term", _) $ Free ("ttt", _) = str2term "TERM ttt";
neuper@42279
   844
"           ^^^^^^^^^ see above";
neuper@42279
   845
atomwy t;
neuper@42279
   846
neuper@42279
   847
"----- trial 2";
neuper@42279
   848
val Free ("term", _) $ Free ("ttt", _) = str2term "term ttt";
neuper@42279
   849
"   ^^^^^^^^^^^ means, that no appropriate Const has be found (descriptions are all Const !)";
neuper@42279
   850
atomwy t;
neuper@42279
   851
neuper@42279
   852
"----- trial 3";
neuper@42279
   853
val Const ("Simplify.Term", _) $ Free ("ttt", _) = str2term "Term ttt";
neuper@42279
   854
"           ^^^^^^^^^^^^^^ this is what in Simplify.thy has been defined ";
neuper@42279
   855
"                          and unsed in pbl [plus_minus,polynom,vereinfachen]";
neuper@42279
   856
atomwy t;
neuper@42279
   857
neuper@42279
   858
"----- so this is the correct fmz:";
neuper@42279
   859
val fmz = ["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)","normalform N"];
neuper@42279
   860
val ([(1, [1], "#Given", Const ("Simplify.Term", _), [Const ("Groups.plus_class.plus", _) $ _ $ _]),
neuper@42279
   861
      (*########################^^^^^^^^^ defined in Simplify.thy*)
neuper@42279
   862
      (2, [1], "#Find", Const ("Simplify.normalform", _ ),
neuper@42279
   863
                            [Free ("N", _ )])],
neuper@42279
   864
     _ ) = prep_ori fmz thy ((#ppc o get_pbt) pI);
neuper@42279
   865
neuper@42279
   866
"----- we could have checked the pbl at the very beginning and compare with (internal) fmz:";
neuper@42279
   867
val [("#Given", (Const ("Simplify.Term", _), Free ("t_t", _))),
neuper@42279
   868
     ("#Find", (Const ("Simplify.normalform", _), Free ("n_n", _)))] = (#ppc o get_pbt) pI;
neuper@42279
   869
wneuper@59265
   870
"--------- fun typeless ---------------------------------";
wneuper@59265
   871
"--------- fun typeless ---------------------------------";
wneuper@59265
   872
"--------- fun typeless ---------------------------------";
wneuper@59265
   873
(*
wneuper@59265
   874
> val (SOME ct) = parse thy "max_relation (A=#2*a*b - a^^^#2)";
wneuper@59265
   875
> val (_,t1) = split_dsc_t hs (Thm.term_of ct);
wneuper@59265
   876
> val (SOME ct) = parse thy "A=#2*a*b - a^^^#2";
wneuper@59265
   877
> val (_,t2) = split_dsc_t hs (Thm.term_of ct);
wneuper@59265
   878
> typeless t1 = typeless t2;
wneuper@59265
   879
val it = true : bool
wneuper@59265
   880
*)
wneuper@59265
   881
"--------- fun variants_in ------------------------------";
wneuper@59265
   882
"--------- fun variants_in ------------------------------";
wneuper@59265
   883
"--------- fun variants_in ------------------------------";
wneuper@59265
   884
(*
wneuper@59265
   885
> cnt (op=) [2,2,2,4,5,5,5,5,5] 2 0;
wneuper@59265
   886
val it = ([3],[4,5,5,5,5,5]) : int list * int list
wneuper@59265
   887
> coll (op=) [] [1,2,2,2,4,5,5,5,5,5];
wneuper@59265
   888
val it = [1,3,1,5] : int list
wneuper@59265
   889
*)
wneuper@59265
   890
"--------- fun is_list_type -----------------------------";
wneuper@59265
   891
"--------- fun is_list_type -----------------------------";
wneuper@59265
   892
"--------- fun is_list_type -----------------------------";
wneuper@59265
   893
(* fun destr (Type(str,sort)) = (str,sort);
wneuper@59265
   894
> val (SOME ct) = parse thy "lll::real list";
wneuper@59265
   895
> val ty = (#T o rep_cterm) ct;
wneuper@59265
   896
> is_list_type ty;
wneuper@59265
   897
val it = true : bool 
wneuper@59265
   898
> destr ty;
wneuper@59265
   899
val it = ("List.list",["RealDef.real"]) : string * typ list
wneuper@59265
   900
> atomty ((#t o rep_cterm) ct);
wneuper@59265
   901
*** -------------
wneuper@59265
   902
*** Free ( lll, real list)
wneuper@59265
   903
val it = () : unit
wneuper@59265
   904
 
wneuper@59265
   905
> val (SOME ct) = parse thy "[lll::real]";
wneuper@59265
   906
> val ty = (#T o rep_cterm) ct;
wneuper@59265
   907
> is_list_type ty;
wneuper@59265
   908
val it = true : bool 
wneuper@59265
   909
> destr ty;
wneuper@59265
   910
val it = ("List.list",["'a"]) : string * typ list
wneuper@59265
   911
> atomty ((#t o rep_cterm) ct);
wneuper@59265
   912
*** -------------
wneuper@59265
   913
*** Const ( List.list.Cons, [real, real list] => real list)
wneuper@59265
   914
***   Free ( lll, real)
wneuper@59265
   915
***   Const ( List.list.Nil, real list) 
wneuper@59265
   916
wneuper@59265
   917
> val (SOME ct) = parse thy "lll";
wneuper@59265
   918
> val ty = (#T o rep_cterm) ct;
wneuper@59265
   919
> is_list_type ty;
wneuper@59265
   920
val it = false : bool  *)
wneuper@59265
   921
"--------- fun has_list_type ----------------------------";
wneuper@59265
   922
"--------- fun has_list_type ----------------------------";
wneuper@59265
   923
"--------- fun has_list_type ----------------------------";
wneuper@59265
   924
(*
wneuper@59265
   925
> val (SOME ct) = parse thy "lll::real list";
wneuper@59265
   926
> has_list_type (Thm.term_of ct);
wneuper@59265
   927
val it = true : bool
wneuper@59265
   928
> val (SOME ct) = parse thy "[lll::real]";
wneuper@59265
   929
> has_list_type (Thm.term_of ct);
wneuper@59265
   930
val it = false : bool *)
wneuper@59265
   931
"--------- fun tag_form ---------------------------------";
wneuper@59265
   932
"--------- fun tag_form ---------------------------------";
wneuper@59265
   933
"--------- fun tag_form ---------------------------------";
wneuper@59265
   934
(* val formal = (the o (parse thy)) "[R::real]";
wneuper@59265
   935
> val given = (the o (parse thy)) "fixed_values (cs::real list)";
wneuper@59265
   936
> tag_form thy (formal, given);
wneuper@59265
   937
val it = "fixed_values [R]" : cterm
wneuper@59265
   938
*)
wneuper@59265
   939
"--------- fun foldr1, foldl1 ---------------------------";
wneuper@59265
   940
"--------- fun foldr1, foldl1 ---------------------------";
wneuper@59265
   941
"--------- fun foldr1, foldl1 ---------------------------";
wneuper@59265
   942
(*
wneuper@59265
   943
> val (SOME ct) = parse thy "[a=b,c=d,e=f]";
wneuper@59265
   944
> val ces = map (Thm.global_cterm_of thy) (isalist2list (Thm.term_of ct));
wneuper@59265
   945
> val conj = foldr1 HOLogic.mk_conj (isalist2list (Thm.term_of ct));
wneuper@59265
   946
> Thm.global_cterm_of thy conj;
wneuper@59265
   947
val it = "(a = b & c = d) & e = f" : cterm
wneuper@59265
   948
*)
wneuper@59265
   949
(*
wneuper@59265
   950
> val (SOME ct) = parse thy "[a=b,c=d,e=f,g=h]";
wneuper@59265
   951
> val ces = map (Thm.global_cterm_of thy) (isalist2list (Thm.term_of ct));
wneuper@59265
   952
> val conj = foldl1 HOLogic.mk_conj (isalist2list (Thm.term_of ct));
wneuper@59265
   953
> Thm.global_cterm_of thy conj;
wneuper@59265
   954
val it = "a = b & c = d & e = f & g = h" : cterm
wneuper@59265
   955
*)