src/Tools/isac/Knowledge/RootRatEq.ML
author Walther Neuper <neuper@ist.tugraz.at>
Wed, 25 Aug 2010 16:20:07 +0200
branchisac-update-Isa09-2
changeset 37947 22235e4dbe5f
parent 37935 src/Tools/isac/IsacKnowledge/RootRatEq.ML@27d365c3dd31
child 37952 9ddd1000b900
permissions -rw-r--r--
renamed isac's directories and Build_Isac.thy

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