test/Tools/isac/ADDTESTS/course/SignalProcess/Build_Inverse_Z_Transform.thy
author Jan Rocnik <jan.rocnik@student.tugraz.at>
Tue, 22 Nov 2011 00:33:02 +0100
branchdecompose-isar
changeset 42337 e09aeb95345b
parent 42335 7bb5070f2415
child 42338 539c8cc51be7
permissions -rwxr-xr-x
implementation try with errors, just for exchange
neuper@42301
     1
(* Title:  Build_Inverse_Z_Transform
neuper@42279
     2
   Author: Jan Rocnik
neuper@42279
     3
   (c) copyright due to lincense terms.
neuper@42279
     4
12345678901234567890123456789012345678901234567890123456789012345678901234567890
neuper@42279
     5
        10        20        30        40        50        60        70        80
neuper@42279
     6
*)
neuper@42279
     7
jan@42298
     8
theory Build_Inverse_Z_Transform imports Isac
neuper@42289
     9
  
neuper@42289
    10
begin
neuper@42279
    11
neuper@42289
    12
text{* We stepwise build Inverse_Z_Transform.thy as an exercise.
jan@42299
    13
  Because subsection "Stepwise Check the Program" requires 
jan@42299
    14
  Inverse_Z_Transform.thy as a subtheory of Isac.thy, the setup has been changed 
jan@42299
    15
  from "theory Inverse_Z_Transform imports Isac begin.." to the above.
neuper@42279
    16
neuper@42279
    17
  ATTENTION WITH NAMES OF IDENTIFIERS WHEN GOING INTO INTERNALS:
neuper@42279
    18
  Here in this theory there are the internal names twice, for instance we have
neuper@42279
    19
  (Thm.derivation_name @{thm rule1} = "Build_Inverse_Z_Transform.rule1") = true;
neuper@42279
    20
  but actually in us will be "Inverse_Z_Transform.rule1"
neuper@42279
    21
*}
neuper@42279
    22
ML {*val thy = @{theory Isac};*}
neuper@42279
    23
neuper@42279
    24
neuper@42279
    25
section {*trials towards Z transform *}
neuper@42279
    26
text{*===============================*}
neuper@42279
    27
subsection {*terms*}
neuper@42279
    28
ML {*
neuper@42279
    29
@{term "1 < || z ||"};
neuper@42279
    30
@{term "z / (z - 1)"};
neuper@42279
    31
@{term "-u -n - 1"};
neuper@42279
    32
@{term "-u [-n - 1]"}; (*[ ] denotes lists !!!*)
neuper@42279
    33
@{term "z /(z - 1) = -u [-n - 1]"};Isac
neuper@42279
    34
@{term "1 < || z || ==> z / (z - 1) = -u [-n - 1]"};
neuper@42279
    35
term2str @{term "1 < || z || ==> z / (z - 1) = -u [-n - 1]"};
neuper@42279
    36
*}
neuper@42279
    37
ML {*
neuper@42279
    38
(*alpha -->  "</alpha>" *)
neuper@42279
    39
@{term "\<alpha> "};
neuper@42279
    40
@{term "\<delta> "};
neuper@42279
    41
@{term "\<phi> "};
neuper@42279
    42
@{term "\<rho> "};
neuper@42279
    43
term2str @{term "\<rho> "};
neuper@42279
    44
*}
neuper@42279
    45
neuper@42279
    46
subsection {*rules*}
neuper@42279
    47
(*axiomatization "z / (z - 1) = -u [-n - 1]" Illegal variable name: "z / (z - 1) = -u [-n - 1]" *)
neuper@42279
    48
(*definition     "z / (z - 1) = -u [-n - 1]" Bad head of lhs: existing constant "op /"*)
neuper@42279
    49
axiomatization where 
neuper@42279
    50
  rule1: "1 = \<delta>[n]" and
neuper@42279
    51
  rule2: "|| z || > 1 ==> z / (z - 1) = u [n]" and
neuper@42279
    52
  rule3: "|| z || < 1 ==> z / (z - 1) = -u [-n - 1]" and 
neuper@42279
    53
  rule4: "|| z || > || \<alpha> || ==> z / (z - \<alpha>) = \<alpha>^^^n * u [n]" and
neuper@42279
    54
  rule5: "|| z || < || \<alpha> || ==> z / (z - \<alpha>) = -(\<alpha>^^^n) * u [-n - 1]" and
neuper@42279
    55
  rule6: "|| z || > 1 ==> z/(z - 1)^^^2 = n * u [n]"
neuper@42279
    56
ML {*
neuper@42279
    57
@{thm rule1};
neuper@42279
    58
@{thm rule2};
neuper@42279
    59
@{thm rule3};
neuper@42279
    60
@{thm rule4};
neuper@42279
    61
*}
neuper@42279
    62
neuper@42279
    63
subsection {*apply rules*}
neuper@42279
    64
