src/Tools/isac/Knowledge/LinEq.thy
author Walther Neuper <wneuper@ist.tugraz.at>
Sun, 18 Dec 2016 16:27:41 +0100
changeset 59269 1da53d1540fe
parent 55444 ede4248a827b
child 59334 690f0822e102
permissions -rw-r--r--
added structure Specify : MODEL_SPECIFY
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@52148
    19
axiomatization where
neuper@37906
    20
(*-- normalize --*)
neuper@37906
    21
  (*WN0509 compare PolyEq.all_left "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"*)
neuper@52148
    22
  all_left:          "[|Not(b=!=0)|] ==> (a=b) = (a+(-1)*b=0)" and
neuper@52148
    23
  makex1_x:          "a^^^1  = a" and
neuper@52148
    24
  real_assoc_1:      "a+(b+c) = a+b+c" and
neuper@52148
    25
  real_assoc_2:      "a*(b*c) = a*b*c" and
neuper@37906
    26
neuper@37906
    27
(*-- solve --*)
neuper@52148
    28
  lin_isolate_add1:  "(a + b*bdv = 0) = (b*bdv = (-1)*a)" and
neuper@52148
    29
  lin_isolate_add2:  "(a +   bdv = 0) = (  bdv = (-1)*a)" and
neuper@37982
    30
  lin_isolate_div:   "[|Not(b=0)|] ==> (b*bdv = c) = (bdv = c / b)"
neuper@37950
    31
neuper@37950
    32
ML {*
neuper@37972
    33
val thy = @{theory};
neuper@37972
    34
neuper@37950
    35
val LinEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
neuper@37950
    36
  append_rls "LinEq_prls" e_rls 
neuper@41922
    37
	     [Calc ("HOL.eq",eval_equal "#equal_"),
neuper@37950
    38
	      Calc ("Tools.matches",eval_matches ""),
neuper@37950
    39
	      Calc ("Tools.lhs"    ,eval_lhs ""),
neuper@37950
    40
	      Calc ("Tools.rhs"    ,eval_rhs ""),
neuper@37950
    41
	      Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),
neuper@37950
    42
 	      Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
neuper@37950
    43
	      Calc ("Atools.occurs'_in",eval_occurs_in ""),    
neuper@37950
    44
	      Calc ("Atools.ident",eval_ident "#ident_"),
neuper@37969
    45
	      Thm ("not_true",num_str @{thm not_true}),
neuper@37969
    46
	      Thm ("not_false",num_str @{thm not_false}),
neuper@37969
    47
	      Thm ("and_true",num_str @{thm and_true}),
neuper@37969
    48
	      Thm ("and_false",num_str @{thm and_false}),
neuper@37969
    49
	      Thm ("or_true",num_str @{thm or_true}),
neuper@37969
    50
	      Thm ("or_false",num_str @{thm or_false})
neuper@37950
    51
              ];
neuper@37950
    52
(* ----- erls ----- *)
neuper@37950
    53
val LinEq_crls = 
neuper@37950
    54
   append_rls "LinEq_crls" poly_crls
neuper@37969
    55
   [Thm  ("real_assoc_1",num_str @{thm real_assoc_1})
neuper@37950
    56
    (*		
neuper@37950
    57
     Don't use
neuper@48789
    58
     Calc ("Fields.inverse_class.divide", eval_cancel "#divide_e"),
neuper@37950
    59
     Calc ("Atools.pow" ,eval_binop "#power_"),
neuper@37950
    60
     *)
neuper@37950
    61
    ];
neuper@37950
    62
neuper@37950
    63
(* ----- crls ----- *)
neuper@37950
    64
val LinEq_erls = 
neuper@37950
    65
   append_rls "LinEq_erls" Poly_erls
neuper@37969
    66
   [Thm  ("real_assoc_1",num_str @{thm real_assoc_1})
neuper@37950
    67
    (*		
neuper@37950
    68
     Don't use
neuper@48789
    69
     Calc ("Fields.inverse_class.divide", eval_cancel "#divide_e"),
neuper@37950
    70
     Calc ("Atools.pow" ,eval_binop "#power_"),
neuper@37950
    71
     *)
neuper@37950
    72
    ];
