src/Tools/isac/Knowledge/RootRatEq.thy
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 31 Aug 2010 16:38:22 +0200
branchisac-update-Isa09-2
changeset 37967 bd4f7a35e892
parent 37966 78938fc8e022
child 37969 81922154e742
permissions -rw-r--r--
updating Knowledge/Simplify, changes ahead + in test

# overwritelnthy thy --> overwritelnthy @{theory}
# test: thms-replace-Isa02-Isa09-2.sml @{thm ..}
neuper@37906
     1
(* collecting all knowledge for Root and Rational Equations
neuper@37906
     2
   created by: rlang 
neuper@37906
     3
         date: 02.10
neuper@37906
     4
   changed by: rlang
neuper@37906
     5
   last change by: rlang
neuper@37906
     6
             date: 02.11.04
neuper@37954
     7
   (c) by Richard Lang, 2003
neuper@37906
     8
*)
neuper@37906
     9
neuper@37954
    10
theory RootRatEq imports RootEq RatEq RootRat begin 
neuper@37906
    11
neuper@37906
    12
consts
neuper@37906
    13
neuper@37954
    14
  is'_rootRatAddTerm'_in :: "[real, real] => bool" 
neuper@37954
    15
                             ("_ is'_rootRatAddTerm'_in _") (*RL DA*)
neuper@37906
    16
neuper@37906
    17
(*---------scripts--------------------------*)
neuper@37906
    18
  Elim'_rootrat'_equation
neuper@37954
    19
             :: "[bool,real,  
neuper@37954
    20
		    bool list] => bool list"
neuper@37954
    21
               ("((Script Elim'_rootrat'_equation (_ _ =))//  
neuper@37954
    22
                   (_))" 9)
neuper@37906
    23
 (*-------------------- rules------------------------------------------------*)
neuper@37906
    24
neuper@37954
    25
axioms
neuper@37906
    26
  (* eliminate ratRootTerm *)
neuper@37906
    27
  rootrat_equation_left_1
neuper@37906
    28
   "[|c is_rootTerm_in bdv|] ==> ( (a + b/c = d) = ( b = (d - a) * c ))"
neuper@37906
    29
  rootrat_equation_left_2
neuper@37906
    30
   "[|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c ))"
neuper@37906
    31
  rootrat_equation_right_2
neuper@37906
    32
   "[|f is_rootTerm_in bdv|] ==> ( (a = d + e/f) = ( (a - d) * f = e ))"
neuper@37906
    33
  rootrat_equation_right_1
neuper@37906
    34
   "[|f is_rootTerm_in bdv|] ==> ( (a = e/f) = ( a * f = e ))"
neuper@37906
    35
neuper@37954
    36