ML {*
neuper@42279
    65
val inverse_Z = append_rls "inverse_Z" e_rls
neuper@42279
    66
  [ Thm  ("rule3",num_str @{thm rule3}),
neuper@42279
    67
    Thm  ("rule4",num_str @{thm rule4}),
neuper@42279
    68
    Thm  ("rule1",num_str @{thm rule1})   
neuper@42279
    69
  ];
neuper@42279
    70
neuper@42279
    71
val t = str2term "z / (z - 1) + z / (z - \<alpha>) + 1";
neuper@42279
    72
val SOME (t', asm) = rewrite_set_ thy true inverse_Z t;
neuper@42279
    73
term2str t' = "z / (z - ?\<delta> [?n]) + z / (z - \<alpha>) + ?\<delta> [?n]"; (*attention rule1 !!!*)
neuper@42279
    74
*}
neuper@42279
    75
ML {*
neuper@42279
    76
val (thy, ro, er) = (@{theory Isac}, tless_true, eval_rls);
neuper@42279
    77
*}
neuper@42279
    78
ML {*
neuper@42279
    79
val SOME (t, asm1) = rewrite_ thy ro er true (num_str @{thm rule3}) t;
neuper@42279
    80
term2str t = "- ?u [- ?n - 1] + z / (z - \<alpha>) + 1"; (*- real *)
neuper@42301
    81
term2str t;*}
neuper@42279
    82
ML {*
neuper@42279
    83
val SOME (t, asm2) = rewrite_ thy ro er true (num_str @{thm rule4}) t;
neuper@42279
    84
term2str t = "- ?u [- ?n - 1] + \<alpha> ^^^ ?n * ?u [?n] + 1"; (*- real *)
neuper@42279
    85
term2str t;
neuper@42279
    86
*}
neuper@42279
    87
ML {*
neuper@42279
    88
val SOME (t, asm3) = rewrite_ thy ro er true (num_str @{thm rule1}) t;
neuper@42279
    89
term2str t = "- ?u [- ?n - 1] + \<alpha> ^^^ ?n * ?u [?n] + ?\<delta> [?n]"; (*- real *)
neuper@42279
    90
term2str t;
neuper@42279
    91
*}
neuper@42279
    92
ML {*
neuper@42279
    93
terms2str (asm1 @ asm2 @ asm3);
neuper@42279
    94
*}
neuper@42279
    95
jan@42296
    96
section {*Prepare steps for CTP-based programming language*}
jan@42296
    97
text{*TODO insert Calculation (Referenz?!)
jan@42296
    98
jan@42296
    99
The goal... realized in sections below, in Sect.\ref{spec-meth} and Sect.\ref{prog-steps} 
jan@42296
   100
jan@42296
   101
the reader is advised to jump between the subsequent subsections and the respective steps in Sect.\ref{prog-steps} 
jan@42296
   102
jan@42296
   103
*}
jan@42296
   104
subsection {*prepare expression \label{prep-expr}*}
neuper@42279
   105
ML {*
neuper@42279
   106
val ctxt = ProofContext.init_global @{theory Isac};
neuper@42279
   107
val ctxt = declare_constraints' [@{term "z::real"}] ctxt;
neuper@42279
   108
neuper@42279
   109
val SOME fun1 = parseNEW ctxt "X z = 3 / (z - 1/4 + -1/8 * z ^^^ -1)"; term2str fun1;
neuper@42279
   110
val SOME fun1' = parseNEW ctxt "X z = 3 / (z - 1/4 + -1/8 * (1/z))"; term2str fun1';
neuper@42279
   111
*}
neuper@42279
   112
jan@42298
   113
subsubsection {*multply with z*}
neuper@42279
   114
axiomatization where
neuper@42279
   115
  ruleZY: "(X z = a / b) = (X' z = a / (z * b))"
neuper@42279
   116
neuper@42279
   117
ML {*
neuper@42279
   118
val (thy, ro, er) = (@{theory Isac}, tless_true, eval_rls);
neuper@42279
   119
val SOME (fun2, asm1) = rewrite_ thy ro er true  @{thm ruleZY} fun1; term2str fun2;
neuper@42279
   120
val SOME (fun2', asm1) = rewrite_ thy ro er true  @{thm ruleZY} fun1'; term2str fun2';
neuper@42279
   121
neuper@42279
   122
val SOME (fun3,_) = rewrite_set_ @{theory Isac} false norm_Rational fun2;
neuper@42279
   123
term2str fun3; (*fails on x^^^(-1) TODO*)
neuper@42279
   124
val SOME (fun3',_) = rewrite_set_ @{theory Isac} false norm_Rational fun2';
neuper@42279
   125
term2str fun3'; (*OK*)
neuper@42289
   126
*}
neuper@42279
   127
jan@42298
   128
subsubsection {*get argument of X': z is the variable the equation is solved for*}
jan@42298
   129
text{*grep... Atools.thy, Tools.thy contain general utilities: eval_argument_in, eval_rhs, eval_lhs,...
jan@42298
   130
jan@42298
   131
grep -r "fun eva_" ... shows all functions witch can be used in a script.
jan@42298
   132
lookup this files how to build and handle such functions.
jan@42298
   133
jan@42298
   134
the next section shows how to introduce such a function.
jan@42298
   135
*}
jan@42298
   136
neuper@42302
   137
subsubsection {*Decompose given term into lhs = rhs*}
neuper@42302
   138
ML {*
neuper@42302
   139
  val (_, expr) = HOLogic.dest_eq fun3'; term2str expr;
neuper@42302
   140
  val (_, denom) = HOLogic.dest_bin "Rings.inverse_class.divide" (type_of expr) expr;
neuper@42302
   141
  term2str denom = "-1 + -2 * z + 8 * z ^^^ 2";
neuper@42302
   142
*}
neuper@42302
   143
text {*we have rhs in the Script language, but we need a function 
neuper@42302
   144
  which gets the denominator of a fraction*}
jan@42298
   145
jan@42298
   146
text{*---------------------------begin partial fractions snip--------------------------*}
jan@42298
   147
jan@42298
   148
subsubsection {*get the denominator out of a fraction*}
jan@42298
   149
text {*get denominator should become a constant for the isabelle parser: *}
jan@42298
   150
jan@42298
   151
consts
neuper@42302
   152
  get_denominator :: "real => real"
jan@42298
   153
neuper@42302
   154
text {* With the above definition we run into problems with parsing the Script InverseZTransform:
neuper@42302
   155
  This leads to "ambiguous parse trees" and we avoid this by shifting the definition
neuper@42335
   156
  to Rational.thy and re-building Isac.
neuper@42302
   157
  ATTENTION: from now on Build_Inverse_Z_Transform mimics a build from scratch;
neuper@42302
   158
  it only works due to re-building Isac several times (indicated explicityl).
neuper@42302
   159
*}
jan@42300
   160
jan@42298
   161
ML {*
neuper@42301
   162
(*("get_denominator", ("Rational.get_denominator", eval_get_denominator ""))*)
jan@42298
   163
fun eval_get_denominator (thmid:string) _ 
neuper@42301
   164
		      (t as Const ("Rational.get_denominator", _) $
jan@42298
   165
              (Const ("Rings.inverse_class.divide", _) $ num $
jan@42298
   166
                denom)) thy = 
neuper@42302
   167
        SOME (mk_thmid thmid "" 
jan@42298
   168
            (Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt thy)) denom) "", 
jan@42298
   169
	          Trueprop $ (mk_equality (t, denom)))
jan@42300
   170
  | eval_get_denominator _ _ _ _ = NONE; 
jan@42299
   171
jan@42298
   172
*}
neuper@42302
   173
text {* tests of eval_get_denominator see test/Knowledge/rational.sml*}
neuper@42289
   174
jan@42297
   175
jan@42297
   176
text{*---------------------------end partial fractions snip--------------------------*}
neuper@42279
   177
jan@42337
   178
subsubsection {*get the numerator out of a fraction*}
jan@42337
   179
text {*get dnumerator should also become a constant for the isabelle parser: *}
jan@42337
   180
jan@42337
   181
consts
jan@42337
   182
  get_numerator :: "real => real"
jan@42337
   183
jan@42337
   184
ML {*
jan@42337
   185
fun eval_get_numerator (thmid:string) _ 
jan@42337
   186
		      (t as Const ("Rational.get_numerator", _) $
jan@42337
   187
              (Const ("Rings.inverse_class.divide", _) numerator
jan@42337
   188
                $ num $ )) thy = 
jan@42337
   189
        SOME (mk_thmid thmid "" 
jan@42337
   190
            (Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt thy)) denom) "", 
jan@42337
   191
	          Trueprop $ (mk_equality (t, denom)))
jan@42337
   192
  | eval_get_numerator _ _ _ _ = NONE; 
jan@42337
   193
jan@42337
   194
*}
jan@42337
   195