neuper@52125
    73
*}
neuper@52125
    74
setup {* KEStore_Elems.add_rlss 
neuper@52125
    75
  [("LinEq_erls", (Context.theory_name @{theory}, LinEq_erls))] *}
neuper@52125
    76
ML {*
neuper@37950
    77
    
s1210629013@55444
    78
val LinPoly_simplify = prep_rls'(
neuper@37950
    79
  Rls {id = "LinPoly_simplify", preconds = [], 
neuper@37950
    80
       rew_ord = ("termlessI",termlessI), 
neuper@37950
    81
       erls = LinEq_erls, 
neuper@37950
    82
       srls = Erls, 
neuper@42451
    83
       calc = [], errpatts = [],
neuper@37950
    84
       rules = [
neuper@37969
    85
		Thm  ("real_assoc_1",num_str @{thm real_assoc_1}),
neuper@38014
    86
		Calc ("Groups.plus_class.plus",eval_binop "#add_"),
neuper@38014
    87
		Calc ("Groups.minus_class.minus",eval_binop "#sub_"),
neuper@38034
    88
		Calc ("Groups.times_class.times",eval_binop "#mult_"),
neuper@37950
    89
		(*  Dont use  
neuper@48789
    90
		 Calc ("Fields.inverse_class.divide", eval_cancel "#divide_e"),		
neuper@37982
    91
		 Calc ("NthRoot.sqrt",eval_sqrt "#sqrt_"),
neuper@37950
    92
		 *)
neuper@37950
    93
		Calc ("Atools.pow" ,eval_binop "#power_")
neuper@37950
    94
		],
neuper@37982
    95
       scr = EmptyScr}:rls);
neuper@52125
    96
*}
neuper@52125
    97
setup {* KEStore_Elems.add_rlss 
neuper@52125
    98
  [("LinPoly_simplify", (Context.theory_name @{theory}, LinPoly_simplify))] *}
neuper@52125
    99
ML {*
neuper@37950
   100
neuper@37950
   101
(*isolate the bound variable in an linear equation; 'bdv' is a meta-constant*)
s1210629013@55444
   102
val LinEq_simplify = prep_rls'(
neuper@37950
   103
Rls {id = "LinEq_simplify", preconds = [],
neuper@37950
   104
     rew_ord = ("e_rew_ord",e_rew_ord),
neuper@37950
   105
     erls = LinEq_erls,
neuper@37950
   106
     srls = Erls,
neuper@42451
   107
     calc = [], errpatts = [],
neuper@37950
   108
     rules = [
neuper@37969
   109
	      Thm("lin_isolate_add1",num_str @{thm lin_isolate_add1}), 
neuper@37950
   110
	      (* a+bx=0 -> bx=-a *)
neuper@37969
   111
	      Thm("lin_isolate_add2",num_str @{thm lin_isolate_add2}), 
neuper@37950
   112
	      (* a+ x=0 ->  x=-a *)
neuper@37969
   113
	      Thm("lin_isolate_div",num_str @{thm lin_isolate_div})    
neuper@37950
   114
	      (*   bx=c -> x=c/b *)  
neuper@37950
   115
	      ],
neuper@37982
   116
     scr = EmptyScr}:rls);
neuper@52125
   117
*}
neuper@52125
   118
setup {* KEStore_Elems.add_rlss 
neuper@52125
   119
  [("LinEq_simplify", (Context.theory_name @{theory}, LinEq_simplify))] *}
neuper@37950
   120
neuper@37950
   121
(*----------------------------- problem types --------------------------------*)
neuper@37950
   122
(* ---------linear----------- *)
s1210629013@55359
   123
