src/Tools/isac/Knowledge/PolyMinus.thy
author wneuper <walther.neuper@jku.at>
Mon, 19 Jul 2021 15:34:54 +0200
changeset 60335 7701598a2182
parent 60331 40eb8aa2b0d6
child 60351 d74e7e33db35
permissions -rw-r--r--
ALL const_name replaces (others cannot be replaced)
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 _") 
walther@60278
    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@52148
    23
axiomatization where
neuper@37906
    24
neuper@52148
    25
  null_minus:            "0 - a = -a" and
neuper@52148
    26
  vor_minus_mal:         "- a * b = (-a) * b" and
neuper@37906
    27
neuper@37906
    28
  (*commute with invariant (a.b).c -association*)
neuper@37980
    29
  tausche_plus:		"[| b ist_monom; a kleiner b  |] ==> 
neuper@52148
    30
			 (b + a) = (a + b)" and
neuper@37980
    31
  tausche_minus:		"[| b ist_monom; a kleiner b  |] ==> 
neuper@52148
    32
			 (b - a) = (-a + b)" and
neuper@37980
    33
  tausche_vor_plus:	"[| b ist_monom; a kleiner b  |] ==> 
neuper@52148
    34
			 (- b + a) = (a - b)" and
neuper@37980
    35
  tausche_vor_minus:	"[| b ist_monom; a kleiner b  |] ==> 
neuper@52148
    36
			 (- b - a) = (-a - b)" and
walther@60269
    37
(*Ambiguous input\<^here> produces 3 parse trees -----------------------------\\*)
neuper@52148
    38
  tausche_plus_plus:	"b kleiner c ==> (a + c + b) = (a + b + c)" and
neuper@52148
    39
  tausche_plus_minus:	"b kleiner c ==> (a + c - b) = (a - b + c)" and
neuper@52148
    40
  tausche_minus_plus:	"b kleiner c ==> (a - c + b) = (a + b - c)" and
neuper@52148
    41
  tausche_minus_minus:	"b kleiner c ==> (a - c - b) = (a - b - c)" and
walther@60269
    42
