src/Tools/isac/Knowledge/Rational.thy
author wneuper <walther.neuper@jku.at>
Mon, 19 Jul 2021 15:34:54 +0200
changeset 60335 7701598a2182
parent 60331 40eb8aa2b0d6
child 60337 cbad4e18e91b
permissions -rw-r--r--
ALL const_name replaces (others cannot be replaced)
neuper@52105
     1
(* rationals, fractions of multivariate polynomials over the real field
neuper@37906
     2
   author: isac team
neuper@52105
     3
   Copyright (c) isac team 2002, 2013
neuper@37906
     4
   Use is subject to license terms.
neuper@37906
     5
neuper@37906
     6
   depends on Poly (and not on Atools), because 
wneuper@59370
     7
   fractions with _normalised_ polynomials are canceled, added, etc.
neuper@37906
     8
*)
neuper@37906
     9
neuper@48884
    10
theory Rational 
wneuper@59553
    11
imports Poly GCD_Poly_ML
neuper@48884
    12
begin
neuper@37906
    13
walther@59878
    14
section \<open>Constants for evaluation by "Rule.Eval"\<close>
neuper@37906
    15
consts
neuper@37906
    16
walther@60278
    17
  is_expanded    :: "real => bool" ("_ is'_expanded")     (*RL->Poly.thy*)
walther@60278
    18
  is_ratpolyexp  :: "real => bool" ("_ is'_ratpolyexp") 
jan@42300
    19
  get_denominator :: "real => real"
walther@60017
    20
  get_numerator   :: "real => real"           
neuper@37906
    21
wneuper@59472
    22
ML \<open>
neuper@52105
    23
(*.the expression contains + - * ^ / only ?.*)
neuper@52105
    24
fun is_ratpolyexp (Free _) = true
wenzelm@60309
    25
  | is_ratpolyexp (Const (\<^const_name>\<open>plus\<close>,_) $ Free _ $ Free _) = true
wenzelm@60309
    26
  | is_ratpolyexp (Const (\<^const_name>\<open>minus\<close>,_) $ Free _ $ Free _) = true
wenzelm@60309
    27
  | is_ratpolyexp (Const (\<^const_name>\<open>times\<close>,_) $ Free _ $ Free _) = true
wenzelm@60309
    28
  | is_ratpolyexp (Const (\<^const_name>\<open>powr\<close>,_) $ Free _ $ Free _) = true
wenzelm@60309
    29
  | is_ratpolyexp (Const (\<^const_name>\<open>divide\<close>,_) $ Free _ $ Free _) = true
wenzelm@60309
    30
  | is_ratpolyexp (Const (\<^const_name>\<open>plus\<close>,_) $ t1 $ t2) = 
neuper@52105
    31
               ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
wenzelm@60309
    32
  | is_ratpolyexp (Const (\<^const_name>\<open>minus\<close>,_) $ t1 $ t2) = 
neuper@52105
    33
               ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
wenzelm@60309
    34
  | is_ratpolyexp (Const (\<^const_name>\<open>times\<close>,_) $ t1 $ t2) = 
neuper@52105
    35
               ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
wenzelm@60309
    36
  | is_ratpolyexp (Const (\<^const_name>\<open>powr\<close>,_) $ t1 $ t2) = 
neuper@52105
    37
               ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
wenzelm@60309
    38
  | is_ratpolyexp (Const (\<^const_name>\<open>divide\<close>,_) $ t1 $ t2) = 
neuper@52105
    39
               ((is_ratpolyexp t1) andalso (is_ratpolyexp t2))
neuper@52105
    40
  | is_ratpolyexp _ = false;
neuper@37950
    41
walther@60278
    42
(*("is_ratpolyexp", ("Rational.is_ratpolyexp", eval_is_ratpolyexp ""))*)
neuper@52105
    43
fun eval_is_ratpolyexp (thmid:string) _ 
walther@60335
    44
		       (t as (Const (\<^const_name>\<open>Rational.is_ratpolyexp\<close>, _) $ arg)) thy =
neuper@52105
    45
    if is_ratpolyexp arg
walther@59870
    46
    then SOME (TermC.mk_thmid thmid (UnparseC.term_in_thy thy arg) "", 
wneuper@59390
    47
	         HOLogic.Trueprop $ (TermC.mk_equality (t, @{term True})))
walther@59870
    48
    else SOME (TermC.mk_thmid thmid (UnparseC.term_in_thy thy arg) "", 
wneuper@59390
    49
	         HOLogic.Trueprop $ (TermC.mk_equality (t, @{term False})))
neuper@52105
    50
  | eval_is_ratpolyexp _ _ _ _ = NONE; 
neuper@52105
    51
neuper@52105
    52
(*("get_denominator", ("Rational.get_denominator", eval_get_denominator ""))*)
neuper@52105
    53
fun eval_get_denominator (thmid:string) _ 
walther@60335
    54
		      (t as Const (\<^const_name>\<open>Rational.get_denominator\<close>, _) $
wenzelm@60309
    55
              (Const (\<^const_name>\<open>divide\<close>, _) $ _(*num*) $
neuper@52105
    56
                denom)) thy = 
walther@59870
    57
      SOME (TermC.mk_thmid thmid (UnparseC.term_in_thy thy denom) "", 
wneuper@59390
    58
	            HOLogic.Trueprop $ (TermC.mk_equality (t, denom)))
neuper@52105
    59
  | eval_get_denominator _ _ _ _ = NONE; 
neuper@52105
    60
neuper@52105
    61
(*("get_numerator", ("Rational.get_numerator", eval_get_numerator ""))*)
neuper@52105
    62
fun eval_get_numerator (thmid:string) _ 
walther@60335
    63
      (t as Const (\<^const_name>\<open>Rational.get_numerator\<close>, _) $
wenzelm@60309
    64
          (Const (\<^const_name>\<open>divide\<close>, _) $num
neuper@52105
    65
            $denom )) thy = 
walther@59870
    66
    SOME (TermC.mk_thmid thmid (UnparseC.term_in_thy thy num) "", 
wneuper@59390
    67
	    HOLogic.Trueprop $ (TermC.mk_equality (t, num)))
neuper@52105
    68
  | eval_get_numerator _ _ _ _ = NONE; 
wneuper@59472
    69
\<close>
neuper@52105
    70
wneuper@59472
    71
section \<open>Theorems for rewriting\<close>
neuper@52105
    72
neuper@52105
    73
axiomatization (* naming due to Isabelle2002, but not contained in Isabelle2002; 
neuper@52105
    74
                  many thms are due to RL and can be removed with updating the equation solver;
neuper@52105
    75
                  TODO: replace by equivalent thms in recent Isabelle201x *) 
neuper@52105
    76
where
neuper@52105
    77
  mult_cross:      "[| b ~= 0; d ~= 0 |] ==> (a / b = c / d) = (a * d = b * c)" and
neuper@52105
    78
  mult_cross1:     "   b ~= 0            ==> (a / b = c    ) = (a     = b * c)" and
neuper@52105
    79
  mult_cross2:     "           d ~= 0    ==> (a     = c / d) = (a * d =     c)" and
neuper@37950
    80
                  
neuper@52105
    81
  add_minus:       "a + b - b = a"(*RL->Poly.thy*) and
neuper@52105
    82
  add_minus1:      "a - b + b = a"(*RL->Poly.thy*) and
neuper@37950
    83
                  
neuper@52105
    84
  rat_mult:        "a / b * (c / d) = a * c / (b * d)"(*?Isa02*)  and
neuper@52105
    85
  rat_mult2:       "a / b *  c      = a * c /  b     "(*?Isa02*) and
t@42211
    86
neuper@52105
    87
  rat_mult_poly_l: "c is_polyexp ==> c * (a / b) = c * a /  b" and
neuper@52105
    88
  rat_mult_poly_r: "c is_polyexp ==> (a / b) * c = a * c /  b" and
neuper@37906
    89
neuper@37906
    90
(*real_times_divide1_eq .. Isa02*) 
neuper@52105
    91
  real_times_divide_1_eq:  "-1 * (c / d) = -1 * c / d " and
neuper@52105
    92
  real_times_divide_num:   "a is_const ==> a * (c / d) = a * c / d " and
t@42211
    93
neuper@52105
    94
  real_mult_div_cancel2:   "k ~= 0 ==> m * k / (n * k) = m / n" and
neuper@37978
    95
(*real_mult_div_cancel1:   "k ~= 0 ==> k * m / (k * n) = m / n"..Isa02*)
neuper@37906
    96
			  
neuper@52105
    97
  real_divide_divide1:     "y ~= 0 ==> (u / v) / (y / z) = (u / v) * (z / y)" and
neuper@52105
    98
  real_divide_divide1_mg:  "y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)" and
neuper@37978
    99
(*real_divide_divide2_eq:  "x / y / z = x / (y * z)"..Isa02*)
neuper@37906
   100
			  
walther@60242
   101
  rat_power:               "(a / b) \<up> n = (a \<up> n) / (b \<up> n)" and