neuper@42279
   196
subsection {*solve equation*}
neuper@42279
   197
text {*this type of equation if too general for the present program*}
neuper@42279
   198
ML {*
neuper@42279
   199
"----------- Minisubplb/100-init-rootp (*OK*)bl.sml ---------------------";
neuper@42279
   200
val denominator = parseNEW ctxt "z^^^2 - 1/4*z - 1/8 = 0";
neuper@42279
   201
val fmz = ["equality (z^^^2 - 1/4*z - 1/8 = (0::real))", "solveFor z","solutions L"];
neuper@42279
   202
val (dI',pI',mI') =("Isac", ["univariate","equation"], ["no_met"]);
neuper@42279
   203
(*                           ^^^^^^^^^^^^^^^^^^^^^^ TODO: ISAC determines type of eq*)
neuper@42279
   204
*}
neuper@42279
   205
text {*Does the Equation Match the Specification ?*}
neuper@42279
   206
ML {*
neuper@42279
   207
match_pbl fmz (get_pbt ["univariate","equation"]);
neuper@42279
   208
*}
neuper@42279
   209
ML {*Context.theory_name thy = "Isac"(*==================================================*)*}
neuper@42279
   210
neuper@42279
   211
ML {*
neuper@42303
   212
val denominator = parseNEW ctxt "-1 + -2 * z + 8 * z ^^^ 2 = 0";
neuper@42279
   213
val fmz =                                            (*specification*)
neuper@42303
   214
  ["equality (-1 + -2 * z + 8 * z ^^^ 2 = (0::real))", (*equality*)
neuper@42279
   215
   "solveFor z",                                     (*bound variable*)
neuper@42279
   216
   "solutions L"];                                   (*identifier for solution*)
jan@42300
   217
neuper@42279
   218
val (dI',pI',mI') =
neuper@42303
   219
  ("Isac", ["abcFormula","degree_2","polynomial","univariate","equation"], ["no_met"]);
neuper@42279
   220
*}
neuper@42279
   221
text {*Does the Other Equation Match the Specification ?*}
neuper@42279
   222
ML {*
neuper@42303
   223
match_pbl fmz (get_pbt ["abcFormula","degree_2","polynomial","univariate","equation"]);
neuper@42279
   224
*}
neuper@42279
   225
text {*Solve Equation Stepwise*}
neuper@42279
   226
ML {*
neuper@42303
   227
*}
neuper@42303
   228
ML {*
neuper@42279
   229
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42279
   230
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   231
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   232
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   233
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   234
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   235
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   236
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   237
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   238
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   239
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   240
val (p,_,f,nxt,_,pt) = me nxt p [] pt;         
neuper@42279
   241
val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt =..,Check_elementwise "Assumptions")*)
neuper@42279
   242
val (p,_,f,nxt,_,pt) = me nxt p [] pt;         
neuper@42279
   243
val (p,_,f,nxt,_,pt) = me nxt p [] pt; f2str f;
neuper@42303
   244
(*[z = 1 / 2, z = -1 / 4]*)
neuper@42279
   245
show_pt pt; 
neuper@42279
   246
val SOME f = parseNEW ctxt "[z=1/2, z=-1/4]";
neuper@42279
   247
*}
neuper@42279
   248
neuper@42279
   249
subsection {*partial fraction decomposition*}
neuper@42279
   250
subsubsection {*solution of the equation*}
neuper@42279
   251
ML {*
neuper@42279
   252
val SOME solutions = parseNEW ctxt "[z=1/2, z=-1/4]";
neuper@42279
   253
term2str solutions;
neuper@42279
   254
atomty solutions;
neuper@42279
   255
*}
neuper@42279
   256
neuper@42279
   257
subsubsection {*get solutions out of list*}
neuper@42279
   258
text {*in isac's CTP-based programming language: let$ $s_1 = NTH 1$ solutions; $s_2 = NTH 2...$*}
neuper@42279
   259
ML {*
neuper@42279
   260
val Const ("List.list.Cons", _) $ s_1 $ (Const ("List.list.Cons", _) $
neuper@42279
   261
      s_2 $ Const ("List.list.Nil", _)) = solutions;
neuper@42279
   262
term2str s_1;
neuper@42279
   263
term2str s_2;
neuper@42279
   264
*}
neuper@42279
   265
neuper@42279
   266
ML {* (*Solutions as Denominator --> Denominator1 = z - Zeropoint1, Denominator2 = z-Zeropoint2,...*)
neuper@42279
   267
val xx = HOLogic.dest_eq s_1;
neuper@42279
   268
val s_1' = HOLogic.mk_binop "Groups.minus_class.minus" xx;
neuper@42279
   269
val xx = HOLogic.dest_eq s_2;
neuper@42279
   270
val s_2' = HOLogic.mk_binop "Groups.minus_class.minus" xx;
neuper@42279
   271
term2str s_1';
neuper@42279
   272
term2str s_2';
neuper@42279
   273
*}
neuper@42335
   274
text {* for the programming language a function 
neuper@42335
   275
  collecting all the above manipulations is helpful*}
neuper@42335
   276
ML {*
neuper@42335
   277
fun mk_minus_1 T = Free("-1", T); (*TODO DELETE WITH numbers_to_string*)
neuper@42335
   278
fun flip_sign t = (*TODO improve for use in factors_from_solution: -(-1) etc*)
neuper@42335
   279
  let val minus_1 = t |> type_of |> mk_minus_1
neuper@42335
   280
  in HOLogic.mk_binop "Groups.times_class.times" (minus_1, t) end;
neuper@42335
   281
fun fac_from_sol s =
neuper@42335
   282
  let val (lhs, rhs) = HOLogic.dest_eq s
neuper@42335
   283
  in HOLogic.mk_binop "Groups.plus_class.plus" (lhs, flip_sign rhs) end;
neuper@42335
   284
*}
neuper@42335
   285
ML {*
neuper@42335
   286
e_term
neuper@42335
   287
*}
neuper@42335
   288
ML {*
neuper@42335
   289
fun mk_prod prod [] =
neuper@42335
   290
      if prod = e_term then error "mk_prod called with []" else prod
neuper@42335
   291
  | mk_prod prod (t :: []) =
neuper@42335
   292
      if prod = e_term then t else HOLogic.mk_binop "Groups.times_class.times" (prod, t)
neuper@42335
   293
  | mk_prod prod (t1 :: t2 :: ts) =
neuper@42335
   294
        if prod = e_term 
neuper@42335
   295
        then 
neuper@42335
   296
           let val p = HOLogic.mk_binop "Groups.times_class.times" (t1, t2)
neuper@42335
   297
           in mk_prod p ts end 
neuper@42335
   298
        else 
neuper@42335
   299
           let val p = HOLogic.mk_binop "Groups.times_class.times" (prod, t1)
neuper@42335
   300
           in mk_prod p (t2 :: ts) end 
neuper@42335
   301
*}
neuper@42335
   302
ML {*
neuper@42335
   303
*}
neuper@42335
   304
ML {*
neuper@42335
   305
(*probably keept these test in test/Tools/isac/...
neuper@42335
   306
(*mk_prod e_term [];*)
neuper@42335
   307
neuper@42335
   308
val prod = mk_prod e_term [str2term "x + 123"]; 
neuper@42335
   309
term2str prod = "x + 123";
neuper@42335
   310
neuper@42335
   311
val sol = str2term "[z = 1 / 2, z = -1 / 4]";
neuper@42335
   312
val sols = HOLogic.dest_list sol;
neuper@42335
   313
val facs = map fac_from_sol sols;
neuper@42335
   314
val prod = mk_prod e_term facs; 
neuper@42335
   315
term2str prod = "(z + -1 * (1 / 2)) * (z + -1 * (-1 / 4))";
neuper@42335
   316
neuper@42335
   317
val prod = mk_prod e_term [str2term "x + 1", str2term "x + 2", str2term "x + 3"]; 
neuper@42335
   318
term2str prod = "(x + 1) * (x + 2) * (x + 3)";
neuper@42335
   319
*)
neuper@42335
   320
neuper@42335
   321
fun factors_from_solution sol = 
neuper@42335
   322
  let val ts = HOLogic.dest_list sol
neuper@42335
   323
  in mk_prod e_term (map fac_from_sol ts) end;
neuper@42335
   324
(*
neuper@42335
   325
val sol = str2term "[z = 1 / 2, z = -1 / 4]";
neuper@42335
   326
val fs = factors_from_solution sol;
neuper@42335
   327
term2str fs = "(z + -1 * (1 / 2)) * (z + -1 * (-1 / 4))"
neuper@42335
   328
*)
neuper@42335
   329
*}
neuper@42335
   330
text {* This function needs to be packed such that it can be evaluated by the Lucas-Interpreter:
neuper@42335
   331
  # shift these functions into the related Equation.thy
neuper@42335
   332
  #  -- compare steps done with get_denominator above
neuper@42335
   333
  *}
neuper@42335
   334
ML {*
neuper@42335
   335
(*("factors_from_solution", ("Equation.factors_from_solution", eval_factors_from_solution ""))*)
neuper@42335
   336
fun eval_factors_from_solution (thmid:string) _ t thy =
neuper@42335
   337
    (let val prod = factors_from_solution t
neuper@42335
   338
     in SOME (mk_thmid thmid "" 
neuper@42335
   339
            (Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt thy)) prod) "", 
neuper@42335
   340
	          Trueprop $ (mk_equality (t, prod)))
neuper@42335
   341
     end)