(*Ambiguous input\<^here> produces 3 parse trees -----------------------------//*)
neuper@37906
    43
neuper@37906
    44
  (*commute with invariant (a.b).c -association*)
neuper@37980
    45
  tausche_mal:		"[| b is_atom; a kleiner b  |] ==> 
neuper@52148
    46
			 (b * a) = (a * b)" and
neuper@37980
    47
  tausche_vor_mal:	"[| b is_atom; a kleiner b  |] ==> 
neuper@52148
    48
			 (-b * a) = (-a * b)" and
neuper@37980
    49
  tausche_mal_mal:	"[| c is_atom; b kleiner c  |] ==> 
neuper@52148
    50
			 (x * c * b) = (x * b * c)" and
walther@60242
    51
  x_quadrat:             "(x * a) * a = x * a \<up> 2" and
neuper@37906
    52
neuper@37906
    53
neuper@37980
    54
  subtrahiere:               "[| l is_const; m is_const |] ==>  
neuper@52148
    55
			     m * v - l * v = (m - l) * v" and
neuper@37980
    56
  subtrahiere_von_1:         "[| l is_const |] ==>  
neuper@52148
    57
			     v - l * v = (1 - l) * v" and
neuper@37980
    58
  subtrahiere_1:             "[| l is_const; m is_const |] ==>  
neuper@52148
    59
			     m * v - v = (m - 1) * v" and
neuper@37906
    60
neuper@37980
    61
  subtrahiere_x_plus_minus:  "[| l is_const; m is_const |] ==>  
neuper@52148
    62
			     (x + m * v) - l * v = x + (m - l) * v" and
neuper@37980
    63
  subtrahiere_x_plus1_minus: "[| l is_const |] ==>  
neuper@52148
    64
			     (x + v) - l * v = x + (1 - l) * v" and
neuper@37980
    65
  subtrahiere_x_plus_minus1: "[| m is_const |] ==>  
neuper@52148
    66
			     (x + m * v) - v = x + (m - 1) * v" and
neuper@37906
    67
neuper@37980
    68
  subtrahiere_x_minus_plus:  "[| l is_const; m is_const |] ==>  
neuper@52148
    69
			     (x - m * v) + l * v = x + (-m + l) * v" and
neuper@37980
    70
  subtrahiere_x_minus1_plus: "[| l is_const |] ==>  
neuper@52148
    71
			     (x - v) + l * v = x + (-1 + l) * v" and
neuper@37980
    72
  subtrahiere_x_minus_plus1: "[| m is_const |] ==>  
neuper@52148
    73
			     (x - m * v) + v = x + (-m + 1) * v" and
neuper@37906
    74
neuper@37980
    75
  subtrahiere_x_minus_minus: "[| l is_const; m is_const |] ==>  
neuper@52148
    76
			     (x - m * v) - l * v = x + (-m - l) * v" and
neuper@37980
    77
  subtrahiere_x_minus1_minus:"[| l is_const |] ==>  
neuper@52148
    78
			     (x - v) - l * v = x + (-1 - l) * v" and
neuper@37980
    79
  subtrahiere_x_minus_minus1:"[| m is_const |] ==>  
neuper@52148
    80
			     (x - m * v) - v = x + (-m - 1) * v" and
neuper@37906
    81
neuper@37906
    82
neuper@37980
    83
  addiere_vor_minus:         "[| l is_const; m is_const |] ==>  
neuper@52148
    84
			     - (l * v) +  m * v = (-l + m) * v" and
neuper@37980
    85
  addiere_eins_vor_minus:    "[| m is_const |] ==>  
neuper@52148
    86
			     -  v +  m * v = (-1 + m) * v" and
neuper@37980
    87
  subtrahiere_vor_minus:     "[| l is_const; m is_const |] ==>  
neuper@52148
    88
			     - (l * v) -  m * v = (-l - m) * v" and
neuper@37980
    89
  subtrahiere_eins_vor_minus:"[| m is_const |] ==>  
neuper@52148
    90
			     -  v -  m * v = (-1 - m) * v" and
neuper@37906
    91
walther@60269
    92
(*Ambiguous input\<^here> produces 3 parse trees -----------------------------\\*)
neuper@52148
    93
  vorzeichen_minus_weg1:      "l kleiner 0 ==> a + l * b = a - -1*l * b" and
neuper@52148
    94
  vorzeichen_minus_weg2:      "l kleiner 0 ==> a - l * b = a + -1*l * b" and
neuper@52148
    95
  vorzeichen_minus_weg3:      "l kleiner 0 ==> k + a - l * b = k + a + -1*l * b" and
neuper@52148
    96
  vorzeichen_minus_weg4:      "l kleiner 0 ==> k - a - l * b = k - a + -1*l * b" and
walther@60269
    97
(*Ambiguous input\<^here> produces 3 parse trees -----------------------------//*)
neuper@37906
    98
walther@59877
    99
  (*klammer_plus_plus = (add.assoc RS sym)*)
neuper@52148
   100
  klammer_plus_minus:          "a + (b - c) = (a + b) - c" and
neuper@52148
   101
  klammer_minus_plus:          "a - (b + c) = (a - b) - c" and
neuper@52148
   102
  klammer_minus_minus:         "a - (b - c) = (a - b) + c" and
neuper@37906
   103
neuper@52148
   104
  klammer_mult_minus:          "a * (b - c) = a * b - a * c" and
neuper@37980
   105
  klammer_minus_mult:          "(b - c) * a = b * a - c * a"
neuper@37906
   106
wneuper@59472
   107
ML \<open>
neuper@37972
   108
val thy = @{theory};
neuper@37972
   109
neuper@37950
   110
(** eval functions **)
neuper@37906
   111
neuper@37950
   112
(*. get the identifier from specific monomials; see fun ist_monom .*)
walther@60325
   113
fun identifier (Free (id, _)) = id                                               (* //2, a   *)
walther@60325
   114
(*TOODOO*)
walther@60325
   115
  | identifier                                                                   (* 3*a*b    *)
walther@60335
   116
      (Const (\<^const_name>\<open>Groups.times_class.times\<close>, _) $ (Const (\<^const_name>\<open>Groups.times_class.times\<close>, _) $
walther@60325
   117
			   num $ t) $ Free (id, _)) = 
walther@60325
   118
    if TermC.is_num num andalso TermC.is_atom t then id
neuper@37950
   119
    else "|||||||||||||"
walther@60325
   120
walther@60325
   121
  | identifier                                                                   (* 2*a, a*b *)
walther@60335
   122
      (Const (\<^const_name>\<open>Groups.times_class.times\<close>, _) $ num $ Free (id, _)) =
walther@60325
   123
    if TermC.is_atom num then id
neuper@37950
   124
    else "|||||||||||||"
walther@60278
   125
  | identifier _ = "|||||||||||||"(*the "largest" string*);
neuper@37950
   126
neuper@37950
   127
(*("kleiner", ("PolyMinus.kleiner", eval_kleiner ""))*)
neuper@37950
   128
(* order "by alphabet" w.r.t. var: num < (var | num*var) > (var*var | ..) *)
walther@60335
   129
fun eval_kleiner _ _ (p as (Const (\<^const_name>\<open>PolyMinus.kleiner\<close>,_) $ a $ b)) _  =
walther@60325
   130
    if TermC.is_num b then
walther@60325
   131
  	  if TermC.is_num a then (*123 kleiner 32 = True !!!*)
walther@60325
   132
  	    if TermC.num_of_term a < TermC.num_of_term b then 
walther@60325
   133
  		    SOME ((UnparseC.term p) ^ " = True", 
walther@60325
   134
            HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))
walther@60325
   135
  	    else SOME ((UnparseC.term p) ^ " = False",
walther@60325
   136
  			  HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))
walther@60325
   137
  	  else (* -1 * -2 kleiner 0 *)
walther@60325
   138
  	    SOME ((UnparseC.term p) ^ " = False",
walther@60325
   139
  		    HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))
neuper@37950
   140
    else
walther@60325
   141
    	if identifier a < identifier b then 
walther@60325
   142
    	  SOME ((UnparseC.term p) ^ " = True",
walther@60325
   143
    		  HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))
walther@60325
   144
    	else SOME ((UnparseC.term p) ^ " = False",
walther@60325
   145
    		HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))
neuper@37950
   146
  | eval_kleiner _ _ _ _ =  NONE;
neuper@37950
   147
walther@60325
   148
fun ist_monom t =
walther@60325
   149
  if TermC.is_atom t then true
walther@60325
   150
  else
walther@60325
   151
    case t of
walther@60335
   152
      Const (\<^const_name>\<open>Groups.times_class.times\<close>, _) $ t1 $ t2 =>
walther@60325
   153
        ist_monom t1 andalso ist_monom t2
walther@60335
   154
    | Const (\<^const_name>\<open>Transcendental.powr\<close>, _) $ t1 $ t2 =>
walther@60325
   155
        ist_monom t1 andalso ist_monom t2
walther@60325
   156
    | _ => false
neuper@37950
   157
neuper@37950
   158
(* is this a univariate monomial ? *)
walther@60278
   159
(*("ist_monom", ("PolyMinus.ist_monom", eval_ist_monom ""))*)
walther@60335
   160
