test/Tools/isac/Knowledge/partial_fractions.sml
author Walther Neuper <neuper@ist.tugraz.at>
Wed, 05 Dec 2012 15:29:36 +0100
changeset 48789 498ed5bb1004
parent 48761 4162c4f6f897
child 52103 0d13f07d8e2a
permissions -rwxr-xr-x
est_Isac.thy works until "ProgLang/scrtools.sml"
neuper@42289
     1
(* Title:  partial fraction decomposition
neuper@42289
     2
   Author: Jan Rocnik
neuper@42289
     3
   (c) due to copyright terms
neuper@42289
     4
*)
neuper@42289
     5
neuper@42289
     6
"--------------------------------------------------------";
neuper@42289
     7
"table of contents --------------------------------------";
neuper@42289
     8
"--------------------------------------------------------";
neuper@42305
     9
"----------- why helpless here ? ------------------------";
neuper@42310
    10
"----------- why not nxt = Model_Problem here ? ---------";
neuper@42359
    11
"----------- fun factors_from_solution ------------------";
neuper@42359
    12
"----------- Logic.unvarify_global ----------------------";
neuper@42359
    13
"----------- eval_drop_questionmarks --------------------";
neuper@42376
    14
"----------- = me for met_partial_fraction --------------";
neuper@42413
    15
"----------- autoCalculate for met_partial_fraction -----";
neuper@42386
    16
"----------- progr.vers.2: check erls for multiply_ansatz";
neuper@42386
    17
"----------- progr.vers.2: improve program --------------";
neuper@42289
    18
"--------------------------------------------------------";
neuper@42289
    19
"--------------------------------------------------------";
neuper@42289
    20
"--------------------------------------------------------";
neuper@42289
    21
neuper@42289
    22
neuper@42305
    23
"----------- why helpless here ? ------------------------";
neuper@42305
    24
"----------- why helpless here ? ------------------------";
neuper@42305
    25
"----------- why helpless here ? ------------------------";
neuper@42305
    26
val fmz = ["filterExpression (X z = 3 / (z - 1/4 + -1/8 * (1/(z::real))))", 
neuper@42305
    27
  "stepResponse (x[n::real]::bool)"];
neuper@42405
    28
val (dI,pI,mI) = ("Isac", ["Inverse", "Z_Transform", "SignalProcessing"], 
neuper@42405
    29
  ["SignalProcessing","Z_Transform","Inverse"]);
neuper@42305
    30
val (p,_,f,nxt,_,pt)  = CalcTreeTEST [(fmz, (dI,pI,mI))]; 
neuper@42305
    31
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Add_Given";
neuper@42305
    32
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Add_Find";
neuper@42305
    33
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Specify_Theory";
neuper@42305
    34
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Specify_Problem";
neuper@42305
    35
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Specify_Method";
neuper@42305
    36
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Apply_Method";
neuper@42315
    37
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Rewrite (ruleZY, Inverse_Z_Transform.ruleZY) --> X z = 3 / (z - 1 / 4 + -1 / 8 * (1 / z))";
neuper@42315
    38