ML {*
neuper@37954
    37
(*-------------------------functions---------------------*)
neuper@37954
    38
(* true if denominator contains (sq)root in + or - term 
neuper@37954
    39
   1/(sqrt(x+3)*(x+4)) -> false; 1/(sqrt(x)+2) -> true
neuper@37954
    40
   if false then (term)^2 contains no (sq)root *)
neuper@37954
    41
fun is_rootRatAddTerm_in t v = 
neuper@37954
    42
    let 
neuper@37954
    43
	fun coeff_in c v = member op = (vars c) v;
neuper@37954
    44
	fun rootadd (t as (Const ("op +",_) $ t2 $ t3)) v = 
neuper@37954
    45
            (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
neuper@37954
    46
	  | rootadd (t as (Const ("op -",_) $ t2 $ t3)) v = 
neuper@37954
    47
            (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
neuper@37954
    48
	  | rootadd _ _ = false;
neuper@37954
    49
	fun findrootrat (_ $ _ $ _ $ _) v = raise error("is_rootRatAddTerm_in:")
neuper@37954
    50
	  (* at the moment there is no term like this, but ....*)
neuper@37954
    51
	  | findrootrat (t as (Const ("HOL.divide",_) $ _ $ t3)) v = 
neuper@37954
    52
	               if (is_rootTerm_in t3 v) then rootadd t3 v else false
neuper@37954
    53
	  | findrootrat (_ $ t1 $ t2) v = 
neuper@37954
    54
            (findrootrat t1 v) orelse (findrootrat t2 v)
neuper@37954
    55
	  | findrootrat (_ $ t1) v = (findrootrat t1 v)
neuper@37954
    56
	  | findrootrat _ _ = false;
neuper@37954
    57
     in
neuper@37954
    58
	findrootrat t v
neuper@37954
    59
    end;
neuper@37906
    60
neuper@37954
    61
fun eval_is_rootRatAddTerm_in _ _ 
neuper@37954
    62
           (p as (Const ("RootRatEq.is'_rootRatAddTerm'_in",_) $ t $ v)) _  =
neuper@37954
    63
    if is_rootRatAddTerm_in t v then 
neuper@37954
    64
	SOME ((term2str p) ^ " = True",
neuper@37954
    65
	      Trueprop $ (mk_equality (p, HOLogic.true_const)))
neuper@37954
    66
    else SOME ((term2str p) ^ " = True",
neuper@37954
    67
	       Trueprop $ (mk_equality (p, HOLogic.false_const)))
neuper@37954
    68
  | eval_is_rootRatAddTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) NONE);
neuper@37954
    69
neuper@37954
    70
(*-------------------------rulse-------------------------*)
neuper@37954
    71
val RootRatEq_prls = 
neuper@37954
    72
    append_rls "RootRatEq_prls" e_rls
neuper@37954
    73
		[Calc ("Atools.ident",eval_ident "#ident_"),
neuper@37954
    74
                 Calc ("Tools.matches",eval_matches ""),
neuper@37954
    75
                 Calc ("Tools.lhs"    ,eval_lhs ""),
neuper@37954
    76
                 Calc ("Tools.rhs"    ,eval_rhs ""),
neuper@37954
    77
                 Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
neuper@37954
    78
                 Calc ("RootRatEq.is'_rootRatAddTerm'_in", 
neuper@37954
    79
                       eval_is_rootRatAddTerm_in ""),
neuper@37954
    80
                 Calc ("op =",eval_equal "#equal_"),
neuper@37966
    81
                 Thm ("not_true",num_str @{not_true),
neuper@37966
    82
                 Thm ("not_false",num_str @{not_false),
neuper@37966
    83
                 Thm ("and_true",num_str @{and_true),
neuper@37966
    84
                 Thm ("and_false",num_str @{and_false),
neuper@37966
    85
                 Thm ("or_true",num_str @{or_true),
neuper@37966
    86
                 Thm ("or_false",num_str @{or_false)
neuper@37954
    87
		 ];
neuper@37954
    88
neuper@37954
    89
val RooRatEq_erls = 
neuper@37954
    90
    merge_rls "RooRatEq_erls" rootrat_erls
neuper@37954
    91
    (merge_rls "" RootEq_erls
neuper@37954
    92
     (merge_rls "" rateq_erls
neuper@37954
    93
      (append_rls "" e_rls
neuper@37954
    94
		[])));
neuper@37954
    95
neuper@37954
    96
val RootRatEq_crls = 
neuper@37954
    97
    merge_rls "RootRatEq_crls" rootrat_erls
neuper@37954
    98
    (merge_rls "" RootEq_erls
neuper@37954
    99
     (merge_rls "" rateq_erls
neuper@37954
   100
      (append_rls "" e_rls
neuper@37954
   101
		[])));
neuper@37954
   102
neuper@37967
   103
ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954
   104
	     [("RooRatEq_erls",RooRatEq_erls) (*FIXXXME:del with rls.rls'*)]);
neuper@37954
   105
neuper@37954
   106
(* Solves a rootrat Equation *)
neuper@37954
   107
 val rootrat_solve = prep_rls(
neuper@37954
   108
     Rls {id = "rootrat_solve", preconds = [], 
neuper@37954
   109
	  rew_ord = ("termlessI",termlessI), 
neuper@37954
   110
     erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
neuper@37966
   111
     rules = [Thm("rootrat_equation_left_1", num_str @{rootrat_equation_left_1),   
neuper@37954
   112
	        (* [|c is_rootTerm_in bdv|] ==> 
neuper@37954
   113
                                    ( (a + b/c = d) = ( b = (d - a) * c )) *)
neuper@37966
   114
              Thm("rootrat_equation_left_2",num_str @{rootrat_equation_left_2),
neuper@37954
   115
	        (* [|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c )) *)
neuper@37966
   116
	      Thm("rootrat_equation_right_1",num_str @{rootrat_equation_right_1),
neuper@37954
   117
		(* [|f is_rootTerm_in bdv|] ==> 
neuper@37954
   118
                                    ( (a = d + e/f) = ( (a - d) * f = e )) *)
neuper@37966
   119
	      Thm("rootrat_equation_right_2",num_str @{rootrat_equation_right_2)
neuper@37954
   120
		(* [|f is_rootTerm_in bdv|] ==> ( (a =  e/f) = ( a  * f = e ))*)
neuper@37954
   121
	      ],
neuper@37954
   122
	 scr = Script ((term_of o the o (parse thy)) "empty_script")
neuper@37954
   123
         }:rls);
neuper@37967
   124
ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954
   125
			[("rootrat_solve",rootrat_solve)
neuper@37954
   126
			 ]);
neuper@37954
   127
neuper@37954
   128
(*-----------------------probleme------------------------*)
neuper@37954
   129
(*
neuper@37954
   130
(get_pbt ["rat","root","univariate","equation"]);
neuper@37954
   131
show_ptyps(); 
neuper@37954
   132
*)
neuper@37954
   133
store_pbt
neuper@37954
   134
 (prep_pbt (theory "RootRatEq") "pbl_equ_univ_root_sq_rat" [] e_pblID
neuper@37954
   135
 (["rat","sq","root","univariate","equation"],
neuper@37954
   136
  [("#Given" ,["equality e_","solveFor v_"]),
neuper@37954
   137
   ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) )| " ^
neuper@37954
   138
	       "( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
neuper@37954
   139
   ("#Find"  ,["solutions v_i_"])
neuper@37954
   140
   ],
neuper@37954
   141
  RootRatEq_prls, SOME "solve (e_::bool, v_)",
neuper@37954
   142
  [["RootRatEq","elim_rootrat_equation"]]));
neuper@37954
   143
neuper@37954
   144
(*-------------------------Methode-----------------------*)
neuper@37954
   145
store_met
neuper@37954
   146
 (prep_met (theory "LinEq") "met_rootrateq" [] e_metID
neuper@37954
   147
 (["RootRatEq"],
neuper@37954
   148
   [],
neuper@37954
   149
   {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
neuper@37954
   150
    crls=Atools_erls, nrls=norm_Rational}, "empty_script"));
neuper@37954
   151
(*-- left 20.10.02 --*)
neuper@37954
   152
store_met
neuper@37954
   153
 (prep_met (theory "RootRatEq") "met_rootrateq_elim" [] e_metID
neuper@37954
   154
 (["RootRatEq","elim_rootrat_equation"],
neuper@37954
   155
   [("#Given" ,["equality e_","solveFor v_"]),
neuper@37954
   156
    ("#Where" ,["( (lhs e_) is_rootRatAddTerm_in (v_::real) ) | " ^
neuper@37954
   157
	       "( (rhs e_) is_rootRatAddTerm_in (v_::real) )"]),
neuper@37954
   158
    ("#Find"  ,["solutions v_i_"])
neuper@37954
   159
   ],
neuper@37954
   160
   {rew_ord'="termlessI",
neuper@37954
   161
    rls'=RooRatEq_erls,
neuper@37954
   162
    srls=e_rls,
neuper@37954
   163
    prls=RootRatEq_prls,
neuper@37954
   164
    calc=[],
neuper@37954
   165
    crls=RootRatEq_crls, nrls=norm_Rational(*,
neuper@37954
   166
    asm_rls=[],
neuper@37954
   167
    asm_thm=[]*)},
neuper@37954
   168
   "Script Elim_rootrat_equation  (e_::bool) (v_::real)  =      " ^
neuper@37954
   169
    "(let e_ = ((Try (Rewrite_Set expand_rootbinoms False)) @@  " ^ 
neuper@37954
   170
    "           (Try (Rewrite_Set rooteq_simplify   False)) @@  " ^ 
neuper@37954
   171
    "           (Try (Rewrite_Set make_rooteq       False)) @@  " ^
neuper@37954
   172
    "           (Try (Rewrite_Set rooteq_simplify   False)) @@  " ^
neuper@37954
   173
    "           (Try (Rewrite_Set_Inst [(bdv,v_)]               " ^
neuper@37954
   174
    "                                  rootrat_solve False))) e_ " ^
neuper@37954
   175
    " in (SubProblem (RootEq_,[univariate,equation],            " ^
neuper@37954
   176
    "        [no_met]) [bool_ e_, real_ v_]))"
neuper@37954
   177
   ));
neuper@37954
   178
calclist':= overwritel (!calclist', 
neuper@37954
   179
   [("is_rootRatAddTerm_in", ("RootRatEq.is_rootRatAddTerm_in", 
neuper@37954
   180
			      eval_is_rootRatAddTerm_in""))
neuper@37954
   181
    ]);
neuper@37954
   182
*}
neuper@37906
   183
neuper@37906
   184
end