fun eval_ist_monom _ _ (p as (Const (\<^const_name>\<open>PolyMinus.ist_monom\<close>,_) $ a)) _  =
neuper@37950
   161
    if ist_monom a  then 
walther@59868
   162
	SOME ((UnparseC.term p) ^ " = True",
wneuper@59390
   163
	      HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))
walther@59868
   164
    else SOME ((UnparseC.term p) ^ " = False",
wneuper@59390
   165
	       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))
neuper@37950
   166
  | eval_ist_monom _ _ _ _ =  NONE;
neuper@37950
   167
neuper@37950
   168
neuper@37950
   169
(** rewrite order **)
neuper@37950
   170
neuper@37950
   171
(** rulesets **)
neuper@37950
   172
neuper@37950
   173
val erls_ordne_alphabetisch =
walther@60325
   174
  Rule_Set.append_rules "erls_ordne_alphabetisch" Rule_Set.empty
walther@60325
   175
	 [Rule.Eval ("PolyMinus.kleiner", eval_kleiner ""),
walther@60278
   176
		Rule.Eval ("PolyMinus.ist_monom", eval_ist_monom "")
neuper@37950
   177
		];
neuper@37950
   178
neuper@37950
   179
val ordne_alphabetisch = 
walther@59851
   180
  Rule_Def.Repeat{id = "ordne_alphabetisch", preconds = [], 
walther@59857
   181
      rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@37950
   182
      erls = erls_ordne_alphabetisch, 
wenzelm@60297
   183
      rules = [\<^rule_thm>\<open>tausche_plus\<close>,
neuper@37950
   184
	       (*"b kleiner a ==> (b + a) = (a + b)"*)
wenzelm@60297
   185
	       \<^rule_thm>\<open>tausche_minus\<close>,
neuper@37950
   186
	       (*"b kleiner a ==> (b - a) = (-a + b)"*)
wenzelm@60297
   187
	       \<^rule_thm>\<open>tausche_vor_plus\<close>,
neuper@37950
   188
	       (*"[| b ist_monom; a kleiner b  |] ==> (- b + a) = (a - b)"*)
wenzelm@60297
   189
	       \<^rule_thm>\<open>tausche_vor_minus\<close>,
neuper@37950
   190
	       (*"[| b ist_monom; a kleiner b  |] ==> (- b - a) = (-a - b)"*)
wenzelm@60297
   191
	       \<^rule_thm>\<open>tausche_plus_plus\<close>,
neuper@37950
   192
	       (*"c kleiner b ==> (a + c + b) = (a + b + c)"*)
wenzelm@60297
   193
	       \<^rule_thm>\<open>tausche_plus_minus\<close>,
neuper@37950
   194
	       (*"c kleiner b ==> (a + c - b) = (a - b + c)"*)
wenzelm@60297
   195
	       \<^rule_thm>\<open>tausche_minus_plus\<close>,
neuper@37950
   196
	       (*"c kleiner b ==> (a - c + b) = (a + b - c)"*)
wenzelm@60297
   197
	       \<^rule_thm>\<open>tausche_minus_minus\<close>
neuper@37950
   198
	       (*"c kleiner b ==> (a - c - b) = (a - b - c)"*)
walther@59878
   199
	       ], scr = Rule.Empty_Prog};
neuper@37950
   200
neuper@37950
   201
val fasse_zusammen = 
walther@59851
   202
    Rule_Def.Repeat{id = "fasse_zusammen", preconds = [], 
walther@59857
   203
	rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord),
walther@59852
   204
	erls = Rule_Set.append_rules "erls_fasse_zusammen" Rule_Set.empty 
wenzelm@60294
   205
			  [\<^rule_eval>\<open>Prog_Expr.is_const\<close> (Prog_Expr.eval_const "#is_const_")],
walther@59851
   206
	srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@37950
   207
	rules = 