neuper@37978
   102
neuper@37978
   103
  rat_add:         "[| a is_const; b is_const; c is_const; d is_const |] ==> 
neuper@52105
   104
	           a / c + b / d = (a * d + b * c) / (c * d)" and
neuper@37978
   105
  rat_add_assoc:   "[| a is_const; b is_const; c is_const; d is_const |] ==> 
neuper@52105
   106
	           a / c +(b / d + e) = (a * d + b * c)/(d * c) + e" and
neuper@37978
   107
  rat_add1:        "[| a is_const; b is_const; c is_const |] ==> 
neuper@52105
   108
	           a / c + b / c = (a + b) / c" and
neuper@37978
   109
  rat_add1_assoc:   "[| a is_const; b is_const; c is_const |] ==> 
neuper@52105
   110
	           a / c + (b / c + e) = (a + b) / c + e" and
neuper@37978
   111
  rat_add2:        "[| a is_const; b is_const; c is_const |] ==> 
neuper@52105
   112
	           a / c + b = (a + b * c) / c" and
neuper@37978
   113
  rat_add2_assoc:  "[| a is_const; b is_const; c is_const |] ==> 
neuper@52105
   114
	           a / c + (b + e) = (a + b * c) / c + e" and
neuper@37978
   115
  rat_add3:        "[| a is_const; b is_const; c is_const |] ==> 
neuper@52105
   116
	           a + b / c = (a * c + b) / c" and
neuper@37978
   117
  rat_add3_assoc:   "[| a is_const; b is_const; c is_const |] ==> 
neuper@37950
   118
	           a + (b / c + e) = (a * c + b) / c + e"
neuper@37950
   119
wneuper@59472
   120
section \<open>Cancellation and addition of fractions\<close>
wneuper@59472
   121
subsection \<open>Conversion term <--> poly\<close>
wneuper@59472
   122
subsubsection \<open>Convert a term to the internal representation of a multivariate polynomial\<close>
wneuper@59472
   123
ML \<open>
wneuper@59532
   124
fun monom_of_term vs (c, es) (t as Const _) =
wneuper@59532
   125
    (c, list_update es (find_index (curry op = t) vs) 1)
walther@60335
   126
  | monom_of_term _ (c, es) (t as (Const (\<^const_name>\<open>numeral\<close>, _) $ _)) =
walther@60319
   127
    (t |> HOLogic.dest_number |> snd |> curry op * c, es) (*several numerals in one monom*)
walther@60335
   128
  | monom_of_term _ (c, es) (t as (Const (\<^const_name>\<open>uminus\<close>, _) $ _)) =
walther@60319
   129
    (t |> HOLogic.dest_number |> snd |> curry op * c, es) (*several numerals in one monom*)
walther@60318
   130
  | monom_of_term  vs (c, es) (t as Free _) =
walther@60318
   131
    (c, list_update es (find_index (curry op = t) vs) 1)
walther@60335
   132
  | monom_of_term  vs (c, es) (Const (\<^const_name>\<open>Transcendental.powr\<close>, _) $ (b as Free _) $
walther@60335
   133
      (e as Const (\<^const_name>\<open>numeral\<close>, _) $ _)) =
walther@60319
   134
    (c, list_update es (find_index (curry op = b) vs) (e |> HOLogic.dest_number |> snd))
walther@60335
   135
  | monom_of_term  vs (c, es) (Const (\<^const_name>\<open>Transcendental.powr\<close>, _) $ (b as Free _) $
walther@60335
   136
      (e as Const (\<^const_name>\<open>uminus\<close>, _) $ _)) =
walther@60319
   137
    (c, list_update es (find_index (curry op = b) vs) (e |> HOLogic.dest_number |> snd))
walther@60331
   138
wenzelm@60309
   139
  | monom_of_term vs (c, es) (Const (\<^const_name>\<open>times\<close>, _) $ m1 $ m2) =
neuper@52087
   140
    let val (c', es') = monom_of_term vs (c, es) m1
neuper@52087
   141
    in monom_of_term vs (c', es') m2 end
walther@59868
   142
  | monom_of_term _ _ t = raise ERROR ("poly malformed 1 with " ^ UnparseC.term t)
neuper@52087
   143
walther@60318
   144
(*-------v------*)
wneuper@59531
   145
fun monoms_of_term vs (t as Const _) =
wneuper@59531
   146
    [monom_of_term  vs (1, replicate (length vs) 0) t]
walther@60335
   147
  | monoms_of_term vs (t as Const (\<^const_name>\<open>numeral\<close>, _) $ _) =
walther@60319
   148
    [monom_of_term  vs (1, replicate (length vs) 0) t]
walther@60335
   149
  | monoms_of_term vs (t as Const (\<^const_name>\<open>uminus\<close>, _) $ _) =
walther@60319
   150
    [monom_of_term  vs (1, replicate (length vs) 0) t]
wneuper@59531
   151
  | monoms_of_term vs (t as Free _) =
neuper@52087
   152
    [monom_of_term  vs (1, replicate (length vs) 0) t]
wenzelm@60309
   153
  | monoms_of_term vs (t as Const (\<^const_name>\<open>powr\<close>, _) $ _ $  _) =
neuper@52087
   154
    [monom_of_term  vs (1, replicate (length vs) 0) t]
wenzelm@60309
   155
  | monoms_of_term vs (t as Const (\<^const_name>\<open>times\<close>, _) $ _ $  _) =
neuper@52087
   156
    [monom_of_term  vs (1, replicate (length vs) 0) t]
wenzelm@60309
   157
  | monoms_of_term vs (Const (\<^const_name>\<open>plus\<close>, _) $ ms1 $ ms2) =
neuper@52087
   158
    (monoms_of_term vs ms1) @ (monoms_of_term vs ms2)
walther@59868
   159
  | monoms_of_term _ t = raise ERROR ("poly malformed 2 with " ^ UnparseC.term t)
neuper@52087
   160
neuper@52087
   161
(* convert a term to the internal representation of a multivariate polynomial;
neuper@52087
   162
  the conversion is quite liberal, see test --- fun poly_of_term ---:
neuper@52087
   163
* the order of variables and the parentheses within a monomial are arbitrary
neuper@52087
   164
* the coefficient may be somewhere
neuper@52087
   165
* he order and the parentheses within monomials are arbitrary
neuper@52087
   166
But the term must be completely expand + over * (laws of distributivity are not applicable).
neuper@52087
   167
neuper@52087
   168
The function requires the free variables as strings already given, 
neuper@52087
   169
because the gcd involves 2 polynomials (with the same length for their list of exponents).
neuper@52087
   170
*)
wenzelm@60309
   171
fun poly_of_term vs (t as Const (\<^const_name>\<open>plus\<close>, _) $ _ $ _) =
neuper@52101
   172
    (SOME (t |> monoms_of_term vs |> order)
neuper@52087
   173
      handle ERROR _ => NONE)
neuper@52087
   174
  | poly_of_term vs t =
neuper@52101
   175
    (SOME [monom_of_term vs (1, replicate (length vs) 0) t]
neuper@52087
   176
      handle ERROR _ => NONE)
neuper@52087
   177
neuper@52087
   178
fun is_poly t =
wneuper@59532
   179
  let
wneuper@59532
   180
    val vs = TermC.vars_of t
neuper@52087
   181
  in 
neuper@52087
   182
    case poly_of_term vs t of SOME _ => true | NONE => false
neuper@52087
   183
  end
neuper@52105
   184
val is_expanded = is_poly   (* TODO: check names *)
neuper@52105
   185
val is_polynomial = is_poly (* TODO: check names *)
wneuper@59472
   186
\<close>
neuper@52087
   187
wneuper@59472
   188
subsubsection \<open>Convert internal representation of a multivariate polynomial to a term\<close>
wneuper@59472
   189
ML \<open>
neuper@52087
   190
fun term_of_es _ _ _ [] = [] (*assumes same length for vs and es*)
wneuper@59532
   191
  | term_of_es baseT expT (_ :: vs) (0 :: es) = [] @ term_of_es baseT expT vs es
wneuper@59532
   192
  | term_of_es baseT expT (v :: vs) (1 :: es) = v :: term_of_es baseT expT vs es
neuper@52087
   193
  | term_of_es baseT expT (v :: vs) (e :: es) =
walther@60335
   194
    Const (\<^const_name>\<open>Transcendental.powr\<close>, [baseT, expT] ---> baseT) $ v $ (HOLogic.mk_number expT e)
wneuper@59532
   195
    :: term_of_es baseT expT vs es
wneuper@59532
   196
  | term_of_es _ _ _ _ = raise ERROR "term_of_es: length vs <> length es"
neuper@52087
   197
neuper@52087
   198
fun term_of_monom baseT expT vs ((c, es): monom) =
neuper@52087
   199
    let val es' = term_of_es baseT expT vs es
neuper@52087
   200
    in 
neuper@52087
   201
      if c = 1 
neuper@52087
   202
      then 
neuper@52087
   203
        if es' = [] (*if es = [0,0,0,...]*)
