src/Tools/isac/Knowledge/RootRatEq.thy
author Walther Neuper <neuper@ist.tugraz.at>
Mon, 06 Sep 2010 16:56:22 +0200
branchisac-update-Isa09-2
changeset 37983 03bfbc480107
parent 37982 66f3570ba808
child 37984 972a73d7c50b
permissions -rw-r--r--
corrected format for axioms in remaining theories
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@37983
    27
  rootrat_equation_left_1:
neuper@37906
    28
   "[|c is_rootTerm_in bdv|] ==> ( (a + b/c = d) = ( b = (d - a) * c ))"
neuper@37983
    29
  rootrat_equation_left_2:
neuper@37906
    30
   "[|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c ))"
neuper@37983
    31
  rootrat_equation_right_2:
neuper@37906
    32
   "[|f is_rootTerm_in bdv|] ==> ( (a = d + e/f) = ( (a - d) * f = e ))"
neuper@37983
    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@37972
    37
val thy = @{theory};
neuper@37972
    38
neuper@37954
    39
(*-------------------------functions---------------------*)
neuper@37954
    40
(* true if denominator contains (sq)root in + or - term 
neuper@37954
    41
   1/(sqrt(x+3)*(x+4)) -> false; 1/(sqrt(x)+2) -> true
neuper@37954
    42
   if false then (term)^2 contains no (sq)root *)
neuper@37954
    43
fun is_rootRatAddTerm_in t v = 
neuper@37954
    44
    let 
neuper@37954
    45
	fun coeff_in c v = member op = (vars c) v;
neuper@37954
    46
	fun 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 (t as (Const ("op -",_) $ t2 $ t3)) v = 
neuper@37954
    49
            (is_rootTerm_in t2 v) orelse (is_rootTerm_in t3 v)
neuper@37954
    50
	  | rootadd _ _ = false;
neuper@37954
    51
	fun findrootrat (_ $ _ $ _ $ _) v = raise error("is_rootRatAddTerm_in:")
neuper@37954
    52
	  (* at the moment there is no term like this, but ....*)
neuper@37954
    53
	  | findrootrat (t as (Const ("HOL.divide",_) $ _ $ t3)) v = 
neuper@37954
    54
	               if (is_rootTerm_in t3 v) then rootadd t3 v else false
neuper@37954
    55
	  | findrootrat (_ $ t1 $ t2) v = 
neuper@37954
    56
            (findrootrat t1 v) orelse (findrootrat t2 v)
neuper@37954
    57
	  | findrootrat (_ $ t1) v = (findrootrat t1 v)
neuper@37954
    58
	  | findrootrat _ _ = false;
neuper@37954
    59
     in
neuper@37954
    60
	findrootrat t v
neuper@37954
    61
    end;
neuper@37906
    62
neuper@37954
    63
fun eval_is_rootRatAddTerm_in _ _ 
neuper@37954
    64
           (p as (Const ("RootRatEq.is'_rootRatAddTerm'_in",_) $ t $ v)) _  =
neuper@37954
    65
    if is_rootRatAddTerm_in t v then 
neuper@37954
    66
	SOME ((term2str p) ^ " = True",
neuper@37954
    67
	      Trueprop $ (mk_equality (p, HOLogic.true_const)))
neuper@37954
    68
    else SOME ((term2str p) ^ " = True",
neuper@37954
    69
	       Trueprop $ (mk_equality (p, HOLogic.false_const)))
neuper@37954
    70
  | eval_is_rootRatAddTerm_in _ _ _ _ = ((*writeln"### nichts matcht";*) NONE);
neuper@37954
    71
neuper@37954
    72
(*-------------------------rulse-------------------------*)
neuper@37954
    73
val RootRatEq_prls = 
neuper@37954
    74
    append_rls "RootRatEq_prls" e_rls