wenzelm@60297
   208
	[\<^rule_thm>\<open>real_num_collect\<close>, 
neuper@37950
   209
	 (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
wenzelm@60297
   210
	 \<^rule_thm>\<open>real_num_collect_assoc_r\<close>,
neuper@37950
   211
	 (*"[| l is_const; m..|] ==>  (k + m * n) + l * n = k + (l + m)*n"*)
wenzelm@60297
   212
	 \<^rule_thm>\<open>real_one_collect\<close>,	
neuper@37950
   213
	 (*"m is_const ==> n + m * n = (1 + m) * n"*)
wenzelm@60297
   214
	 \<^rule_thm>\<open>real_one_collect_assoc_r\<close>, 
neuper@37950
   215
	 (*"m is_const ==> (k + n) + m * n = k + (m + 1) * n"*)
neuper@37950
   216
neuper@37950
   217
wenzelm@60297
   218
	 \<^rule_thm>\<open>subtrahiere\<close>,
neuper@37950
   219
	 (*"[| l is_const; m is_const |] ==> m * v - l * v = (m - l) * v"*)
wenzelm@60297
   220
	 \<^rule_thm>\<open>subtrahiere_von_1\<close>,
neuper@37950
   221
	 (*"[| l is_const |] ==> v - l * v = (1 - l) * v"*)
wenzelm@60297
   222
	 \<^rule_thm>\<open>subtrahiere_1\<close>,
neuper@37950
   223
	 (*"[| l is_const; m is_const |] ==> m * v - v = (m - 1) * v"*)
neuper@37950
   224
wenzelm@60297
   225
	 \<^rule_thm>\<open>subtrahiere_x_plus_minus\<close>, 
neuper@37950
   226
	 (*"[| l is_const; m..|] ==> (k + m * n) - l * n = k + ( m - l) * n"*)
wenzelm@60297
   227
	 \<^rule_thm>\<open>subtrahiere_x_plus1_minus\<close>,
neuper@37950
   228
	 (*"[| l is_const |] ==> (x + v) - l * v = x + (1 - l) * v"*)
wenzelm@60297
   229
	 \<^rule_thm>\<open>subtrahiere_x_plus_minus1\<close>,
neuper@37950
   230
	 (*"[| m is_const |] ==> (x + m * v) - v = x + (m - 1) * v"*)
neuper@37950
   231
wenzelm@60297
   232
	 \<^rule_thm>\<open>subtrahiere_x_minus_plus\<close>, 
neuper@37950
   233
	 (*"[| l is_const; m..|] ==> (k - m * n) + l * n = k + (-m + l) * n"*)
wenzelm@60297
   234
	 \<^rule_thm>\<open>subtrahiere_x_minus1_plus\<close>,
neuper@37950
   235
	 (*"[| l is_const |] ==> (x - v) + l * v = x + (-1 + l) * v"*)
wenzelm@60297
   236
	 \<^rule_thm>\<open>subtrahiere_x_minus_plus1\<close>,
neuper@37950
   237
	 (*"[| m is_const |] ==> (x - m * v) + v = x + (-m + 1) * v"*)
neuper@37950
   238
wenzelm@60297
   239
	 \<^rule_thm>\<open>subtrahiere_x_minus_minus\<close>, 
neuper@37950
   240
	 (*"[| l is_const; m..|] ==> (k - m * n) - l * n = k + (-m - l) * n"*)
wenzelm@60297
   241
	 \<^rule_thm>\<open>subtrahiere_x_minus1_minus\<close>,
neuper@37950
   242
	 (*"[| l is_const |] ==> (x - v) - l * v = x + (-1 - l) * v"*)
wenzelm@60297
   243
	 \<^rule_thm>\<open>subtrahiere_x_minus_minus1\<close>,
neuper@37950
   244
	 (*"[| m is_const |] ==> (x - m * v) - v = x + (-m - 1) * v"*)
neuper@37950
   245
	 
wenzelm@60294
   246
	 \<^rule_eval>\<open>plus\<close> (**)(eval_binop "#add_"),
wenzelm@60294
   247
	 \<^rule_eval>\<open>minus\<close> (**)(eval_binop "#subtr_"),
neuper@37950
   248
	 
wneuper@59416
   249
	 (*MG: Reihenfolge der folgenden 2 Rule.Thm muss so bleiben, wegen
neuper@37950
   250
           (a+a)+a --> a + 2*a --> 3*a and not (a+a)+a --> 2*a + a *)
wenzelm@60297
   251
	 \<^rule_thm>\<open>real_mult_2_assoc_r\<close>,
neuper@37950
   252
	 (*"(k + z1) + z1 = k + 2 * z1"*)
wenzelm@60296
   253
	 \<^rule_thm_sym>\<open>real_mult_2\<close>,
neuper@37950
   254
	 (*"z1 + z1 = 2 * z1"*)
neuper@37950
   255
wenzelm@60297
   256
	 \<^rule_thm>\<open>addiere_vor_minus\<close>,
neuper@37950
   257
	 (*"[| l is_const; m is_const |] ==> -(l * v) +  m * v = (-l + m) *v"*)
wenzelm@60297
   258
	 \<^rule_thm>\<open>addiere_eins_vor_minus\<close>,
neuper@37950
   259
	 (*"[| m is_const |] ==> -  v +  m * v = (-1 + m) * v"*)
wenzelm@60297
   260
	 \<^rule_thm>\<open>subtrahiere_vor_minus\<close>,
neuper@37950
   261
	 (*"[| l is_const; m is_const |] ==> -(l * v) -  m * v = (-l - m) *v"*)
wenzelm@60297
   262
	 \<^rule_thm>\<open>subtrahiere_eins_vor_minus\<close>
neuper@37950
   263
	 (*"[| m is_const |] ==> -  v -  m * v = (-1 - m) * v"*)
neuper@37950
   264
	 
walther@59878
   265
	 ], scr = Rule.Empty_Prog};
neuper@37950
   266
    
neuper@37950
   267
val verschoenere = 
walther@59851
   268
  Rule_Def.Repeat{id = "verschoenere", preconds = [], 
walther@59857
   269
      rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), srls = Rule_Set.Empty, calc = [], errpatts = [],
walther@59852
   270
      erls = Rule_Set.append_rules "erls_verschoenere" Rule_Set.empty 
wenzelm@60294
   271
			[\<^rule_eval>\<open>PolyMinus.kleiner\<close> (eval_kleiner "")],
wenzelm@60297
   272
      rules = [\<^rule_thm>\<open>vorzeichen_minus_weg1\<close>,
neuper@37950
   273
	       (*"l kleiner 0 ==> a + l * b = a - -l * b"*)
wenzelm@60297
   274
	       \<^rule_thm>\<open>vorzeichen_minus_weg2\<close>,
neuper@37950
   275
	       (*"l kleiner 0 ==> a - l * b = a + -l * b"*)
wenzelm@60297
   276
	       \<^rule_thm>\<open>vorzeichen_minus_weg3\<close>,
neuper@37950
   277
	       (*"l kleiner 0 ==> k + a - l * b = k + a + -l * b"*)
wenzelm@60297
   278
	       \<^rule_thm>\<open>vorzeichen_minus_weg4\<close>,
neuper@37950
   279
	       (*"l kleiner 0 ==> k - a - l * b = k - a + -l * b"*)
neuper@37950
   280
wenzelm@60294
   281
	       \<^rule_eval>\<open>times\<close> (**)(eval_binop "#mult_"),
neuper@37950
   282
wenzelm@60297
   283
	       \<^rule_thm>\<open>mult_zero_left\<close>,    
neuper@37950
   284
	       (*"0 * z = 0"*)
wenzelm@60297
   285
	       \<^rule_thm>\<open>mult_1_left\<close>,     
neuper@37950
   286
	       (*"1 * z = z"*)
wenzelm@60297
   287
	       \<^rule_thm>\<open>add_0_left\<close>,
neuper@37950
   288
	       (*"0 + z = z"*)
wenzelm@60297
   289
	       \<^rule_thm>\<open>null_minus\<close>,
neuper@37950
   290
	       (*"0 - a = -a"*)
wenzelm@60297
   291
	       \<^rule_thm>\<open>vor_minus_mal\<close>
neuper@37950
   292
	       (*"- a * b = (-a) * b"*)
walther@59878
   293
	       ], scr = Rule.Empty_Prog} (*end verschoenere*);