walther@60317
   204
        then HOLogic.mk_number baseT c
neuper@52087
   205
        else foldl (HOLogic.mk_binop "Groups.times_class.times") (hd es', tl es')
walther@60317
   206
      else foldl (HOLogic.mk_binop "Groups.times_class.times")
walther@60317
   207
        (HOLogic.mk_number baseT c, es') 
neuper@52087
   208
    end
neuper@52087
   209
neuper@52087
   210
fun term_of_poly baseT expT vs p =
wneuper@59190
   211
  let val monos = map (term_of_monom baseT expT vs) p
wenzelm@60309
   212
  in foldl (HOLogic.mk_binop \<^const_name>\<open>plus\<close>) (hd monos, tl monos) end
wneuper@59472
   213
\<close>
neuper@52087
   214
wneuper@59472
   215
subsection \<open>Apply gcd_poly for cancelling and adding fractions as terms\<close>
wneuper@59472
   216
ML \<open>
neuper@52091
   217
fun mk_noteq_0 baseT t = 
walther@60335
   218
  Const (\<^const_name>\<open>Not\<close>, HOLogic.boolT --> HOLogic.boolT) $ 
walther@60335
   219
    (Const (\<^const_name>\<open>HOL.eq\<close>, [baseT, baseT] ---> HOLogic.boolT) $ t $ HOLogic.mk_number HOLogic.realT 0)
neuper@52091
   220
neuper@52094
   221
fun mk_asms baseT ts =
wneuper@59389
   222
  let val as' = filter_out TermC.is_num ts (* asm like "2 ~= 0" is needless *)
neuper@52094
   223
  in map (mk_noteq_0 baseT) as' end
wneuper@59472
   224
\<close>
neuper@52094
   225
wneuper@59472
   226
subsubsection \<open>Factor out gcd for cancellation\<close>
wneuper@59472
   227
ML \<open>
neuper@52091
   228
fun check_fraction t =
walther@60269
   229
  case t of
wenzelm@60309
   230
    Const (\<^const_name>\<open>divide\<close>, _) $ numerator $ denominator
walther@60269
   231
      => SOME (numerator, denominator)
walther@60269
   232
  | _ => NONE
neuper@52091
   233
neuper@52091
   234
(* prepare a term for cancellation by factoring out the gcd
neuper@52091
   235
  assumes: is a fraction with outmost "/"*)
neuper@52091
   236
fun factout_p_ (thy: theory) t =
neuper@52091
   237
  let val opt = check_fraction t
neuper@52091
   238
  in
neuper@52091
   239
    case opt of 
neuper@52091
   240
      NONE => NONE
neuper@52091
   241
    | SOME (numerator, denominator) =>
wneuper@59532
   242
      let
wneuper@59532
   243
        val vs = TermC.vars_of t
neuper@52091
   244
        val baseT = type_of numerator
neuper@52091
   245
        val expT = HOLogic.realT
neuper@52091
   246
      in
neuper@52091
   247
        case (poly_of_term vs numerator, poly_of_term vs denominator) of
neuper@52091
   248
          (SOME a, SOME b) =>
neuper@52091
   249
            let
neuper@52091
   250
              val ((a', b'), c) = gcd_poly a b
neuper@52096
   251
              val es = replicate (length vs) 0 
neuper@52096
   252
            in
neuper@52096
   253
              if c = [(1, es)] orelse c = [(~1, es)]
neuper@52096
   254
              then NONE
neuper@52096
   255
              else 
neuper@52096
   256
                let
neuper@52096
   257
                  val b't = term_of_poly baseT expT vs b'
neuper@52096
   258
                  val ct = term_of_poly baseT expT vs c
neuper@52096
   259
                  val t' = 
wenzelm@60309
   260
                    HOLogic.mk_binop \<^const_name>\<open>divide\<close> 
wenzelm@60309
   261
                      (HOLogic.mk_binop \<^const_name>\<open>times\<close>
wneuper@59190
   262
                        (term_of_poly baseT expT vs a', ct),
wenzelm@60309
   263
                       HOLogic.mk_binop \<^const_name>\<open>times\<close> (b't, ct))
neuper@52105
   264
                in SOME (t', mk_asms baseT [b't, ct]) end
neuper@52096
   265
            end
neuper@52091
   266
        | _ => NONE : (term * term list) option
neuper@52091
   267
      end
neuper@52091
   268
  end
wneuper@59472
   269
\<close>
neuper@52091
   270
wneuper@59472
   271
subsubsection \<open>Cancel a fraction\<close>
wneuper@59472
   272
ML \<open>
neuper@52096
   273
(* cancel a term by the gcd ("" denote terms with internal algebraic structure)
neuper@52096
   274
  cancel_p_ :: theory \<Rightarrow> term  \<Rightarrow> (term \<times> term list) option
neuper@52096
   275
  cancel_p_ thy "a / b" = SOME ("a' / b'", ["b' \<noteq> 0"])
neuper@52096
   276
  assumes: a is_polynomial  \<and>  b is_polynomial  \<and>  b \<noteq> 0
neuper@52096
   277
  yields
neuper@52096
   278
    SOME ("a' / b'", ["b' \<noteq> 0"]). gcd_poly a b \<noteq> 1  \<and>  gcd_poly a b \<noteq> -1  \<and>  
neuper@52096
   279
      a' * gcd_poly a b = a  \<and>  b' * gcd_poly a b = b
neuper@52096
   280
    \<or> NONE *)
neuper@52101
   281
fun cancel_p_ (_: theory) t =
neuper@52091
   282
  let val opt = check_fraction t
neuper@52091
   283
  in
neuper@52091
   284
    case opt of 
neuper@52091
   285
      NONE => NONE
neuper@52091
   286
    | SOME (numerator, denominator) =>
wneuper@59532
   287
      let
wneuper@59532
   288
        val vs = TermC.vars_of t
neuper@52091
   289
        val baseT = type_of numerator
neuper@52091
   290
        val expT = HOLogic.realT
neuper@52091
   291
      in
neuper@52091
   292
        case (poly_of_term vs numerator, poly_of_term vs denominator) of
neuper@52091
   293
          (SOME a, SOME b) =>
neuper@52091
   294
            let
neuper@52091
   295
              val ((a', b'), c) = gcd_poly a b
neuper@52096
   296
              val es = replicate (length vs) 0 
neuper@52096
   297
            in
neuper@52096
   298
              if c = [(1, es)] orelse c = [(~1, es)]
neuper@52096
   299
              then NONE
neuper@52096
   300
              else 
neuper@52096
   301
                let
neuper@52096
   302
                  val bt' = term_of_poly baseT expT vs b'
neuper@52096
   303
                  val ct = term_of_poly baseT expT vs c
neuper@52096
   304
                  val t' = 
wenzelm@60309
   305
                    HOLogic.mk_binop \<^const_name>\<open>divide\<close> 
wneuper@59190
   306
                      (term_of_poly baseT expT vs a', bt')
neuper@52096
   307
                  val asm = mk_asms baseT [bt']
neuper@52096
   308
                in SOME (t', asm) end
neuper@52096
   309
            end
neuper@52091
   310
        | _ => NONE : (term * term list) option
neuper@52091
   311
      end
neuper@52091
   312
  end
wneuper@59472
   313
\<close>
neuper@52091
   314
wneuper@59472
   315
subsubsection \<open>Factor out to a common denominator for addition\<close>
wneuper@59472
   316
ML \<open>
neuper@52101
   317
(* addition of fractions allows (at most) one non-fraction (a monomial) *)
neuper@52101
   318
fun check_frac_sum 
wenzelm@60309
   319
    (Const (\<^const_name>\<open>plus\<close>, _) $ 
wenzelm@60309
   320
      (Const (\<^const_name>\<open>divide\<close>, _) $ n1 $ d1) $
wenzelm@60309
   321
      (Const (\<^const_name>\<open>divide\<close>, _) $ n2 $ d2))
neuper@52091
   322
    = SOME ((n1, d1), (n2, d2))
neuper@52101
   323
  | check_frac_sum 
wenzelm@60309
   324
    (Const (\<^const_name>\<open>plus\<close>, _) $ 
neuper@52091
   325
      nofrac $ 
wenzelm@60309
   326
      (Const (\<^const_name>\<open>divide\<close>, _) $ n2 $ d2))
walther@60278
   327
    = SOME ((nofrac, Free ("1", HOLogic.realT)), (n2, d2))
neuper@52101
   328
  | check_frac_sum 
wenzelm@60309
   329
    (Const (\<^const_name>\<open>plus\<close>, _) $ 
wenzelm@60309
   330
      (Const (\<^const_name>\<open>divide\<close>, _) $ n1 $ d1) $ 
neuper@52091
   331
      nofrac)
walther@60317
   332
    = SOME ((n1, d1), (nofrac, HOLogic.mk_number HOLogic.realT 1))
neuper@52101
   333
  | check_frac_sum _ = NONE  
neuper@52091
   334
neuper@52091
   335
(* prepare a term for addition by providing the least common denominator as a product
neuper@52091
   336
  assumes: is a term with outmost "+" and at least one outmost "/" in respective summands*)
neuper@52101
   337
fun common_nominator_p_ (_: theory) t =
neuper@52101
   338
  let val opt = check_frac_sum t
neuper@52091
   339
  in
neuper@52091
   340
    case opt of 
neuper@52091
   341
      NONE => NONE
neuper@52091
   342
    | SOME ((n1, d1), (n2, d2)) =>
wneuper@59532
   343
      let
wneuper@59532
   344
        val vs = TermC.vars_of t
neuper@52091
   345
      in
neuper@52091
   346
        case (poly_of_term vs d1, poly_of_term vs d2) of
neuper@52091
   347
          (SOME a, SOME b) =>
neuper@52091
   348
            let
neuper@52091
   349
              val ((a', b'), c) = gcd_poly a b
neuper@52101
   350
              val (baseT, expT) = (type_of n1, HOLogic.realT)
wneuper@59190
   351
              val [d1', d2', c'] = map (term_of_poly baseT expT vs) [a', b', c]
neuper@52091
   352
              (*----- minimum of parentheses & nice result, but breaks tests: -------------
wenzelm@60309
   353
              val denom = HOLogic.mk_binop \<^const_name>\<open>times\<close> 
wenzelm@60309
   354
                (HOLogic.mk_binop \<^const_name>\<open>times\<close> (d1', d2'), c') -------------*)
neuper@52101
   355
              val denom =
neuper@52101
   356
                if c = [(1, replicate (length vs) 0)]
wenzelm@60309
   357
                then HOLogic.mk_binop \<^const_name>\<open>times\<close> (d1', d2')
neuper@52101
   358
                else
wenzelm@60309
   359
                  HOLogic.mk_binop \<^const_name>\<open>times\<close> (c',
wenzelm@60309
   360
                  HOLogic.mk_binop \<^const_name>\<open>times\<close> (d1', d2')) (*--------------*)
neuper@52091
   361
              val t' =
wenzelm@60309
   362
                HOLogic.mk_binop \<^const_name>\<open>plus\<close>
wenzelm@60309
   363
                  (HOLogic.mk_binop \<^const_name>\<open>divide\<close>
wenzelm@60309
   364
                    (HOLogic.mk_binop \<^const_name>\<open>times\<close> (n1, d2'), denom),
wenzelm@60309
   365
                  HOLogic.mk_binop \<^const_name>\<open>divide\<close> 
wenzelm@60309
   366
                    (HOLogic.mk_binop \<^const_name>\<open>times\<close> (n2, d1'), denom))
neuper@52094
   367
              val asm = mk_asms baseT [d1', d2', c']
neuper@52091
   368
            in SOME (t', asm) end
neuper@52091
   369
        | _ => NONE : (term * term list) option
neuper@52091
   370
      end
neuper@52091
   371
  end
wneuper@59472
   372
\<close>
neuper@52105
   373
wneuper@59472
   374
subsubsection \<open>Addition of at least one fraction within a sum\<close>
wneuper@59472
   375
ML \<open>
neuper@52091
   376
(* add fractions
neuper@52100
   377
  assumes: is a term with outmost "+" and at least one outmost "/" in respective summands
neuper@52100
   378
  NOTE: the case "(_ + _) + _" need not be considered due to iterated addition.*)
neuper@52105
   379
fun add_fraction_p_ (_: theory) t =
neuper@52101
   380
  case check_frac_sum t of 
neuper@52101
   381
    NONE => NONE
neuper@52101
   382
  | SOME ((n1, d1), (n2, d2)) =>
wneuper@59532
   383
    let
wneuper@59532
   384
      val vs = TermC.vars_of t
neuper@52101
   385
    in
neuper@52101
   386
      case (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) of
neuper@52101
   387
        (SOME _, SOME a, SOME _, SOME b) =>
neuper@52101
   388
          let
neuper@52101
   389
            val ((a', b'), c) = gcd_poly a b
neuper@52101
   390
            val (baseT, expT) = (type_of n1, HOLogic.realT)
neuper@52101
   391
            val nomin = term_of_poly baseT expT vs 
neuper@52101
   392
              (((the (poly_of_term vs n1)) %%*%% b') %%+%% ((the (poly_of_term vs n2)) %%*%% a')) 
neuper@52101
   393
            val denom = term_of_poly baseT expT vs ((c %%*%% a') %%*%% b')
wenzelm@60309
   394
            val t' = HOLogic.mk_binop \<^const_name>\<open>divide\<close> (nomin, denom)
neuper@52101
   395
          in SOME (t', mk_asms baseT [denom]) end
neuper@52101
   396
      | _ => NONE : (term * term list) option
neuper@52101
   397
    end
wneuper@59472
   398
\<close>
neuper@52091
   399
wneuper@59472
   400
section \<open>Embed cancellation and addition into rewriting\<close>
wenzelm@60291
   401
wneuper@59472
   402
subsection \<open>Rulesets and predicate for embedding\<close>
wneuper@59472
   403
ML \<open>
neuper@52105
   404
(* evaluates conditions in calculate_Rational *)
neuper@52105
   405
val calc_rat_erls =
s1210629013@55444
   406
  prep_rls'
walther@59857
   407
    (Rule_Def.Repeat {id = "calc_rat_erls", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59852
   408
      erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@52105
   409
      rules = 
walther@60320
   410
       [Rule.Eval ("Prog_Expr.matches", Prog_Expr.eval_matches "#matches_"),
walther@60320
   411
        Rule.Eval ("HOL.eq", Prog_Expr.eval_equal "#equal_"),
walther@60278
   412
        Rule.Eval ("Prog_Expr.is_const", Prog_Expr.eval_const "#is_const_"),
walther@59871
   413
        Rule.Thm ("not_true", ThmC.numerals_to_Free @{thm not_true}),
walther@59871
   414
        Rule.Thm ("not_false", ThmC.numerals_to_Free @{thm not_false})], 
walther@59878
   415
      scr = Rule.Empty_Prog});
neuper@37950
   416
neuper@52105
   417
(* simplifies expressions with numerals;
neuper@52105
   418
   does NOT rearrange the term by AC-rewriting; thus terms with variables 
neuper@52105
   419
   need to have constants to be commuted together respectively           *)
neuper@52105
   420
val calculate_Rational =
walther@59852
   421
  prep_rls' (Rule_Set.merge "calculate_Rational"
walther@59857
   422
    (Rule_Def.Repeat {id = "divide", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59851
   423
      erls = calc_rat_erls, srls = Rule_Set.Empty,
neuper@52105
   424
      calc = [], errpatts = [],
neuper@52105
   425
      rules = 
wenzelm@60294
   426
        [\<^rule_eval>\<open>divide\<close> (Prog_Expr.eval_cancel "#divide_e"),
neuper@37950
   427
walther@59871
   428
        Rule.Thm ("minus_divide_left", ThmC.numerals_to_Free (@{thm minus_divide_left} RS @{thm sym})),
neuper@52105
   429
          (*SYM - ?x / ?y = - (?x / ?y)  may come from subst*)
wenzelm@60297
   430
        \<^rule_thm>\<open>rat_add\<close>,
neuper@52105
   431
          (*"[| a is_const; b is_const; c is_const; d is_const |] ==> \
neuper@52105
   432
          \a / c + b / d = (a * d) / (c * d) + (b * c ) / (d * c)"*)
wenzelm@60297
   433
        \<^rule_thm>\<open>rat_add1\<close>,
neuper@52105
   434
          (*"[| a is_const; b is_const; c is_const |] ==> a / c + b / c = (a + b) / c"*)
wenzelm@60297
   435
        \<^rule_thm>\<open>rat_add2\<close>,
neuper@52105
   436
          (*"[| ?a is_const; ?b is_const; ?c is_const |] ==> ?a / ?c + ?b = (?a + ?b * ?c) / ?c"*)
wenzelm@60297
   437
        \<^rule_thm>\<open>rat_add3\<close>,
neuper@52105
   438
          (*"[| a is_const; b is_const; c is_const |] ==> a + b / c = (a * c) / c + b / c"\
neuper@52105
   439
          .... is_const to be omitted here FIXME*)
neuper@52105
   440
        
wenzelm@60297
   441
        \<^rule_thm>\<open>rat_mult\<close>, 
neuper@52105
   442
          (*a / b * (c / d) = a * c / (b * d)*)
wenzelm@60297
   443
        \<^rule_thm>\<open>times_divide_eq_right\<close>,
neuper@52105
   444
          (*?x * (?y / ?z) = ?x * ?y / ?z*)
wenzelm@60297
   445
        \<^rule_thm>\<open>times_divide_eq_left\<close>,
neuper@52105
   446
          (*?y / ?z * ?x = ?y * ?x / ?z*)
neuper@52105
   447
        
wenzelm@60297
   448
        \<^rule_thm>\<open>real_divide_divide1\<close>,
neuper@52105
   449
          (*"?y ~= 0 ==> ?u / ?v / (?y / ?z) = ?u / ?v * (?z / ?y)"*)
wenzelm@60297
   450
        \<^rule_thm>\<open>divide_divide_eq_left\<close>,
neuper@52105
   451
          (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
neuper@52105
   452
        
wenzelm@60297
   453
        \<^rule_thm>\<open>rat_power\<close>,
walther@60260
   454
          (*"(?a / ?b)  \<up>  ?n = ?a  \<up>  ?n / ?b  \<up>  ?n"*)
neuper@52105
   455
        
wenzelm@60297
   456
        \<^rule_thm>\<open>mult_cross\<close>,
neuper@52105
   457
          (*"[| b ~= 0; d ~= 0 |] ==> (a / b = c / d) = (a * d = b * c)*)
wenzelm@60297
   458
        \<^rule_thm>\<open>mult_cross1\<close>,
neuper@52105
   459
          (*"   b ~= 0            ==> (a / b = c    ) = (a     = b * c)*)
wenzelm@60297
   460
        \<^rule_thm>\<open>mult_cross2\<close>
neuper@52105
   461
          (*"           d ~= 0    ==> (a     = c / d) = (a * d =     c)*)], 
walther@59878
   462
      scr = Rule.Empty_Prog})
neuper@52105
   463
    calculate_Poly);
neuper@37950
   464
walther@60278
   465
(*("is_expanded", ("Rational.is_expanded", eval_is_expanded ""))*)
neuper@37950
   466
fun eval_is_expanded (thmid:string) _ 
walther@60335
   467
		       (t as (Const (\<^const_name>\<open>Rational.is_expanded\<close>, _) $ arg)) thy = 
neuper@37950
   468
    if is_expanded arg
walther@59870
   469
    then SOME (TermC.mk_thmid thmid (UnparseC.term_in_thy thy arg) "", 
wneuper@59390
   470
	         HOLogic.Trueprop $ (TermC.mk_equality (t, @{term True})))
walther@59870
   471
    else SOME (TermC.mk_thmid thmid (UnparseC.term_in_thy thy arg) "", 
wneuper@59390
   472
	         HOLogic.Trueprop $ (TermC.mk_equality (t, @{term False})))
s1210629013@52159
   473
  | eval_is_expanded _ _ _ _ = NONE;
wneuper@59472
   474
\<close>
wenzelm@60313
   475
calculation is_expanded = \<open>eval_is_expanded ""\<close>
wneuper@59472
   476
ML \<open>
neuper@37950
   477
val rational_erls = 
walther@59852
   478
  Rule_Set.merge "rational_erls" calculate_Rational 
walther@59852
   479
    (Rule_Set.append_rules "is_expanded" Atools_erls 
wenzelm@60294
   480
      [\<^rule_eval>\<open>is_expanded\<close> (eval_is_expanded "")]);
wneuper@59472
   481
\<close>
neuper@37950
   482
wneuper@59472
   483
subsection \<open>Embed cancellation into rewriting\<close>
wneuper@59472
   484
ML \<open>
walther@59603
   485
(**)local (* cancel_p *)
neuper@37950
   486
walther@59852
   487
val {rules = rules, rew_ord = (_, ro), ...} = Rule_Set.rep (assoc_rls' @{theory} "rev_rew_p");
neuper@37950
   488
neuper@52105
   489
fun init_state thy eval_rls ro t =
neuper@52105
   490
  let
neuper@52105
   491
    val SOME (t', _) = factout_p_ thy t;
neuper@52105
   492
    val SOME (t'', asm) = cancel_p_ thy t;
walther@59907
   493
    val der = Derive.steps_reverse thy eval_rls rules ro NONE t';
neuper@52105
   494
    val der = der @ 
wenzelm@60297
   495
      [(\<^rule_thm>\<open>real_mult_div_cancel2\<close>, (t'', asm))]
walther@60017
   496
    val rs = (Rule.distinct' o (map #1)) der
walther@60017
   497
  	val rs = filter_out (ThmC.member'
neuper@52105
   498
  	  ["sym_real_add_zero_left", "sym_real_mult_0", "sym_real_mult_1"]) rs
neuper@52105
   499
  in (t, t'', [rs(*one in order to ease locate_rule*)], der) end;
neuper@37950
   500
neuper@52105
   501
fun locate_rule thy eval_rls ro [rs] t r =
walther@59876
   502
    if member op = ((map (Rule.thm_id)) rs) (Rule.thm_id r)
neuper@52105
   503
    then 
walther@59876
   504
      let val ropt = Rewrite.rewrite_ thy ro eval_rls true (Rule.thm r) t;
neuper@52105
   505
      in
neuper@52105
   506
        case ropt of SOME ta => [(r, ta)]
walther@59733
   507
	      | NONE => ((*tracing 
walther@59876
   508
	          ("### locate_rule:  rewrite " ^ Rule.thm_id r ^ " " ^ UnparseC.term t ^ " = NONE");*) []) 
neuper@52105
   509
			end
walther@59876
   510
    else ((*tracing ("### locate_rule:  " ^ Rule.thm_id r ^ " not mem rrls");*) [])
walther@59962
   511
  | locate_rule _ _ _ _ _ _ = raise ERROR "locate_rule: doesnt match rev-sets in istate";
neuper@37950
   512
neuper@52105
   513
fun next_rule thy eval_rls ro [rs] t =
neuper@52105
   514
    let
walther@59907
   515
      val der = Derive.do_one thy eval_rls rs ro NONE t;
neuper@52105
   516
    in case der of (_, r, _) :: _ => SOME r | _ => NONE end
walther@59962
   517
  | next_rule _ _ _ _ _ = raise ERROR ("next_rule: doesnt match rev-sets in istate");
neuper@37950
   518
wneuper@59416
   519
fun attach_form (_: Rule.rule list list) (_: term) (_: term) = 
wneuper@59416
   520
  [(*TODO*)]: ( Rule.rule * (term * term list)) list;
neuper@37950
   521
walther@59861
   522
(**)in(**)
neuper@37950
   523
neuper@52105
   524
val cancel_p = 
walther@59850
   525
  Rule_Set.Rrls {id = "cancel_p", prepat = [],
wenzelm@60291
   526
	rew_ord=("ord_make_polynomial", ord_make_polynomial false \<^theory>),
neuper@52105
   527
	erls = rational_erls, 
neuper@52105
   528
	calc = 
wenzelm@60309
   529
	  [("PLUS", (\<^const_name>\<open>plus\<close>, (**)eval_binop "#add_")),
wenzelm@60309
   530
	  ("TIMES" , (\<^const_name>\<open>times\<close>, (**)eval_binop "#mult_")),
wenzelm@60309
   531
	  ("DIVIDE", (\<^const_name>\<open>divide\<close>, Prog_Expr.eval_cancel "#divide_e")),
wenzelm@60309
   532
	  ("POWER", (\<^const_name>\<open>powr\<close>, (**)eval_binop "#power_"))],
neuper@52105
   533
    errpatts = [],
neuper@52105
   534
	scr =
wenzelm@60291
   535
	  Rule.Rfuns {init_state  = init_state \<^theory> Atools_erls ro,
wenzelm@60291
   536
		normal_form = cancel_p_ \<^theory>, 
wenzelm@60291
   537
		locate_rule = locate_rule \<^theory> Atools_erls ro,
wenzelm@60291
   538
		next_rule   = next_rule \<^theory> Atools_erls ro,
neuper@52105
   539
		attach_form = attach_form}}
walther@59861
   540
(**)end(* local cancel_p *)
wneuper@59472
   541
\<close>
neuper@37950
   542
wneuper@59472
   543
subsection \<open>Embed addition into rewriting\<close>
wneuper@59472
   544
ML \<open>
walther@59861
   545
(**)local (* add_fractions_p *)
neuper@37950
   546
walther@59852
   547
(*val {rules = rules, rew_ord = (_, ro), ...} = Rule_Set.rep (assoc_rls "make_polynomial");*)
walther@59852
   548
val {rules, rew_ord=(_,ro),...} = Rule_Set.rep (assoc_rls' @{theory} "rev_rew_p");
neuper@37950
   549
neuper@52105
   550
fun init_state thy eval_rls ro t =
neuper@52105
   551
  let 
neuper@52105
   552
    val SOME (t',_) = common_nominator_p_ thy t;
neuper@52105
   553
    val SOME (t'', asm) = add_fraction_p_ thy t;
walther@59907
   554
    val der = Derive.steps_reverse thy eval_rls rules ro NONE t';
neuper@52105
   555
    val der = der @ 
wenzelm@60297
   556
      [(\<^rule_thm>\<open>real_mult_div_cancel2\<close>, (t'',asm))]
walther@60017
   557
    val rs = (Rule.distinct' o (map #1)) der;
walther@60017
   558
    val rs = filter_out (ThmC.member'
neuper@52105
   559
      ["sym_real_add_zero_left", "sym_real_mult_0", "sym_real_mult_1"]) rs;
neuper@52105
   560
  in (t, t'', [rs(*here only _ONE_*)], der) end;
neuper@37950
   561
neuper@52105
   562
fun locate_rule thy eval_rls ro [rs] t r =
walther@59876
   563
    if member op = ((map (Rule.thm_id)) rs) (Rule.thm_id r)
neuper@52105
   564
    then 
walther@59876
   565
      let val ropt = Rewrite.rewrite_ thy ro eval_rls true (Rule.thm r) t;
neuper@52105
   566
      in 
neuper@52105
   567
        case ropt of
neuper@52105
   568
          SOME ta => [(r, ta)]
neuper@52105
   569
	      | NONE => 
walther@59876
   570
	        ((*tracing ("### locate_rule:  rewrite " ^ Rule.thm_id r ^ " " ^ UnparseC.term t ^ " = NONE");*)
neuper@52105
   571
	        []) end
walther@59876
   572
    else ((*tracing ("### locate_rule:  " ^ Rule.thm_id r ^ " not mem rrls");*) [])
walther@59962
   573
  | locate_rule _ _ _ _ _ _ = raise ERROR "locate_rule: doesnt match rev-sets in istate";
neuper@37950
   574
neuper@37950
   575
fun next_rule thy eval_rls ro [rs] t =
walther@59907
   576
    let val der = Derive.do_one thy eval_rls rs ro NONE t;
neuper@52105
   577
    in 
neuper@52105
   578
      case der of
neuper@52105
   579
	      (_,r,_)::_ => SOME r
neuper@52105
   580
	    | _ => NONE
neuper@37950
   581
    end
walther@59962
   582
  | next_rule _ _ _ _ _ = raise ERROR ("next_rule: doesnt match rev-sets in istate");
neuper@37950
   583
wenzelm@60291
   584
val pat0 = TermC.parse_patt \<^theory> "?r/?s+?u/?v :: real";
wenzelm@60291
   585
val pat1 = TermC.parse_patt \<^theory> "?r/?s+?u    :: real";
wenzelm@60291
   586
val pat2 = TermC.parse_patt \<^theory> "?r   +?u/?v :: real";
neuper@48760
   587
val prepat = [([@{term True}], pat0),
neuper@48760
   588
	      ([@{term True}], pat1),
neuper@48760
   589
	      ([@{term True}], pat2)];
walther@59861
   590
(**)in(**)
neuper@37950
   591
neuper@52105
   592
val add_fractions_p =
walther@59850
   593
  Rule_Set.Rrls {id = "add_fractions_p", prepat=prepat,
wenzelm@60291
   594
    rew_ord = ("ord_make_polynomial", ord_make_polynomial false \<^theory>),
neuper@52105
   595
    erls = rational_erls,
wenzelm@60309
   596
    calc = [("PLUS", (\<^const_name>\<open>plus\<close>, (**)eval_binop "#add_")),
wenzelm@60309
   597
      ("TIMES", (\<^const_name>\<open>times\<close>, (**)eval_binop "#mult_")),
wenzelm@60309
   598
      ("DIVIDE", (\<^const_name>\<open>divide\<close>, Prog_Expr.eval_cancel "#divide_e")),
wenzelm@60309
   599
      ("POWER", (\<^const_name>\<open>powr\<close>, (**)eval_binop "#power_"))],
neuper@52105
   600
    errpatts = [],
wenzelm@60291
   601
    scr = Rule.Rfuns {init_state  = init_state \<^theory> Atools_erls ro,
wenzelm@60291
   602
      normal_form = add_fraction_p_ \<^theory>,
wenzelm@60291
   603
      locate_rule = locate_rule \<^theory> Atools_erls ro,
wenzelm@60291
   604
      next_rule   = next_rule \<^theory> Atools_erls ro,
neuper@52105
   605
      attach_form = attach_form}}
walther@59861
   606
(**)end(*local add_fractions_p *)
wneuper@59472
   607
\<close>
neuper@37950
   608
wneuper@59472
   609
subsection \<open>Cancelling and adding all occurrences in a term /////////////////////////////\<close>
wneuper@59472
   610
ML \<open>
neuper@52105
   611
(*copying cancel_p_rls + add her caused error in interface.sml*)
wneuper@59472
   612
\<close>
neuper@42451
   613
wneuper@59472
   614
section \<open>Rulesets for general simplification\<close>
wneuper@59472
   615
ML \<open>
neuper@37950
   616
(*.all powers over + distributed; atoms over * collected, other distributed
neuper@37950
   617
   contains absolute minimum of thms for context in norm_Rational .*)
s1210629013@55444
   618
val powers = prep_rls'(
walther@59857
   619
  Rule_Def.Repeat {id = "powers", preconds = [], rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
walther@59851
   620
      erls = powers_erls, srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60297
   621
      rules = [\<^rule_thm>\<open>realpow_multI\<close>,
walther@60260
   622
	       (*"(r * s)  \<up>  n = r  \<up>  n * s  \<up>  n"*)
wenzelm@60297
   623
	       \<^rule_thm>\<open>realpow_pow\<close>,
walther@60260
   624
	       (*"(a  \<up>  b)  \<up>  c = a  \<up>  (b * c)"*)
wenzelm@60297
   625
	       \<^rule_thm>\<open>realpow_oneI\<close>,
walther@60260
   626
	       (*"r  \<up>  1 = r"*)
wenzelm@60297
   627
	       \<^rule_thm>\<open>realpow_minus_even\<close>,
walther@60260
   628
	       (*"n is_even ==> (- r)  \<up>  n = r  \<up>  n" ?-->discard_minus?*)
wenzelm@60297
   629
	       \<^rule_thm>\<open>realpow_minus_odd\<close>,
walther@60260
   630
	       (*"Not (n is_even) ==> (- r)  \<up>  n = -1 * r  \<up>  n"*)
neuper@37950
   631
	       
neuper@37950
   632
	       (*----- collect atoms over * -----*)
wenzelm@60297
   633
	       \<^rule_thm>\<open>realpow_two_atom\<close>,	
walther@60260
   634
	       (*"r is_atom ==> r * r = r  \<up>  2"*)
wenzelm@60297
   635
	       \<^rule_thm>\<open>realpow_plus_1\<close>,		
walther@60260
   636
	       (*"r is_atom ==> r * r  \<up>  n = r  \<up>  (n + 1)"*)
wenzelm@60297
   637
	       \<^rule_thm>\<open>realpow_addI_atom\<close>,
walther@60260
   638
	       (*"r is_atom ==> r  \<up>  n * r  \<up>  m = r  \<up>  (n + m)"*)
neuper@37950
   639
neuper@37950
   640
	       (*----- distribute none-atoms -----*)
wenzelm@60297
   641
	       \<^rule_thm>\<open>realpow_def_atom\<close>,
walther@60276
   642
	       (*"[| 1 < n; ~ (r is_atom) |]==>r  \<up>  n = r * r  \<up>  (n + -1)"*)
wenzelm@60297
   643
	       \<^rule_thm>\<open>realpow_eq_oneI\<close>,
walther@60260
   644
	       (*"1  \<up>  n = 1"*)
wenzelm@60294
   645
	       \<^rule_eval>\<open>plus\<close> (**)(eval_binop "#add_")
neuper@37950
   646
	       ],
walther@59878
   647
      scr = Rule.Empty_Prog
wneuper@59406
   648
      });
neuper@37950
   649
(*.contains absolute minimum of thms for context in norm_Rational.*)
s1210629013@55444
   650
val rat_mult_divide = prep_rls'(
walther@59851
   651
  Rule_Def.Repeat {id = "rat_mult_divide", preconds = [], 
walther@59857
   652
      rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59852
   653
      erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60297
   654
      rules = [\<^rule_thm>\<open>rat_mult\<close>,
neuper@37950
   655
	       (*(1)"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
wenzelm@60297
   656
	       \<^rule_thm>\<open>times_divide_eq_right\<close>,
neuper@37950
   657
	       (*(2)"?a * (?c / ?d) = ?a * ?c / ?d" must be [2],
neuper@37950
   658
	       otherwise inv.to a / b / c = ...*)
wenzelm@60297
   659
	       \<^rule_thm>\<open>times_divide_eq_left\<close>,
walther@60260
   660
	       (*"?a / ?b * ?c = ?a * ?c / ?b" order weights x \<up> n too much
walther@60260
   661
		     and does not commute a / b * c  \<up>  2 !*)
neuper@37950
   662
	       
wenzelm@60298
   663
	       \<^rule_thm>\<open>divide_divide_eq_right\<close>,
neuper@37950
   664
	       (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
wenzelm@60298
   665
	       \<^rule_thm>\<open>divide_divide_eq_left\<close>,
neuper@37950
   666
	       (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
wenzelm@60294
   667
	       \<^rule_eval>\<open>divide\<close> (Prog_Expr.eval_cancel "#divide_e")
neuper@37950
   668
	       ],
walther@59878
   669
      scr = Rule.Empty_Prog
wneuper@59406
   670
      });
neuper@37979
   671
neuper@37950
   672
(*.contains absolute minimum of thms for context in norm_Rational.*)
s1210629013@55444
   673
val reduce_0_1_2 = prep_rls'(
walther@59857
   674
  Rule_Def.Repeat{id = "reduce_0_1_2", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord),
walther@59852
   675
      erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60297
   676
      rules = [(*\<^rule_thm>\<open>divide_1\<close>,
neuper@37950
   677
		 "?x / 1 = ?x" unnecess.for normalform*)
wenzelm@60297
   678
	       \<^rule_thm>\<open>mult_1_left\<close>,                 
neuper@37950
   679
	       (*"1 * z = z"*)
wenzelm@60297
   680
	       (*\<^rule_thm>\<open>real_mult_minus1\<close>,
neuper@37950
   681
	       "-1 * z = - z"*)
wenzelm@60297
   682
	       (*\<^rule_thm>\<open>real_minus_mult_cancel\<close>,
neuper@37950
   683
	       "- ?x * - ?y = ?x * ?y"*)
neuper@37950
   684
wenzelm@60297
   685
	       \<^rule_thm>\<open>mult_zero_left\<close>,        
neuper@37950
   686
	       (*"0 * z = 0"*)
wenzelm@60297
   687
	       \<^rule_thm>\<open>add_0_left\<close>,
neuper@37950
   688
	       (*"0 + z = z"*)
wenzelm@60297
   689
	       (*\<^rule_thm>\<open>right_minus\<close>,
neuper@37950
   690
	       "?z + - ?z = 0"*)
neuper@37950
   691
wenzelm@60296
   692
	       \<^rule_thm_sym>\<open>real_mult_2\<close>,	
neuper@37950
   693
	       (*"z1 + z1 = 2 * z1"*)
wenzelm@60297
   694
	       \<^rule_thm>\<open>real_mult_2_assoc\<close>,
neuper@37950
   695
	       (*"z1 + (z1 + k) = 2 * z1 + k"*)
neuper@37950
   696
wenzelm@60297
   697
	       \<^rule_thm>\<open>division_ring_divide_zero\<close>
neuper@37950
   698
	       (*"0 / ?x = 0"*)
walther@59878
   699
	       ], scr = Rule.Empty_Prog});
neuper@37950
   700
neuper@37950
   701
(*erls for calculate_Rational; 
neuper@37950
   702
  make local with FIXX@ME result:term *term list WN0609???SKMG*)
s1210629013@55444
   703
val norm_rat_erls = prep_rls'(
walther@59857
   704
  Rule_Def.Repeat {id = "norm_rat_erls", preconds = [], rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
walther@59852
   705
      erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60294
   706
      rules = [\<^rule_eval>\<open>Prog_Expr.is_const\<close> (Prog_Expr.eval_const "#is_const_")
walther@59878
   707
	       ], scr = Rule.Empty_Prog});
neuper@37979
   708
neuper@52105
   709
(* consists of rls containing the absolute minimum of thms *)
neuper@37950
   710
(*040209: this version has been used by RL for his equations,
neuper@52105
   711
which is now replaced by MGs version "norm_Rational" below *)
s1210629013@55444
   712
val norm_Rational_min = prep_rls'(
walther@59857
   713
  Rule_Def.Repeat {id = "norm_Rational_min", preconds = [], rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
walther@59851
   714
      erls = norm_rat_erls, srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@37950
   715
      rules = [(*sequence given by operator precedence*)
wneuper@59416
   716
	       Rule.Rls_ discard_minus,
wneuper@59416
   717
	       Rule.Rls_ powers,
wneuper@59416
   718
	       Rule.Rls_ rat_mult_divide,
wneuper@59416
   719
	       Rule.Rls_ expand,
wneuper@59416
   720
	       Rule.Rls_ reduce_0_1_2,
wneuper@59416
   721
	       Rule.Rls_ order_add_mult,
wneuper@59416
   722
	       Rule.Rls_ collect_numerals,
wneuper@59416
   723
	       Rule.Rls_ add_fractions_p,
wneuper@59416
   724
	       Rule.Rls_ cancel_p
neuper@37950
   725
	       ],
walther@59878
   726
      scr = Rule.Empty_Prog});
neuper@37979
   727
s1210629013@55444
   728
val norm_Rational_parenthesized = prep_rls'(
walther@59878
   729
  Rule_Set.Sequence {id = "norm_Rational_parenthesized", preconds = []:term list, 
walther@59857
   730
       rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord),
walther@59851
   731
      erls = Atools_erls, srls = Rule_Set.Empty,
neuper@42451
   732
      calc = [], errpatts = [],
wneuper@59416
   733
      rules = [Rule.Rls_  norm_Rational_min,
wneuper@59416
   734
	       Rule.Rls_ discard_parentheses
neuper@37950
   735
	       ],
walther@59878
   736
      scr = Rule.Empty_Prog});      
neuper@37950
   737
neuper@37950
   738
(*WN030318???SK: simplifies all but cancel and common_nominator*)
neuper@37950
   739
val simplify_rational = 
walther@59852
   740
    Rule_Set.merge "simplify_rational" expand_binoms
walther@59852
   741
    (Rule_Set.append_rules "divide" calculate_Rational
wenzelm@60297
   742
		[\<^rule_thm>\<open>div_by_1\<close>,
neuper@37950
   743
		 (*"?x / 1 = ?x"*)
wenzelm@60297
   744
		 \<^rule_thm>\<open>rat_mult\<close>,
neuper@37950
   745
		 (*(1)"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
wenzelm@60297
   746
		 \<^rule_thm>\<open>times_divide_eq_right\<close>,
neuper@37950
   747
		 (*(2)"?a * (?c / ?d) = ?a * ?c / ?d" must be [2],
neuper@37950
   748
		 otherwise inv.to a / b / c = ...*)
wenzelm@60297
   749
		 \<^rule_thm>\<open>times_divide_eq_left\<close>,
neuper@37950
   750
		 (*"?a / ?b * ?c = ?a * ?c / ?b"*)
wenzelm@60297
   751
		 \<^rule_thm>\<open>add_minus\<close>,
neuper@37950
   752
		 (*"?a + ?b - ?b = ?a"*)
wenzelm@60297
   753
		 \<^rule_thm>\<open>add_minus1\<close>,
neuper@37950
   754
		 (*"?a - ?b + ?b = ?a"*)
wenzelm@60297
   755
		 \<^rule_thm>\<open>divide_minus1\<close>
neuper@37950
   756
		 (*"?x / -1 = - ?x"*)
neuper@37950
   757
		 ]);
wneuper@59472
   758
\<close>
wneuper@59472
   759
ML \<open>
s1210629013@55444
   760
val add_fractions_p_rls = prep_rls'(
walther@59857
   761
  Rule_Def.Repeat {id = "add_fractions_p_rls", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59852
   762
	  erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   763
	  rules = [Rule.Rls_ add_fractions_p], 
walther@59878
   764
	  scr = Rule.Empty_Prog});
neuper@37950
   765
walther@59851
   766
(* "Rule_Def.Repeat" causes repeated application of cancel_p to one and the same term *)
s1210629013@55444
   767
val cancel_p_rls = prep_rls'(
walther@59851
   768
  Rule_Def.Repeat 
walther@59857
   769
    {id = "cancel_p_rls", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59852
   770
    erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   771
    rules = [Rule.Rls_ cancel_p], 
walther@59878
   772
	  scr = Rule.Empty_Prog});
neuper@52105
   773
neuper@37950
   774
(*. makes 'normal' fractions; 'is_polyexp' inhibits double fractions;
neuper@37950
   775
    used in initial part norm_Rational_mg, see example DA-M02-main.p.60.*)
s1210629013@55444
   776
val rat_mult_poly = prep_rls'(
walther@59857
   777
  Rule_Def.Repeat {id = "rat_mult_poly", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
wenzelm@60294
   778
	  erls = Rule_Set.append_rules "Rule_Set.empty-is_polyexp" Rule_Set.empty
wenzelm@60294
   779
      [\<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp "")],
walther@59851
   780
	  srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@52105
   781
	  rules = 
wenzelm@60297
   782
	    [\<^rule_thm>\<open>rat_mult_poly_l\<close>,
neuper@52105
   783
	    (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
wenzelm@60297
   784
	    \<^rule_thm>\<open>rat_mult_poly_r\<close>
neuper@52105
   785
	    (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*) ], 
walther@59878
   786
	  scr = Rule.Empty_Prog});
neuper@37979
   787
neuper@37950
   788
(*. makes 'normal' fractions; 'is_polyexp' inhibits double fractions;
neuper@37950
   789
    used in looping part norm_Rational_rls, see example DA-M02-main.p.60 
walther@59852
   790
    .. WHERE THE LATTER DOES ALWAYS WORK, BECAUSE erls = Rule_Set.empty, 
wneuper@59416
   791
    I.E. THE RESPECTIVE ASSUMPTION IS STORED AND Rule.Thm APPLIED; WN051028 
neuper@37950
   792
    ... WN0609???MG.*)
s1210629013@55444
   793
val rat_mult_div_pow = prep_rls'(
walther@59857
   794
  Rule_Def.Repeat {id = "rat_mult_div_pow", preconds = [], rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
walther@59852
   795
    erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60297
   796
    rules = [\<^rule_thm>\<open>rat_mult\<close>,
neuper@52105
   797
      (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
wenzelm@60297
   798
      \<^rule_thm>\<open>rat_mult_poly_l\<close>,
neuper@52105
   799
      (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
wenzelm@60297
   800
      \<^rule_thm>\<open>rat_mult_poly_r\<close>,
neuper@52105
   801
      (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
neuper@52105
   802
      
wenzelm@60297
   803
      \<^rule_thm>\<open>real_divide_divide1_mg\<close>,
neuper@52105
   804
      (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
wenzelm@60297
   805
      \<^rule_thm>\<open>divide_divide_eq_right\<close>,
neuper@52105
   806
      (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
wenzelm@60297
   807
      \<^rule_thm>\<open>divide_divide_eq_left\<close>,
neuper@52105
   808
      (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
wenzelm@60294
   809
      \<^rule_eval>\<open>divide\<close> (Prog_Expr.eval_cancel "#divide_e"),
neuper@52105
   810
      
wenzelm@60297
   811
      \<^rule_thm>\<open>rat_power\<close>
walther@60260
   812
      (*"(?a / ?b)  \<up>  ?n = ?a  \<up>  ?n / ?b  \<up>  ?n"*)
neuper@52105
   813
      ],
walther@59878
   814
    scr = Rule.Empty_Prog});
neuper@37950
   815
s1210629013@55444
   816
val rat_reduce_1 = prep_rls'(
walther@59857
   817
  Rule_Def.Repeat {id = "rat_reduce_1", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59852
   818
    erls = Rule_Set.empty, srls = Rule_Set.Empty, calc = [], errpatts = [], 
neuper@52105
   819
    rules = 
wenzelm@60297
   820
      [\<^rule_thm>\<open>div_by_1\<close>,
neuper@52105
   821
      (*"?x / 1 = ?x"*)
wenzelm@60297
   822
      \<^rule_thm>\<open>mult_1_left\<close>           
neuper@52105
   823
      (*"1 * z = z"*)
neuper@52105
   824
      ],
walther@59878
   825
    scr = Rule.Empty_Prog});
neuper@52105
   826
neuper@52105
   827
(* looping part of norm_Rational *)
s1210629013@55444
   828
val norm_Rational_rls = prep_rls' (
walther@59857
   829
  Rule_Def.Repeat {id = "norm_Rational_rls", preconds = [], rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
walther@59851
   830
    erls = norm_rat_erls, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   831
    rules = [Rule.Rls_ add_fractions_p_rls,
wneuper@59416
   832
      Rule.Rls_ rat_mult_div_pow,
wneuper@59416
   833
      Rule.Rls_ make_rat_poly_with_parentheses,
wneuper@59416
   834
      Rule.Rls_ cancel_p_rls,
wneuper@59416
   835
      Rule.Rls_ rat_reduce_1
neuper@52105
   836
      ],
walther@59878
   837
    scr = Rule.Empty_Prog});
neuper@52105
   838
s1210629013@55444
   839
val norm_Rational = prep_rls' (
walther@59878
   840
  Rule_Set.Sequence 
walther@59857
   841
    {id = "norm_Rational", preconds = [], rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord), 
walther@59851
   842
    erls = norm_rat_erls, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   843
    rules = [Rule.Rls_ discard_minus,
wneuper@59416
   844
      Rule.Rls_ rat_mult_poly,             (* removes double fractions like a/b/c *)
wneuper@59416
   845
      Rule.Rls_ make_rat_poly_with_parentheses,
wneuper@59416
   846
      Rule.Rls_ cancel_p_rls,
wneuper@59416
   847
      Rule.Rls_ norm_Rational_rls,         (* the main rls, looping (#) *)
wneuper@59416
   848
      Rule.Rls_ discard_parentheses1       (* mult only *)
neuper@52100
   849
      ],
walther@59878
   850
    scr = Rule.Empty_Prog});
wneuper@59472
   851
\<close>
neuper@52125
   852
wenzelm@60289
   853
rule_set_knowledge
wenzelm@60286
   854
  calculate_Rational = calculate_Rational and
wenzelm@60286
   855
  calc_rat_erls = calc_rat_erls and
wenzelm@60286
   856
  rational_erls = rational_erls and
wenzelm@60286
   857
  cancel_p = cancel_p and
wenzelm@60286
   858
  add_fractions_p = add_fractions_p and
wenzelm@60286
   859
wenzelm@60286
   860
  add_fractions_p_rls = add_fractions_p_rls and
wenzelm@60286
   861
  powers_erls = powers_erls and
wenzelm@60286
   862
  powers = powers and
wenzelm@60286
   863
  rat_mult_divide = rat_mult_divide and
wenzelm@60286
   864
  reduce_0_1_2 = reduce_0_1_2 and
wenzelm@60286
   865
wenzelm@60286
   866
  rat_reduce_1 = rat_reduce_1 and
wenzelm@60286
   867
  norm_rat_erls = norm_rat_erls and
wenzelm@60286
   868
  norm_Rational = norm_Rational and
wenzelm@60286
   869
  norm_Rational_rls = norm_Rational_rls and
wenzelm@60286
   870
  norm_Rational_min = norm_Rational_min and
wenzelm@60286
   871
  norm_Rational_parenthesized = norm_Rational_parenthesized and
wenzelm@60286
   872
wenzelm@60286
   873
  rat_mult_poly = rat_mult_poly and
wenzelm@60286
   874
  rat_mult_div_pow = rat_mult_div_pow and
wenzelm@60286
   875
  cancel_p_rls = cancel_p_rls
neuper@37950
   876
wneuper@59472
   877
section \<open>A problem for simplification of rationals\<close>
wenzelm@60306
   878
wenzelm@60306
   879
problem pbl_simp_rat : "rational/simplification" =
wenzelm@60306
   880
  \<open>Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)]\<close>
wenzelm@60306
   881
  Method: "simplification/of_rationals"
wenzelm@60306
   882
  CAS: "Simplify t_t"
wenzelm@60306
   883
  Given: "Term t_t"
wenzelm@60306
   884
  Where: "t_t is_ratpolyexp"
wenzelm@60306
   885
  Find: "normalform n_n"
neuper@37950
   886
wneuper@59472
   887
section \<open>A methods for simplification of rationals\<close>
s1210629013@55373
   888
(*WN061025 this methods script is copied from (auto-generated) script
s1210629013@55373
   889
  of norm_Rational in order to ease repair on inform*)
wneuper@59545
   890
wneuper@59504
   891
partial_function (tailrec) simplify :: "real \<Rightarrow> real"
wneuper@59504
   892
  where
walther@59716
   893
"simplify term = (
walther@59637
   894
  (Try (Rewrite_Set ''discard_minus'') #>
walther@59637
   895
   Try (Rewrite_Set ''rat_mult_poly'') #>
walther@59637
   896
   Try (Rewrite_Set ''make_rat_poly_with_parentheses'') #>
walther@59637
   897
   Try (Rewrite_Set ''cancel_p_rls'') #>
walther@59635
   898
   (Repeat (
walther@59637
   899
     Try (Rewrite_Set ''add_fractions_p_rls'') #>
walther@59637
   900
     Try (Rewrite_Set ''rat_mult_div_pow'') #>
walther@59637
   901
     Try (Rewrite_Set ''make_rat_poly_with_parentheses'') #>
walther@59637
   902
     Try (Rewrite_Set ''cancel_p_rls'') #>
walther@59637
   903
     Try (Rewrite_Set ''rat_reduce_1''))) #>
walther@59635
   904
   Try (Rewrite_Set ''discard_parentheses1''))
walther@59716
   905
   term)"
wenzelm@60303
   906
wenzelm@60303
   907
wenzelm@60303
   908
method met_simp_rat : "simplification/of_rationals" =
wenzelm@60303
   909
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, 
wenzelm@60303
   910
    prls = Rule_Set.append_rules "simplification_of_rationals_prls" Rule_Set.empty 
wenzelm@60303
   911
      [(*for preds in where_*) \<^rule_eval>\<open>is_ratpolyexp\<close> (eval_is_ratpolyexp "")],
wenzelm@60303
   912
    crls = Rule_Set.empty, errpats = [], nrls = norm_Rational_rls}\<close>
wenzelm@60303
   913
  Program: simplify.simps
wenzelm@60303
   914
  Given: "Term t_t"
wenzelm@60303
   915
  Where: "t_t is_ratpolyexp"
wenzelm@60303
   916
  Find: "normalform n_n"
wenzelm@60303
   917
ML \<open>
walther@60278
   918
\<close> ML \<open>
wneuper@59472
   919
\<close>
neuper@52105
   920
end