neuper@37954
    75
		[Calc ("Atools.ident",eval_ident "#ident_"),
neuper@37954
    76
                 Calc ("Tools.matches",eval_matches ""),
neuper@37954
    77
                 Calc ("Tools.lhs"    ,eval_lhs ""),
neuper@37954
    78
                 Calc ("Tools.rhs"    ,eval_rhs ""),
neuper@37954
    79
                 Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
neuper@37954
    80
                 Calc ("RootRatEq.is'_rootRatAddTerm'_in", 
neuper@37954
    81
                       eval_is_rootRatAddTerm_in ""),
neuper@37954
    82
                 Calc ("op =",eval_equal "#equal_"),
neuper@37969
    83
                 Thm ("not_true",num_str @{thm not_true}),
neuper@37969
    84
                 Thm ("not_false",num_str @{thm not_false}),
neuper@37969
    85
                 Thm ("and_true",num_str @{thm and_true}),
neuper@37969
    86
                 Thm ("and_false",num_str @{thm and_false}),
neuper@37969
    87
                 Thm ("or_true",num_str @{thm or_true}),
neuper@37969
    88
                 Thm ("or_false",num_str @{thm or_false})
neuper@37954
    89
		 ];
neuper@37954
    90
neuper@37954
    91
val RooRatEq_erls = 
neuper@37954
    92
    merge_rls "RooRatEq_erls" rootrat_erls
neuper@37954
    93
    (merge_rls "" RootEq_erls
neuper@37954
    94
     (merge_rls "" rateq_erls
neuper@37954
    95
      (append_rls "" e_rls
neuper@37954
    96
		[])));
neuper@37954
    97
neuper@37954
    98
val RootRatEq_crls = 
neuper@37954
    99
    merge_rls "RootRatEq_crls" rootrat_erls
neuper@37954
   100
    (merge_rls "" RootEq_erls
neuper@37954
   101
     (merge_rls "" rateq_erls
neuper@37954
   102
      (append_rls "" e_rls
neuper@37954
   103
		[])));
neuper@37954
   104