neuper@37950
   294
neuper@37950
   295
val klammern_aufloesen = 
walther@59851
   296
  Rule_Def.Repeat{id = "klammern_aufloesen", preconds = [], 
walther@59857
   297
      rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), srls = Rule_Set.Empty, calc = [], errpatts = [], erls = Rule_Set.Empty, 
wenzelm@60296
   298
      rules = [\<^rule_thm_sym>\<open>add.assoc\<close>,
neuper@37950
   299
	       (*"a + (b + c) = (a + b) + c"*)
wenzelm@60297
   300
	       \<^rule_thm>\<open>klammer_plus_minus\<close>,
neuper@37950
   301
	       (*"a + (b - c) = (a + b) - c"*)
wenzelm@60297
   302
	       \<^rule_thm>\<open>klammer_minus_plus\<close>,
neuper@37950
   303
	       (*"a - (b + c) = (a - b) - c"*)
wenzelm@60297
   304
	       \<^rule_thm>\<open>klammer_minus_minus\<close>
neuper@37950
   305
	       (*"a - (b - c) = (a - b) + c"*)
walther@59878
   306
	       ], scr = Rule.Empty_Prog};
neuper@37950
   307
neuper@37950
   308
val klammern_ausmultiplizieren = 
walther@59851
   309
  Rule_Def.Repeat{id = "klammern_ausmultiplizieren", preconds = [], 
walther@59857
   310
      rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), srls = Rule_Set.Empty, calc = [], errpatts = [], erls = Rule_Set.Empty, 
wenzelm@60297
   311
      rules = [\<^rule_thm>\<open>distrib_right\<close>,
neuper@37950
   312
	       (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
wenzelm@60297
   313
	       \<^rule_thm>\<open>distrib_left\<close>,
neuper@37950
   314
	       (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
neuper@37950
   315
	       
wenzelm@60297
   316
	       \<^rule_thm>\<open>klammer_mult_minus\<close>,
neuper@37950
   317
	       (*"a * (b - c) = a * b - a * c"*)
wenzelm@60297
   318
	       \<^rule_thm>\<open>klammer_minus_mult\<close>
neuper@37950
   319
	       (*"(b - c) * a = b * a - c * a"*)
walther@59878
   320
	       ], scr = Rule.Empty_Prog};
neuper@37950
   321
neuper@37950
   322
val ordne_monome = 
walther@59851
   323
  Rule_Def.Repeat{id = "ordne_monome", preconds = [], 
walther@59857
   324
      rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), srls = Rule_Set.Empty, calc = [], errpatts = [], 
walther@59852
   325
      erls = Rule_Set.append_rules "erls_ordne_monome" Rule_Set.empty
wenzelm@60294
   326
	       [\<^rule_eval>\<open>PolyMinus.kleiner\<close> (eval_kleiner ""),
wenzelm@60294
   327
		      \<^rule_eval>\<open>Prog_Expr.is_atom\<close> (Prog_Expr.eval_is_atom "")
neuper@37950
   328
		], 
wenzelm@60297
   329
      rules = [\<^rule_thm>\<open>tausche_mal\<close>,
neuper@37950
   330
	       (*"[| b is_atom; a kleiner b  |] ==> (b * a) = (a * b)"*)
wenzelm@60297
   331
	       \<^rule_thm>\<open>tausche_vor_mal\<close>,
neuper@37950
   332
	       (*"[| b is_atom; a kleiner b  |] ==> (-b * a) = (-a * b)"*)
wenzelm@60297
   333
	       \<^rule_thm>\<open>tausche_mal_mal\<close>,
neuper@37950
   334
	       (*"[| c is_atom; b kleiner c  |] ==> (a * c * b) = (a * b *c)"*)
wenzelm@60297
   335
	       \<^rule_thm>\<open>x_quadrat\<close>
walther@60242
   336
	       (*"(x * a) * a = x * a \<up> 2"*)
walther@59878
   337
	       ], scr = Rule.Empty_Prog};
neuper@37950
   338
neuper@37950
   339
neuper@37950
   340
val rls_p_33 = 
walther@59852
   341
    Rule_Set.append_rules "rls_p_33" Rule_Set.empty
wneuper@59416
   342
	       [Rule.Rls_ ordne_alphabetisch,
wneuper@59416
   343
		Rule.Rls_ fasse_zusammen,
wneuper@59416
   344
		Rule.Rls_ verschoenere
neuper@37950
   345
		];
neuper@37950
   346
val rls_p_34 = 
walther@59852
   347
    Rule_Set.append_rules "rls_p_34" Rule_Set.empty
