doc-src/isac/jrocnik/Test_Z_Transform.thy
author Jan Rocnik <jan.rocnik@student.tugraz.at>
Tue, 06 Sep 2011 15:57:25 +0200
branchdecompose-isar
changeset 42245 3d1f27a0f8a4
parent 42244 e8be2cec4ec5
child 42247 56eebac3d65d
permissions -rwxr-xr-x
tuned z-transform-test, add fourier, tuned bakkarb.
neuper@42160
     1
theory Test_Z_Transform imports Isac begin
neuper@42160
     2
neuper@42160
     3
section {*trials towards Z transform *}
neuper@42160
     4
subsection {*terms*}
neuper@42160
     5
ML {*
neuper@42160
     6
@{term "1 < || z ||"};
neuper@42160
     7
@{term "z / (z - 1)"};
neuper@42160
     8
@{term "-u -n - 1"};
neuper@42160
     9
@{term "-u [-n - 1]"}; (*[ ] denotes lists !!!*)
neuper@42160
    10
@{term "z /(z - 1) = -u [-n - 1]"};
neuper@42160
    11
@{term "1 < || z || ==> z / (z - 1) = -u [-n - 1]"};
neuper@42160
    12
term2str @{term "1 < || z || ==> z / (z - 1) = -u [-n - 1]"};
neuper@42160
    13
*}
neuper@42160
    14
ML {*
neuper@42241
    15
(*alpha -->  "</alpha>" *)
jan@42183
    16
neuper@42160
    17
@{term "\<alpha> "};
neuper@42160
    18
@{term "\<delta> "};
neuper@42160
    19
@{term "\<phi> "};
neuper@42160
    20
@{term "\<rho> "};
neuper@42160
    21
term2str @{term "\<rho> "};
neuper@42160
    22
*}
neuper@42160
    23
neuper@42160
    24
subsection {*rules*}
neuper@42160
    25
(*axiomatization "z / (z - 1) = -u [-n - 1]" Illegal variable name: "z / (z - 1) = -u [-n - 1]" *)
neuper@42160
    26
(*definition     "z / (z - 1) = -u [-n - 1]" Bad head of lhs: existing constant "op /"*)
jan@42183
    27
axiomatization where 
jan@42183
    28
  rule1: "1 = \<delta>[n]" and
jan@42183
    29
  rule2: "|| z || > 1 ==> z / (z - 1) = u [n]" and
jan@42183
    30
  rule3: "|| z || < 1 ==> z / (z - 1) = -u [-n - 1]" and 
jan@42183
    31
  rule4: "|| z || > || \<alpha> || ==> z / (z - \<alpha>) = \<alpha>^n * u [n]" and
jan@42183
    32
  rule5: "|| z || < || \<alpha> || ==> z / (z - \<alpha>) = -(\<alpha>^n) * u [-n - 1]" and
jan@42183
    33
  rule6: "|| z || > 1 ==> z/(z - 1)^2 = n * u [n]"
neuper@42160
    34
ML {*
neuper@42160
    35
@{thm rule1};
jan@42183
    36
@{thm rule2};
neuper@42160
    37
@{thm rule3};
neuper@42160
    38
@{thm rule4};
neuper@42160
    39
*}
neuper@42160
    40
neuper@42160
    41
subsection {*apply rules*}
neuper@42160
    42