setup {* KEStore_Elems.add_pbts
wneuper@59269
   124
  [(Specify.prep_pbt thy "pbl_equ_univ_lin" [] e_pblID
s1210629013@55339
   125
      (["LINEAR", "univariate", "equation"],
s1210629013@55339
   126
        [("#Given" ,["equality e_e", "solveFor v_v"]),
s1210629013@55339
   127
          ("#Where" ,["HOL.False", (*WN0509 just detected: this pbl can never be used?!?*)
s1210629013@55339
   128
              "Not( (lhs e_e) is_polyrat_in v_v)",
s1210629013@55339
   129
              "Not( (rhs e_e) is_polyrat_in v_v)",
s1210629013@55339
   130
              "((lhs e_e) has_degree_in v_v)=1",
s1210629013@55339
   131
	            "((rhs e_e) has_degree_in v_v)=1"]),
s1210629013@55339
   132
          ("#Find"  ,["solutions v_v'i'"])],
s1210629013@55339
   133
        LinEq_prls, SOME "solve (e_e::bool, v_v)", [["LinEq", "solve_lineq_equation"]]))] *}
neuper@37950
   134
s1210629013@55373
   135
(*-------------- methods------------------------------------------------------*)
s1210629013@55373
   136
setup {* KEStore_Elems.add_mets
wneuper@59269
   137
  [Specify.prep_met thy "met_eqlin" [] e_metID
s1210629013@55373
   138
      (["LinEq"], [],
s1210629013@55373
   139
        {rew_ord' = "tless_true",rls' = Atools_erls,calc = [], srls = e_rls, prls = e_rls,
s1210629013@55373
   140
          crls = LinEq_crls, errpats = [], nrls = norm_Poly},
s1210629013@55373
   141
        "empty_script"),
s1210629013@55373
   142
    (* ansprechen mit ["LinEq","solve_univar_equation"] *)
wneuper@59269
   143
    Specify.prep_met thy "met_eq_lin" [] e_metID
s1210629013@55373
   144
      (["LinEq","solve_lineq_equation"],
s1210629013@55373
   145
        [("#Given", ["equality e_e", "solveFor v_v"]),
s1210629013@55373
   146
          ("#Where", ["Not ((lhs e_e) is_polyrat_in v_v)", "((lhs e_e)  has_degree_in v_v) = 1"]),
s1210629013@55373
   147
          ("#Find",  ["solutions v_v'i'"])],
s1210629013@55373
   148
        {rew_ord' = "termlessI", rls' = LinEq_erls, srls = e_rls, prls = LinEq_prls, calc = [],
s1210629013@55373
   149
          crls = LinEq_crls, errpats = [], nrls = norm_Poly},
s1210629013@55373
   150
        "Script Solve_lineq_equation (e_e::bool) (v_v::real) =                 " ^
s1210629013@55373
   151
          "(let e_e =((Try         (Rewrite      all_left           False)) @@   " ^ 
s1210629013@55373
   152
          "           (Try (Repeat (Rewrite     makex1_x            False))) @@  " ^ 
s1210629013@55373
   153
          "           (Try         (Rewrite_Set expand_binoms       False)) @@   " ^ 
s1210629013@55373
   154
          "           (Try (Repeat (Rewrite_Set_Inst [(bdv, v_v::real)]          " ^
s1210629013@55373
   155
          "                                 make_ratpoly_in    False)))    @@    " ^
s1210629013@55373
   156
          "           (Try (Repeat (Rewrite_Set LinPoly_simplify      False))))e_e;" ^
s1210629013@55373
   157
          "     e_e = ((Try (Rewrite_Set_Inst [(bdv, v_v::real)]                  " ^
s1210629013@55373
   158
          "                                     LinEq_simplify True)) @@  " ^
s1210629013@55373
   159
          "            (Repeat(Try (Rewrite_Set LinPoly_simplify     False)))) e_e " ^
s1210629013@55373
   160
          " in ((Or_to_List e_e)::bool list))")]
s1210629013@55373
   161
*}
wneuper@59269
   162
ML {* Specify.get_met' @{theory} ["LinEq","solve_lineq_equation"]; *}
neuper@37950
   163
neuper@37906
   164
end
neuper@37906
   165