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