val (p''',_,f,nxt''',_,pt''') = me nxt p [] pt; "nxt = Rewrite_Set norm_Rational --> X' z = 3 / (z * (z - 1 / 4 + -1 / 8 * (1 / z)))";
neuper@42305
    39
"~~~~~ fun me, args:"; val ((_,tac), (p:pos'), _, (pt:ptree)) = (nxt, p, [], pt);
neuper@42305
    40
val ("ok", (_, _, ptp)) = locatetac tac (pt,p)
neuper@42305
    41
val (pt, p) = ptp;
neuper@42305
    42
"~~~~~ fun step, args:"; val (((ip as (_,p_)):pos'), ((ptp as (pt,p), tacis):calcstate)) = 
neuper@42305
    43
                           (p, ((pt, e_pos'),[]));
neuper@42305
    44
val pIopt = get_pblID (pt,ip);
neuper@42305
    45
ip = ([],Res); "false";
neuper@42305
    46
tacis; " = []";
neuper@42405
    47
pIopt; (* = SOME ["Inverse", "Z_Transform", "SignalProcessing"]*)
neuper@42305
    48
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); "false";
neuper@42305
    49
(*nxt_solve_ (pt,ip); "WAS isalist2list applied to NON-list 'no_meth'"
neuper@42305
    50
   THIS MEANS: replace no_meth by [no_meth] in Script.*)
neuper@42305
    51
(*WAS val ("helpless",_) = step p ((pt, e_pos'),[]) *)
neuper@42305
    52
(*WAS val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Empty_Tac instead SubProblem";*)
neuper@42289
    53
neuper@42310
    54
"----------- why not nxt = Model_Problem here ? ---------";
neuper@42310
    55
"----------- why not nxt = Model_Problem here ? ---------";
neuper@42310
    56
"----------- why not nxt = Model_Problem here ? ---------";
neuper@42313
    57
val (p,_,f,nxt,_,pt) = me nxt''' p''' [] pt'''; 
neuper@42313
    58
"~~~~~ fun me, args:"; val (((_,tac):tac'_), (p:pos'), _, (pt:ptree)) = (nxt, p, c, pt);
neuper@42313
    59
val ("ok", (_, _, ptp)) = locatetac tac (pt,p);
neuper@42313
    60
val (pt, p) = ptp;
neuper@42313
    61
"~~~~~ fun step, args:"; val (((ip as (_,p_)):pos'), ((ptp as (pt,p), tacis):calcstate)) =
neuper@42313
    62
                           (p, ((pt, e_pos'),[]));
neuper@42313
    63
val pIopt = get_pblID (pt,ip);
neuper@42313
    64
ip = ([],Res); " = false";
neuper@42313
    65
tacis; " = []";                                         
neuper@42405
    66
pIopt (* = SOME ["Inverse", "Z_Transform", "SignalProcessing"]*);
neuper@42313
    67
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); " = false";
neuper@42313
    68
(*                               ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ leads into
neuper@42313
    69
nxt_solve_, which is definitely WRONG (should be nxt_specify_ for FIND_ADD).
neuper@42313
    70
This ERROR seems to be introduced together with ctxt, concerns Apply_Method without init_form.
neuper@42313
    71
See TODO.txt
neuper@42313
    72
*)
neuper@42310
    73
neuper@42359
    74
"----------- fun factors_from_solution ------------------";
neuper@42359
    75
"----------- fun factors_from_solution ------------------";
neuper@42359
    76
"----------- fun factors_from_solution ------------------";
neuper@48761
    77
val ctxt = Proof_Context.init_global @{theory Isac};
jan@42352
    78
val SOME t = parseNEW ctxt "factors_from_solution [(z::real) = 1 / 2, z = -1 / 4]";
jan@42352
    79
val SOME (_, t') = eval_factors_from_solution "" 0 t thy;
jan@42352
    80
if term2str t' =
neuper@42376
    81
 "factors_from_solution [z = 1 / 2, z = -1 / 4] = (z - 1 / 2) * (z - -1 / 4)"
jan@42352
    82
then () else error "factors_from_solution broken";
jan@42352
    83
neuper@42359
    84
"----------- Logic.unvarify_global ----------------------";
neuper@42359
    85
"----------- Logic.unvarify_global ----------------------";
neuper@42359
    86
"----------- Logic.unvarify_global ----------------------";
neuper@42359
    87
val A_var = parseNEW ctxt "A::real" |> the |> Logic.varify_global
neuper@42359
    88
val B_var = parseNEW ctxt "B::real" |> the |> Logic.varify_global
jan@42352
    89
neuper@42359
    90
val denom1 = parseNEW ctxt "(z + -1 * (1 / 2))::real" |> the;
neuper@42359
    91
val denom2 = parseNEW ctxt "(z + -1 * (-1 / 4))::real" |> the;
neuper@42359
    92
neuper@42359
    93
val test = HOLogic.mk_binop "Groups.plus_class.plus"
neuper@48789
    94
  (HOLogic.mk_binop "Fields.inverse_class.divide" (A_var, denom1),
neuper@48789
    95
   HOLogic.mk_binop "Fields.inverse_class.divide" (B_var, denom2));
neuper@42359
    96
neuper@42359
    97
if term2str test = "?A / (z + -1 * (1 / 2)) + ?B / (z + -1 * (-1 / 4))" then ()
neuper@42359
    98
  else error "HOLogic.mk_binop broken ?";
neuper@42359
    99
neuper@42359
   100
(* Logic.unvarify_global test
neuper@42359
   101
---> exception TERM raised (line 539 of "logic.ML"): Illegal fixed variable: "z"
neuper@42359
   102
thus we need another fun var2free in termC.sml*)
neuper@42359
   103
neuper@42359
   104
"----------- eval_drop_questionmarks --------------------";
neuper@42359
   105
"----------- eval_drop_questionmarks --------------------";
neuper@42359
   106
"----------- eval_drop_questionmarks --------------------";
neuper@42359
   107
if term2str test = "?A / (z + -1 * (1 / 2)) + ?B / (z + -1 * (-1 / 4))"
neuper@42359
   108
then () else error "test setup (ctxt!) probably changed";
neuper@42359
   109
neuper@42359
   110
val t = Const ("Partial_Fractions.drop_questionmarks", HOLogic.realT --> HOLogic.realT) $ test;
neuper@42359
   111
neuper@42359
   112
val SOME (_, t') = eval_drop_questionmarks "drop_questionmarks" 0 t @{theory Isac};
neuper@42359
   113
if term2str t' = "drop_questionmarks (?A / (z + -1 * (1 / 2)) + ?B / (z + -1 * (-1 / 4))) =" ^
neuper@42359
   114
  "\nA / (z + -1 * (1 / 2)) + B / (z + -1 * (-1 / 4))"
neuper@42359
   115
then () else error "eval_drop_questionmarks broken";
neuper@42359
   116
neuper@42376
   117
"----------- = me for met_partial_fraction --------------";
neuper@42376
   118
"----------- = me for met_partial_fraction --------------";
neuper@42376
   119
"----------- = me for met_partial_fraction --------------";
neuper@42376
   120
  val fmz =                                             
neuper@42376
   121
    ["functionTerm (3 / (z * (z - 1 / 4 + -1 / 8 * (1 / z))))", 
neuper@42376
   122
      "solveFor z", "decomposedFunction p_p"];
neuper@42376
   123
  val (dI',pI',mI') =
neuper@42376
   124
    ("Partial_Fractions", 
neuper@42376
   125
      ["partial_fraction", "rational", "simplification"],
neuper@42376
   126
      ["simplification","of_rationals","to_partial_fraction"]);
neuper@42376
   127
  val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42376
   128
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   129
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   130
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   131
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   132
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   133
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   134
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   135
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   136
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   137
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   138
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   139
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   140
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   141
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   142
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   143
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   144
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   145
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   146
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   147
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   148
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   149
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   150
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   151
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   152
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   153
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   154
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   155
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   156
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   157
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   158
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   159
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   160
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   161
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   162
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   163
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   164
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   165
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   166
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   167
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   168
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   169
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   170
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   171
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   172
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   173
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   174
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   175
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   176
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   177
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   178
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   179
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   180
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   181
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   182
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   183
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   184
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   185
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   186
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   187
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   188
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   189
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   190
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   191
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   192
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   193
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   194
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   195
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   196
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   197
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   198
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   199
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   200
  val (p,_,f,nxt,_,pt) = me nxt p [] pt; 
neuper@42376
   201
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   202
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   203
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   204
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   205
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   206
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   207
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   208
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   209
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   210
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   211
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   212
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   213
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   214
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   215
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   216
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   217
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   218
  val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42376
   219
  val (p,_,f,nxt,_,pt) = me nxt p [] pt; 
neuper@42376
   220
neuper@42376
   221
show_pt pt;
neuper@42376
   222
if f2str f = "4 / (z - 1 / 2) + -4 / (z - -1 / 4)" then() 
neuper@42376
   223
else error "= me .. met_partial_fraction broken";
neuper@42376
   224
neuper@42413
   225
"----------- autoCalculate for met_partial_fraction -----";
neuper@42413
   226
"----------- autoCalculate for met_partial_fraction -----";
neuper@42413
   227
"----------- autoCalculate for met_partial_fraction -----";
neuper@42413
   228
states:= [];
neuper@42413
   229
  val fmz =                                             
neuper@42413
   230
    ["functionTerm (3 / (z * (z - 1 / 4 + -1 / 8 * (1 / z))))", 
neuper@42413
   231
      "solveFor z", "decomposedFunction p_p"];
neuper@42413
   232
  val (dI', pI', mI') =
neuper@42413
   233
    ("Partial_Fractions", 
neuper@42413
   234
      ["partial_fraction", "rational", "simplification"],
neuper@42413
   235
      ["simplification","of_rationals","to_partial_fraction"]);
neuper@42413
   236
CalcTree [(fmz, (dI' ,pI' ,mI'))];
neuper@42413
   237
Iterator 1;
neuper@42413
   238
moveActiveRoot 1;
neuper@42413
   239
autoCalculate 1 CompleteCalc; 
neuper@42413
   240
neuper@42413
   241
val ((pt,p),_) = get_calc 1; val ip = get_pos 1 1;
neuper@42413
   242
if p = ip andalso ip = ([], Res) then ()
neuper@42413
   243
  else error "autoCalculate for met_partial_fraction changed: final pos'";
neuper@42413
   244
neuper@42413
   245
val (Form f, tac, asms) = pt_extract (pt, p);
neuper@42413
   246
if term2str f = "4 / (z - 1 / 2) + -4 / (z - -1 / 4)" andalso
neuper@42413
   247
  tac = NONE andalso
neuper@42413
   248
  terms2str' asms = "[~ matches (?a = 0) (3 = -3 * B / 4) | ~ lhs (3 = -3 * B / 4) is_poly_in B," ^
neuper@42413
   249
  "B = -4,lhs (3 + 3 / 4 * B = 0) is_poly_in B,lhs (3 + 3 / 4 * B = 0) has_degree_in B = 1," ^
neuper@42413
   250
  "B is_polyexp,A is_polyexp," ^
neuper@42413
   251
  "~ matches (?a = 0) (3 = 3 * A / 4) | ~ lhs (3 = 3 * A / 4) is_poly_in A," ^
neuper@42413
   252
  "A = 4,lhs (3 + -3 / 4 * A = 0) is_poly_in A,lhs (3 + -3 / 4 * A = 0) has_degree_in A = 1," ^
neuper@42413
   253
  "lhs (-1 + -2 * z + 8 * z ^^^ 2 = 0) has_degree_in z = 2," ^
neuper@42413
   254
  "lhs (-1 + -2 * z + 8 * z ^^^ 2 = 0) is_poly_in z,z = 1 / 2,z = -1 / 4,z ~= 0,z is_polyexp]"
neuper@42413
   255
then ()
neuper@42413
   256
  else error "autoCalculate for met_partial_fraction changed: final result"
neuper@42413
   257
neuper@42413
   258
show_pt pt;
neuper@42413
   259
(*[
neuper@42413
   260
(([], Frm), Problem (Partial_Fractions, [partial_fraction, rational, simplification])),
neuper@42413
   261
(([1], Frm), 3 / (z * (z - 1 / 4 + -1 / 8 * (1 / z)))),
neuper@42413
   262
(([1], Res), 24 / (-1 + -2 * z + 8 * z ^^^ 2)),
neuper@42413
   263
(([2], Pbl), solve (-1 + -2 * z + 8 * z ^^^ 2 = 0, z)),
neuper@42413
   264
(([2,1], Frm), -1 + -2 * z + 8 * z ^^^ 2 = 0),
neuper@42413
   265
(([2,1], Res), z = (- -2 + sqrt (-2 ^^^ 2 - 4 * 8 * -1)) / (2 * 8) |
neuper@42413
   266
z = (- -2 - sqrt (-2 ^^^ 2 - 4 * 8 * -1)) / (2 * 8)),
neuper@42413
   267
(([2,2], Res), z = 1 / 2 | z = -1 / 4),
neuper@42413
   268
(([2,3], Res), [z = 1 / 2, z = -1 / 4]),
neuper@42413
   269
(([2,4], Res), [z = 1 / 2, z = -1 / 4]),
neuper@42413
   270
(([2], Res), [z = 1 / 2, z = -1 / 4]),
neuper@42413
   271
(([3], Frm), 3 / ((z - 1 / 2) * (z - -1 / 4))),
neuper@42413
   272
(([3], Res), ?A / (z - 1 / 2) + ?B / (z - -1 / 4)),
neuper@42413
   273
(([4], Frm), 3 / ((z - 1 / 2) * (z - -1 / 4)) = ?A / (z - 1 / 2) + ?B / (z - -1 / 4)),
neuper@42413
   274
(([4], Res), 3 = ?A * (z - -1 / 4) + ?B * (z - 1 / 2)),
neuper@42413
   275
(([5], Frm), 3 = A * (z - -1 / 4) + B * (z - 1 / 2)),
neuper@42413
   276
(([5], Res), 3 = A * (1 / 2 - -1 / 4) + B * (1 / 2 - 1 / 2)),
neuper@42413
   277
(([6], Res), 3 = 3 * A / 4),
neuper@42413
   278
(([7], Pbl), solve (3 = 3 * A / 4, A)),
neuper@42413
   279
(([7,1], Frm), 3 = 3 * A / 4),
neuper@42413
   280
(([7,1], Res), 3 - 3 * A / 4 = 0),
neuper@42413
   281
(([7,2], Res), 3 / 1 + -3 / 4 * A = 0),
neuper@42413
   282
(([7,3], Res), 3 + -3 / 4 * A = 0),
neuper@42413
   283
(([7,4], Pbl), solve (3 + -3 / 4 * A = 0, A)),
neuper@42413
   284
(([7,4,1], Frm), 3 + -3 / 4 * A = 0),
neuper@42413
   285
(([7,4,1], Res), A = -1 * 3 / (-3 / 4)),
neuper@42413
   286
(([7,4,2], Res), A = -3 / (-3 / 4)),
neuper@42413
   287
(([7,4,3], Res), A = 4),
neuper@42413
   288
(([7,4,4], Res), [A = 4]),
neuper@42413
   289
(([7,4,5], Res), [A = 4]),
neuper@42413
   290
(([7,4], Res), [A = 4]),
neuper@42413
   291
(([7], Res), [A = 4]),
neuper@42413
   292
(([8], Frm), 3 = A * (z - -1 / 4) + B * (z - 1 / 2)),
neuper@42413
   293
(([8], Res), 3 = A * (-1 / 4 - -1 / 4) + B * (-1 / 4 - 1 / 2)),
neuper@42413
   294
(([9], Res), 3 = -3 * B / 4),
neuper@42413
   295
(([10], Pbl), solve (3 = -3 * B / 4, B)),
neuper@42413
   296
(([10,1], Frm), 3 = -3 * B / 4),
neuper@42413
   297
(([10,1], Res), 3 - -3 * B / 4 = 0),
neuper@42413
   298
(([10,2], Res), 3 / 1 + 3 / 4 * B = 0),
neuper@42413
   299
(([10,3], Res), 3 + 3 / 4 * B = 0),
neuper@42413
   300
(([10,4], Pbl), solve (3 + 3 / 4 * B = 0, B)),
neuper@42413
   301
(([10,4,1], Frm), 3 + 3 / 4 * B = 0),
neuper@42413
   302
(([10,4,1], Res), B = -1 * 3 / (3 / 4)),
neuper@42413
   303
(([10,4,2], Res), B = -3 / (3 / 4)),
neuper@42413
   304
(([10,4,3], Res), B = -4),
neuper@42413
   305
(([10,4,4], Res), [B = -4]),
neuper@42413
   306
(([10,4,5], Res), [B = -4]),
neuper@42413
   307
(([10,4], Res), [B = -4]),
neuper@42413
   308
(([10], Res), [B = -4]),
neuper@42413
   309
(([11], Frm), A / (z - 1 / 2) + B / (z - -1 / 4)),
neuper@42413
   310
(([11], Res), 4 / (z - 1 / 2) + -4 / (z - -1 / 4)),
neuper@42413
   311
(([], Res), 4 / (z - 1 / 2) + -4 / (z - -1 / 4))] *)
neuper@42413
   312
neuper@42386
   313
"----------- progr.vers.2: check erls for multiply_ansatz";
neuper@42386
   314
"----------- progr.vers.2: check erls for multiply_ansatz";
neuper@42386
   315
"----------- progr.vers.2: check erls for multiply_ansatz";
neuper@42386
   316
(*test for outcommented 3 lines in script: is norm_Rational strong enough?*)
neuper@42386
   317
val t = str2term "(3 / ((-1 + -2 * z + 8 * z ^^^ 2) *3/24)) = (3 / ((z - 1 / 2) * (z - -1 / 4)))";
neuper@42386
   318
val SOME (t', _) = rewrite_set_ @{theory Isac} true ansatz_rls t;
neuper@42386
   319
term2str t' = "3 / ((-1 + -2 * z + 8 * z ^^^ 2) * 3 / 24) =\n?A / (z - 1 / 2) + ?B / (z - -1 / 4)";
neuper@42386
   320
neuper@42386
   321
val SOME (t'', _) = rewrite_set_ @{theory Isac} true multiply_ansatz t'; (*true*)
neuper@42386
   322
term2str t'' = "(z - 1 / 2) * (z - -1 / 4) * 3 / ((-1 + -2 * z + 8 * z ^^^ 2) * 3 / 24) =\n" ^
neuper@42386
   323
  "?A * (z - -1 / 4) + ?B * (z - 1 / 2)"; (*true*)
neuper@42386
   324
neuper@42386
   325
val SOME (t''', _) = rewrite_set_ @{theory Isac} true norm_Rational t'';
neuper@42386
   326
if term2str t''' = "3 = ?A * (1 + 4 * z) / 4 + ?B * (-1 + 2 * z) / 2" then ()
neuper@42386
   327
else error "ansatz_rls - multiply_ansatz - norm_Rational broken";
neuper@42386
   328
neuper@42386
   329
(*test for outcommented 3 lines in script: empower erls for x = a*b ==> ...*)
neuper@42386
   330
val xxx = append_rls "multiply_ansatz_erls" norm_Rational 
neuper@42386
   331
  [Calc ("HOL.eq",eval_equal "#equal_")];
neuper@42386
   332
neuper@42386
   333
val multiply_ansatz = prep_rls(
neuper@42386
   334
  Rls {id = "multiply_ansatz", preconds = [], rew_ord = ("dummy_ord",dummy_ord), 
neuper@42386
   335
	  erls = xxx,
neuper@42451
   336
	  srls = Erls, calc = [], errpatts = [],
neuper@42386
   337
	  rules = 
neuper@42386
   338
	   [Thm ("multiply_2nd_order",num_str @{thm multiply_2nd_order})
neuper@42386
   339
	   ], 
neuper@42386
   340
	 scr = EmptyScr}:rls);
neuper@42386
   341
neuper@42386
   342
rewrite_set_ thy true xxx @{term "a+b = a+(b::real)"}; (*SOME ok*)
neuper@42386
   343
rewrite_set_ thy true multiply_ansatz @{term "a+b = a+(b::real)"}; (*why NONE?: GOON*)
neuper@42386
   344
neuper@42386
   345
"----------- progr.vers.2: improve program --------------";
neuper@42386
   346
"----------- progr.vers.2: improve program --------------";
neuper@42386
   347
"----------- progr.vers.2: improve program --------------";
neuper@42386
   348
(*WN120318 stopped due to much effort with the test above*)
neuper@42386
   349
     "Script PartFracScript (f_f::real) (zzz::real) =                    " ^(*f_f: 3 / (z * (z - 1 / 4 + -1 / 8 * (1 / z)), zzz: z*)
neuper@42386
   350
     " (let f_f = Take f_f;                                       " ^
neuper@42386
   351
     "   (num_orig::real) = get_numerator f_f;                    " ^(*num_orig: 3*)
neuper@42386
   352
     "   f_f = (Rewrite_Set norm_Rational False) f_f;             " ^(*f_f: 24 / (-1 + -2 * z + 8 * z ^^^ 2)*)
neuper@42386
   353
     "   (numer::real) = get_numerator f_f;                       " ^(*numer: 24*)
neuper@42386
   354
     "   (denom::real) = get_denominator f_f;                     " ^(*denom: -1 + -2 * z + 8 * z ^^^ 2*)
neuper@42386
   355
     "   (equ::bool) = (denom = (0::real));                       " ^(*equ: -1 + -2 * z + 8 * z ^^^ 2 = 0*)
neuper@42386
   356
     "   (L_L::bool list) = (SubProblem (PolyEq',                 " ^
neuper@42386
   357
     "     [abcFormula, degree_2, polynomial, univariate, equation], " ^
neuper@42386
   358
     "     [no_met]) [BOOL equ, REAL zzz]);                       " ^(*L_L: [z = 1 / 2, z = -1 / 4]*)
neuper@42386
   359
     "   (facs::real) = factors_from_solution L_L;                " ^(*facs: (z - 1 / 2) * (z - -1 / 4)*)
neuper@42386
   360
     "   (eql::real) = Take (num_orig / facs);                    " ^(*eql: 3 / ((z - 1 / 2) * (z - -1 / 4)) *) 
neuper@42386
   361
     "   (eqr::real) = (Try (Rewrite_Set ansatz_rls False)) eql;  " ^(*eqr: ?A / (z - 1 / 2) + ?B / (z - -1 / 4)*)
neuper@42386
   362
     "   (eq::bool) = Take (eql = eqr);                           " ^(*eq:  3 / ((z - 1 / 2) * (z - -1 / 4)) = ?A / (z - 1 / 2) + ?B / (z - -1 / 4)*)
neuper@42386
   363
(*this has been tested below by rewrite_set_
neuper@42386
   364
     "   (eeeee::bool) = Take ((num_orig / denom * denom / numer) = (num_orig / facs));" ^(**)
neuper@42386
   365
     "   (eeeee::bool) = (Rewrite_Set ansatz_rls False) eeeee;" ^(**)
neuper@42386
   366
     "   eq = (Try (Rewrite_Set multiply_ansatz False)) eeeee;         " ^(*eq: 3 = ?A * (z - -1 / 4) + ?B * (z - 1 / 2)*) 
neuper@42386
   367
NEXT try to outcomment the very next line..*)
neuper@42386
   368
     "   eq = (Try (Rewrite_Set equival_trans False)) eeeee;         " ^(*eq: 3 = ?A * (z - -1 / 4) + ?B * (z - 1 / 2)*) 
neuper@42386
   369
     "   eq = drop_questionmarks eq;                              " ^(*eq: 3 = A * (z - -1 / 4) + B * (z - 1 / 2)*)
neuper@42386
   370
     "   (z1::real) = (rhs (NTH 1 L_L));                          " ^(*z1: 1 / 2*)
neuper@42386
   371
     "   (z2::real) = (rhs (NTH 2 L_L));                          " ^(*z2: -1 / 4*)
neuper@42386
   372
     "   (eq_a::bool) = Take eq;                                  " ^(*eq_a: 3 = A * (z - -1 / 4) + B * (z - 1 / 2)*)
neuper@42386
   373
     "   eq_a = (Substitute [zzz = z1]) eq;                       " ^(*eq_a: 3 = A * (1 / 2 - -1 / 4) + B * (1 / 2 - 1 / 2)*)
neuper@42386
   374
     "   eq_a = (Rewrite_Set norm_Rational False) eq_a;           " ^(*eq_a: 3 = 3 * A / 4*)
neuper@42386
   375
     "   (sol_a::bool list) =                                     " ^
neuper@42386
   376
     "     (SubProblem (Isac', [univariate,equation], [no_met])   " ^
neuper@42386
   377
     "     [BOOL eq_a, REAL (A::real)]);                          " ^(*sol_a: [A = 4]*)
neuper@42386
   378
     "   (a::real) = (rhs (NTH 1 sol_a));                         " ^(*a: 4*)
neuper@42386
   379
     "   (eq_b::bool) = Take eq;                                  " ^(*eq_b: 3 = A * (z - -1 / 4) + B * (z - 1 / 2)*)
neuper@42386
   380
     "   eq_b = (Substitute [zzz = z2]) eq_b;                     " ^(*eq_b: *)
neuper@42386
   381
     "   eq_b = (Rewrite_Set norm_Rational False) eq_b;           " ^(*eq_b: *)
neuper@42386
   382
     "   (sol_b::bool list) =                                     " ^
neuper@42386
   383
     "     (SubProblem (Isac', [univariate,equation], [no_met])   " ^
neuper@42386
   384
     "     [BOOL eq_b, REAL (B::real)]);                          " ^(*sol_b: [B = -4]*)
neuper@42386
   385
     "   (b::real) = (rhs (NTH 1 sol_b));                         " ^(*b: -4*)
neuper@42386
   386
     "   eqr = drop_questionmarks eqr;                            " ^(*eqr: A / (z - 1 / 2) + B / (z - -1 / 4)*)
neuper@42386
   387
     "   (pbz::real) = Take eqr;                                  " ^(*pbz: A / (z - 1 / 2) + B / (z - -1 / 4)*)
neuper@42386
   388
     "   pbz = ((Substitute [A = a, B = b]) pbz)                  " ^(*pbz: 4 / (z - 1 / 2) + -4 / (z - -1 / 4)*)
neuper@42386
   389
     " in pbz)"
neuper@42386
   390