neuper@37967
   105
ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954
   106
	     [("RooRatEq_erls",RooRatEq_erls) (*FIXXXME:del with rls.rls'*)]);
neuper@37954
   107
neuper@37954
   108
(* Solves a rootrat Equation *)
neuper@37954
   109
 val rootrat_solve = prep_rls(
neuper@37954
   110
     Rls {id = "rootrat_solve", preconds = [], 
neuper@37954
   111
	  rew_ord = ("termlessI",termlessI), 
neuper@37954
   112
     erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
neuper@37969
   113
     rules = [Thm("rootrat_equation_left_1", num_str @{thm }rootrat_equation_left_1),   
neuper@37954
   114
	        (* [|c is_rootTerm_in bdv|] ==> 
neuper@37954
   115
                                    ( (a + b/c = d) = ( b = (d - a) * c )) *)
neuper@37969
   116
              Thm("rootrat_equation_left_2",num_str @{thm rootrat_equation_left_2}),
neuper@37954
   117
	        (* [|c is_rootTerm_in bdv|] ==> ( (b/c = d) = ( b = d * c )) *)
neuper@37969
   118
	      Thm("rootrat_equation_right_1",num_str @{thm rootrat_equation_right_1}),
neuper@37954
   119
		(* [|f is_rootTerm_in bdv|] ==> 
neuper@37954
   120
                                    ( (a = d + e/f) = ( (a - d) * f = e )) *)
neuper@37969
   121
	      Thm("rootrat_equation_right_2",num_str @{thm rootrat_equation_right_2})
neuper@37954
   122
		(* [|f is_rootTerm_in bdv|] ==> ( (a =  e/f) = ( a  * f = e ))*)
neuper@37954
   123
	      ],
neuper@37954
   124
	 scr = Script ((term_of o the o (parse thy)) "empty_script")
neuper@37954
   125
         }:rls);
neuper@37967
   126
ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954
   127
			[("rootrat_solve",rootrat_solve)
neuper@37954
   128
			 ]);
neuper@37954
   129
neuper@37954
   130
(*-----------------------probleme------------------------*)
neuper@37954
   131
(*
neuper@37954
   132
(get_pbt ["rat","root","univariate","equation"]);
neuper@37954
   133
show_ptyps(); 
neuper@37954
   134
*)
neuper@37972
   135
neuper@37954
   136
store_pbt
neuper@37972
   137
 (prep_pbt thy "pbl_equ_univ_root_sq_rat" [] e_pblID
neuper@37954
   138
 (["rat","sq","root","univariate","equation"],
neuper@37981
   139
  [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37982
   140
   ("#Where" ,["( (lhs e_e) is_rootRatAddTerm_in (v_v::real) )| " ^
neuper@37982
   141
	       "( (rhs e_e) is_rootRatAddTerm_in (v_v::real) )"]),
neuper@37981
   142
   ("#Find"  ,["solutions v_i"])
neuper@37954
   143
   ],
neuper@37981
   144
  RootRatEq_prls, SOME "solve (e_e::bool, v_v)",
neuper@37954
   145
  [["RootRatEq","elim_rootrat_equation"]]));
neuper@37954
   146
neuper@37954
   147
(*-------------------------Methode-----------------------*)
neuper@37954
   148
store_met
neuper@37954
   149
 (prep_met (theory "LinEq") "met_rootrateq" [] e_metID
neuper@37954
   150
 (["RootRatEq"],
neuper@37954
   151
   [],
neuper@37954
   152
   {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
neuper@37954
   153
    crls=Atools_erls, nrls=norm_Rational}, "empty_script"));
neuper@37954
   154
(*-- left 20.10.02 --*)
neuper@37954
   155
store_met
neuper@37972
   156
 (prep_met thy "met_rootrateq_elim" [] e_metID
neuper@37954
   157
 (["RootRatEq","elim_rootrat_equation"],
neuper@37981
   158
   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37982
   159
    ("#Where" ,["( (lhs e_e) is_rootRatAddTerm_in (v_v::real) ) | " ^
neuper@37982
   160
	       "( (rhs e_e) is_rootRatAddTerm_in (v_v::real) )"]),
neuper@37981
   161
    ("#Find"  ,["solutions v_i"])
neuper@37954
   162
   ],
neuper@37954
   163
   {rew_ord'="termlessI",
neuper@37954
   164
    rls'=RooRatEq_erls,
neuper@37954
   165
    srls=e_rls,
neuper@37954
   166
    prls=RootRatEq_prls,
neuper@37954
   167
    calc=[],
neuper@37954
   168
    crls=RootRatEq_crls, nrls=norm_Rational(*,
neuper@37954
   169
    asm_rls=[],
neuper@37954
   170
    asm_thm=[]*)},
neuper@37982
   171
   "Script Elim_rootrat_equation  (e_e::bool) (v_v::real)  =      " ^
neuper@37981
   172
    "(let e_e = ((Try (Rewrite_Set expand_rootbinoms False)) @@  " ^ 
neuper@37954
   173
    "           (Try (Rewrite_Set rooteq_simplify   False)) @@  " ^ 
neuper@37954
   174
    "           (Try (Rewrite_Set make_rooteq       False)) @@  " ^
neuper@37954
   175
    "           (Try (Rewrite_Set rooteq_simplify   False)) @@  " ^
neuper@37954
   176
    "           (Try (Rewrite_Set_Inst [(bdv,v_)]               " ^
neuper@37981
   177
    "                                  rootrat_solve False))) e_e " ^
neuper@37954
   178
    " in (SubProblem (RootEq_,[univariate,equation],            " ^
neuper@37981
   179
    "        [no_met]) [bool_ e_e, real_ v_]))"
neuper@37954
   180
   ));
neuper@37954
   181
calclist':= overwritel (!calclist', 
neuper@37954
   182
   [("is_rootRatAddTerm_in", ("RootRatEq.is_rootRatAddTerm_in", 
neuper@37954
   183
			      eval_is_rootRatAddTerm_in""))
neuper@37954
   184
    ]);
neuper@37954
   185
*}
neuper@37906
   186
neuper@37906
   187
end