src/Tools/isac/Knowledge/PolyMinus.thy
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 28 Sep 2010 10:10:26 +0200
branchisac-update-Isa09-2
changeset 38034 928cebc9c4aa
parent 38014 3e11e3c2dc42
child 38083 a1d13f3de312
permissions -rw-r--r--
updated "op *" --> Groups.times_class.times in src and test

find . -type f -exec sed -i s/"\"op \*\""/"\"Groups.times_class.times\""/g {} \;
neuper@37906
     1
(* attempts to perserve binary minus as wanted by Austrian teachers
neuper@37906
     2
   WN071207
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
*)
neuper@37906
     5
neuper@37950
     6
theory PolyMinus imports (*Poly// due to "is_ratpolyexp" in...*) Rational begin
neuper@37906
     7
neuper@37906
     8
consts
neuper@37906
     9
neuper@37906
    10
  (*predicates for conditions in rewriting*)
neuper@37906
    11
  kleiner     :: "['a, 'a] => bool" 	("_ kleiner _") 
neuper@37906
    12
  ist'_monom  :: "'a => bool"		("_ ist'_monom")
neuper@37906
    13
neuper@37906
    14
  (*the CAS-command*)
neuper@37906
    15
  Probe       :: "[bool, bool list] => bool"  
neuper@37906
    16
	(*"Probe (3*a+2*b+a = 4*a+2*b) [a=1,b=2]"*)
neuper@37906
    17
neuper@37906
    18
  (*descriptions for the pbl and met*)
neuper@37950
    19
  Pruefe      :: "bool => una"
neuper@37950
    20
  mitWert     :: "bool list => tobooll"
neuper@37950
    21
  Geprueft    :: "bool => una"
neuper@37906
    22
neuper@37906
    23
  (*Script-name*)
neuper@37950
    24
  ProbeScript :: "[bool, bool list,       bool] 
neuper@37950
    25
				      => bool"
neuper@37906
    26
                  ("((Script ProbeScript (_ _ =))// (_))" 9)
neuper@37906
    27
neuper@37980
    28
axioms
neuper@37906
    29
neuper@37980
    30
  null_minus:            "0 - a = -a"
neuper@37980
    31
  vor_minus_mal:         "- a * b = (-a) * b"
neuper@37906
    32
neuper@37906
    33
  (*commute with invariant (a.b).c -association*)
neuper@37980
    34
  tausche_plus:		"[| b ist_monom; a kleiner b  |] ==> 
neuper@37950
    35
			 (b + a) = (a + b)"
neuper@37980
    36
  tausche_minus:		"[| b ist_monom; a kleiner b  |] ==> 
neuper@37950
    37
			 (b - a) = (-a + b)"
neuper@37980
    38
  tausche_vor_plus:	"[| b ist_monom; a kleiner b  |] ==> 
neuper@37950
    39
			 (- b + a) = (a - b)"
neuper@37980
    40
  tausche_vor_minus:	"[| b ist_monom; a kleiner b  |] ==> 
neuper@37950
    41
			 (- b - a) = (-a - b)"
neuper@37980
    42
  tausche_plus_plus:	"b kleiner c ==> (a + c + b) = (a + b + c)"
neuper@37980
    43
  tausche_plus_minus:	"b kleiner c ==> (a + c - b) = (a - b + c)"
neuper@37980
    44
  tausche_minus_plus:	"b kleiner c ==> (a - c + b) = (a + b - c)"
neuper@37980
    45
  tausche_minus_minus:	"b kleiner c ==> (a - c - b) = (a - b - c)"
neuper@37906
    46
neuper@37906
    47
  (*commute with invariant (a.b).c -association*)
neuper@37980
    48
  tausche_mal:		"[| b is_atom; a kleiner b  |] ==> 
neuper@37950
    49
			 (b * a) = (a * b)"
neuper@37980
    50
  tausche_vor_mal:	"[| b is_atom; a kleiner b  |] ==> 
neuper@37950
    51
			 (-b * a) = (-a * b)"
neuper@37980
    52
  tausche_mal_mal:	"[| c is_atom; b kleiner c  |] ==> 
neuper@37950
    53
			 (x * c * b) = (x * b * c)"
neuper@37980
    54
  x_quadrat:             "(x * a) * a = x * a ^^^ 2"
neuper@37906
    55
neuper@37906
    56
neuper@37980
    57
  subtrahiere:               "[| l is_const; m is_const |] ==>  
neuper@37950
    58
			     m * v - l * v = (m - l) * v"
neuper@37980
    59
  subtrahiere_von_1:         "[| l is_const |] ==>  
neuper@37950
    60
			     v - l * v = (1 - l) * v"
neuper@37980
    61
  subtrahiere_1:             "[| l is_const; m is_const |] ==>  
neuper@37950
    62
			     m * v - v = (m - 1) * v"
neuper@37906
    63
neuper@37980
    64
  subtrahiere_x_plus_minus:  "[| l is_const; m is_const |] ==>  
neuper@37950
    65
			     (x + m * v) - l * v = x + (m - l) * v"
neuper@37980
    66
  subtrahiere_x_plus1_minus: "[| l is_const |] ==>  
neuper@37950
    67
			     (x + v) - l * v = x + (1 - l) * v"
neuper@37980
    68
  subtrahiere_x_plus_minus1: "[| m is_const |] ==>  
neuper@37950
    69
			     (x + m * v) - v = x + (m - 1) * v"
neuper@37906
    70
neuper@37980
    71
  subtrahiere_x_minus_plus:  "[| l is_const; m is_const |] ==>  
neuper@37950
    72
			     (x - m * v) + l * v = x + (-m + l) * v"
neuper@37980
    73
  subtrahiere_x_minus1_plus: "[| l is_const |] ==>  
neuper@37950
    74
			     (x - v) + l * v = x + (-1 + l) * v"
neuper@37980
    75
  subtrahiere_x_minus_plus1: "[| m is_const |] ==>  
neuper@37950
    76
			     (x - m * v) + v = x + (-m + 1) * v"
neuper@37906
    77
neuper@37980
    78
  subtrahiere_x_minus_minus: "[| l is_const; m is_const |] ==>  
neuper@37950
    79
			     (x - m * v) - l * v = x + (-m - l) * v"
neuper@37980
    80
  subtrahiere_x_minus1_minus:"[| l is_const |] ==>  
neuper@37950
    81
			     (x - v) - l * v = x + (-1 - l) * v"
neuper@37980
    82
  subtrahiere_x_minus_minus1:"[| m is_const |] ==>  
neuper@37950
    83
			     (x - m * v) - v = x + (-m - 1) * v"
neuper@37906
    84
neuper@37906
    85
neuper@37980
    86
  addiere_vor_minus:         "[| l is_const; m is_const |] ==>  
neuper@37950
    87
			     - (l * v) +  m * v = (-l + m) * v"
neuper@37980
    88
  addiere_eins_vor_minus:    "[| m is_const |] ==>  
neuper@37950
    89
			     -  v +  m * v = (-1 + m) * v"
neuper@37980
    90
  subtrahiere_vor_minus:     "[| l is_const; m is_const |] ==>  
neuper@37950
    91
			     - (l * v) -  m * v = (-l - m) * v"
neuper@37980
    92
  subtrahiere_eins_vor_minus:"[| m is_const |] ==>  
neuper@37950
    93
			     -  v -  m * v = (-1 - m) * v"
neuper@37906
    94
neuper@37980
    95
  vorzeichen_minus_weg1:      "l kleiner 0 ==> a + l * b = a - -1*l * b"
neuper@37980
    96
  vorzeichen_minus_weg2:      "l kleiner 0 ==> a - l * b = a + -1*l * b"
neuper@37980
    97
  vorzeichen_minus_weg3:      "l kleiner 0 ==> k + a - l * b = k + a + -1*l * b"
neuper@37980
    98
  vorzeichen_minus_weg4:      "l kleiner 0 ==> k - a - l * b = k - a + -1*l * b"
neuper@37906
    99
neuper@37974
   100
  (*klammer_plus_plus = (add_assoc RS sym)*)
neuper@37980
   101
  klammer_plus_minus:          "a + (b - c) = (a + b) - c"
neuper@37980
   102
  klammer_minus_plus:          "a - (b + c) = (a - b) - c"
neuper@37980
   103
  klammer_minus_minus:         "a - (b - c) = (a - b) + c"
neuper@37906
   104
neuper@37980
   105
  klammer_mult_minus:          "a * (b - c) = a * b - a * c"
neuper@37980
   106
  klammer_minus_mult:          "(b - c) * a = b * a - c * a"
neuper@37906
   107
neuper@37950
   108
ML {*
neuper@37972
   109
val thy = @{theory};
neuper@37972
   110
neuper@37950
   111
(** eval functions **)
neuper@37906
   112
neuper@37950
   113
(*. get the identifier from specific monomials; see fun ist_monom .*)
neuper@37950
   114
(*HACK.WN080107*)
neuper@37950
   115
fun increase str = 
neuper@37950
   116
    let val s::ss = explode str
neuper@37950
   117
    in implode ((chr (ord s + 1))::ss) end;
neuper@37950
   118
fun identifier (Free (id,_)) = id                            (* 2,   a   *)
neuper@38034
   119
  | identifier (Const ("Groups.times_class.times", _) $ Free (num, _) $ Free (id, _)) = 
neuper@37950
   120
    id                                                       (* 2*a, a*b *)
neuper@38034
   121
  | identifier (Const ("Groups.times_class.times", _) $                          (* 3*a*b    *)
neuper@38034
   122
		     (Const ("Groups.times_class.times", _) $
neuper@37950
   123
			    Free (num, _) $ Free _) $ Free (id, _)) = 
neuper@37950
   124
    if is_numeral num then id
neuper@37950
   125
    else "|||||||||||||"
neuper@37950
   126
  | identifier (Const ("Atools.pow", _) $ Free (base, _) $ Free (exp, _)) =
neuper@37950
   127
    if is_numeral base then "|||||||||||||"                  (* a^2      *)
neuper@37950
   128
    else (*increase*) base
neuper@38034
   129
  | identifier (Const ("Groups.times_class.times", _) $ Free (num, _) $          (* 3*a^2    *)
neuper@37950
   130
		     (Const ("Atools.pow", _) $
neuper@37950
   131
			    Free (base, _) $ Free (exp, _))) = 
neuper@37950
   132
    if is_numeral num andalso not (is_numeral base) then (*increase*) base
neuper@37950
   133
    else "|||||||||||||"
neuper@37950
   134
  | identifier _ = "|||||||||||||"(*the "largest" string*);
neuper@37950
   135
neuper@37950
   136
(*("kleiner", ("PolyMinus.kleiner", eval_kleiner ""))*)
neuper@37950
   137
(* order "by alphabet" w.r.t. var: num < (var | num*var) > (var*var | ..) *)
neuper@37950
   138
fun eval_kleiner _ _ (p as (Const ("PolyMinus.kleiner",_) $ a $ b)) _  =
neuper@37950
   139
     if is_num b then
neuper@37950
   140
	 if is_num a then (*123 kleiner 32 = True !!!*)
neuper@37950
   141
	     if int_of_Free a < int_of_Free b then 
neuper@37950
   142
		 SOME ((term2str p) ^ " = True",
neuper@37950
   143
		       Trueprop $ (mk_equality (p, HOLogic.true_const)))
neuper@37950
   144
	     else SOME ((term2str p) ^ " = False",
neuper@37950
   145
			Trueprop $ (mk_equality (p, HOLogic.false_const)))
neuper@37950
   146
	 else (* -1 * -2 kleiner 0 *)
neuper@37950
   147
	     SOME ((term2str p) ^ " = False",
neuper@37950
   148
		   Trueprop $ (mk_equality (p, HOLogic.false_const)))
neuper@37950
   149
    else
neuper@37950
   150
	if identifier a < identifier b then 
neuper@37950
   151
	     SOME ((term2str p) ^ " = True",
neuper@37950
   152
		  Trueprop $ (mk_equality (p, HOLogic.true_const)))
neuper@37950
   153
	else SOME ((term2str p) ^ " = False",
neuper@37950
   154
		   Trueprop $ (mk_equality (p, HOLogic.false_const)))
neuper@37950
   155
  | eval_kleiner _ _ _ _ =  NONE;
neuper@37950
   156
neuper@37950
   157
fun ist_monom (Free (id,_)) = true
neuper@38034
   158
  | ist_monom (Const ("Groups.times_class.times", _) $ Free (num, _) $ Free (id, _)) = 
neuper@37950
   159
    if is_numeral num then true else false
neuper@37950
   160
  | ist_monom _ = false;
neuper@37950
   161
(*. this function only accepts the most simple monoms       vvvvvvvvvv .*)
neuper@37950
   162
fun ist_monom (Free (id,_)) = true                          (* 2,   a   *)
neuper@38034
   163
  | ist_monom (Const ("Groups.times_class.times", _) $ Free _ $ Free (id, _)) = (* 2*a, a*b *)
neuper@37950
   164
    if is_numeral id then false else true
neuper@38034
   165
  | ist_monom (Const ("Groups.times_class.times", _) $                          (* 3*a*b    *)
neuper@38034
   166
		     (Const ("Groups.times_class.times", _) $
neuper@37950
   167
			    Free (num, _) $ Free _) $ Free (id, _)) =
neuper@37950
   168
    if is_numeral num andalso not (is_numeral id) then true else false
neuper@37950
   169
  | ist_monom (Const ("Atools.pow", _) $ Free (base, _) $ Free (exp, _)) = 
neuper@37950
   170
    true                                                    (* a^2      *)
neuper@38034
   171
  | ist_monom (Const ("Groups.times_class.times", _) $ Free (num, _) $          (* 3*a^2    *)
neuper@37950
   172
		     (Const ("Atools.pow", _) $
neuper@37950
   173
			    Free (base, _) $ Free (exp, _))) = 
neuper@37950
   174
    if is_numeral num then true else false
neuper@37950
   175
  | ist_monom _ = false;
neuper@37950
   176
neuper@37950
   177
(* is this a univariate monomial ? *)
neuper@37950
   178
(*("ist_monom", ("PolyMinus.ist'_monom", eval_ist_monom ""))*)
neuper@37950
   179
fun eval_ist_monom _ _ (p as (Const ("PolyMinus.ist'_monom",_) $ a)) _  =
neuper@37950
   180
    if ist_monom a  then 
neuper@37950
   181
	SOME ((term2str p) ^ " = True",
neuper@37950
   182
	      Trueprop $ (mk_equality (p, HOLogic.true_const)))
neuper@37950
   183
    else SOME ((term2str p) ^ " = False",
neuper@37950
   184
	       Trueprop $ (mk_equality (p, HOLogic.false_const)))
neuper@37950
   185
  | eval_ist_monom _ _ _ _ =  NONE;
neuper@37950
   186
neuper@37950
   187
neuper@37950
   188
(** rewrite order **)
neuper@37950
   189
neuper@37950
   190
(** rulesets **)
neuper@37950
   191
neuper@37950
   192
val erls_ordne_alphabetisch =
neuper@37950
   193
    append_rls "erls_ordne_alphabetisch" e_rls
neuper@37950
   194
	       [Calc ("PolyMinus.kleiner", eval_kleiner ""),
neuper@37950
   195
		Calc ("PolyMinus.ist'_monom", eval_ist_monom "")
neuper@37950
   196
		];
neuper@37950
   197
neuper@37950
   198
val ordne_alphabetisch = 
neuper@37950
   199
  Rls{id = "ordne_alphabetisch", preconds = [], 
neuper@37950
   200
      rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [],
neuper@37950
   201
      erls = erls_ordne_alphabetisch, 
neuper@37969
   202
      rules = [Thm ("tausche_plus",num_str @{thm tausche_plus}),
neuper@37950
   203
	       (*"b kleiner a ==> (b + a) = (a + b)"*)
neuper@37969
   204
	       Thm ("tausche_minus",num_str @{thm tausche_minus}),
neuper@37950
   205
	       (*"b kleiner a ==> (b - a) = (-a + b)"*)
neuper@37969
   206
	       Thm ("tausche_vor_plus",num_str @{thm tausche_vor_plus}),
neuper@37950
   207
	       (*"[| b ist_monom; a kleiner b  |] ==> (- b + a) = (a - b)"*)
neuper@37969
   208
	       Thm ("tausche_vor_minus",num_str @{thm tausche_vor_minus}),
neuper@37950
   209
	       (*"[| b ist_monom; a kleiner b  |] ==> (- b - a) = (-a - b)"*)
neuper@37969
   210
	       Thm ("tausche_plus_plus",num_str @{thm tausche_plus_plus}),
neuper@37950
   211
	       (*"c kleiner b ==> (a + c + b) = (a + b + c)"*)
neuper@37969
   212
	       Thm ("tausche_plus_minus",num_str @{thm tausche_plus_minus}),
neuper@37950
   213
	       (*"c kleiner b ==> (a + c - b) = (a - b + c)"*)
neuper@37969
   214
	       Thm ("tausche_minus_plus",num_str @{thm tausche_minus_plus}),
neuper@37950
   215
	       (*"c kleiner b ==> (a - c + b) = (a + b - c)"*)
neuper@37980
   216
	       Thm ("tausche_minus_minus",num_str @{thm tausche_minus_minus})
neuper@37950
   217
	       (*"c kleiner b ==> (a - c - b) = (a - b - c)"*)
neuper@37950
   218
	       ], scr = EmptyScr}:rls;
neuper@37950
   219
neuper@37950
   220
val fasse_zusammen = 
neuper@37950
   221
    Rls{id = "fasse_zusammen", preconds = [], 
neuper@37950
   222
	rew_ord = ("dummy_ord", dummy_ord),
neuper@37950
   223
	erls = append_rls "erls_fasse_zusammen" e_rls 
neuper@37950
   224
			  [Calc ("Atools.is'_const",eval_const "#is_const_")], 
neuper@37950
   225
	srls = Erls, calc = [],
neuper@37950
   226
	rules = 
neuper@37969
   227
	[Thm ("real_num_collect",num_str @{thm real_num_collect}), 
neuper@37950
   228
	 (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
neuper@37969
   229
	 Thm ("real_num_collect_assoc_r",num_str @{thm real_num_collect_assoc_r}),
neuper@37950
   230
	 (*"[| l is_const; m..|] ==>  (k + m * n) + l * n = k + (l + m)*n"*)
neuper@37969
   231
	 Thm ("real_one_collect",num_str @{thm real_one_collect}),	
neuper@37950
   232
	 (*"m is_const ==> n + m * n = (1 + m) * n"*)
neuper@37969
   233
	 Thm ("real_one_collect_assoc_r",num_str @{thm real_one_collect_assoc_r}), 
neuper@37950
   234
	 (*"m is_const ==> (k + n) + m * n = k + (m + 1) * n"*)
neuper@37950
   235
neuper@37950
   236
neuper@37969
   237
	 Thm ("subtrahiere",num_str @{thm subtrahiere}),
neuper@37950
   238
	 (*"[| l is_const; m is_const |] ==> m * v - l * v = (m - l) * v"*)
neuper@37969
   239
	 Thm ("subtrahiere_von_1",num_str @{thm subtrahiere_von_1}),
neuper@37950
   240
	 (*"[| l is_const |] ==> v - l * v = (1 - l) * v"*)
neuper@37969
   241
	 Thm ("subtrahiere_1",num_str @{thm subtrahiere_1}),
neuper@37950
   242
	 (*"[| l is_const; m is_const |] ==> m * v - v = (m - 1) * v"*)
neuper@37950
   243
neuper@37969
   244
	 Thm ("subtrahiere_x_plus_minus",num_str @{thm subtrahiere_x_plus_minus}), 
neuper@37950
   245
	 (*"[| l is_const; m..|] ==> (k + m * n) - l * n = k + ( m - l) * n"*)
neuper@37969
   246
	 Thm ("subtrahiere_x_plus1_minus",num_str @{thm subtrahiere_x_plus1_minus}),
neuper@37950
   247
	 (*"[| l is_const |] ==> (x + v) - l * v = x + (1 - l) * v"*)
neuper@37969
   248
	 Thm ("subtrahiere_x_plus_minus1",num_str @{thm subtrahiere_x_plus_minus1}),
neuper@37950
   249
	 (*"[| m is_const |] ==> (x + m * v) - v = x + (m - 1) * v"*)
neuper@37950
   250
neuper@37969
   251
	 Thm ("subtrahiere_x_minus_plus",num_str @{thm subtrahiere_x_minus_plus}), 
neuper@37950
   252
	 (*"[| l is_const; m..|] ==> (k - m * n) + l * n = k + (-m + l) * n"*)
neuper@37969
   253
	 Thm ("subtrahiere_x_minus1_plus",num_str @{thm subtrahiere_x_minus1_plus}),
neuper@37950
   254
	 (*"[| l is_const |] ==> (x - v) + l * v = x + (-1 + l) * v"*)
neuper@37969
   255
	 Thm ("subtrahiere_x_minus_plus1",num_str @{thm subtrahiere_x_minus_plus1}),
neuper@37950
   256
	 (*"[| m is_const |] ==> (x - m * v) + v = x + (-m + 1) * v"*)
neuper@37950
   257
neuper@37969
   258
	 Thm ("subtrahiere_x_minus_minus",num_str @{thm subtrahiere_x_minus_minus}), 
neuper@37950
   259
	 (*"[| l is_const; m..|] ==> (k - m * n) - l * n = k + (-m - l) * n"*)
neuper@37969
   260
	 Thm ("subtrahiere_x_minus1_minus",num_str @{thm subtrahiere_x_minus1_minus}),
neuper@37950
   261
	 (*"[| l is_const |] ==> (x - v) - l * v = x + (-1 - l) * v"*)
neuper@37969
   262
	 Thm ("subtrahiere_x_minus_minus1",num_str @{thm subtrahiere_x_minus_minus1}),
neuper@37950
   263
	 (*"[| m is_const |] ==> (x - m * v) - v = x + (-m - 1) * v"*)
neuper@37950
   264
	 
neuper@38014
   265
	 Calc ("Groups.plus_class.plus", eval_binop "#add_"),
neuper@38014
   266
	 Calc ("Groups.minus_class.minus", eval_binop "#subtr_"),
neuper@37950
   267
	 
neuper@37950
   268
	 (*MG: Reihenfolge der folgenden 2 Thm muss so bleiben, wegen
neuper@37950
   269
           (a+a)+a --> a + 2*a --> 3*a and not (a+a)+a --> 2*a + a *)
neuper@37969
   270
	 Thm ("real_mult_2_assoc_r",num_str @{thm real_mult_2_assoc_r}),
neuper@37950
   271
	 (*"(k + z1) + z1 = k + 2 * z1"*)
neuper@37969
   272
	 Thm ("sym_real_mult_2",num_str (@{thm real_mult_2} RS @{thm sym})),
neuper@37950
   273
	 (*"z1 + z1 = 2 * z1"*)
neuper@37950
   274
neuper@37969
   275
	 Thm ("addiere_vor_minus",num_str @{thm addiere_vor_minus}),
neuper@37950
   276
	 (*"[| l is_const; m is_const |] ==> -(l * v) +  m * v = (-l + m) *v"*)
neuper@37969
   277
	 Thm ("addiere_eins_vor_minus",num_str @{thm addiere_eins_vor_minus}),
neuper@37950
   278
	 (*"[| m is_const |] ==> -  v +  m * v = (-1 + m) * v"*)
neuper@37969
   279
	 Thm ("subtrahiere_vor_minus",num_str @{thm subtrahiere_vor_minus}),
neuper@37950
   280
	 (*"[| l is_const; m is_const |] ==> -(l * v) -  m * v = (-l - m) *v"*)
neuper@37969
   281
	 Thm ("subtrahiere_eins_vor_minus",num_str @{thm subtrahiere_eins_vor_minus})
neuper@37950
   282
	 (*"[| m is_const |] ==> -  v -  m * v = (-1 - m) * v"*)
neuper@37950
   283
	 
neuper@37950
   284
	 ], scr = EmptyScr}:rls;
neuper@37950
   285
    
neuper@37950
   286
val verschoenere = 
neuper@37950
   287
  Rls{id = "verschoenere", preconds = [], 
neuper@37950
   288
      rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [],
neuper@37950
   289
      erls = append_rls "erls_verschoenere" e_rls 
neuper@37950
   290
			[Calc ("PolyMinus.kleiner", eval_kleiner "")], 
neuper@37969
   291
      rules = [Thm ("vorzeichen_minus_weg1",num_str @{thm vorzeichen_minus_weg1}),
neuper@37950
   292
	       (*"l kleiner 0 ==> a + l * b = a - -l * b"*)
neuper@37969
   293
	       Thm ("vorzeichen_minus_weg2",num_str @{thm vorzeichen_minus_weg2}),
neuper@37950
   294
	       (*"l kleiner 0 ==> a - l * b = a + -l * b"*)
neuper@37969
   295
	       Thm ("vorzeichen_minus_weg3",num_str @{thm vorzeichen_minus_weg3}),
neuper@37950
   296
	       (*"l kleiner 0 ==> k + a - l * b = k + a + -l * b"*)
neuper@37969
   297
	       Thm ("vorzeichen_minus_weg4",num_str @{thm vorzeichen_minus_weg4}),
neuper@37950
   298
	       (*"l kleiner 0 ==> k - a - l * b = k - a + -l * b"*)
neuper@37950
   299
neuper@38034
   300
	       Calc ("Groups.times_class.times", eval_binop "#mult_"),
neuper@37950
   301
neuper@37965
   302
	       Thm ("mult_zero_left",num_str @{thm mult_zero_left}),    
neuper@37950
   303
	       (*"0 * z = 0"*)
neuper@37965
   304
	       Thm ("mult_1_left",num_str @{thm mult_1_left}),     
neuper@37950
   305
	       (*"1 * z = z"*)
neuper@37965
   306
	       Thm ("add_0_left",num_str @{thm add_0_left}),
neuper@37950
   307
	       (*"0 + z = z"*)
neuper@37969
   308
	       Thm ("null_minus",num_str @{thm null_minus}),
neuper@37950
   309
	       (*"0 - a = -a"*)
neuper@37969
   310
	       Thm ("vor_minus_mal",num_str @{thm vor_minus_mal})
neuper@37950
   311
	       (*"- a * b = (-a) * b"*)
neuper@37950
   312
neuper@37969
   313
	       (*Thm ("",num_str @{}),*)
neuper@37950
   314
	       (**)
neuper@37950
   315
	       ], scr = EmptyScr}:rls (*end verschoenere*);
neuper@37950
   316
neuper@37950
   317
val klammern_aufloesen = 
neuper@37950
   318
  Rls{id = "klammern_aufloesen", preconds = [], 
neuper@37950
   319
      rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [], erls = Erls, 
neuper@37974
   320
      rules = [Thm ("sym_add_assoc",
neuper@37974
   321
                     num_str (@{thm add_assoc} RS @{thm sym})),
neuper@37950
   322
	       (*"a + (b + c) = (a + b) + c"*)
neuper@37969
   323
	       Thm ("klammer_plus_minus",num_str @{thm klammer_plus_minus}),
neuper@37950
   324
	       (*"a + (b - c) = (a + b) - c"*)
neuper@37969
   325
	       Thm ("klammer_minus_plus",num_str @{thm klammer_minus_plus}),
neuper@37950
   326
	       (*"a - (b + c) = (a - b) - c"*)
neuper@37969
   327
	       Thm ("klammer_minus_minus",num_str @{thm klammer_minus_minus})
neuper@37950
   328
	       (*"a - (b - c) = (a - b) + c"*)
neuper@37950
   329
	       ], scr = EmptyScr}:rls;
neuper@37950
   330
neuper@37950
   331
val klammern_ausmultiplizieren = 
neuper@37950
   332
  Rls{id = "klammern_ausmultiplizieren", preconds = [], 
neuper@37950
   333
      rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [], erls = Erls, 
neuper@37965
   334
      rules = [Thm ("left_distrib" ,num_str @{thm left_distrib}),
neuper@37950
   335
	       (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
neuper@37974
   336
	       Thm ("right_distrib",num_str @{thm right_distrib}),
neuper@37950
   337
	       (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
neuper@37950
   338
	       
neuper@37969
   339
	       Thm ("klammer_mult_minus",num_str @{thm klammer_mult_minus}),
neuper@37950
   340
	       (*"a * (b - c) = a * b - a * c"*)
neuper@37969
   341
	       Thm ("klammer_minus_mult",num_str @{thm klammer_minus_mult})
neuper@37950
   342
	       (*"(b - c) * a = b * a - c * a"*)
neuper@37950
   343
neuper@37969
   344
	       (*Thm ("",num_str @{}),
neuper@37950
   345
	       (*""*)*)
neuper@37950
   346
	       ], scr = EmptyScr}:rls;
neuper@37950
   347
neuper@37950
   348
val ordne_monome = 
neuper@37950
   349
  Rls{id = "ordne_monome", preconds = [], 
neuper@37950
   350
      rew_ord = ("dummy_ord", dummy_ord), srls = Erls, calc = [], 
neuper@37950
   351
      erls = append_rls "erls_ordne_monome" e_rls
neuper@37950
   352
	       [Calc ("PolyMinus.kleiner", eval_kleiner ""),
neuper@37950
   353
		Calc ("Atools.is'_atom", eval_is_atom "")
neuper@37950
   354
		], 
neuper@37969
   355
      rules = [Thm ("tausche_mal",num_str @{thm tausche_mal}),
neuper@37950
   356
	       (*"[| b is_atom; a kleiner b  |] ==> (b * a) = (a * b)"*)
neuper@37969
   357
	       Thm ("tausche_vor_mal",num_str @{thm tausche_vor_mal}),
neuper@37950
   358
	       (*"[| b is_atom; a kleiner b  |] ==> (-b * a) = (-a * b)"*)
neuper@37969
   359
	       Thm ("tausche_mal_mal",num_str @{thm tausche_mal_mal}),
neuper@37950
   360
	       (*"[| c is_atom; b kleiner c  |] ==> (a * c * b) = (a * b *c)"*)
neuper@37969
   361
	       Thm ("x_quadrat",num_str @{thm x_quadrat})
neuper@37950
   362
	       (*"(x * a) * a = x * a ^^^ 2"*)
neuper@37950
   363
neuper@37969
   364
	       (*Thm ("",num_str @{}),
neuper@37950
   365
	       (*""*)*)
neuper@37950
   366
	       ], scr = EmptyScr}:rls;
neuper@37950
   367
neuper@37950
   368
neuper@37950
   369
val rls_p_33 = 
neuper@37950
   370
    append_rls "rls_p_33" e_rls
neuper@37950
   371
	       [Rls_ ordne_alphabetisch,
neuper@37950
   372
		Rls_ fasse_zusammen,
neuper@37950
   373
		Rls_ verschoenere
neuper@37950
   374
		];
neuper@37950
   375
val rls_p_34 = 
neuper@37950
   376
    append_rls "rls_p_34" e_rls
neuper@37950
   377
	       [Rls_ klammern_aufloesen,
neuper@37950
   378
		Rls_ ordne_alphabetisch,
neuper@37950
   379
		Rls_ fasse_zusammen,
neuper@37950
   380
		Rls_ verschoenere
neuper@37950
   381
		];
neuper@37950
   382
val rechnen = 
neuper@37950
   383
    append_rls "rechnen" e_rls
neuper@38034
   384
	       [Calc ("Groups.times_class.times", eval_binop "#mult_"),
neuper@38014
   385
		Calc ("Groups.plus_class.plus", eval_binop "#add_"),
neuper@38014
   386
		Calc ("Groups.minus_class.minus", eval_binop "#subtr_")
neuper@37950
   387
		];
neuper@37950
   388
neuper@37950
   389
ruleset' := 
neuper@37967
   390
overwritelthy @{theory} (!ruleset',
neuper@37950
   391
		   [("ordne_alphabetisch", prep_rls ordne_alphabetisch),
neuper@37950
   392
		    ("fasse_zusammen", prep_rls fasse_zusammen),
neuper@37950
   393
		    ("verschoenere", prep_rls verschoenere),
neuper@37950
   394
		    ("ordne_monome", prep_rls ordne_monome),
neuper@37950
   395
		    ("klammern_aufloesen", prep_rls klammern_aufloesen),
neuper@37950
   396
		    ("klammern_ausmultiplizieren", 
neuper@37950
   397
		     prep_rls klammern_ausmultiplizieren)
neuper@37950
   398
		    ]);
neuper@37950
   399
neuper@37950
   400
(** problems **)
neuper@37950
   401
neuper@37950
   402
store_pbt
neuper@37972
   403
 (prep_pbt thy "pbl_vereinf_poly" [] e_pblID
neuper@37950
   404
 (["polynom","vereinfachen"],
neuper@37950
   405
  [], Erls, NONE, []));
neuper@37950
   406
neuper@37950
   407
store_pbt
neuper@37972
   408
 (prep_pbt thy "pbl_vereinf_poly_minus" [] e_pblID
neuper@37950
   409
 (["plus_minus","polynom","vereinfachen"],
neuper@37980
   410
  [("#Given" ,["TERM t_t"]),
neuper@37980
   411
   ("#Where" ,["t_t is_polyexp",
neuper@37980
   412
	       "Not (matchsub (?a + (?b + ?c)) t_t | " ^
neuper@37980
   413
	       "     matchsub (?a + (?b - ?c)) t_t | " ^
neuper@37980
   414
	       "     matchsub (?a - (?b + ?c)) t_t | " ^
neuper@37980
   415
	       "     matchsub (?a + (?b - ?c)) t_t )",
neuper@37980
   416
	       "Not (matchsub (?a * (?b + ?c)) t_t | " ^
neuper@37980
   417
	       "     matchsub (?a * (?b - ?c)) t_t | " ^
neuper@37980
   418
	       "     matchsub ((?b + ?c) * ?a) t_t | " ^
neuper@37980
   419
	       "     matchsub ((?b - ?c) * ?a) t_t )"]),
neuper@37980
   420
   ("#Find"  ,["normalform n_n"])
neuper@37950
   421
  ],
neuper@37950
   422
  append_rls "prls_pbl_vereinf_poly" e_rls 
neuper@37950
   423
	     [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
neuper@37950
   424
	      Calc ("Tools.matchsub", eval_matchsub ""),
neuper@37980
   425
	      Thm ("or_true", num_str @{thm or_true}),
neuper@37950
   426
	      (*"(?a | True) = True"*)
neuper@37980
   427
	      Thm ("or_false", num_str @{thm or_false}),
neuper@37950
   428
	      (*"(?a | False) = ?a"*)
neuper@37969
   429
	      Thm ("not_true",num_str @{thm not_true}),
neuper@37950
   430
	      (*"(~ True) = False"*)
neuper@37969
   431
	      Thm ("not_false",num_str @{thm not_false})
neuper@37950
   432
	      (*"(~ False) = True"*)], 
neuper@37980
   433
  SOME "Vereinfache t_t", 
neuper@37950
   434
  [["simplification","for_polynomials","with_minus"]]));
neuper@37950
   435
neuper@37950
   436
store_pbt
neuper@37972
   437
 (prep_pbt thy "pbl_vereinf_poly_klammer" [] e_pblID
neuper@37950
   438
 (["klammer","polynom","vereinfachen"],
neuper@37980
   439
  [("#Given" ,["TERM t_t"]),
neuper@37980
   440
   ("#Where" ,["t_t is_polyexp",
neuper@37980
   441
	       "Not (matchsub (?a * (?b + ?c)) t_t | " ^
neuper@37980
   442
	       "     matchsub (?a * (?b - ?c)) t_t | " ^
neuper@37980
   443
	       "     matchsub ((?b + ?c) * ?a) t_t | " ^
neuper@37980
   444
	       "     matchsub ((?b - ?c) * ?a) t_t )"]),
neuper@37980
   445
   ("#Find"  ,["normalform n_n"])
neuper@37950
   446
  ],
neuper@37950
   447
  append_rls "prls_pbl_vereinf_poly_klammer" e_rls [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
neuper@37950
   448
	      Calc ("Tools.matchsub", eval_matchsub ""),
neuper@37980
   449
	      Thm ("or_true", num_str @{thm or_true}),
neuper@37950
   450
	      (*"(?a | True) = True"*)
neuper@37980
   451
	      Thm ("or_false", num_str @{thm or_false}),
neuper@37950
   452
	      (*"(?a | False) = ?a"*)
neuper@37969
   453
	      Thm ("not_true",num_str @{thm not_true}),
neuper@37950
   454
	      (*"(~ True) = False"*)
neuper@37969
   455
	      Thm ("not_false",num_str @{thm not_false})
neuper@37950
   456
	      (*"(~ False) = True"*)], 
neuper@37980
   457
  SOME "Vereinfache t_t", 
neuper@37950
   458
  [["simplification","for_polynomials","with_parentheses"]]));
neuper@37950
   459
neuper@37950
   460
store_pbt
neuper@37972
   461
 (prep_pbt thy "pbl_vereinf_poly_klammer_mal" [] e_pblID
neuper@37950
   462
 (["binom_klammer","polynom","vereinfachen"],
neuper@37980
   463
  [("#Given" ,["TERM t_t"]),
neuper@37980
   464
   ("#Where" ,["t_t is_polyexp"]),
neuper@37980
   465
   ("#Find"  ,["normalform n_n"])
neuper@37950
   466
  ],
neuper@37950
   467
  append_rls "e_rls" e_rls [(*for preds in where_*)
neuper@37950
   468
			    Calc ("Poly.is'_polyexp", eval_is_polyexp "")], 
neuper@37980
   469
  SOME "Vereinfache t_t", 
neuper@37950
   470
  [["simplification","for_polynomials","with_parentheses_mult"]]));
neuper@37950
   471
neuper@37950
   472
store_pbt
neuper@37972
   473
 (prep_pbt thy "pbl_probe" [] e_pblID
neuper@37950
   474
 (["probe"],
neuper@37950
   475
  [], Erls, NONE, []));
neuper@37950
   476
neuper@37950
   477
store_pbt
neuper@37972
   478
 (prep_pbt thy "pbl_probe_poly" [] e_pblID
neuper@37950
   479
 (["polynom","probe"],
neuper@37980
   480
  [("#Given" ,["Pruefe e_e", "mitWert w_w"]),
neuper@37980
   481
   ("#Where" ,["e_e is_polyexp"]),
neuper@37980
   482
   ("#Find"  ,["Geprueft p_p"])
neuper@37950
   483
  ],
neuper@37950
   484
  append_rls "prls_pbl_probe_poly" 
neuper@37950
   485
	     e_rls [(*for preds in where_*)
neuper@37950
   486
		    Calc ("Poly.is'_polyexp", eval_is_polyexp "")], 
neuper@37980
   487
  SOME "Probe e_e w_w", 
neuper@37950
   488
  [["probe","fuer_polynom"]]));
neuper@37950
   489
neuper@37950
   490
store_pbt
neuper@37972
   491
 (prep_pbt thy "pbl_probe_bruch" [] e_pblID
neuper@37950
   492
 (["bruch","probe"],
neuper@37980
   493
  [("#Given" ,["Pruefe e_e", "mitWert w_w"]),
neuper@37980
   494
   ("#Where" ,["e_e is_ratpolyexp"]),
neuper@37980
   495
   ("#Find"  ,["Geprueft p_p"])
neuper@37950
   496
  ],
neuper@37950
   497
  append_rls "prls_pbl_probe_bruch"
neuper@37950
   498
	     e_rls [(*for preds in where_*)
neuper@37950
   499
		    Calc ("Rational.is'_ratpolyexp", eval_is_ratpolyexp "")], 
neuper@37980
   500
  SOME "Probe e_e w_w", 
neuper@37950
   501
  [["probe","fuer_bruch"]]));
neuper@37950
   502
neuper@37950
   503
neuper@37950
   504
(** methods **)
neuper@37950
   505
neuper@37950
   506
store_met
neuper@37972
   507
    (prep_met thy "met_simp_poly_minus" [] e_metID
neuper@37950
   508
	      (["simplification","for_polynomials","with_minus"],
neuper@37980
   509
	       [("#Given" ,["TERM t_t"]),
neuper@37980
   510
		("#Where" ,["t_t is_polyexp",
neuper@37980
   511
	       "Not (matchsub (?a + (?b + ?c)) t_t | " ^
neuper@37980
   512
	       "     matchsub (?a + (?b - ?c)) t_t | " ^
neuper@37980
   513
	       "     matchsub (?a - (?b + ?c)) t_t | " ^
neuper@37980
   514
	       "     matchsub (?a + (?b - ?c)) t_t )"]),
neuper@37980
   515
		("#Find"  ,["normalform n_n"])
neuper@37950
   516
		],
neuper@37950
   517
	       {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, 
neuper@37950
   518
		prls = append_rls "prls_met_simp_poly_minus" e_rls 
neuper@37950
   519
				  [Calc ("Poly.is'_polyexp", eval_is_polyexp ""),
neuper@37950
   520
	      Calc ("Tools.matchsub", eval_matchsub ""),
neuper@37980
   521
	      Thm ("and_true",num_str @{thm and_true}),
neuper@37950
   522
	      (*"(?a & True) = ?a"*)
neuper@37980
   523
	      Thm ("and_false",num_str @{thm and_false}),
neuper@37950
   524
	      (*"(?a & False) = False"*)
neuper@37969
   525
	      Thm ("not_true",num_str @{thm not_true}),
neuper@37950
   526
	      (*"(~ True) = False"*)
neuper@37969
   527
	      Thm ("not_false",num_str @{thm not_false})
neuper@37950
   528
	      (*"(~ False) = True"*)],
neuper@37950
   529
		crls = e_rls, nrls = rls_p_33},
neuper@37980
   530
"Script SimplifyScript (t_t::real) =                   " ^
neuper@37950
   531
"  ((Repeat((Try (Rewrite_Set ordne_alphabetisch False)) @@  " ^
neuper@37950
   532
"           (Try (Rewrite_Set fasse_zusammen     False)) @@  " ^
neuper@37980
   533
"           (Try (Rewrite_Set verschoenere       False)))) t_t)"
neuper@37950
   534
	       ));
neuper@37950
   535
neuper@37950
   536
store_met
neuper@37972
   537
    (prep_met thy "met_simp_poly_parenth" [] e_metID
neuper@37950
   538
	      (["simplification","for_polynomials","with_parentheses"],
neuper@37980
   539
	       [("#Given" ,["TERM t_t"]),
neuper@37980
   540
		("#Where" ,["t_t is_polyexp"]),
neuper@37980
   541
		("#Find"  ,["normalform n_n"])
neuper@37950
   542
		],
neuper@37950
   543
	       {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, 
neuper@37950
   544
		prls = append_rls "simplification_for_polynomials_prls" e_rls 
neuper@37950
   545
				  [(*for preds in where_*)
neuper@37950
   546
				   Calc("Poly.is'_polyexp",eval_is_polyexp"")],
neuper@37950
   547
		crls = e_rls, nrls = rls_p_34},
neuper@37980
   548
"Script SimplifyScript (t_t::real) =                          " ^
neuper@37950
   549
"  ((Repeat((Try (Rewrite_Set klammern_aufloesen False)) @@  " ^
neuper@37950
   550
"           (Try (Rewrite_Set ordne_alphabetisch False)) @@  " ^
neuper@37950
   551
"           (Try (Rewrite_Set fasse_zusammen     False)) @@  " ^
neuper@37980
   552
"           (Try (Rewrite_Set verschoenere       False)))) t_t)"
neuper@37950
   553
	       ));
neuper@37950
   554
neuper@37950
   555
store_met
neuper@37972
   556
    (prep_met thy "met_simp_poly_parenth_mult" [] e_metID
neuper@37950
   557
	      (["simplification","for_polynomials","with_parentheses_mult"],
neuper@37980
   558
	       [("#Given" ,["TERM t_t"]),
neuper@37980
   559
		("#Where" ,["t_t is_polyexp"]),
neuper@37980
   560
		("#Find"  ,["normalform n_n"])
neuper@37950
   561
		],
neuper@37950
   562
	       {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, 
neuper@37950
   563
		prls = append_rls "simplification_for_polynomials_prls" e_rls 
neuper@37950
   564
				  [(*for preds in where_*)
neuper@37950
   565
				   Calc("Poly.is'_polyexp",eval_is_polyexp"")],
neuper@37950
   566
		crls = e_rls, nrls = rls_p_34},
neuper@37980
   567
"Script SimplifyScript (t_t::real) =                          " ^
neuper@37950
   568
"  ((Repeat((Try (Rewrite_Set klammern_ausmultiplizieren False)) @@ " ^
neuper@37950
   569
"           (Try (Rewrite_Set discard_parentheses        False)) @@ " ^
neuper@37950
   570
"           (Try (Rewrite_Set ordne_monome               False)) @@ " ^
neuper@37950
   571
"           (Try (Rewrite_Set klammern_aufloesen         False)) @@ " ^
neuper@37950
   572
"           (Try (Rewrite_Set ordne_alphabetisch         False)) @@ " ^
neuper@37950
   573
"           (Try (Rewrite_Set fasse_zusammen             False)) @@ " ^
neuper@37980
   574
"           (Try (Rewrite_Set verschoenere               False)))) t_t)"
neuper@37950
   575
	       ));
neuper@37950
   576
neuper@37950
   577
store_met
neuper@37972
   578
    (prep_met thy "met_probe" [] e_metID
neuper@37950
   579
	      (["probe"],
neuper@37950
   580
	       [],
neuper@37950
   581
	       {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, 
neuper@37950
   582
		prls = Erls, crls = e_rls, nrls = Erls}, 
neuper@37950
   583
	       "empty_script"));
neuper@37950
   584
neuper@37950
   585
store_met
neuper@37972
   586
    (prep_met thy "met_probe_poly" [] e_metID
neuper@37950
   587
	      (["probe","fuer_polynom"],
neuper@37980
   588
	       [("#Given" ,["Pruefe e_e", "mitWert w_w"]),
neuper@37980
   589
		("#Where" ,["e_e is_polyexp"]),
neuper@37980
   590
		("#Find"  ,["Geprueft p_p"])
neuper@37950
   591
		],
neuper@37950
   592
	       {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, 
neuper@37950
   593
		prls = append_rls "prls_met_probe_bruch"
neuper@37950
   594
				  e_rls [(*for preds in where_*)
neuper@37950
   595
					 Calc ("Rational.is'_ratpolyexp", 
neuper@37950
   596
					       eval_is_ratpolyexp "")], 
neuper@37950
   597
		crls = e_rls, nrls = rechnen}, 
neuper@37980
   598
"Script ProbeScript (e_e::bool) (w_w::bool list) = " ^
neuper@37980
   599
" (let e_e = Take e_e;                              " ^
neuper@37980
   600
"      e_e = Substitute w_w e_e                     " ^
neuper@37975
   601
" in (Repeat((Try (Repeat (Calculate TIMES))) @@  " ^
neuper@37975
   602
"            (Try (Repeat (Calculate PLUS ))) @@  " ^
neuper@37980
   603
"            (Try (Repeat (Calculate MINUS))))) e_e)"
neuper@37950
   604
));
neuper@37950
   605
neuper@37950
   606
store_met
neuper@37972
   607
    (prep_met thy "met_probe_bruch" [] e_metID
neuper@37950
   608
	      (["probe","fuer_bruch"],
neuper@37980
   609
	       [("#Given" ,["Pruefe e_e", "mitWert w_w"]),
neuper@37980
   610
		("#Where" ,["e_e is_ratpolyexp"]),
neuper@37980
   611
		("#Find"  ,["Geprueft p_p"])
neuper@37950
   612
		],
neuper@37950
   613
	       {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, 
neuper@37950
   614
		prls = append_rls "prls_met_probe_bruch"
neuper@37950
   615
				  e_rls [(*for preds in where_*)
neuper@37950
   616
					 Calc ("Rational.is'_ratpolyexp", 
neuper@37950
   617
					       eval_is_ratpolyexp "")], 
neuper@37950
   618
		crls = e_rls, nrls = Erls}, 
neuper@37950
   619
	       "empty_script"));
neuper@37950
   620
*}
neuper@37906
   621
neuper@37906
   622
end
neuper@37906
   623