ML {*
neuper@42185
    43
val inverse_Z = append_rls "inverse_Z" e_rls
neuper@42185
    44
  [ Thm  ("rule3",num_str @{thm rule3}),
neuper@42186
    45
    Thm  ("rule4",num_str @{thm rule4}),
neuper@42185
    46
    Thm  ("rule1",num_str @{thm rule1})   
jan@42183
    47
  ];
neuper@42185
    48
neuper@42185
    49
val t = str2term "z / (z - 1) + z / (z - \<alpha>) + 1";
neuper@42215
    50
val SOME (t', asm) = rewrite_set_ thy true inverse_Z t;
neuper@42185
    51
term2str t' = "z / (z - ?\<delta> [?n]) + z / (z - \<alpha>) + ?\<delta> [?n]"; (*attention rule1 !!!*)
neuper@42185
    52
*}
neuper@42185
    53
ML {*
neuper@42160
    54
val (thy, ro, er) = (@{theory}, tless_true, eval_rls);
neuper@42160
    55
*}
neuper@42160
    56
ML {*
neuper@42215
    57
val SOME (t, asm1) = rewrite_ thy ro er true (num_str @{thm rule3}) t;
neuper@42187
    58
term2str t = "- ?u [- ?n - 1] + z / (z - \<alpha>) + 1"; (*- real *)
neuper@42187
    59
term2str t;
neuper@42160
    60
*}
neuper@42160
    61
ML {*
neuper@42215
    62
val SOME (t, asm2) = rewrite_ thy ro er true (num_str @{thm rule4}) t;
neuper@42187
    63
term2str t = "- ?u [- ?n - 1] + \<alpha> ^ ?n * ?u [?n] + 1"; (*- real *)
neuper@42187
    64
term2str t;
neuper@42185
    65
*}
neuper@42185
    66
ML {*
neuper@42215
    67
val SOME (t, asm3) = rewrite_ thy ro er true (num_str @{thm rule1}) t;
neuper@42187
    68
term2str t = "- ?u [- ?n - 1] + \<alpha> ^ ?n * ?u [?n] + ?\<delta> [?n]"; (*- real *)
neuper@42187
    69
term2str t;
neuper@42160
    70
*}
neuper@42160
    71
ML {*
neuper@42215
    72
terms2str (asm1 @ asm2 @ asm3);
neuper@42215
    73
*}
neuper@42241
    74
neuper@42243
    75
subsection {*prepare expression*}
neuper@42243
    76
ML {*
neuper@42243
    77
val ctxt = ProofContext.init_global @{theory Isac};
neuper@42243
    78
val ctxt = declare_constraints' [@{term "z::real"}] ctxt;
neuper@42243
    79
val SOME expression = parseNEW ctxt "3 / (-1/8 + -1/4*z + z^2)";
neuper@42243
    80
term2str expression;
neuper@42243
    81
*}
neuper@42243
    82
neuper@42241
    83
subsection {*solve equation*}
neuper@42215
    84
ML {*(*from test/Tools/isac/Minisubpbl/100-init-rootpbl.sml*)
neuper@42215
    85
"----------- Minisubplb/100-init-rootpbl.sml ---------------------";
neuper@42241
    86
val denominator = parseNEW ctxt "z^2 - 1/4*z - 1/8 = 0";
neuper@42215
    87
val fmz = ["equality (z^2 - 1/4*z - 1/8 = (0::real))", "solveFor z","solutions L"];
neuper@42215
    88
val (dI',pI',mI') =("Isac", ["univariate","equation"], ["no_met"]);
neuper@42160
    89
*}
neuper@42160
    90
ML {*
neuper@42215
    91
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42215
    92
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42215
    93
(*[
neuper@42215
    94
(([], Frm), solve (z ^ 2 - 1 / 4 * z - 1 / 8 = 0, z)),
neuper@42215
    95
(([1], Frm), z ^ 2 - 1 / 4 * z - 1 / 8 = 0),              bad rewrite order
neuper@42215
    96
(([1], Res), -1 / 8 + z ^ 2 + -1 / 4 * z = 0),            bad pattern
neuper@42215
    97
(([2], Pbl), solve (-1 / 8 + z ^ 2 + -1 / 4 * z = 0, z)),
neuper@42215
    98
(([2,1], Pbl), solve (-1 / 8 + z ^ 2 + -1 / 4 * z = 0, z)),
neuper@42215
    99
(([2,1,1], Pbl), solve (-1 / 8 + z ^ 2 + -1 / 4 * z = 0, z)),
neuper@42215
   100
(([2,1,1,1], Frm), -1 / 8 + z ^ 2 + -1 / 4 * z = 0)] 
neuper@42215
   101
*)
neuper@42160
   102
*}
neuper@42160
   103
ML {*
neuper@42241
   104
val denominator = parseNEW ctxt "-1/8 + -1/4*z + z^2 = 0";
jan@42242
   105
(*ergebnis: [gleichung, was tun?, lösung]*)
neuper@42241
   106
val fmz = ["equality (-1/8 + -1/4*z + z^2 = (0::real))", "solveFor z","solutions L"];
jan@42242
   107
(*liste der theoreme die zum lösen benötigt werden, aus isac, keine spezielle methode (no met)*)
neuper@42241
   108
val (dI',pI',mI') =
neuper@42241
   109
  ("Isac", ["pqFormula","degree_2","polynomial","univariate","equation"], ["no_met"]);
jan@42242
   110
(*schritte abarbeiten*)
neuper@42241
   111
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42241
   112
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42241
   113
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42241
   114
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42241
   115
val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*val nxt = ("Empty_Tac", ...): tac'_*)
neuper@42241
   116
show_pt pt;
neuper@42241
   117
*}
neuper@42241
   118
neuper@42241
   119
subsection {*partial fraction decomposition*}
neuper@42241
   120
subsubsection {*solution of the equation*}
neuper@42241
   121
ML {*
neuper@42241
   122
val SOME solutions = parseNEW ctxt "[z=1/2, z=-1/4]";
neuper@42241
   123
term2str solutions;
neuper@42243
   124
atomty solutions;
neuper@42241
   125
*}
neuper@42241
   126
neuper@42241
   127
subsubsection {*get solutions out of list*}
neuper@42241
   128
text {*in isac's CTP-based programming language: let s_1 = NTH 1 solutions; s_2 = NTH 2...*}
neuper@42241
   129
ML {*
neuper@42241
   130
val Const ("List.list.Cons", _) $ s_1 $ (Const ("List.list.Cons", _) $
neuper@42241
   131
      s_2 $ Const ("List.list.Nil", _)) = solutions;
neuper@42241
   132
term2str s_1;
neuper@42241
   133
term2str s_2;
neuper@42215
   134
*}
jan@42245
   135
jan@42245
   136
ML {* (*Solutions as Denominator --> Denominator1 = z - Zeropoint1, Denominator2 = z-Zeropoint2,...*)
neuper@42241
   137
val xx = HOLogic.dest_eq s_1;
neuper@42241
   138
val s_1' = HOLogic.mk_binop "Groups.minus_class.minus" xx;
neuper@42241
   139
val xx = HOLogic.dest_eq s_2;
neuper@42241
   140
val s_2' = HOLogic.mk_binop "Groups.minus_class.minus" xx;
neuper@42241
   141
term2str s_1';
neuper@42241
   142
term2str s_2';
neuper@42241
   143
*}
neuper@42241
   144
neuper@42241
   145
subsubsection {*build expression*}
neuper@42241
   146
text {*in isac's CTP-based programming language: let s_1 = Take numerator / (s_1 * s_2)*}
neuper@42241
   147
ML {*
jan@42245
   148
(*The Main Denominator is the multiplikation of the partial fraction denominators*)
neuper@42241
   149
val denominator' = HOLogic.mk_binop "Groups.times_class.times" (s_1', s_2') ;
jan@42245
   150
val SOME numerator = parseNEW ctxt "3::real";
jan@42245
   151
jan@42245
   152
val expression' = HOLogic.mk_binop "Rings.inverse_class.divide" (numerator, denominator');
neuper@42241
   153
term2str expression';
neuper@42243
   154
*}
neuper@42243
   155
jan@42245
   156
subsubsection {*Ansatz - create partial fractions out of our expression*}
jan@42245
   157
neuper@42243
   158
axiomatization where
neuper@42243
   159
  ansatz2: "n / (a*b) = A/a + B/(b::real)" and
neuper@42243
   160
  multiply_eq2: "(n / (a*b) = A/a + B/b) = (a*b*(n  / (a*b)) = a*b*(A/a + B/b))"
jan@42245
   161
neuper@42243
   162
ML {*
jan@42245
   163
(*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@42243
   164
val SOME (t1,_) = rewrite_ @{theory Isac} e_rew_ord e_rls false @{thm ansatz2} expression';
neuper@42243
   165
term2str t1;
neuper@42243
   166
atomty t1;
neuper@42243
   167
val eq1 = HOLogic.mk_eq (expression', t1);
neuper@42243
   168
term2str eq1;
neuper@42215
   169
*}
neuper@42215
   170
ML {*
jan@42245
   171
(*eliminate the demoninators by multiplying the left and the right side with the main denominator*)
neuper@42243
   172
val SOME (eq2,_) = rewrite_ @{theory Isac} e_rew_ord e_rls false @{thm multiply_eq2} eq1;
neuper@42243
   173
term2str eq2;
neuper@42241
   174
*}
neuper@42241
   175
ML {*
jan@42245
   176
(*simplificatoin*)
neuper@42243
   177
val SOME (eq3,_) = rewrite_set_ @{theory Isac} false norm_Rational eq2;
neuper@42243
   178
term2str eq3; (*?A ?B not simplified*)
neuper@42243
   179
*}
neuper@42243
   180
ML {*
neuper@42243
   181
val SOME fract1 =
neuper@42243
   182
  parseNEW ctxt "(z - 1 / 2) * (z - -1 / 4) * (A / (z - 1 / 2) + B / (z - -1 / 4))"; (*A B !*)
neuper@42243
   183
val SOME (fract2,_) = rewrite_set_ @{theory Isac} false norm_Rational fract1;
neuper@42243
   184
term2str fract2 = "(A + -2 * B + 4 * A * z + 4 * B * z) / 4";
neuper@42243
   185
(*term2str fract2 = "A * (1 / 4 + z) + B * (-1 / 2 + z)" would be more traditional*)
neuper@42243
   186
*}
neuper@42243
   187
ML {*
neuper@42243
   188
val (numerator, denominator) = HOLogic.dest_eq eq3;
neuper@42243
   189
val eq3' = HOLogic.mk_eq (numerator, fract1); (*A B !*)
neuper@42243
   190
term2str eq3';
neuper@42243
   191
*}
neuper@42243
   192
ML {* (*MANDATORY: otherwise 3 = 0*)
neuper@42243
   193
val SOME (eq3'' ,_) = rewrite_set_ @{theory Isac} false norm_Rational eq3';
neuper@42243
   194
term2str eq3'';
neuper@42243
   195
*}
jan@42244
   196
jan@42244
   197
subsubsection {*get first koeffizient*}
jan@42244
   198
neuper@42243
   199
ML {*
jan@42245
   200
(*substitude z with the first zeropoint to get A*)
neuper@42243
   201
val SOME (eq4_1,_) = rewrite_terms_ @{theory Isac} e_rew_ord e_rls [s_1] eq3'';
neuper@42243
   202
term2str eq4_1;
neuper@42243
   203
*}
neuper@42243
   204
ML {*
neuper@42243
   205
val SOME (eq4_2,_) = rewrite_set_ @{theory Isac} false norm_Rational eq4_1;
neuper@42243
   206
term2str eq4_2;
neuper@42243
   207
*}
neuper@42243
   208
ML {*
neuper@42243
   209
val fmz = ["equality (3 = 3 * A / (4::real))", "solveFor A","solutions L"];
neuper@42243
   210
val (dI',pI',mI') =("Isac", ["univariate","equation"], ["no_met"]);
neuper@42241
   211
neuper@42241
   212
*}
neuper@42241
   213
ML {*
jan@42245
   214
(*solve the simple linear equilation for A*)
neuper@42243
   215
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42243
   216
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   217
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   218
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   219
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   220
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   221
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   222
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   223
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   224
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   225
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   226
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   227
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   228
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   229
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   230
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   231
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   232
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   233
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   234
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   235
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   236
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   237
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   238
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   239
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   240
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42243
   241
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42160
   242
*}
neuper@42160
   243
ML {*
neuper@42243
   244
val (p,_,f,nxt,_,pt) = me nxt p [] pt; 
jan@42244
   245
f2str f;
neuper@42243
   246
*}
jan@42244
   247
jan@42244
   248
subsubsection {*get second koeffizient*}
jan@42244
   249
neuper@42243
   250
ML {*
jan@42245
   251
(*substitude z with the second zeropoint to get B*)
jan@42244
   252
val SOME (eq4b_1,_) = rewrite_terms_ @{theory Isac} e_rew_ord e_rls [s_2] eq3'';
jan@42244
   253
term2str eq4_1;
jan@42244
   254
*}
jan@42244
   255
jan@42244
   256
ML {*
jan@42244
   257
val SOME (eq4b_2,_) = rewrite_set_ @{theory Isac} false norm_Rational eq4b_1;
jan@42244
   258
term2str eq4b_2;
jan@42244
   259
*}
jan@42244
   260
jan@42244
   261
ML {*
jan@42245
   262
(*solve the simple linear equilation for B*)
jan@42245
   263
jan@42244
   264
val fmz = ["equality (3 = -3 * B / (4::real))", "solveFor B","solutions L"];
jan@42244
   265
val (dI',pI',mI') =("Isac", ["univariate","equation"], ["no_met"]);
jan@42244
   266
jan@42244
   267
val (p,_,fb,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
jan@42244
   268
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   269
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   270
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   271
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   272
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   273
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   274
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   275
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   276
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   277
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   278
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   279
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   280
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   281
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   282
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   283
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   284
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   285
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   286
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   287
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   288
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   289
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   290
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   291
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   292
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   293
val (p,_,fb,nxt,_,pt) = me nxt p [] pt;
jan@42244
   294
val (p,_,fb,nxt,_,pt) = me nxt p [] pt; 
jan@42244
   295
f2str fb;
jan@42244
   296
*}
jan@42244
   297
jan@42244
   298
ML {* (*check koeffizients*)
neuper@42243
   299
if f2str f = "[A = 4]" then () else error "part.fract. eq4_1";
jan@42244
   300
if f2str fb = "[B = -4]" then () else error "part.fract. eq4_1";
neuper@42160
   301
*}
neuper@42160
   302
neuper@42160
   303
end
neuper@42160
   304