src/HOL/Library/positivstellensatz.ML
changeset 44454 6f28f96a09bf
parent 44058 ae85c5d64913
child 45654 cf10bde35973
equal deleted inserted replaced
44453:082edd97ffe1 44454:6f28f96a09bf
   202 val weak_dnf_simps =
   202 val weak_dnf_simps =
   203   List.take (simp_thms, 34) @
   203   List.take (simp_thms, 34) @
   204     @{lemma "((P & (Q | R)) = ((P&Q) | (P&R)))" and "((Q | R) & P) = ((Q&P) | (R&P))" and
   204     @{lemma "((P & (Q | R)) = ((P&Q) | (P&R)))" and "((Q | R) & P) = ((Q&P) | (R&P))" and
   205       "(P & Q) = (Q & P)" and "((P | Q) = (Q | P))" by blast+};
   205       "(P & Q) = (Q & P)" and "((P | Q) = (Q | P))" by blast+};
   206 
   206 
       
   207 (*
   207 val nnfD_simps =
   208 val nnfD_simps =
   208   @{lemma "((~(P & Q)) = (~P | ~Q))" and "((~(P | Q)) = (~P & ~Q) )" and
   209   @{lemma "((~(P & Q)) = (~P | ~Q))" and "((~(P | Q)) = (~P & ~Q) )" and
   209     "((P --> Q) = (~P | Q) )" and "((P = Q) = ((P & Q) | (~P & ~ Q)))" and
   210     "((P --> Q) = (~P | Q) )" and "((P = Q) = ((P & Q) | (~P & ~ Q)))" and
   210     "((~(P = Q)) = ((P & ~ Q) | (~P & Q)) )" and "((~ ~(P)) = P)" by blast+};
   211     "((~(P = Q)) = ((P & ~ Q) | (~P & Q)) )" and "((~ ~(P)) = P)" by blast+};
       
   212 *)
   211 
   213 
   212 val choice_iff = @{lemma "(ALL x. EX y. P x y) = (EX f. ALL x. P x (f x))" by metis};
   214 val choice_iff = @{lemma "(ALL x. EX y. P x y) = (EX f. ALL x. P x (f x))" by metis};
   213 val prenex_simps =
   215 val prenex_simps =
   214   map (fn th => th RS sym)
   216   map (fn th => th RS sym)
   215     ([@{thm "all_conj_distrib"}, @{thm "ex_disj_distrib"}] @
   217     ([@{thm "all_conj_distrib"}, @{thm "ex_disj_distrib"}] @
   291   fun dest_ratconst t = case term_of t of
   293   fun dest_ratconst t = case term_of t of
   292    Const(@{const_name divide}, _)$a$b => Rat.rat_of_quotient(HOLogic.dest_number a |> snd, HOLogic.dest_number b |> snd)
   294    Const(@{const_name divide}, _)$a$b => Rat.rat_of_quotient(HOLogic.dest_number a |> snd, HOLogic.dest_number b |> snd)
   293  | _ => Rat.rat_of_int (HOLogic.dest_number (term_of t) |> snd)
   295  | _ => Rat.rat_of_int (HOLogic.dest_number (term_of t) |> snd)
   294  fun is_ratconst t = can dest_ratconst t
   296  fun is_ratconst t = can dest_ratconst t
   295 
   297 
       
   298 (*
   296 fun find_term p t = if p t then t else 
   299 fun find_term p t = if p t then t else 
   297  case t of
   300  case t of
   298   a$b => (find_term p a handle TERM _ => find_term p b)
   301   a$b => (find_term p a handle TERM _ => find_term p b)
   299  | Abs (_,_,t') => find_term p t'
   302  | Abs (_,_,t') => find_term p t'
   300  | _ => raise TERM ("find_term",[t]);
   303  | _ => raise TERM ("find_term",[t]);
       
   304 *)
   301 
   305 
   302 fun find_cterm p t = if p t then t else 
   306 fun find_cterm p t = if p t then t else 
   303  case term_of t of
   307  case term_of t of
   304   a$b => (find_cterm p (Thm.dest_fun t) handle CTERM _ => find_cterm p (Thm.dest_arg t))
   308   _$_ => (find_cterm p (Thm.dest_fun t) handle CTERM _ => find_cterm p (Thm.dest_arg t))
   305  | Abs (_,_,t') => find_cterm p (Thm.dest_abs NONE t |> snd)
   309  | Abs (_,_,_) => find_cterm p (Thm.dest_abs NONE t |> snd)
   306  | _ => raise CTERM ("find_cterm",[t]);
   310  | _ => raise CTERM ("find_cterm",[t]);
   307 
   311 
   308     (* Some conversions-related stuff which has been forbidden entrance into Pure/conv.ML*)
   312     (* Some conversions-related stuff which has been forbidden entrance into Pure/conv.ML*)
   309 fun instantiate_cterm' ty tms = Drule.cterm_rule (Drule.instantiate' ty tms)
   313 fun instantiate_cterm' ty tms = Drule.cterm_rule (Drule.instantiate' ty tms)
   310 fun is_comb t = case (term_of t) of _$_ => true | _ => false;
   314 fun is_comb t = case (term_of t) of _$_ => true | _ => false;
   475   end
   479   end
   476  (* FIXME!!! Copied from groebner.ml *)
   480  (* FIXME!!! Copied from groebner.ml *)
   477  val strip_exists =
   481  val strip_exists =
   478   let fun h (acc, t) =
   482   let fun h (acc, t) =
   479    case (term_of t) of
   483    case (term_of t) of
   480     Const(@{const_name Ex},_)$Abs(x,T,p) => h (Thm.dest_abs NONE (Thm.dest_arg t) |>> (fn v => v::acc))
   484     Const(@{const_name Ex},_)$Abs(_,_,_) => h (Thm.dest_abs NONE (Thm.dest_arg t) |>> (fn v => v::acc))
   481   | _ => (acc,t)
   485   | _ => (acc,t)
   482   in fn t => h ([],t)
   486   in fn t => h ([],t)
   483   end
   487   end
   484   fun name_of x = case term_of x of
   488   fun name_of x = case term_of x of
   485    Free(s,_) => s
   489    Free(s,_) => s
   510      choose v (Thm.assume ((Thm.capply @{cterm Trueprop} o mk_ex v) ((Thm.dest_arg o hd o #hyps o Thm.crep_thm) th))) th
   514      choose v (Thm.assume ((Thm.capply @{cterm Trueprop} o mk_ex v) ((Thm.dest_arg o hd o #hyps o Thm.crep_thm) th))) th
   511 
   515 
   512  val strip_forall =
   516  val strip_forall =
   513   let fun h (acc, t) =
   517   let fun h (acc, t) =
   514    case (term_of t) of
   518    case (term_of t) of
   515     Const(@{const_name All},_)$Abs(x,T,p) => h (Thm.dest_abs NONE (Thm.dest_arg t) |>> (fn v => v::acc))
   519     Const(@{const_name All},_)$Abs(_,_,_) => h (Thm.dest_abs NONE (Thm.dest_arg t) |>> (fn v => v::acc))
   516   | _ => (acc,t)
   520   | _ => (acc,t)
   517   in fn t => h ([],t)
   521   in fn t => h ([],t)
   518   end
   522   end
   519 
   523 
   520  fun f ct =
   524  fun f ct =
   723 (* An instance for reals*) 
   727 (* An instance for reals*) 
   724 
   728 
   725 fun gen_prover_real_arith ctxt prover = 
   729 fun gen_prover_real_arith ctxt prover = 
   726  let
   730  let
   727   fun simple_cterm_ord t u = Term_Ord.term_ord (term_of t, term_of u) = LESS
   731   fun simple_cterm_ord t u = Term_Ord.term_ord (term_of t, term_of u) = LESS
   728   val {add,mul,neg,pow,sub,main} = 
   732   val {add, mul, neg, pow = _, sub = _, main} = 
   729      Semiring_Normalizer.semiring_normalizers_ord_wrapper ctxt
   733      Semiring_Normalizer.semiring_normalizers_ord_wrapper ctxt
   730       (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"})) 
   734       (the (Semiring_Normalizer.match ctxt @{cterm "(0::real) + 1"})) 
   731      simple_cterm_ord
   735      simple_cterm_ord
   732 in gen_real_arith ctxt
   736 in gen_real_arith ctxt
   733    (cterm_of_rat, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv,
   737    (cterm_of_rat, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv, Numeral_Simprocs.field_comp_conv,