src/Tools/isac/Knowledge/LinEq.thy
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 31 Aug 2010 16:00:13 +0200
branchisac-update-Isa09-2
changeset 37966 78938fc8e022
parent 37953 369b3012f6f6
child 37967 bd4f7a35e892
permissions -rw-r--r--
num_str --> num_str @{thm
neuper@37906
     1
(*. (c) by Richard Lang, 2003 .*)
neuper@37906
     2
(* theory collecting all knowledge for LinearEquations
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.10.20
neuper@37906
     8
*)
neuper@37906
     9
neuper@37950
    10
theory LinEq imports Poly Equation begin
neuper@37906
    11
neuper@37906
    12
consts
neuper@37906
    13
   Solve'_lineq'_equation
neuper@37950
    14
             :: "[bool,real, 
neuper@37950
    15
		   bool list] => bool list"
neuper@37950
    16
               ("((Script Solve'_lineq'_equation (_ _ =))// 
neuper@37950
    17
                  (_))" 9)
neuper@37906
    18
neuper@37950
    19
axioms
neuper@37906
    20
(*-- normalize --*)
neuper@37906
    21
  (*WN0509 compare PolyEq.all_left "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"*)
neuper@37950
    22
  all_left          "[|Not(b=!=0)|] ==> (a=b) = (a+(-1)*b=0)"
neuper@37950
    23
  makex1_x          "a^^^1  = a"  
neuper@37950
    24
  real_assoc_1      "a+(b+c) = a+b+c"
neuper@37950
    25
  real_assoc_2      "a*(b*c) = a*b*c"
neuper@37906
    26
neuper@37906
    27
(*-- solve --*)
neuper@37950
    28
  lin_isolate_add1  "(a + b*bdv = 0) = (b*bdv = (-1)*a)"
neuper@37950
    29
  lin_isolate_add2  "(a +   bdv = 0) = (  bdv = (-1)*a)"
neuper@37950
    30
  lin_isolate_div   "[|Not(b=0)|] ==> (b*bdv = c) = (bdv = c / b)"
neuper@37950
    31
neuper@37950
    32