neuper@42335
   342
     handle _ => NONE; 
neuper@42335
   343
*}
neuper@42279
   344
neuper@42279
   345
subsubsection {*build expression*}
neuper@42279
   346
text {*in isac's CTP-based programming language: let s_1 = Take numerator / (s_1 * s_2)*}
neuper@42279
   347
ML {*
neuper@42279
   348
(*The Main Denominator is the multiplikation of the partial fraction denominators*)
neuper@42279
   349
val denominator' = HOLogic.mk_binop "Groups.times_class.times" (s_1', s_2') ;
neuper@42279
   350
val SOME numerator = parseNEW ctxt "3::real";
neuper@42279
   351
neuper@42279
   352
val expr' = HOLogic.mk_binop "Rings.inverse_class.divide" (numerator, denominator');
neuper@42279
   353
term2str expr';
neuper@42279
   354
*}
neuper@42279
   355
neuper@42279
   356
subsubsection {*Ansatz - create partial fractions out of our expression*}
neuper@42302
   357
ML {*Context.theory_name thy = "Isac"*}
neuper@42279
   358
neuper@42279
   359
axiomatization where
neuper@42279
   360
  ansatz2: "n / (a*b) = A/a + B/(b::real)" and
jan@42337
   361
  multiply_eq2: "(n / (a*b) = A/a + B/b) = (a*b*(n  / (a*b)) = a*b*(A/a + B/b))" and
jan@42337
   362
  ansatz3: "n / (a * b * c) = (A/a) + (B/b) + (C/c)" and
jan@42337
   363
  ansatz4: "n / (a * b * c * d) = (A/a) + (B/b) + (C/c) + (D/d)" 
neuper@42279
   364
neuper@42279
   365