wneuper@59416
   348
	       [Rule.Rls_ klammern_aufloesen,
wneuper@59416
   349
		Rule.Rls_ ordne_alphabetisch,
wneuper@59416
   350
		Rule.Rls_ fasse_zusammen,
wneuper@59416
   351
		Rule.Rls_ verschoenere
neuper@37950
   352
		];
neuper@37950
   353
val rechnen = 
walther@59852
   354
    Rule_Set.append_rules "rechnen" Rule_Set.empty
wenzelm@60294
   355
	       [\<^rule_eval>\<open>times\<close> (**)(eval_binop "#mult_"),
wenzelm@60294
   356
          \<^rule_eval>\<open>plus\<close> (**)(eval_binop "#add_"),
wenzelm@60294
   357
          \<^rule_eval>\<open>minus\<close> (**)(eval_binop "#subtr_")
neuper@37950
   358
		];
wneuper@59472
   359
\<close>
wenzelm@60289
   360
rule_set_knowledge
wenzelm@60286
   361
  ordne_alphabetisch = \<open>prep_rls' ordne_alphabetisch\<close> and
wenzelm@60286
   362
  fasse_zusammen = \<open>prep_rls' fasse_zusammen\<close> and
wenzelm@60286
   363
  verschoenere = \<open>prep_rls' verschoenere\<close> and
wenzelm@60286
   364
  ordne_monome = \<open>prep_rls' ordne_monome\<close> and
wenzelm@60286
   365
  klammern_aufloesen = \<open>prep_rls' klammern_aufloesen\<close> and
wenzelm@60286
   366
  klammern_ausmultiplizieren = \<open>prep_rls' klammern_ausmultiplizieren\<close>
neuper@37950
   367
neuper@37950
   368
(** problems **)
wenzelm@60306
   369
wenzelm@60306
   370
problem pbl_vereinf_poly : "polynom/vereinfachen" = \<open>Rule_Set.Empty\<close>
wenzelm@60306
   371
wenzelm@60306
   372
problem pbl_vereinf_poly_minus : "plus_minus/polynom/vereinfachen" =
wenzelm@60306
   373
  \<open>Rule_Set.append_rules "prls_pbl_vereinf_poly" Rule_Set.empty 
wenzelm@60306
   374
    [\<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp ""),
wenzelm@60306
   375
     \<^rule_eval>\<open>Prog_Expr.matchsub\<close> (Prog_Expr.eval_matchsub ""),
wenzelm@60306
   376
      \<^rule_thm>\<open>or_true\<close>,
wenzelm@60306
   377
      (*"(?a | True) = True"*)
wenzelm@60306
   378
      \<^rule_thm>\<open>or_false\<close>,
wenzelm@60306
   379
      (*"(?a | False) = ?a"*)
wenzelm@60306
   380
      \<^rule_thm>\<open>not_true\<close>,
wenzelm@60306
   381
      (*"(~ True) = False"*)
wenzelm@60306
   382
      \<^rule_thm>\<open>not_false\<close>
wenzelm@60306
   383
      (*"(~ False) = True"*)]\<close>
wenzelm@60306
   384
  Method: "simplification/for_polynomials/with_minus"
wenzelm@60306
   385
  CAS: "Vereinfache t_t"
wenzelm@60306
   386
  Given: "Term t_t"
wenzelm@60306
   387
  Where:
wenzelm@60306
   388
    "t_t is_polyexp"
wenzelm@60306
   389
    "Not (matchsub (?a + (?b + ?c)) t_t |
wenzelm@60306
   390
          matchsub (?a + (?b - ?c)) t_t |
wenzelm@60306
   391
          matchsub (?a - (?b + ?c)) t_t |
wenzelm@60306
   392
          matchsub (?a + (?b - ?c)) t_t )"
wenzelm@60306
   393
    "Not (matchsub (?a * (?b + ?c)) t_t |
wenzelm@60306
   394
          matchsub (?a * (?b - ?c)) t_t |
wenzelm@60306
   395
          matchsub ((?b + ?c) * ?a) t_t |
wenzelm@60306
   396
          matchsub ((?b - ?c) * ?a) t_t )"
wenzelm@60306
   397
  Find: "normalform n_n"
wenzelm@60306
   398
wenzelm@60306
   399
problem pbl_vereinf_poly_klammer : "klammer/polynom/vereinfachen" =
wenzelm@60306
   400
  \<open>Rule_Set.append_rules "prls_pbl_vereinf_poly_klammer" Rule_Set.empty
wenzelm@60306
   401
    [\<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp ""),
wenzelm@60306
   402
     \<^rule_eval>\<open>Prog_Expr.matchsub\<close> (Prog_Expr.eval_matchsub ""),
wenzelm@60306
   403
     \<^rule_thm>\<open>or_true\<close>,
wenzelm@60306
   404
     (*"(?a | True) = True"*)
wenzelm@60306
   405
     \<^rule_thm>\<open>or_false\<close>,
wenzelm@60306
   406
     (*"(?a | False) = ?a"*)
wenzelm@60306
   407
     \<^rule_thm>\<open>not_true\<close>,
wenzelm@60306
   408
     (*"(~ True) = False"*)
wenzelm@60306
   409
     \<^rule_thm>\<open>not_false\<close>
wenzelm@60306
   410
     (*"(~ False) = True"*)]\<close>
wenzelm@60306
   411
  Method: "simplification/for_polynomials/with_parentheses"
wenzelm@60306
   412
  CAS: "Vereinfache t_t"
wenzelm@60306
   413
  Given: "Term t_t"
wenzelm@60306
   414
  Where:
wenzelm@60306
   415
    "t_t is_polyexp"
wenzelm@60306
   416
    "Not (matchsub (?a * (?b + ?c)) t_t |
wenzelm@60306
   417
          matchsub (?a * (?b - ?c)) t_t |