ML {*
neuper@37950
    33
val LinEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
neuper@37950
    34
  append_rls "LinEq_prls" e_rls 
neuper@37950
    35
	     [Calc ("op =",eval_equal "#equal_"),
neuper@37950
    36
	      Calc ("Tools.matches",eval_matches ""),
neuper@37950
    37
	      Calc ("Tools.lhs"    ,eval_lhs ""),
neuper@37950
    38
	      Calc ("Tools.rhs"    ,eval_rhs ""),
neuper@37950
    39
	      Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),
neuper@37950
    40
 	      Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
neuper@37950
    41
	      Calc ("Atools.occurs'_in",eval_occurs_in ""),    
neuper@37950
    42
	      Calc ("Atools.ident",eval_ident "#ident_"),
neuper@37966
    43
	      Thm ("not_true",num_str @{not_true),
neuper@37966
    44
	      Thm ("not_false",num_str @{not_false),
neuper@37966
    45
	      Thm ("and_true",num_str @{and_true),
neuper@37966
    46
	      Thm ("and_false",num_str @{and_false),
neuper@37966
    47
	      Thm ("or_true",num_str @{or_true),
neuper@37966
    48
	      Thm ("or_false",num_str @{or_false)
neuper@37950
    49
              ];
neuper@37950
    50
(* ----- erls ----- *)
neuper@37950
    51
val LinEq_crls = 
neuper@37950
    52
   append_rls "LinEq_crls" poly_crls
neuper@37966
    53
   [Thm  ("real_assoc_1",num_str @{real_assoc_1)
neuper@37950
    54
    (*		
neuper@37950
    55
     Don't use
neuper@37950
    56
     Calc ("HOL.divide", eval_cancel "#divide_"),
neuper@37950
    57
     Calc ("Atools.pow" ,eval_binop "#power_"),
neuper@37950
    58
     *)
neuper@37950
    59
    ];
neuper@37950
    60
neuper@37950
    61
(* ----- crls ----- *)
neuper@37950
    62
val LinEq_erls = 
neuper@37950
    63
   append_rls "LinEq_erls" Poly_erls
neuper@37966
    64
   [Thm  ("real_assoc_1",num_str @{real_assoc_1)
neuper@37950
    65
    (*		
neuper@37950
    66
     Don't use
neuper@37950
    67
     Calc ("HOL.divide", eval_cancel "#divide_"),
neuper@37950
    68
     Calc ("Atools.pow" ,eval_binop "#power_"),
neuper@37950
    69
     *)
neuper@37950
    70
    ];
neuper@37950
    71
neuper@37950
    72
ruleset' := overwritelthy thy (!ruleset',
neuper@37950
    73
			[("LinEq_erls",LinEq_erls)(*FIXXXME:del with rls.rls'*)
neuper@37950
    74
			 ]);
neuper@37950
    75
    
neuper@37950
    76
val LinPoly_simplify = prep_rls(
neuper@37950
    77
  Rls {id = "LinPoly_simplify", preconds = [], 
neuper@37950
    78
       rew_ord = ("termlessI",termlessI), 
neuper@37950
    79
       erls = LinEq_erls, 
neuper@37950
    80
       srls = Erls, 
neuper@37950
    81
       calc = [], 
neuper@37950
    82
       (*asm_thm = [],*)
neuper@37950
    83
       rules = [
neuper@37966
    84
		Thm  ("real_assoc_1",num_str @{real_assoc_1),
neuper@37950
    85
		Calc ("op +",eval_binop "#add_"),
neuper@37950
    86
		Calc ("op -",eval_binop "#sub_"),
neuper@37950
    87
		Calc ("op *",eval_binop "#mult_"),
neuper@37950
    88
		(*  Dont use  
neuper@37950
    89
		 Calc ("HOL.divide", eval_cancel "#divide_"),		
neuper@37950
    90
		 Calc ("Root.sqrt",eval_sqrt "#sqrt_"),
neuper@37950
    91
		 *)
neuper@37950
    92
		Calc ("Atools.pow" ,eval_binop "#power_")
neuper@37950
    93
		],
neuper@37950
    94
       scr = Script ((term_of o the o (parse thy)) "empty_script")
neuper@37950
    95
       }:rls);
neuper@37950
    96
ruleset' := overwritelthy thy (!ruleset',
neuper@37950
    97
			  [("LinPoly_simplify",LinPoly_simplify)]);
neuper@37950
    98
neuper@37950
    99
(*isolate the bound variable in an linear equation; 'bdv' is a meta-constant*)
neuper@37950
   100
val LinEq_simplify = prep_rls(
neuper@37950
   101
Rls {id = "LinEq_simplify", preconds = [],
neuper@37950
   102
     rew_ord = ("e_rew_ord",e_rew_ord),
neuper@37950
   103
     erls = LinEq_erls,
neuper@37950
   104
     srls = Erls,
neuper@37950
   105
     calc = [],
neuper@37950
   106
     (*asm_thm = [("lin_isolate_div","")],*)
neuper@37950
   107
     rules = [
neuper@37966
   108
	      Thm("lin_isolate_add1",num_str @{lin_isolate_add1), 
neuper@37950
   109
	      (* a+bx=0 -> bx=-a *)
neuper@37966
   110
	      Thm("lin_isolate_add2",num_str @{lin_isolate_add2), 
neuper@37950
   111
	      (* a+ x=0 ->  x=-a *)
neuper@37966
   112
	      Thm("lin_isolate_div",num_str @{lin_isolate_div)    
neuper@37950
   113
	      (*   bx=c -> x=c/b *)  
neuper@37950
   114
	      ],
neuper@37950
   115
     scr = Script ((term_of o the o (parse thy)) "empty_script")
neuper@37950
   116
     }:rls);
neuper@37950
   117
ruleset' := overwritelthy thy (!ruleset',
neuper@37950
   118
			[("LinEq_simplify",LinEq_simplify)]);
neuper@37950
   119
neuper@37950
   120
(*----------------------------- problem types --------------------------------*)
neuper@37950
   121
(* 
neuper@37950
   122
show_ptyps(); 
neuper@37950
   123
(get_pbt ["linear","univariate","equation"]);
neuper@37950
   124
*)
neuper@37950
   125
(* ---------linear----------- *)
neuper@37950
   126
store_pbt
neuper@37953
   127
 (prep_pbt (theory "LinEq") "pbl_equ_univ_lin" [] e_pblID
neuper@37950
   128
 (["linear","univariate","equation"],
neuper@37950
   129
  [("#Given" ,["equality e_","solveFor v_"]),
neuper@37950
   130
   ("#Where" ,["False", (*WN0509 just detected: this pbl can never be used?!?*)
neuper@37950
   131
               "Not( (lhs e_) is_polyrat_in v_)",
neuper@37950
   132
               "Not( (rhs e_) is_polyrat_in v_)",
neuper@37950
   133
               "((lhs e_) has_degree_in v_)=1",
neuper@37950
   134
	       "((rhs e_) has_degree_in v_)=1"]),
neuper@37950
   135
   ("#Find"  ,["solutions v_i_"]) 
neuper@37950
   136
  ],
neuper@37950
   137
  LinEq_prls, SOME "solve (e_::bool, v_)",
neuper@37950
   138
  [["LinEq","solve_lineq_equation"]]));
neuper@37950
   139
neuper@37950
   140
(*-------------- methods------------------------------------------------------*)
neuper@37950
   141
store_met
neuper@37953
   142
 (prep_met (theory "LinEq") "met_eqlin" [] e_metID
neuper@37950
   143
 (["LinEq"],
neuper@37950
   144
   [],
neuper@37950
   145
   {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
neuper@37950
   146
    crls=LinEq_crls, nrls=norm_Poly
neuper@37950
   147
    (*, asm_rls=[],asm_thm=[]*)}, "empty_script"));
neuper@37950
   148
neuper@37950
   149
(* ansprechen mit ["LinEq","solve_univar_equation"] *)
neuper@37950
   150
store_met
neuper@37953
   151
(prep_met (theory "LinEq") "met_eq_lin" [] e_metID
neuper@37950
   152
 (["LinEq","solve_lineq_equation"],
neuper@37950
   153
   [("#Given" ,["equality e_","solveFor v_"]),
neuper@37950
   154
    ("#Where" ,["Not( (lhs e_) is_polyrat_in v_)",
neuper@37950
   155
                "( (lhs e_)  has_degree_in v_)=1"]),
neuper@37950
   156
    ("#Find"  ,["solutions v_i_"])
neuper@37950
   157
   ],
neuper@37950
   158
   {rew_ord'="termlessI",
neuper@37950
   159
    rls'=LinEq_erls,
neuper@37950
   160
    srls=e_rls,
neuper@37950
   161
    prls=LinEq_prls,
neuper@37950
   162
    calc=[],
neuper@37950
   163
    crls=LinEq_crls, nrls=norm_Poly(*,
neuper@37950
   164
    asm_rls=[],
neuper@37950
   165
    asm_thm=[("lin_isolate_div","")]*)},
neuper@37950
   166
    "Script Solve_lineq_equation (e_::bool) (v_::real) =                 " ^
neuper@37950
   167
    "(let e_ =((Try         (Rewrite     all_left            False)) @@  " ^ 
neuper@37950
   168
    "          (Try (Repeat (Rewrite     makex1_x           False))) @@  " ^ 
neuper@37950
   169
    "          (Try         (Rewrite_Set expand_binoms       False)) @@  " ^ 
neuper@37950
   170
    "          (Try (Repeat (Rewrite_Set_Inst [(bdv,v_::real)]           " ^
neuper@37950
   171
    "                                 make_ratpoly_in    False)))    @@  " ^
neuper@37950
   172
    "          (Try (Repeat (Rewrite_Set LinPoly_simplify      False)))) e_;" ^
neuper@37950
   173
    "     e_ = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]                  " ^
neuper@37950
   174
    "                                          LinEq_simplify True)) @@  " ^
neuper@37950
   175
    "            (Repeat(Try (Rewrite_Set LinPoly_simplify     False)))) e_ " ^
neuper@37950
   176
    " in ((Or_to_List e_)::bool list))"
neuper@37950
   177
 ));
neuper@37950
   178
"******* LinEq.ML end *******";
neuper@37950
   179
get_met ["LinEq","solve_lineq_equation"];
neuper@37950
   180
*}
neuper@37950
   181
neuper@37906
   182
end
neuper@37906
   183