ML {*
neuper@42279
   366
(*we use our ansatz2 to rewrite our expression and get an equilation with our expression on the left and the partial fractions of it on the right side*)
neuper@42279
   367
val SOME (t1,_) = rewrite_ @{theory Isac} e_rew_ord e_rls false @{thm ansatz2} expr';
neuper@42279
   368
term2str t1; atomty t1;
neuper@42279
   369
val eq1 = HOLogic.mk_eq (expr', t1);
neuper@42279
   370
term2str eq1;
neuper@42279
   371
*}
neuper@42279
   372
ML {*
neuper@42279
   373
(*eliminate the demoninators by multiplying the left and the right side with the main denominator*)
neuper@42279
   374
val SOME (eq2,_) = rewrite_ @{theory Isac} e_rew_ord e_rls false @{thm multiply_eq2} eq1;
neuper@42279
   375
term2str eq2;
neuper@42279
   376
*}
neuper@42279
   377
ML {*
neuper@42279
   378
(*simplificatoin*)
neuper@42279
   379
val SOME (eq3,_) = rewrite_set_ @{theory Isac} false norm_Rational eq2;
neuper@42279
   380
term2str eq3; (*?A ?B not simplified*)
neuper@42279
   381
*}
neuper@42279
   382
ML {*
neuper@42279
   383
val SOME fract1 =
neuper@42279
   384
  parseNEW ctxt "(z - 1 / 2) * (z - -1 / 4) * (A / (z - 1 / 2) + B / (z - -1 / 4))"; (*A B !*)
neuper@42279
   385
val SOME (fract2,_) = rewrite_set_ @{theory Isac} false norm_Rational fract1;
neuper@42279
   386
term2str fract2 = "(A + -2 * B + 4 * A * z + 4 * B * z) / 4";
neuper@42279
   387
(*term2str fract2 = "A * (1 / 4 + z) + B * (-1 / 2 + z)" would be more traditional*)
neuper@42279
   388
*}
neuper@42279
   389
ML {*
neuper@42279
   390
val (numerator, denominator) = HOLogic.dest_eq eq3;
neuper@42279
   391
val eq3' = HOLogic.mk_eq (numerator, fract1); (*A B !*)
neuper@42279
   392
term2str eq3';
neuper@42279
   393
(*MANDATORY: simplify (and remove denominator) otherwise 3 = 0*)
neuper@42279
   394
val SOME (eq3'' ,_) = rewrite_set_ @{theory Isac} false norm_Rational eq3';
neuper@42279
   395
term2str eq3'';
neuper@42279
   396
*}
neuper@42279
   397
ML {*Context.theory_name thy = "Isac"(*==================================================*)*}
neuper@42279
   398
neuper@42279
   399
subsubsection {*get first koeffizient*}
neuper@42279
   400
neuper@42279
   401
ML {*
neuper@42279
   402
(*substitude z with the first zeropoint to get A*)
neuper@42279
   403
val SOME (eq4_1,_) = rewrite_terms_ @{theory Isac} e_rew_ord e_rls [s_1] eq3'';
neuper@42279
   404
term2str eq4_1;
neuper@42279
   405
neuper@42279
   406
val SOME (eq4_2,_) = rewrite_set_ @{theory Isac} false norm_Rational eq4_1;
neuper@42279
   407
term2str eq4_2;
neuper@42279
   408
neuper@42279
   409
val fmz = ["equality (3 = 3 * A / (4::real))", "solveFor A","solutions L"];
neuper@42279
   410
val (dI',pI',mI') =("Isac", ["univariate","equation"], ["no_met"]);
neuper@42279
   411
(*solve the simple linear equilation for A TODO: return eq, not list of eq*)
neuper@42279
   412
val (p,_,fa,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42279
   413
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   414
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   415
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   416
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   417
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   418
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   419
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   420
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   421
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   422
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   423
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   424
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   425
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   426
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   427
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   428
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   429
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   430
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   431
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   432
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   433
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   434
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   435
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   436
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   437
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   438
val (p,_,fa,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   439
val (p,_,fa,nxt,_,pt) = me nxt p [] pt; 
neuper@42279
   440
f2str fa;
neuper@42279
   441
*}
neuper@42279
   442
neuper@42279
   443
subsubsection {*get second koeffizient*}
neuper@42279
   444
ML {*thy*}
neuper@42279
   445
neuper@42279
   446
ML {*
neuper@42279
   447
(*substitude z with the second zeropoint to get B*)
neuper@42279
   448
val SOME (eq4b_1,_) = rewrite_terms_ @{theory Isac} e_rew_ord e_rls [s_2] eq3'';
neuper@42279
   449
term2str eq4b_1;
neuper@42279
   450
neuper@42279
   451
val SOME (eq4b_2,_) = rewrite_set_ @{theory Isac} false norm_Rational eq4b_1;
neuper@42279
   452
term2str eq4b_2;
neuper@42279
   453
*}
neuper@42279
   454
ML {*
neuper@42279
   455
(*solve the simple linear equilation for B TODO: return eq, not list of eq*)
neuper@42279
   456
val fmz = ["equality (3 = -3 * B / (4::real))", "solveFor B","solutions L"];
neuper@42279
   457
val (dI',pI',mI') =("Isac", ["univariate","equation"], ["no_met"]);
neuper@42279
   458
val (p,_,fb,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42279
   459
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   460
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   461
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   462
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   463
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   464
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   465
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   466
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   467
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   468
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   469
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   470
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   471
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   472
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   473
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   474
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   475
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   476
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   477
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   478
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   479
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   480
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   481
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   482
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   483
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   484
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   485
val (p,_,fb,nxt,_,pt) = me nxt p [] pt; 
neuper@42279
   486
f2str fb;
neuper@42279
   487
*}
neuper@42279
   488
neuper@42279
   489
ML {* (*check koeffizients*)
neuper@42279
   490
if f2str fa = "[A = 4]" then () else error "part.fract. eq4_1";
neuper@42279
   491
if f2str fb = "[B = -4]" then () else error "part.fract. eq4_1";
neuper@42279
   492
*}
neuper@42279
   493
neuper@42279
   494
subsubsection {*substitute expression with solutions*}
neuper@42279
   495
ML {*
neuper@42279
   496
*}
neuper@42279
   497
ML {*thy*}
neuper@42279
   498
jan@42296
   499
section {*Implement the Specification and the Method \label{spec-meth}*}
neuper@42279
   500
text{*==============================================*}
neuper@42279
   501
subsection{*Define the Field Descriptions for the specification*}
neuper@42279
   502
consts
neuper@42279
   503
  filterExpression  :: "bool => una"
neuper@42279
   504
  stepResponse      :: "bool => una"
neuper@42279
   505
neuper@42279
   506
subsection{*Define the Specification*}
neuper@42279
   507
ML {*
neuper@42279
   508
store_pbt
neuper@42279
   509
 (prep_pbt thy "pbl_SP" [] e_pblID
neuper@42279
   510
 (["SignalProcessing"], [], e_rls, NONE, []));
neuper@42279
   511
store_pbt
neuper@42279
   512
 (prep_pbt thy "pbl_SP_Ztrans" [] e_pblID
neuper@42279
   513
 (["Z_Transform","SignalProcessing"], [], e_rls, NONE, []));
neuper@42279
   514
*}
neuper@42279
   515
ML {*thy*}
neuper@42279
   516
ML {*
neuper@42279
   517
store_pbt
neuper@42279
   518
 (prep_pbt thy "pbl_SP_Ztrans_inv" [] e_pblID
neuper@42279
   519
 (["inverse", "Z_Transform", "SignalProcessing"],
neuper@42279
   520
  [("#Given" ,["filterExpression X_eq"]),
neuper@42279
   521
   ("#Find"  ,["stepResponse n_eq"])
neuper@42279
   522
  ],
neuper@42279
   523
  append_rls "e_rls" e_rls [(*for preds in where_*)], NONE, 
neuper@42279
   524
  [["SignalProcessing","Z_Transform","inverse"]]));
neuper@42279
   525
neuper@42279
   526
show_ptyps();
neuper@42279
   527
get_pbt ["inverse","Z_Transform","SignalProcessing"];
neuper@42279
   528
*}
neuper@42279
   529
neuper@42279
   530
subsection {*Define Name and Signature for the Method*}
neuper@42279
   531
consts
neuper@42279
   532
  InverseZTransform :: "[bool, bool] => bool"
neuper@42279
   533
    ("((Script InverseZTransform (_ =))// (_))" 9)
neuper@42279
   534
neuper@42279
   535
subsection {*Setup Parent Nodes in Hierarchy of Method*}
neuper@42279
   536
ML {*
neuper@42279
   537
store_met
neuper@42279
   538
 (prep_met thy "met_SP" [] e_metID
neuper@42279
   539
 (["SignalProcessing"], [],
neuper@42279
   540
   {rew_ord'="tless_true", rls'= e_rls, calc = [], srls = e_rls, prls = e_rls,
neuper@42279
   541
    crls = e_rls, nrls = e_rls}, "empty_script"));
neuper@42279
   542
store_met
neuper@42279
   543
 (prep_met thy "met_SP_Ztrans" [] e_metID
neuper@42279
   544
 (["SignalProcessing", "Z_Transform"], [],
neuper@42279
   545
   {rew_ord'="tless_true", rls'= e_rls, calc = [], srls = e_rls, prls = e_rls,
neuper@42279
   546
    crls = e_rls, nrls = e_rls}, "empty_script"));
neuper@42279
   547
*}
neuper@42279
   548
ML {*
neuper@42279
   549
store_met
neuper@42279
   550
 (prep_met thy "met_SP_Ztrans_inv" [] e_metID
neuper@42279
   551
 (["SignalProcessing", "Z_Transform", "inverse"], 
neuper@42279
   552
  [("#Given" ,["filterExpression X_eq"]),
neuper@42279
   553
   ("#Find"  ,["stepResponse n_eq"])
neuper@42279
   554
  ],
neuper@42279
   555
   {rew_ord'="tless_true", rls'= e_rls, calc = [], srls = e_rls, prls = e_rls,
neuper@42279
   556
    crls = e_rls, nrls = e_rls},
neuper@42279
   557
  "empty_script"
neuper@42279
   558
 ));
neuper@42279
   559
*}
neuper@42279
   560
ML {*
neuper@42279
   561
store_met
neuper@42279
   562
 (prep_met thy "met_SP_Ztrans_inv" [] e_metID
neuper@42279
   563
 (["SignalProcessing", "Z_Transform", "inverse"], 
neuper@42279
   564
  [("#Given" ,["filterExpression X_eq"]),
neuper@42279
   565
   ("#Find"  ,["stepResponse n_eq"])
neuper@42279
   566
  ],
neuper@42279
   567
   {rew_ord'="tless_true", rls'= e_rls, calc = [], srls = e_rls, prls = e_rls,
neuper@42279
   568
    crls = e_rls, nrls = e_rls},
neuper@42279
   569
  "Script InverseZTransform (Xeq::bool) =" ^
neuper@42279
   570
  " (let X = Take Xeq;" ^
neuper@42279
   571
  "      X = Rewrite ruleZY False X" ^
neuper@42279
   572
  "  in X)"
neuper@42279
   573
 ));
jan@42299
   574
*}
jan@42299
   575
ML {*
neuper@42279
   576
show_mets();
jan@42299
   577
*}
jan@42299
   578
ML {*
neuper@42279
   579
get_met ["SignalProcessing","Z_Transform","inverse"];
neuper@42279
   580
*}
neuper@42279
   581
jan@42296
   582
section {*Program in CTP-based language \label{prog-steps}*}
neuper@42279
   583
text{*=================================*}
neuper@42279
   584
subsection {*Stepwise extend Program*}
neuper@42279
   585
ML {*
neuper@42279
   586
val str = 
neuper@42279
   587
"Script InverseZTransform (Xeq::bool) =" ^
neuper@42279
   588
" Xeq";
neuper@42279
   589
*}
neuper@42279
   590
ML {*
neuper@42279
   591
val str = 
neuper@42279
   592
"Script InverseZTransform (Xeq::bool) =" ^ (*(1/z) instead of z ^^^ -1*)
neuper@42279
   593
" (let X = Take Xeq;" ^
neuper@42279
   594
"      X' = Rewrite ruleZY False X;" ^ (*z * denominator*)
neuper@42279
   595
"      X' = (Rewrite_Set norm_Rational False) X'" ^ (*simplify*)
neuper@42279
   596
"  in X)";
neuper@42279
   597
(*NONE*)
neuper@42279
   598
"Script InverseZTransform (Xeq::bool) =" ^ (*(1/z) instead of z ^^^ -1*)
neuper@42279
   599
" (let X = Take Xeq;" ^
neuper@42279
   600
"      X' = Rewrite ruleZY False X;" ^ (*z * denominator*)
neuper@42279
   601
"      X' = (Rewrite_Set norm_Rational False) X';" ^ (*simplify*)
neuper@42279
   602
"      X' = (SubProblem (Isac',[pqFormula,degree_2,polynomial,univariate,equation], [no_met])   " ^
neuper@42279
   603
    "                 [BOOL e_e, REAL v_v])" ^
neuper@42279
   604
"  in X)";
neuper@42279
   605
*}
neuper@42279
   606
ML {*
neuper@42279
   607
val str = 
neuper@42279
   608
"Script InverseZTransform (Xeq::bool) =" ^ (*(1/z) instead of z ^^^ -1*)
neuper@42279
   609
" (let X = Take Xeq;" ^
neuper@42279
   610
"      X' = Rewrite ruleZY False X;" ^ (*z * denominator*)
neuper@42279
   611
"      X' = (Rewrite_Set norm_Rational False) X';" ^ (*simplify*)
neuper@42279
   612
"      funterm = rhs X'" ^ (*drop X'= for equation solving*)
neuper@42279
   613
"  in X)";
neuper@42279
   614
*}
neuper@42279
   615
ML {*
neuper@42290
   616
val str = 
neuper@42290
   617
"Script InverseZTransform (X_eq::bool) =" ^ (*(1/z) instead of z ^^^ -1*)
neuper@42290
   618
" (let X = Take X_eq;" ^
neuper@42290
   619
"      X' = Rewrite ruleZY False X;" ^ (*z * denominator*)
neuper@42290
   620
"      X' = (Rewrite_Set norm_Rational False) X';" ^ (*simplify*)
jan@42298
   621
"      (X'_z::real) = lhs X';" ^
jan@42298
   622
"      (z::real) = argument_in X'_z;" ^
jan@42298
   623
"      (funterm::real) = rhs X';" ^ (*drop X' z = for equation solving*)
jan@42298
   624
"      (denom::real) = get_denominator funterm;" ^ (*get_denominator*)
jan@42298
   625
"      (equ::bool) = (denom = (0::real));" ^
neuper@42290
   626
"      (L_L::bool list) =                                    " ^
neuper@42290
   627
"            (SubProblem (Test',                            " ^
neuper@42290
   628
"                         [linear,univariate,equation,test]," ^
neuper@42290
   629
"                         [Test,solve_linear])              " ^
neuper@42290
   630
"                        [BOOL equ, REAL z])              " ^
neuper@42290
   631
"  in X)"
neuper@42290
   632
;
neuper@42290
   633
neuper@42279
   634
parse thy str;
neuper@42279
   635
val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@42279
   636
atomty sc;
neuper@42279
   637
neuper@42279
   638
*}
jan@42300
   639
jan@42300
   640
text {*
jan@42300
   641
This ruleset contains all functions that are in the script; 
jan@42300
   642
The evaluation of the functions is done by rewriting using this ruleset.
jan@42300
   643
*}
jan@42300
   644
neuper@42279
   645
ML {*
neuper@42290
   646
val srls = Rls {id="srls_InverseZTransform", 
neuper@42290
   647
		  preconds = [], rew_ord = ("termlessI",termlessI), 
neuper@42290
   648
		  erls = append_rls "erls_in_srls_InverseZTransform" e_rls
neuper@42290
   649
				    [(*for asm in NTH_CONS ...*) Calc ("Orderings.ord_class.less",eval_equ "#less_"),
neuper@42290
   650
				     (*2nd NTH_CONS pushes n+-1 into asms*) Calc("Groups.plus_class.plus", eval_binop "#add_")
neuper@42290
   651
				    ], 
neuper@42290
   652
  srls = Erls, calc = [],
neuper@42290
   653
		  rules =
neuper@42290
   654
    [Thm ("NTH_CONS",num_str @{thm NTH_CONS}),
neuper@42290
   655
			     Calc("Groups.plus_class.plus", eval_binop "#add_"),
neuper@42290
   656
			     Thm ("NTH_NIL",num_str @{thm NTH_NIL}),
neuper@42290
   657
			     Calc("Tools.lhs", eval_lhs"eval_lhs_"), (*<=== ONLY USED*)
neuper@42290
   658
			     Calc("Tools.rhs", eval_rhs"eval_rhs_"), (*<=== ONLY USED*)
jan@42300
   659
			     Calc("Atools.argument'_in", eval_argument_in "Atools.argument'_in"),
neuper@42301
   660
     Calc("Rational.get_denominator",
neuper@42301
   661
       eval_get_denominator "Rational.get_denominator")
neuper@42290
   662
			    ],
neuper@42290
   663
		  scr = EmptyScr};
neuper@42279
   664
*}
neuper@42279
   665
neuper@42279
   666
neuper@42279
   667
subsection {*Store Final Version of Program for Execution*}
neuper@42279
   668
ML {*
neuper@42279
   669
store_met
neuper@42279
   670
 (prep_met thy "met_SP_Ztrans_inv" [] e_metID
neuper@42279
   671
 (["SignalProcessing", "Z_Transform", "inverse"], 
neuper@42279
   672
  [("#Given" ,["filterExpression X_eq"]),
neuper@42279
   673
   ("#Find"  ,["stepResponse n_eq"])
neuper@42279
   674
  ],
neuper@42290
   675
   {rew_ord'="tless_true", rls'= e_rls, calc = [], srls = srls, 
neuper@42290
   676
    prls = e_rls,
neuper@42279
   677
    crls = e_rls, nrls = e_rls},
neuper@42289
   678
"Script InverseZTransform (X_eq::bool) =" ^ (*(1/z) instead of z ^^^ -1*)
neuper@42289
   679
" (let X = Take X_eq;" ^
neuper@42279
   680
"      X' = Rewrite ruleZY False X;" ^ (*z * denominator*)
neuper@42279
   681
"      X' = (Rewrite_Set norm_Rational False) X';" ^ (*simplify*)
jan@42298
   682
"      (X'_z::real) = lhs X';" ^ (**)
neuper@42303
   683
"      (zzz::real) = argument_in X'_z;" ^ (**)
jan@42298
   684
"      (funterm::real) = rhs X';" ^ (*drop X' z = for equation solving*)
jan@42298
   685
"      (denom::real) = get_denominator funterm;" ^ (*get_denominator*)
jan@42337
   686
"      (numer::real) = get_numerator funterm;" ^
jan@42298
   687
"      (equ::bool) = (denom = (0::real));" ^
neuper@42303
   688
neuper@42303
   689
"      (L_L::bool list) = (SubProblem (PolyEq'," ^
neuper@42315
   690
"          [abcFormula,degree_2,polynomial,univariate,equation],[no_met])" ^
neuper@42303
   691
"        [BOOL equ, REAL zzz])              " ^
jan@42337
   692
"  in X);" ^
jan@42337
   693
jan@42337
   694
"   facs = factors_from_solution L_L;" ^
jan@42337
   695
"   (eq::real) = Take (funterm = (num / facs));" ^
jan@42337
   696
"   (eq::real) = (Try (Rewrite_Set ansatz False)) eq " ^
jan@42337
   697
neuper@42279
   698
 ));
neuper@42279
   699
*}
neuper@42279
   700
neuper@42281
   701
subsection {*Check the Program*}
neuper@42279
   702
neuper@42281
   703
subsubsection {*Check the formalization*}
neuper@42279
   704
ML {*
neuper@42279
   705
val fmz = ["filterExpression (X  = 3 / (z - 1/4 + -1/8 * (1/(z::real))))", 
neuper@42279
   706
  "stepResponse (x[n::real]::bool)"];
neuper@42279
   707
val (dI,pI,mI) = ("Isac", ["inverse", "Z_Transform", "SignalProcessing"], 
neuper@42279
   708
  ["SignalProcessing","Z_Transform","inverse"]);
neuper@42281
   709
neuper@42281
   710
val ([(1, [1], "#Given", Const ("Inverse_Z_Transform.filterExpression", _),
neuper@42281
   711
            [Const ("HOL.eq", _) $ _ $ _]),
neuper@42281
   712
           (2, [1], "#Find", Const ("Inverse_Z_Transform.stepResponse", _),
neuper@42281
   713
            [Free ("x", _) $ _])],
neuper@42281
   714
          _) = prep_ori fmz thy ((#ppc o get_pbt) pI);
neuper@42281
   715
*}
neuper@42290
   716
ML {*
neuper@42290
   717
val Script sc = (#scr o get_met) ["SignalProcessing","Z_Transform","inverse"];
neuper@42290
   718
atomty sc;
neuper@42290
   719
*}
neuper@42281
   720
neuper@42281
   721
subsubsection {*Stepwise check the program*}
neuper@42281
   722
ML {*
neuper@42302
   723
trace_rewrite := false;
neuper@42306
   724
trace_script := false; print_depth 9;
neuper@42281
   725
val fmz = ["filterExpression (X z = 3 / (z - 1/4 + -1/8 * (1/(z::real))))", 
neuper@42281
   726
  "stepResponse (x[n::real]::bool)"];
neuper@42281
   727
val (dI,pI,mI) = ("Isac", ["inverse", "Z_Transform", "SignalProcessing"], 
neuper@42281
   728
  ["SignalProcessing","Z_Transform","inverse"]);
neuper@42310
   729
val (p,_,f,nxt,_,pt)  = CalcTreeTEST [(fmz, (dI,pI,mI))];
neuper@42310
   730
*}
neuper@42310
   731
ML {*
neuper@42303
   732
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Add_Given";
neuper@42303
   733
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Add_Find";
neuper@42303
   734
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Specify_Theory";
neuper@42303
   735
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Specify_Problem";
neuper@42303
   736
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "Specify_Method";
jan@42296
   737
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Apply_Method";
jan@42297
   738
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))"; (*TODO naming!*)
jan@42296
   739
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@42315
   740
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = SubProblem";
jan@42300
   741
*}
neuper@42305
   742
text {* Instead of nxt = Subproblem above we had Empty_Tac; the search for the reason 
neuper@42305
   743
  considered the following points:
neuper@42303
   744
  # what shows show_pt pt; ...
neuper@42303
   745
    (([2], Res), ?X' z = 24 / (-1 + -2 * z + 8 * z ^^^ 2))] ..calculation ok,
neuper@42303
   746
    but no "next" step found: should be "nxt = Subproblem" ?!?
neuper@42303
   747
  # what shows trace_script := true; we read bottom up ...
neuper@42303
   748
    @@@ next   leaf 'SubProbfrom
neuper@42303
   749
     (PolyEq', [abcFormula, degree_2, polynomial, univariate, equation],
neuper@42303
   750
      no_meth)
neuper@42303
   751
     [BOOL equ, REAL z]' ---> STac 'SubProblem
neuper@42303
   752
     (PolyEq', [abcFormula, degree_2, polynomial, univariate, equation],
neuper@42303
   753
      no_meth)
neuper@42303
   754
     [BOOL (-1 + -2 * z + 8 * z ^^^ 2 = 0), REAL z]'
neuper@42305
   755
    ... and see the SubProblem with correct arguments from searching next step
neuper@42305
   756
    (program text !!!--->!!! STac (script tactic) with arguments evaluated.)
neuper@42310
   757
  # do we have the right Script ...difference in the argumentsdifference in the arguments
neuper@42303
   758
    val Script s = (#scr o get_met) ["SignalProcessing","Z_Transform","inverse"];
neuper@42303
   759
    writeln (term2str s);
neuper@42310
   760
    ... shows the right script.difference in the arguments
neuper@42305
   761
  # test --- why helpless here ? --- shows: replace no_meth by [no_meth] in Script
neuper@42301
   762
*}
neuper@42315
   763
neuper@42301
   764
ML {*
neuper@42315
   765
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Model_Problem";
neuper@42306
   766
*}
neuper@42306
   767
text {* Instead of nxt = Model_Problem above we had Empty_Tac; the search for the reason 
neuper@42310
   768
  considered the following points:difference in the arguments
neuper@42306
   769
  # comparison with subsection { *solve equation* }: there solving this equation works,
neuper@42315
   770
    so there must be some difference in the arguments of the Subproblem:
neuper@42315
   771
    RIGHT: we had [no_meth] instead of [no_met] ;-))
neuper@42305
   772
*}
neuper@42305
   773
ML {*
neuper@42315
   774
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Add_Given equality (-1 + -2 * z + 8 * z ^^^ 2 = 0)";
neuper@42315
   775
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Add_Given solveFor z";
neuper@42315
   776
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Add_Find solutions z_i";
neuper@42315
   777
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Specify_Theory Isac";
neuper@42301
   778
*}
neuper@42315
   779
text {* We had "nxt = Empty_Tac instead Specify_Theory; 
neuper@42315
   780
  the search for the reason considered the following points:
neuper@42302
   781
  # was there an error message ? NO --ok
neuper@42302
   782
  # has "nxt = Add_Find" been inserted in pt: get_obj g_pbl pt (fst p); YES --ok
neuper@42302
   783
  # what is the returned "formula": print_depth 999; f; print_depth 999; --
neuper@42302
   784
    {Find = [Correct "solutions z_i"], With = [], 
neuper@42302
   785
     Given = [Correct "equality (-1 + -2 * z + 8 * z ^^^ 2 = 0)", Correct "solveFor z"],
neuper@42302
   786
     Where = [False "matches (z = 0) (-1 + -2 * z + 8 * z ^^^ 2 = 0) |\n
neuper@42302
   787
                     matches (?b * z = 0) (-1 + -2 * z + 8 * z ^^^ 2 = 0) |\n
neuper@42302
   788
                     matches (?a + z = 0) (-1 + -2 * z + 8 * z ^^^ 2 = 0) |\n
neuper@42302
   789
                     matches (?a + ?b * z = 0) (-1 + -2 * z + 8 * z ^^^ 2 = 0)"],
neuper@42302
   790
     Relate = []}
neuper@42302
   791
     -- the only False is the reason: the Where (the precondition) is False for good reasons:
neuper@42302
   792
     the precondition seems to check for linear equations, not for the one we want to solve!
neuper@42302
   793
  Removed this error by correcting the Script
neuper@42302
   794
  from SubProblem (PolyEq', [linear,univariate,equation,test], [Test,solve_linear]
neuper@42302
   795
  to   SubProblem (PolyEq', [abcFormula,degree_2,polynomial,univariate,equation],
neuper@42303
   796
                   [PolyEq,solve_d2_polyeq_abc_equation]
neuper@42302
   797
  You find the appropriate type of equation at
neuper@42302
   798
    http://www.ist.tugraz.at/projects/isac/www/kbase/pbl/index_pbl.html
neuper@42302
   799
  and the respective method in Knowledge/PolyEq.thy at the respective store_pbt.
neuper@42302
   800
  Or you leave the selection of the appropriate type to isac as done in the final Script ;-))
neuper@42302
   801
*}
neuper@42302
   802
ML {*
neuper@42315
   803
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Specify_Problem [abcFormula,...";
neuper@42315
   804
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Specify_Method [PolyEq,solve_d2_polyeq_abc_equation";
neuper@42315
   805
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Apply_Method [PolyEq,solve_d2_polyeq_abc_equation";
neuper@42315
   806
val (p,_,f,nxt,_,pt) = me nxt p [] pt; "nxt = Rewrite_Set_Inst ([(bdv, z)], d2_polyeq_abcFormula_simplify";
neuper@42289
   807
show_pt pt;
neuper@42279
   808
*}
neuper@42279
   809
ML {*
neuper@42335
   810
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42279
   811
*}
neuper@42279
   812
ML {*
neuper@42335
   813
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42335
   814
*}
neuper@42335
   815
ML {*
neuper@42335
   816
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42335
   817
*}
neuper@42335
   818
ML {*
neuper@42335
   819
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42335
   820
*}
neuper@42335
   821
ML {*
neuper@42335
   822
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42335
   823
*}
neuper@42335
   824
ML {*
neuper@42335
   825
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42335
   826
show_pt pt;
neuper@42279
   827
*}
neuper@42279
   828
ML {*
neuper@42279
   829
*}
neuper@42279
   830
neuper@42279
   831
section {*Write Tests for Crucial Details*}
neuper@42279
   832
text{*===================================*}
neuper@42279
   833
ML {*
neuper@42279
   834
*}
neuper@42279
   835
neuper@42279
   836
section {*Integrate Program into Knowledge*}
neuper@42279
   837
ML {*
neuper@42290
   838
@{theory Isac}
neuper@42279
   839
*}
neuper@42279
   840
neuper@42279
   841
end
neuper@42279
   842