wenzelm@60306
   418
          matchsub ((?b + ?c) * ?a) t_t |
wenzelm@60306
   419
          matchsub ((?b - ?c) * ?a) t_t )"
wenzelm@60306
   420
  Find: "normalform n_n"
wenzelm@60306
   421
wenzelm@60306
   422
problem pbl_vereinf_poly_klammer_mal : "binom_klammer/polynom/vereinfachen" =
wenzelm@60306
   423
  \<open>Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)
wenzelm@60306
   424
    \<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp "")]\<close>
wenzelm@60306
   425
  Method: "simplification/for_polynomials/with_parentheses_mult"
wenzelm@60306
   426
  CAS: "Vereinfache t_t"
wenzelm@60306
   427
  Given: "Term t_t"
wenzelm@60306
   428
  Where: "t_t is_polyexp"
wenzelm@60306
   429
  Find: "normalform n_n"
wenzelm@60306
   430
wenzelm@60306
   431
problem pbl_probe : "probe" = \<open>Rule_Set.Empty\<close>
wenzelm@60306
   432
wenzelm@60306
   433
problem pbl_probe_poly : "polynom/probe" =
wenzelm@60306
   434
  \<open>Rule_Set.append_rules "prls_pbl_probe_poly" Rule_Set.empty [(*for preds in where_*)
wenzelm@60306
   435
    \<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp "")]\<close>
wenzelm@60306
   436
  Method: "probe/fuer_polynom"
wenzelm@60306
   437
  CAS: "Probe e_e w_w"
wenzelm@60306
   438
  Given: "Pruefe e_e" "mitWert w_w"
wenzelm@60306
   439
  Where: "e_e is_polyexp"
wenzelm@60306
   440
  Find: "Geprueft p_p"
wenzelm@60306
   441
wenzelm@60306
   442
problem pbl_probe_bruch : "bruch/probe" =
wenzelm@60306
   443
  \<open>Rule_Set.append_rules "prls_pbl_probe_bruch" Rule_Set.empty [(*for preds in where_*)
wenzelm@60306
   444
    \<^rule_eval>\<open>is_ratpolyexp\<close> (eval_is_ratpolyexp "")]\<close>
wenzelm@60306
   445
  Method: "probe/fuer_bruch"
wenzelm@60306
   446
  CAS: "Probe e_e w_w"
wenzelm@60306
   447
  Given: "Pruefe e_e" "mitWert w_w"
wenzelm@60306
   448
  Where: "e_e is_ratpolyexp"
wenzelm@60306
   449
  Find: "Geprueft p_p"
neuper@37950
   450
neuper@37950
   451
(** methods **)
wneuper@59545
   452
wneuper@59504
   453
partial_function (tailrec) simplify :: "real \<Rightarrow> real"
wneuper@59504
   454
  where
walther@59635
   455
"simplify t_t = (
walther@59635
   456
  (Repeat(
walther@59637
   457
    (Try (Rewrite_Set ''ordne_alphabetisch'')) #>
walther@59637
   458
    (Try (Rewrite_Set ''fasse_zusammen'')) #>
walther@59635
   459
    (Try (Rewrite_Set ''verschoenere'')))
walther@59635
   460
  ) t_t)"
wenzelm@60303
   461
wenzelm@60303
   462
method met_simp_poly_minus : "simplification/for_polynomials/with_minus" =
wenzelm@60303
   463
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty,
wenzelm@60303
   464
    prls =
wenzelm@60303
   465
      Rule_Set.append_rules "prls_met_simp_poly_minus" Rule_Set.empty 
wenzelm@60303
   466
        [\<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp ""),
wenzelm@60303
   467
          \<^rule_eval>\<open>Prog_Expr.matchsub\<close> (Prog_Expr.eval_matchsub ""),
wenzelm@60303
   468
          \<^rule_thm>\<open>and_true\<close>,
wenzelm@60303
   469
          (*"(?a & True) = ?a"*)
wenzelm@60303
   470
          \<^rule_thm>\<open>and_false\<close>,
wenzelm@60303
   471
          (*"(?a & False) = False"*)
wenzelm@60303
   472
          \<^rule_thm>\<open>not_true\<close>,
wenzelm@60303
   473
          (*"(~ True) = False"*)
wenzelm@60303
   474
          \<^rule_thm>\<open>not_false\<close>
wenzelm@60303
   475
          (*"(~ False) = True"*)],
wenzelm@60303
   476
    crls = Rule_Set.empty, errpats = [], nrls = rls_p_33}\<close>
wenzelm@60303
   477
  Program: simplify.simps
wenzelm@60303
   478
  Given: "Term t_t"
wenzelm@60303
   479
  Where:
wenzelm@60303
   480
    "t_t is_polyexp"
wenzelm@60303
   481
    "Not (matchsub (?a + (?b + ?c)) t_t |
wenzelm@60303
   482
          matchsub (?a + (?b - ?c)) t_t |
wenzelm@60303
   483
          matchsub (?a - (?b + ?c)) t_t |
wenzelm@60303
   484
          matchsub (?a + (?b - ?c)) t_t)"
wenzelm@60303
   485
  Find: "normalform n_n"
wneuper@59545
   486
wneuper@59504
   487
partial_function (tailrec) simplify2 :: "real \<Rightarrow> real"
wneuper@59504
   488
  where
walther@59635
   489
"simplify2 t_t = (
walther@59635
   490
  (Repeat(
walther@59637
   491
    (Try (Rewrite_Set ''klammern_aufloesen'')) #>
walther@59637
   492
    (Try (Rewrite_Set ''ordne_alphabetisch'')) #>
walther@59637
   493
    (Try (Rewrite_Set ''fasse_zusammen'')) #>
walther@59635
   494
    (Try (Rewrite_Set ''verschoenere'')))
walther@59635
   495
  ) t_t)"
wenzelm@60303
   496
wenzelm@60303
   497
method met_simp_poly_parenth : "simplification/for_polynomials/with_parentheses" =
wenzelm@60303
   498
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, 
wenzelm@60303
   499
    prls = Rule_Set.append_rules "simplification_for_polynomials_prls" Rule_Set.empty 
wenzelm@60303
   500
      [(*for preds in where_*) \<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp"")],
wenzelm@60303
   501
    crls = Rule_Set.empty, errpats = [], nrls = rls_p_34}\<close>
wenzelm@60303
   502
  Program: simplify2.simps
wenzelm@60303
   503
  Given: "Term t_t"
wenzelm@60303
   504
  Where: "t_t is_polyexp"
wenzelm@60303
   505
  Find: "normalform n_n"
wneuper@59545
   506
wneuper@59504
   507
partial_function (tailrec) simplify3 :: "real \<Rightarrow> real"
wneuper@59504
   508
  where
walther@59635
   509
"simplify3 t_t = (
walther@59635
   510
  (Repeat(
walther@59637
   511
    (Try (Rewrite_Set ''klammern_ausmultiplizieren'')) #>
walther@59637
   512
    (Try (Rewrite_Set ''discard_parentheses'')) #>
walther@59637
   513
    (Try (Rewrite_Set ''ordne_monome'')) #>
walther@59637
   514
    (Try (Rewrite_Set ''klammern_aufloesen'')) #>
walther@59637
   515
    (Try (Rewrite_Set ''ordne_alphabetisch'')) #>
walther@59637
   516
    (Try (Rewrite_Set ''fasse_zusammen'')) #>
walther@59635
   517
    (Try (Rewrite_Set ''verschoenere'')))
walther@59635
   518
  ) t_t)"
wenzelm@60303
   519
wenzelm@60303
   520
method met_simp_poly_parenth_mult : "simplification/for_polynomials/with_parentheses_mult" =
wenzelm@60303
   521
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, 
wenzelm@60303
   522
    prls = Rule_Set.append_rules "simplification_for_polynomials_prls" Rule_Set.empty 
wenzelm@60303
   523
      [(*for preds in where_*) \<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp"")],
wenzelm@60303
   524
    crls = Rule_Set.empty, errpats = [], nrls = rls_p_34}\<close>
wenzelm@60303
   525
  Program: simplify3.simps
wenzelm@60303
   526
  Given: "Term t_t"
wenzelm@60303
   527
  Where: "t_t is_polyexp"
wenzelm@60303
   528
  Find: "normalform n_n"
wenzelm@60303
   529
wenzelm@60303
   530
method met_probe : "probe" =
wenzelm@60303
   531
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, prls = Rule_Set.Empty, crls = Rule_Set.empty,
wenzelm@60303
   532
    errpats = [], nrls = Rule_Set.Empty}\<close>
wneuper@59545
   533
wneuper@59504
   534
partial_function (tailrec) mache_probe :: "bool \<Rightarrow> bool list \<Rightarrow> bool"
wneuper@59504
   535
  where
walther@59635
   536
"mache_probe e_e w_w = (
walther@59635
   537
  let
walther@59635
   538
     e_e = Take e_e;
walther@59635
   539
     e_e = Substitute w_w e_e
walther@59635
   540
  in (
walther@59635
   541
    Repeat (
walther@59637
   542
      (Try (Repeat (Calculate ''TIMES''))) #>
walther@59637
   543
      (Try (Repeat (Calculate ''PLUS'' ))) #>
walther@59635
   544
      (Try (Repeat (Calculate ''MINUS''))))
walther@59635
   545
    ) e_e)"
wenzelm@60303
   546
wenzelm@60303
   547
method met_probe_poly : "probe/fuer_polynom" =
wenzelm@60303
   548
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, 
wenzelm@60303
   549
    prls = Rule_Set.append_rules "prls_met_probe_bruch" Rule_Set.empty
wenzelm@60303
   550
        [(*for preds in where_*) \<^rule_eval>\<open>is_ratpolyexp\<close> (eval_is_ratpolyexp "")], 
wenzelm@60303
   551
    crls = Rule_Set.empty, errpats = [], nrls = rechnen}\<close>
wenzelm@60303
   552
  Program: mache_probe.simps
wenzelm@60303
   553
  Given: "Pruefe e_e" "mitWert w_w"
wenzelm@60303
   554
  Where: "e_e is_polyexp"
wenzelm@60303
   555
  Find: "Geprueft p_p"
wenzelm@60303
   556
wenzelm@60303
   557
method met_probe_bruch : "probe/fuer_bruch" =
wenzelm@60303
   558
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, 
wenzelm@60303
   559
    prls = Rule_Set.append_rules "prls_met_probe_bruch" Rule_Set.empty
wenzelm@60303
   560
        [(*for preds in where_*) \<^rule_eval>\<open>is_ratpolyexp\<close> (eval_is_ratpolyexp "")],
wenzelm@60303
   561
    crls = Rule_Set.empty, errpats = [], nrls = Rule_Set.Empty}\<close>
wenzelm@60303
   562
  Given: "Pruefe e_e" "mitWert w_w"
wenzelm@60303
   563
  Where: "e_e is_ratpolyexp"
wenzelm@60303
   564
  Find: "Geprueft p_p"
wenzelm@60303
   565
wenzelm@60303
   566
ML \<open>
walther@60278
   567
\<close> ML \<open>
wneuper@59472
   568
\<close>
neuper@37906
   569
neuper@37906
   570
end
neuper@37906
   571