integration of Metis prover
authorpaulson
Thu Jun 21 13:23:33 2007 +0200 (2007-06-21)
changeset 23449dd874e6a3282
parent 23448 020381339d87
child 23450 f274975039b2
integration of Metis prover
CONTRIBUTORS
NEWS
src/HOL/IsaMakefile
src/HOL/MetisExamples/Abstraction.thy
src/HOL/MetisExamples/BT.thy
src/HOL/MetisExamples/BigO.thy
src/HOL/MetisExamples/Message.thy
src/HOL/MetisExamples/ROOT.ML
src/HOL/MetisExamples/Tarski.thy
src/HOL/MetisExamples/TransClosure.thy
src/HOL/MetisExamples/set.thy
     1.1 --- a/CONTRIBUTORS	Thu Jun 21 12:01:27 2007 +0200
     1.2 +++ b/CONTRIBUTORS	Thu Jun 21 13:23:33 2007 +0200
     1.3 @@ -10,6 +10,12 @@
     1.4  * June 2007: Amine Chaieb, TUM
     1.5    Semiring normalization and Groebner Bases
     1.6  
     1.7 +* June 2007: Joe Hurd, Oxford
     1.8 +  Metis theorem-prover
     1.9 +
    1.10 +* 2006/2007: Kong W. Susanto, Cambridge
    1.11 +  HOL: Metis prover integration.
    1.12 +
    1.13  * 2006/2007: Florian Haftmann, TUM
    1.14    Pure: generic code generator framework.
    1.15    Pure: class package.
     2.1 --- a/NEWS	Thu Jun 21 12:01:27 2007 +0200
     2.2 +++ b/NEWS	Thu Jun 21 13:23:33 2007 +0200
     2.3 @@ -541,6 +541,13 @@
     2.4  
     2.5  *** HOL ***
     2.6  
     2.7 +* Method "metis" proves goals by applying the Metis general-purpose resolution prover.
     2.8 +  Examples are in the directory MetisExamples.
     2.9 +  
    2.10 +* Command "sledgehammer" invokes external automatic theorem provers as background processes.
    2.11 +  It generates calls to the "metis" method if successful. These can be pasted into the proof.
    2.12 +  Users do not have to wait for the automatic provers to return.
    2.13 +
    2.14  * IntDef: The constant "int :: nat => int" has been removed; now
    2.15    "int" is an abbreviation for "of_nat :: nat => int". Potential
    2.16    INCOMPATIBILITY due to differences in default simp rules:
     3.1 --- a/src/HOL/IsaMakefile	Thu Jun 21 12:01:27 2007 +0200
     3.2 +++ b/src/HOL/IsaMakefile	Thu Jun 21 13:23:33 2007 +0200
     3.3 @@ -27,6 +27,7 @@
     3.4    HOL-Isar_examples \
     3.5    HOL-Lambda \
     3.6    HOL-Lattice \
     3.7 +  HOL-MetisExamples \
     3.8    HOL-MicroJava \
     3.9    HOL-Modelcheck \
    3.10    HOL-NanoJava \
    3.11 @@ -390,6 +391,18 @@
    3.12  	@$(ISATOOL) usedir -g true $(OUT)/HOL HoareParallel
    3.13  
    3.14  
    3.15 +## HOL-MetisExamples
    3.16 +
    3.17 +HOL-MetisExamples: HOL $(LOG)/HOL-MetisExamples.gz
    3.18 +
    3.19 +$(LOG)/HOL-MetisExamples.gz: $(OUT)/HOL \
    3.20 +  MetisExamples/ROOT.ML \
    3.21 +  MetisExamples/Abstraction.thy MetisExamples/BigO.thy MetisExamples/BT.thy \
    3.22 +  MetisExamples/Message.thy MetisExamples/Tarski.thy MetisExamples/TransClosure.thy \
    3.23 +  MetisExamples/set.thy
    3.24 +	@$(ISATOOL) usedir -g true $(OUT)/HOL MetisExamples
    3.25 +
    3.26 +
    3.27  ## HOL-Algebra
    3.28  
    3.29  HOL-Algebra: HOL $(LOG)/HOL-Algebra.gz
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/MetisExamples/Abstraction.thy	Thu Jun 21 13:23:33 2007 +0200
     4.3 @@ -0,0 +1,248 @@
     4.4 +(*  Title:      HOL/MetisExamples/Abstraction.thy
     4.5 +    ID:         $Id$
     4.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     4.7 +
     4.8 +Testing the metis method
     4.9 +*)
    4.10 +
    4.11 +theory Abstraction imports FuncSet
    4.12 +begin
    4.13 +
    4.14 +(*For Christoph Benzmueller*)
    4.15 +lemma "x<1 & ((op=) = (op=)) ==> ((op=) = (op=)) & (x<(2::nat))";
    4.16 +  by (metis One_nat_def less_Suc0 not_less0 not_less_eq numeral_2_eq_2)
    4.17 +
    4.18 +(*this is a theorem, but we can't prove it unless ext is applied explicitly
    4.19 +lemma "(op=) = (%x y. y=x)"
    4.20 +*)
    4.21 +
    4.22 +consts
    4.23 +  monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool"
    4.24 +  pset  :: "'a set => 'a set"
    4.25 +  order :: "'a set => ('a * 'a) set"
    4.26 +
    4.27 +ML{*ResAtp.problem_name := "Abstraction__Collect_triv"*}
    4.28 +lemma (*Collect_triv:*) "a \<in> {x. P x} ==> P a"
    4.29 +proof (neg_clausify)
    4.30 +assume 0: "(a\<Colon>'a\<Colon>type) \<in> Collect (P\<Colon>'a\<Colon>type \<Rightarrow> bool)"
    4.31 +assume 1: "\<not> (P\<Colon>'a\<Colon>type \<Rightarrow> bool) (a\<Colon>'a\<Colon>type)"
    4.32 +have 2: "(P\<Colon>'a\<Colon>type \<Rightarrow> bool) (a\<Colon>'a\<Colon>type)"
    4.33 +  by (metis CollectD 0)
    4.34 +show "False"
    4.35 +  by (metis 2 1)
    4.36 +qed
    4.37 +
    4.38 +lemma Collect_triv: "a \<in> {x. P x} ==> P a"
    4.39 +by (metis member_Collect_eq member_def)
    4.40 +
    4.41 +
    4.42 +ML{*ResAtp.problem_name := "Abstraction__Collect_mp"*}
    4.43 +lemma "a \<in> {x. P x --> Q x} ==> a \<in> {x. P x} ==> a \<in> {x. Q x}"
    4.44 +  by (metis CollectI Collect_imp_eq ComplD UnE memberI member_Collect_eq);
    4.45 +  --{*34 secs*}
    4.46 +
    4.47 +ML{*ResAtp.problem_name := "Abstraction__Sigma_triv"*}
    4.48 +lemma "(a,b) \<in> Sigma A B ==> a \<in> A & b \<in> B a"
    4.49 +proof (neg_clausify)
    4.50 +assume 0: "(a\<Colon>'a\<Colon>type, b\<Colon>'b\<Colon>type) \<in> Sigma (A\<Colon>'a\<Colon>type set) (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set)"
    4.51 +assume 1: "(a\<Colon>'a\<Colon>type) \<notin> (A\<Colon>'a\<Colon>type set) \<or> (b\<Colon>'b\<Colon>type) \<notin> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) a"
    4.52 +have 2: "(a\<Colon>'a\<Colon>type) \<in> (A\<Colon>'a\<Colon>type set)"
    4.53 +  by (metis SigmaD1 0)
    4.54 +have 3: "(b\<Colon>'b\<Colon>type) \<in> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) (a\<Colon>'a\<Colon>type)"
    4.55 +  by (metis SigmaD2 0)
    4.56 +have 4: "(b\<Colon>'b\<Colon>type) \<notin> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) (a\<Colon>'a\<Colon>type)"
    4.57 +  by (metis 1 2)
    4.58 +show "False"
    4.59 +  by (metis 3 4)
    4.60 +qed
    4.61 +
    4.62 +lemma Sigma_triv: "(a,b) \<in> Sigma A B ==> a \<in> A & b \<in> B a"
    4.63 +by (metis SigmaD1 SigmaD2)
    4.64 +
    4.65 +ML{*ResAtp.problem_name := "Abstraction__Sigma_Collect"*}
    4.66 +lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
    4.67 +(*???metis cannot prove this
    4.68 +by (metis CollectD SigmaD1 SigmaD2 UN_eq)
    4.69 +Also, UN_eq is unnecessary*)
    4.70 +by (meson CollectD SigmaD1 SigmaD2)
    4.71 +
    4.72 +
    4.73 +
    4.74 +(*single-step*)
    4.75 +lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
    4.76 +proof (neg_clausify)
    4.77 +assume 0: "(a, b) \<in> Sigma A (llabs_subgoal_1 f)"
    4.78 +assume 1: "\<And>f x. llabs_subgoal_1 f x = Collect (COMBB (op = x) f)"
    4.79 +assume 2: "a \<notin> A \<or> a \<noteq> f b"
    4.80 +have 3: "a \<in> A"
    4.81 +  by (metis SigmaD1 0)
    4.82 +have 4: "b \<in> llabs_subgoal_1 f a"
    4.83 +  by (metis SigmaD2 0)
    4.84 +have 5: "\<And>X1 X2. X2 -` {X1} = llabs_subgoal_1 X2 X1"
    4.85 +  by (metis 1 vimage_Collect_eq singleton_conv2)
    4.86 +have 6: "\<And>X1 X2 X3. X1 X2 = X3 \<or> X2 \<notin> llabs_subgoal_1 X1 X3"
    4.87 +  by (metis vimage_singleton_eq 5)
    4.88 +have 7: "f b \<noteq> a"
    4.89 +  by (metis 2 3)
    4.90 +have 8: "f b = a"
    4.91 +  by (metis 6 4)
    4.92 +show "False"
    4.93 +  by (metis 8 7)
    4.94 +qed finish_clausify
    4.95 +
    4.96 +
    4.97 +ML{*ResAtp.problem_name := "Abstraction__CLF_eq_in_pp"*}
    4.98 +lemma "(cl,f) \<in> CLF ==> CLF = (SIGMA cl: CL.{f. f \<in> pset cl}) ==> f \<in> pset cl"
    4.99 +apply (metis Collect_mem_eq SigmaD2);
   4.100 +done
   4.101 +
   4.102 +lemma "(cl,f) \<in> CLF ==> CLF = (SIGMA cl: CL.{f. f \<in> pset cl}) ==> f \<in> pset cl"proof (neg_clausify)
   4.103 +assume 0: "(cl, f) \<in> CLF"
   4.104 +assume 1: "CLF = Sigma CL llabs_subgoal_1"
   4.105 +assume 2: "\<And>cl. llabs_subgoal_1 cl =
   4.106 +     Collect (llabs_Predicate_XRangeP_def_2_ op \<in> (pset cl))"
   4.107 +assume 3: "f \<notin> pset cl"
   4.108 +show "False"
   4.109 +  by (metis 0 1 SigmaD2 3 2 Collect_mem_eq)
   4.110 +qed finish_clausify (*ugly hack: combinators??*)
   4.111 +
   4.112 +ML{*ResAtp.problem_name := "Abstraction__Sigma_Collect_Pi"*}
   4.113 +lemma
   4.114 +    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
   4.115 +    f \<in> pset cl \<rightarrow> pset cl"
   4.116 +apply (metis Collect_mem_eq SigmaD2);
   4.117 +done
   4.118 +
   4.119 +lemma
   4.120 +    "(cl,f) \<in> (SIGMA cl::'a set : CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
   4.121 +    f \<in> pset cl \<rightarrow> pset cl" 
   4.122 +proof (neg_clausify)
   4.123 +assume 0: "(cl, f) \<in> Sigma CL llabs_subgoal_1"
   4.124 +assume 1: "\<And>cl. llabs_subgoal_1 cl =
   4.125 +     Collect
   4.126 +      (llabs_Predicate_XRangeP_def_2_ op \<in> (Pi (pset cl) (COMBK (pset cl))))"
   4.127 +assume 2: "f \<notin> Pi (pset cl) (COMBK (pset cl))"
   4.128 +show "False"
   4.129 +  by (metis Collect_mem_eq 1 2 SigmaD2 0 member2_def)
   4.130 +qed finish_clausify
   4.131 +    (*Hack to prevent the "Additional hypotheses" error*)
   4.132 +
   4.133 +ML{*ResAtp.problem_name := "Abstraction__Sigma_Collect_Int"*}
   4.134 +lemma
   4.135 +    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
   4.136 +   f \<in> pset cl \<inter> cl"
   4.137 +by (metis Collect_mem_eq SigmaD2)
   4.138 +
   4.139 +ML{*ResAtp.problem_name := "Abstraction__Sigma_Collect_Pi_mono"*}
   4.140 +lemma
   4.141 +    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl & monotone f (pset cl) (order cl)}) ==>
   4.142 +   (f \<in> pset cl \<rightarrow> pset cl)  &  (monotone f (pset cl) (order cl))"
   4.143 +by auto
   4.144 +
   4.145 +ML{*ResAtp.problem_name := "Abstraction__CLF_subset_Collect_Int"*}
   4.146 +lemma "(cl,f) \<in> CLF ==> 
   4.147 +   CLF \<subseteq> (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
   4.148 +   f \<in> pset cl \<inter> cl"
   4.149 +by (metis Collect_mem_eq Int_def SigmaD2 UnCI Un_absorb1)
   4.150 +  --{*@{text Int_def} is redundant}
   4.151 +
   4.152 +ML{*ResAtp.problem_name := "Abstraction__CLF_eq_Collect_Int"*}
   4.153 +lemma "(cl,f) \<in> CLF ==> 
   4.154 +   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
   4.155 +   f \<in> pset cl \<inter> cl"
   4.156 +by (metis Collect_mem_eq Int_commute SigmaD2)
   4.157 +
   4.158 +ML{*ResAtp.problem_name := "Abstraction__CLF_subset_Collect_Pi"*}
   4.159 +lemma 
   4.160 +   "(cl,f) \<in> CLF ==> 
   4.161 +    CLF \<subseteq> (SIGMA cl': CL. {f. f \<in> pset cl' \<rightarrow> pset cl'}) ==> 
   4.162 +    f \<in> pset cl \<rightarrow> pset cl"
   4.163 +by (metis Collect_mem_eq SigmaD2 subsetD)
   4.164 +
   4.165 +ML{*ResAtp.problem_name := "Abstraction__CLF_eq_Collect_Pi"*}
   4.166 +lemma 
   4.167 +  "(cl,f) \<in> CLF ==> 
   4.168 +   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
   4.169 +   f \<in> pset cl \<rightarrow> pset cl"
   4.170 +by (metis Collect_mem_eq SigmaD2 contra_subsetD equalityE)
   4.171 +
   4.172 +ML{*ResAtp.problem_name := "Abstraction__CLF_eq_Collect_Pi_mono"*}
   4.173 +lemma 
   4.174 +  "(cl,f) \<in> CLF ==> 
   4.175 +   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl & monotone f (pset cl) (order cl)}) ==>
   4.176 +   (f \<in> pset cl \<rightarrow> pset cl)  &  (monotone f (pset cl) (order cl))"
   4.177 +by auto
   4.178 +
   4.179 +ML{*ResAtp.problem_name := "Abstraction__map_eq_zipA"*}
   4.180 +lemma "map (%x. (f x, g x)) xs = zip (map f xs) (map g xs)"
   4.181 +apply (induct xs)
   4.182 +(*sledgehammer*)  
   4.183 +apply auto
   4.184 +done
   4.185 +
   4.186 +ML{*ResAtp.problem_name := "Abstraction__map_eq_zipB"*}
   4.187 +lemma "map (%w. (w -> w, w \<times> w)) xs = 
   4.188 +       zip (map (%w. w -> w) xs) (map (%w. w \<times> w) xs)"
   4.189 +apply (induct xs)
   4.190 +(*sledgehammer*)  
   4.191 +apply auto
   4.192 +done
   4.193 +
   4.194 +ML{*ResAtp.problem_name := "Abstraction__image_evenA"*}
   4.195 +lemma "(%x. Suc(f x)) ` {x. even x} <= A ==> (\<forall>x. even x --> Suc(f x) \<in> A)";
   4.196 +(*sledgehammer*)  
   4.197 +by auto
   4.198 +
   4.199 +ML{*ResAtp.problem_name := "Abstraction__image_evenB"*}
   4.200 +lemma "(%x. f (f x)) ` ((%x. Suc(f x)) ` {x. even x}) <= A 
   4.201 +       ==> (\<forall>x. even x --> f (f (Suc(f x))) \<in> A)";
   4.202 +(*sledgehammer*)  
   4.203 +by auto
   4.204 +
   4.205 +ML{*ResAtp.problem_name := "Abstraction__image_curry"*}
   4.206 +lemma "f \<in> (%u v. b \<times> u \<times> v) ` A ==> \<forall>u v. P (b \<times> u \<times> v) ==> P(f y)" 
   4.207 +(*sledgehammer*)  
   4.208 +by auto
   4.209 +
   4.210 +ML{*ResAtp.problem_name := "Abstraction__image_TimesA"*}
   4.211 +lemma image_TimesA: "(%(x,y). (f x, g y)) ` (A \<times> B) = (f`A) \<times> (g`B)"
   4.212 +(*sledgehammer*) 
   4.213 +apply (rule equalityI)
   4.214 +(***Even the two inclusions are far too difficult
   4.215 +ML{*ResAtp.problem_name := "Abstraction__image_TimesA_simpler"*}
   4.216 +***)
   4.217 +apply (rule subsetI)
   4.218 +apply (erule imageE)
   4.219 +(*V manages from here with help: Abstraction__image_TimesA_simpler_1_b.p*)
   4.220 +apply (erule ssubst)
   4.221 +apply (erule SigmaE)
   4.222 +(*V manages from here: Abstraction__image_TimesA_simpler_1_a.p*)
   4.223 +apply (erule ssubst)
   4.224 +apply (subst split_conv)
   4.225 +apply (rule SigmaI) 
   4.226 +apply (erule imageI) +
   4.227 +txt{*subgoal 2*}
   4.228 +apply (clarify );
   4.229 +apply (simp add: );  
   4.230 +apply (rule rev_image_eqI)  
   4.231 +apply (blast intro: elim:); 
   4.232 +apply (simp add: );
   4.233 +done
   4.234 +
   4.235 +(*Given the difficulty of the previous problem, these two are probably
   4.236 +impossible*)
   4.237 +
   4.238 +ML{*ResAtp.problem_name := "Abstraction__image_TimesB"*}
   4.239 +lemma image_TimesB:
   4.240 +    "(%(x,y,z). (f x, g y, h z)) ` (A \<times> B \<times> C) = (f`A) \<times> (g`B) \<times> (h`C)" 
   4.241 +(*sledgehammer*) 
   4.242 +by force
   4.243 +
   4.244 +ML{*ResAtp.problem_name := "Abstraction__image_TimesC"*}
   4.245 +lemma image_TimesC:
   4.246 +    "(%(x,y). (x \<rightarrow> x, y \<times> y)) ` (A \<times> B) = 
   4.247 +     ((%x. x \<rightarrow> x) ` A) \<times> ((%y. y \<times> y) ` B)" 
   4.248 +(*sledgehammer*) 
   4.249 +by auto
   4.250 +
   4.251 +end
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/MetisExamples/BT.thy	Thu Jun 21 13:23:33 2007 +0200
     5.3 @@ -0,0 +1,242 @@
     5.4 +(*  Title:      HOL/MetisTest/BT.thy
     5.5 +    ID:         $Id$
     5.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     5.7 +
     5.8 +Testing the metis method
     5.9 +*)
    5.10 +
    5.11 +header {* Binary trees *}
    5.12 +
    5.13 +theory BT imports Main begin
    5.14 +
    5.15 +
    5.16 +datatype 'a bt =
    5.17 +    Lf
    5.18 +  | Br 'a  "'a bt"  "'a bt"
    5.19 +
    5.20 +consts
    5.21 +  n_nodes   :: "'a bt => nat"
    5.22 +  n_leaves  :: "'a bt => nat"
    5.23 +  depth     :: "'a bt => nat"
    5.24 +  reflect   :: "'a bt => 'a bt"
    5.25 +  bt_map    :: "('a => 'b) => ('a bt => 'b bt)"
    5.26 +  preorder  :: "'a bt => 'a list"
    5.27 +  inorder   :: "'a bt => 'a list"
    5.28 +  postorder :: "'a bt => 'a list"
    5.29 +  appnd    :: "'a bt => 'a bt => 'a bt"
    5.30 +
    5.31 +primrec
    5.32 +  "n_nodes Lf = 0"
    5.33 +  "n_nodes (Br a t1 t2) = Suc (n_nodes t1 + n_nodes t2)"
    5.34 +
    5.35 +primrec
    5.36 +  "n_leaves Lf = Suc 0"
    5.37 +  "n_leaves (Br a t1 t2) = n_leaves t1 + n_leaves t2"
    5.38 +
    5.39 +primrec
    5.40 +  "depth Lf = 0"
    5.41 +  "depth (Br a t1 t2) = Suc (max (depth t1) (depth t2))"
    5.42 +
    5.43 +primrec
    5.44 +  "reflect Lf = Lf"
    5.45 +  "reflect (Br a t1 t2) = Br a (reflect t2) (reflect t1)"
    5.46 +
    5.47 +primrec
    5.48 +  "bt_map f Lf = Lf"
    5.49 +  "bt_map f (Br a t1 t2) = Br (f a) (bt_map f t1) (bt_map f t2)"
    5.50 +
    5.51 +primrec
    5.52 +  "preorder Lf = []"
    5.53 +  "preorder (Br a t1 t2) = [a] @ (preorder t1) @ (preorder t2)"
    5.54 +
    5.55 +primrec
    5.56 +  "inorder Lf = []"
    5.57 +  "inorder (Br a t1 t2) = (inorder t1) @ [a] @ (inorder t2)"
    5.58 +
    5.59 +primrec
    5.60 +  "postorder Lf = []"
    5.61 +  "postorder (Br a t1 t2) = (postorder t1) @ (postorder t2) @ [a]"
    5.62 +
    5.63 +primrec
    5.64 +  "appnd Lf t = t"
    5.65 +  "appnd (Br a t1 t2) t = Br a (appnd t1 t) (appnd t2 t)"
    5.66 +
    5.67 +
    5.68 +text {* \medskip BT simplification *}
    5.69 +
    5.70 +ML {*ResAtp.problem_name := "BT__n_leaves_reflect"*}
    5.71 +lemma n_leaves_reflect: "n_leaves (reflect t) = n_leaves t"
    5.72 +  apply (induct t)
    5.73 +  apply (metis add_right_cancel n_leaves.simps(1) reflect.simps(1))
    5.74 +  apply (metis add_commute n_leaves.simps(2) reflect.simps(2))
    5.75 +  done
    5.76 +
    5.77 +ML {*ResAtp.problem_name := "BT__n_nodes_reflect"*}
    5.78 +lemma n_nodes_reflect: "n_nodes (reflect t) = n_nodes t"
    5.79 +  apply (induct t)
    5.80 +  apply (metis reflect.simps(1))
    5.81 +  apply (metis n_nodes.simps(2) nat_add_commute reflect.simps(2))
    5.82 +  done
    5.83 +
    5.84 +ML {*ResAtp.problem_name := "BT__depth_reflect"*}
    5.85 +lemma depth_reflect: "depth (reflect t) = depth t"
    5.86 +  apply (induct t)
    5.87 +  apply (metis depth.simps(1) reflect.simps(1))
    5.88 +  apply (metis depth.simps(2) min_max.less_eq_less_sup.sup_commute reflect.simps(2))
    5.89 +  done
    5.90 +
    5.91 +text {*
    5.92 +  The famous relationship between the numbers of leaves and nodes.
    5.93 +*}
    5.94 +
    5.95 +ML {*ResAtp.problem_name := "BT__n_leaves_nodes"*}
    5.96 +lemma n_leaves_nodes: "n_leaves t = Suc (n_nodes t)"
    5.97 +  apply (induct t)
    5.98 +  apply (metis n_leaves.simps(1) n_nodes.simps(1))
    5.99 +  apply auto
   5.100 +  done
   5.101 +
   5.102 +ML {*ResAtp.problem_name := "BT__reflect_reflect_ident"*}
   5.103 +lemma reflect_reflect_ident: "reflect (reflect t) = t"
   5.104 +  apply (induct t)
   5.105 +  apply (metis add_right_cancel reflect.simps(1));
   5.106 +  apply (metis Suc_Suc_eq reflect.simps(2))
   5.107 +  done
   5.108 +
   5.109 +ML {*ResAtp.problem_name := "BT__bt_map_ident"*}
   5.110 +lemma bt_map_ident: "bt_map (%x. x) = (%y. y)"
   5.111 +apply (rule ext) 
   5.112 +apply (induct_tac y)
   5.113 +  apply (metis bt_map.simps(1))
   5.114 +txt{*BUG involving flex-flex pairs*}
   5.115 +(*  apply (metis bt_map.simps(2)) *)
   5.116 +apply auto
   5.117 +done
   5.118 +
   5.119 +
   5.120 +ML {*ResAtp.problem_name := "BT__bt_map_appnd"*}
   5.121 +lemma bt_map_appnd: "bt_map f (appnd t u) = appnd (bt_map f t) (bt_map f u)"
   5.122 +apply (induct t)
   5.123 +  apply (metis appnd.simps(1) bt_map.simps(1))
   5.124 +  apply (metis appnd.simps(2) bt_map.simps(2))  (*slow!!*)
   5.125 +done
   5.126 +
   5.127 +
   5.128 +ML {*ResAtp.problem_name := "BT__bt_map_compose"*}
   5.129 +lemma bt_map_compose: "bt_map (f o g) t = bt_map f (bt_map g t)"
   5.130 +apply (induct t) 
   5.131 +  apply (metis bt_map.simps(1))
   5.132 +txt{*Metis runs forever*}
   5.133 +(*  apply (metis bt_map.simps(2) o_apply)*)
   5.134 +apply auto
   5.135 +done
   5.136 +
   5.137 +
   5.138 +ML {*ResAtp.problem_name := "BT__bt_map_reflect"*}
   5.139 +lemma bt_map_reflect: "bt_map f (reflect t) = reflect (bt_map f t)"
   5.140 +  apply (induct t)
   5.141 +  apply (metis add_right_cancel bt_map.simps(1) reflect.simps(1))
   5.142 +  apply (metis add_right_cancel bt_map.simps(2) reflect.simps(2))
   5.143 +  done
   5.144 +
   5.145 +ML {*ResAtp.problem_name := "BT__preorder_bt_map"*}
   5.146 +lemma preorder_bt_map: "preorder (bt_map f t) = map f (preorder t)"
   5.147 +  apply (induct t)
   5.148 +  apply (metis bt_map.simps(1) map.simps(1) preorder.simps(1))
   5.149 +   apply simp
   5.150 +  done
   5.151 +
   5.152 +ML {*ResAtp.problem_name := "BT__inorder_bt_map"*}
   5.153 +lemma inorder_bt_map: "inorder (bt_map f t) = map f (inorder t)"
   5.154 +  apply (induct t)
   5.155 +  apply (metis bt_map.simps(1) inorder.simps(1) map.simps(1))
   5.156 +  apply simp
   5.157 +  done
   5.158 +
   5.159 +ML {*ResAtp.problem_name := "BT__postorder_bt_map"*}
   5.160 +lemma postorder_bt_map: "postorder (bt_map f t) = map f (postorder t)"
   5.161 +  apply (induct t)
   5.162 +  apply (metis bt_map.simps(1) map.simps(1) postorder.simps(1))
   5.163 +   apply simp
   5.164 +  done
   5.165 +
   5.166 +ML {*ResAtp.problem_name := "BT__depth_bt_map"*}
   5.167 +lemma depth_bt_map [simp]: "depth (bt_map f t) = depth t"
   5.168 +  apply (induct t)
   5.169 +  apply (metis bt_map.simps(1) depth.simps(1))
   5.170 +   apply simp
   5.171 +  done
   5.172 +
   5.173 +ML {*ResAtp.problem_name := "BT__n_leaves_bt_map"*}
   5.174 +lemma n_leaves_bt_map [simp]: "n_leaves (bt_map f t) = n_leaves t"
   5.175 +  apply (induct t)
   5.176 +  apply (metis One_nat_def Suc_eq_add_numeral_1 bt_map.simps(1) less_add_one less_antisym linorder_neq_iff n_leaves.simps(1))
   5.177 +  apply (metis add_commute bt_map.simps(2) n_leaves.simps(2))
   5.178 +  done
   5.179 +
   5.180 +
   5.181 +ML {*ResAtp.problem_name := "BT__preorder_reflect"*}
   5.182 +lemma preorder_reflect: "preorder (reflect t) = rev (postorder t)"
   5.183 +  apply (induct t)
   5.184 +  apply (metis postorder.simps(1) preorder.simps(1) reflect.simps(1) rev_is_Nil_conv)
   5.185 +  apply (metis append_eq_append_conv2 inorder.simps(1) postorder.simps(2) preorder.simps(2) reflect.simps(2) rev_append rev_is_rev_conv rev_singleton_conv rev_swap rotate_simps)
   5.186 +  done
   5.187 +
   5.188 +ML {*ResAtp.problem_name := "BT__inorder_reflect"*}
   5.189 +lemma inorder_reflect: "inorder (reflect t) = rev (inorder t)"
   5.190 +  apply (induct t)
   5.191 +  apply (metis inorder.simps(1) reflect.simps(1) rev.simps(1))
   5.192 +  apply simp
   5.193 +  done
   5.194 +
   5.195 +ML {*ResAtp.problem_name := "BT__postorder_reflect"*}
   5.196 +lemma postorder_reflect: "postorder (reflect t) = rev (preorder t)"
   5.197 +  apply (induct t)
   5.198 +  apply (metis postorder.simps(1) preorder.simps(1) reflect.simps(1) rev.simps(1))
   5.199 +  apply (metis Cons_eq_appendI postorder.simps(2) preorder.simps(2) reflect.simps(2) rev.simps(2) rev_append rotate1_def self_append_conv2)
   5.200 +  done
   5.201 +
   5.202 +text {*
   5.203 + Analogues of the standard properties of the append function for lists.
   5.204 +*}
   5.205 +
   5.206 +ML {*ResAtp.problem_name := "BT__appnd_assoc"*}
   5.207 +lemma appnd_assoc [simp]:
   5.208 +     "appnd (appnd t1 t2) t3 = appnd t1 (appnd t2 t3)"
   5.209 +  apply (induct t1)
   5.210 +  apply (metis appnd.simps(1))
   5.211 +  apply (metis appnd.simps(2))
   5.212 +  done
   5.213 +
   5.214 +ML {*ResAtp.problem_name := "BT__appnd_Lf2"*}
   5.215 +lemma appnd_Lf2 [simp]: "appnd t Lf = t"
   5.216 +  apply (induct t)
   5.217 +  apply (metis appnd.simps(1))
   5.218 +  apply (metis appnd.simps(2))
   5.219 +  done
   5.220 +
   5.221 +ML {*ResAtp.problem_name := "BT__depth_appnd"*}
   5.222 +  declare max_add_distrib_left [simp]
   5.223 +lemma depth_appnd [simp]: "depth (appnd t1 t2) = depth t1 + depth t2"
   5.224 +  apply (induct t1)
   5.225 +  apply (metis add_0 appnd.simps(1) depth.simps(1))
   5.226 +apply (simp add: ); 
   5.227 +  done
   5.228 +
   5.229 +ML {*ResAtp.problem_name := "BT__n_leaves_appnd"*}
   5.230 +lemma n_leaves_appnd [simp]:
   5.231 +     "n_leaves (appnd t1 t2) = n_leaves t1 * n_leaves t2"
   5.232 +  apply (induct t1)
   5.233 +  apply (metis One_nat_def appnd.simps(1) less_irrefl less_linear n_leaves.simps(1) nat_mult_1) 
   5.234 +  apply (simp add: left_distrib)
   5.235 +  done
   5.236 +
   5.237 +ML {*ResAtp.problem_name := "BT__bt_map_appnd"*}
   5.238 +lemma bt_map_appnd:
   5.239 +     "bt_map f (appnd t1 t2) = appnd (bt_map f t1) (bt_map f t2)"
   5.240 +  apply (induct t1)
   5.241 +  apply (metis appnd.simps(1) bt_map_appnd)
   5.242 +  apply (metis bt_map_appnd)
   5.243 +  done
   5.244 +
   5.245 +end
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/MetisExamples/BigO.thy	Thu Jun 21 13:23:33 2007 +0200
     6.3 @@ -0,0 +1,1553 @@
     6.4 +(*  Title:      HOL/MetisExamples/BigO.thy
     6.5 +    ID:         $Id$
     6.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     6.7 +
     6.8 +Testing the metis method
     6.9 +*)
    6.10 +
    6.11 +header {* Big O notation *}
    6.12 +
    6.13 +theory BigO
    6.14 +imports SetsAndFunctions 
    6.15 +begin
    6.16 +
    6.17 +subsection {* Definitions *}
    6.18 +
    6.19 +constdefs 
    6.20 +
    6.21 +  bigo :: "('a => 'b::ordered_idom) => ('a => 'b) set"    ("(1O'(_'))")
    6.22 +  "O(f::('a => 'b)) ==   {h. EX c. ALL x. abs (h x) <= c * abs (f x)}"
    6.23 +
    6.24 +ML{*ResAtp.problem_name := "BigO__bigo_pos_const"*}
    6.25 +lemma bigo_pos_const: "(EX (c::'a::ordered_idom). 
    6.26 +    ALL x. (abs (h x)) <= (c * (abs (f x))))
    6.27 +      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
    6.28 +  apply auto
    6.29 +  apply (case_tac "c = 0", simp)
    6.30 +  apply (rule_tac x = "1" in exI, simp)
    6.31 +  apply (rule_tac x = "abs c" in exI, auto);
    6.32 +txt{*Version 1: one-shot proof. MUCH SLOWER with types: 24 versus 6.7 seconds*}
    6.33 +  apply (metis abs_ge_minus_self abs_ge_zero abs_minus_cancel abs_of_nonneg equation_minus_iff Orderings.xt1(6) abs_le_mult)
    6.34 +  done
    6.35 +
    6.36 +(*** Now various verions with an increasing modulus ***)
    6.37 +
    6.38 +ML{*ResReconstruct.modulus := 1*}
    6.39 +
    6.40 +lemma bigo_pos_const: "(EX (c::'a::ordered_idom). 
    6.41 +    ALL x. (abs (h x)) <= (c * (abs (f x))))
    6.42 +      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
    6.43 +  apply auto
    6.44 +  apply (case_tac "c = 0", simp)
    6.45 +  apply (rule_tac x = "1" in exI, simp)
    6.46 +  apply (rule_tac x = "abs c" in exI, auto)
    6.47 +(*hand-modified to give 'a sort ordered_idom and X3 type 'a*)
    6.48 +proof (neg_clausify)
    6.49 +fix c x
    6.50 +assume 0: "\<And>A. \<bar>h A\<bar> \<le> c * \<bar>f A\<bar>"
    6.51 +assume 1: "c \<noteq> (0\<Colon>'a::ordered_idom)"
    6.52 +assume 2: "\<not> \<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>"
    6.53 +have 3: "\<And>X1 X3. \<bar>h X3\<bar> < X1 \<or> \<not> c * \<bar>f X3\<bar> < X1"
    6.54 +  by (metis order_le_less_trans 0)
    6.55 +have 4: "\<And>X3. (1\<Colon>'a) * X3 \<le> X3 \<or> \<not> (1\<Colon>'a) \<le> (1\<Colon>'a)"
    6.56 +  by (metis mult_le_cancel_right2 order_refl)
    6.57 +have 5: "\<And>X3. (1\<Colon>'a) * X3 \<le> X3"
    6.58 +  by (metis 4 order_refl)
    6.59 +have 6: "\<And>X3. \<bar>0\<Colon>'a\<bar> = \<bar>X3\<bar> * (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (0\<Colon>'a)"
    6.60 +  by (metis abs_mult_pos mult_cancel_right1)
    6.61 +have 7: "\<bar>0\<Colon>'a\<bar> = (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (0\<Colon>'a)"
    6.62 +  by (metis 6 mult_cancel_right1)
    6.63 +have 8: "\<bar>0\<Colon>'a\<bar> = (0\<Colon>'a)"
    6.64 +  by (metis 7 order_refl)
    6.65 +have 9: "\<not> (0\<Colon>'a) < (0\<Colon>'a)"
    6.66 +  by (metis abs_not_less_zero 8)
    6.67 +have 10: "\<bar>(1\<Colon>'a) * (0\<Colon>'a)\<bar> = - ((1\<Colon>'a) * (0\<Colon>'a))"
    6.68 +  by (metis abs_of_nonpos 5)
    6.69 +have 11: "(0\<Colon>'a) = - ((1\<Colon>'a) * (0\<Colon>'a))"
    6.70 +  by (metis 10 mult_cancel_right1 8)
    6.71 +have 12: "(0\<Colon>'a) = - (0\<Colon>'a)"
    6.72 +  by (metis 11 mult_cancel_right1)
    6.73 +have 13: "\<And>X3. \<bar>X3\<bar> = X3 \<or> X3 \<le> (0\<Colon>'a)"
    6.74 +  by (metis abs_of_nonneg linorder_linear)
    6.75 +have 14: "c \<le> (0\<Colon>'a) \<or> \<not> \<bar>h x\<bar> \<le> c * \<bar>f x\<bar>"
    6.76 +  by (metis 2 13)
    6.77 +have 15: "c \<le> (0\<Colon>'a)"
    6.78 +  by (metis 14 0)
    6.79 +have 16: "c = (0\<Colon>'a) \<or> c < (0\<Colon>'a)"
    6.80 +  by (metis linorder_antisym_conv2 15)
    6.81 +have 17: "\<bar>c\<bar> = - c"
    6.82 +  by (metis abs_of_nonpos 15)
    6.83 +have 18: "c < (0\<Colon>'a)"
    6.84 +  by (metis 16 1)
    6.85 +have 19: "\<not> \<bar>h x\<bar> \<le> - c * \<bar>f x\<bar>"
    6.86 +  by (metis 2 17)
    6.87 +have 20: "\<And>X3. X3 * (1\<Colon>'a) = X3"
    6.88 +  by (metis mult_cancel_right1 AC_mult.f.commute)
    6.89 +have 21: "\<And>X3. (0\<Colon>'a) \<le> X3 * X3"
    6.90 +  by (metis zero_le_square AC_mult.f.commute)
    6.91 +have 22: "(0\<Colon>'a) \<le> (1\<Colon>'a)"
    6.92 +  by (metis 21 mult_cancel_left1)
    6.93 +have 23: "\<And>X3. (0\<Colon>'a) = X3 \<or> (0\<Colon>'a) \<noteq> - X3"
    6.94 +  by (metis neg_equal_iff_equal 12)
    6.95 +have 24: "\<And>X3. (0\<Colon>'a) = - X3 \<or> X3 \<noteq> (0\<Colon>'a)"
    6.96 +  by (metis 23 minus_equation_iff)
    6.97 +have 25: "\<And>X3. \<bar>0\<Colon>'a\<bar> = \<bar>X3\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
    6.98 +  by (metis abs_minus_cancel 24)
    6.99 +have 26: "\<And>X3. (0\<Colon>'a) = \<bar>X3\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.100 +  by (metis 25 8)
   6.101 +have 27: "\<And>X1 X3. (0\<Colon>'a) * \<bar>X1\<bar> = \<bar>X3 * X1\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.102 +  by (metis abs_mult 26)
   6.103 +have 28: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.104 +  by (metis 27 mult_cancel_left1)
   6.105 +have 29: "\<And>X1 X3. (0\<Colon>'a) = X3 * X1 \<or> (0\<Colon>'a) < (0\<Colon>'a) \<or> X3 \<noteq> (0\<Colon>'a)"
   6.106 +  by (metis zero_less_abs_iff 28)
   6.107 +have 30: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> X3 \<noteq> (0\<Colon>'a)"
   6.108 +  by (metis 29 9)
   6.109 +have 31: "\<And>X1 X3. (0\<Colon>'a) = X1 * X3 \<or> X3 \<noteq> (0\<Colon>'a)"
   6.110 +  by (metis AC_mult.f.commute 30)
   6.111 +have 32: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<bar>X1\<bar> \<noteq> (0\<Colon>'a)"
   6.112 +  by (metis abs_mult 31)
   6.113 +have 33: "\<And>X3::'a. \<bar>X3 * X3\<bar> = X3 * X3"
   6.114 +  by (metis abs_mult_self abs_mult AC_mult.f.commute)
   6.115 +have 34: "\<And>X3. (0\<Colon>'a) \<le> \<bar>X3\<bar> \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.116 +  by (metis abs_ge_zero abs_mult_pos 20)
   6.117 +have 35: "\<And>X3. (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.118 +  by (metis 34 22)
   6.119 +have 36: "\<And>X3. X3 * (1\<Colon>'a) = (0\<Colon>'a) \<or> \<bar>X3\<bar> \<noteq> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.120 +  by (metis abs_eq_0 abs_mult_pos 20)
   6.121 +have 37: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<bar>X3\<bar> \<noteq> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.122 +  by (metis 36 20)
   6.123 +have 38: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<bar>X3\<bar> \<noteq> (0\<Colon>'a)"
   6.124 +  by (metis 37 22)
   6.125 +have 39: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> \<bar>X1\<bar> \<noteq> (0\<Colon>'a)"
   6.126 +  by (metis 38 32)
   6.127 +have 40: "\<And>X3::'a. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.128 +  by (metis abs_idempotent abs_mult_pos 20)
   6.129 +have 41: "\<And>X3::'a. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar>"
   6.130 +  by (metis 40 22)
   6.131 +have 42: "\<And>X3. \<not> \<bar>X3\<bar> < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.132 +  by (metis abs_not_less_zero abs_mult_pos 20)
   6.133 +have 43: "\<And>X3. \<not> \<bar>X3\<bar> < (0\<Colon>'a)"
   6.134 +  by (metis 42 22)
   6.135 +have 44: "\<And>X3. X3 * (1\<Colon>'a) = (0\<Colon>'a) \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.136 +  by (metis abs_le_zero_iff abs_mult_pos 20)
   6.137 +have 45: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.138 +  by (metis 44 20)
   6.139 +have 46: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a)"
   6.140 +  by (metis 45 22)
   6.141 +have 47: "\<And>X3. X3 * X3 = (0\<Colon>'a) \<or> \<not> X3 * X3 \<le> (0\<Colon>'a)"
   6.142 +  by (metis 46 33)
   6.143 +have 48: "\<And>X3. X3 * X3 = (0\<Colon>'a) \<or> \<not> X3 \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> X3"
   6.144 +  by (metis 47 mult_le_0_iff)
   6.145 +have 49: "\<And>X3. \<bar>X3\<bar> = (0\<Colon>'a) \<or> \<not> X3 \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> X3"
   6.146 +  by (metis mult_eq_0_iff abs_mult_self 48)
   6.147 +have 50: "\<And>X1 X3.
   6.148 +   (0\<Colon>'a) * \<bar>X1\<bar> = \<bar>\<bar>X3 * X1\<bar>\<bar> \<or>
   6.149 +   \<not> (0\<Colon>'a) \<le> \<bar>X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.150 +  by (metis abs_mult_pos abs_mult 49)
   6.151 +have 51: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> \<not> X1 \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> X1"
   6.152 +  by (metis 39 49)
   6.153 +have 52: "\<And>X1 X3.
   6.154 +   (0\<Colon>'a) = \<bar>\<bar>X3 * X1\<bar>\<bar> \<or>
   6.155 +   \<not> (0\<Colon>'a) \<le> \<bar>X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.156 +  by (metis 50 mult_cancel_left1)
   6.157 +have 53: "\<And>X1 X3.
   6.158 +   (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<not> (0\<Colon>'a) \<le> \<bar>X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.159 +  by (metis 52 41)
   6.160 +have 54: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.161 +  by (metis 53 35)
   6.162 +have 55: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a)"
   6.163 +  by (metis 54 35)
   6.164 +have 56: "\<And>X1 X3. \<bar>X1 * X3\<bar> = (0\<Colon>'a) \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a)"
   6.165 +  by (metis 55 AC_mult.f.commute)
   6.166 +have 57: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> \<not> \<bar>X1\<bar> \<le> (0\<Colon>'a)"
   6.167 +  by (metis 38 56)
   6.168 +have 58: "\<And>X3. \<bar>h X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> \<bar>f X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>f X3\<bar>"
   6.169 +  by (metis 0 51)
   6.170 +have 59: "\<And>X3. \<bar>h X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> \<bar>f X3\<bar> \<le> (0\<Colon>'a)"
   6.171 +  by (metis 58 35)
   6.172 +have 60: "\<And>X3. \<bar>h X3\<bar> \<le> (0\<Colon>'a) \<or> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.173 +  by (metis 59 linorder_not_le)
   6.174 +have 61: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> (0\<Colon>'a) < \<bar>X1\<bar>"
   6.175 +  by (metis 57 linorder_not_le)
   6.176 +have 62: "(0\<Colon>'a) < \<bar>\<bar>f x\<bar>\<bar> \<or> \<not> \<bar>h x\<bar> \<le> (0\<Colon>'a)"
   6.177 +  by (metis 19 61)
   6.178 +have 63: "(0\<Colon>'a) < \<bar>f x\<bar> \<or> \<not> \<bar>h x\<bar> \<le> (0\<Colon>'a)"
   6.179 +  by (metis 62 41)
   6.180 +have 64: "(0\<Colon>'a) < \<bar>f x\<bar>"
   6.181 +  by (metis 63 60)
   6.182 +have 65: "\<And>X3. \<bar>h X3\<bar> < (0\<Colon>'a) \<or> \<not> c < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.183 +  by (metis 3 mult_less_0_iff)
   6.184 +have 66: "\<And>X3. \<bar>h X3\<bar> < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.185 +  by (metis 65 18)
   6.186 +have 67: "\<And>X3. \<not> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.187 +  by (metis 66 43)
   6.188 +show "False"
   6.189 +  by (metis 67 64)
   6.190 +qed
   6.191 +
   6.192 +lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
   6.193 +    ALL x. (abs (h x)) <= (c * (abs (f x))))
   6.194 +      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
   6.195 +  apply auto
   6.196 +  apply (case_tac "c = 0", simp)
   6.197 +  apply (rule_tac x = "1" in exI, simp)
   6.198 +  apply (rule_tac x = "abs c" in exI, auto);
   6.199 +ML{*ResReconstruct.modulus:=2*}
   6.200 +proof (neg_clausify)
   6.201 +fix c x
   6.202 +assume 0: "\<And>A. \<bar>h A\<bar> \<le> c * \<bar>f A\<bar>"
   6.203 +assume 1: "c \<noteq> (0\<Colon>'a::ordered_idom)"
   6.204 +assume 2: "\<not> \<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>"
   6.205 +have 3: "\<And>X3. (1\<Colon>'a) * X3 \<le> X3"
   6.206 +  by (metis mult_le_cancel_right2 order_refl order_refl)
   6.207 +have 4: "\<bar>0\<Colon>'a\<bar> = (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (0\<Colon>'a)"
   6.208 +  by (metis abs_mult_pos mult_cancel_right1 mult_cancel_right1)
   6.209 +have 5: "\<not> (0\<Colon>'a) < (0\<Colon>'a)"
   6.210 +  by (metis abs_not_less_zero 4 order_refl)
   6.211 +have 6: "(0\<Colon>'a) = - ((1\<Colon>'a) * (0\<Colon>'a))"
   6.212 +  by (metis abs_of_nonpos 3 mult_cancel_right1 4 order_refl)
   6.213 +have 7: "\<And>X3. \<bar>X3\<bar> = X3 \<or> X3 \<le> (0\<Colon>'a)"
   6.214 +  by (metis abs_of_nonneg linorder_linear)
   6.215 +have 8: "c \<le> (0\<Colon>'a)"
   6.216 +  by (metis 2 7 0)
   6.217 +have 9: "\<bar>c\<bar> = - c"
   6.218 +  by (metis abs_of_nonpos 8)
   6.219 +have 10: "\<not> \<bar>h x\<bar> \<le> - c * \<bar>f x\<bar>"
   6.220 +  by (metis 2 9)
   6.221 +have 11: "\<And>X3. X3 * (1\<Colon>'a) = X3"
   6.222 +  by (metis mult_cancel_right1 AC_mult.f.commute)
   6.223 +have 12: "(0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.224 +  by (metis zero_le_square AC_mult.f.commute mult_cancel_left1)
   6.225 +have 13: "\<And>X3. (0\<Colon>'a) = - X3 \<or> X3 \<noteq> (0\<Colon>'a)"
   6.226 +  by (metis neg_equal_iff_equal 6 mult_cancel_right1 minus_equation_iff)
   6.227 +have 14: "\<And>X3. (0\<Colon>'a) = \<bar>X3\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.228 +  by (metis abs_minus_cancel 13 4 order_refl)
   6.229 +have 15: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.230 +  by (metis abs_mult 14 mult_cancel_left1)
   6.231 +have 16: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> X3 \<noteq> (0\<Colon>'a)"
   6.232 +  by (metis zero_less_abs_iff 15 5)
   6.233 +have 17: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<bar>X1\<bar> \<noteq> (0\<Colon>'a)"
   6.234 +  by (metis abs_mult AC_mult.f.commute 16)
   6.235 +have 18: "\<And>X3. (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.236 +  by (metis abs_ge_zero abs_mult_pos 11 12)
   6.237 +have 19: "\<And>X3. X3 * (1\<Colon>'a) = (0\<Colon>'a) \<or> \<bar>X3\<bar> \<noteq> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.238 +  by (metis abs_eq_0 abs_mult_pos 11)
   6.239 +have 20: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<bar>X3\<bar> \<noteq> (0\<Colon>'a)"
   6.240 +  by (metis 19 11 12)
   6.241 +have 21: "\<And>X3::'a. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.242 +  by (metis abs_idempotent abs_mult_pos 11)
   6.243 +have 22: "\<And>X3. \<not> \<bar>X3\<bar> < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.244 +  by (metis abs_not_less_zero abs_mult_pos 11)
   6.245 +have 23: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.246 +  by (metis abs_le_zero_iff abs_mult_pos 11 11)
   6.247 +have 24: "\<And>X3. X3 * X3 = (0\<Colon>'a) \<or> \<not> X3 * X3 \<le> (0\<Colon>'a)"
   6.248 +  by (metis 23 12 abs_mult_self abs_mult AC_mult.f.commute)
   6.249 +have 25: "\<And>X3. \<bar>X3\<bar> = (0\<Colon>'a) \<or> \<not> X3 \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> X3"
   6.250 +  by (metis mult_eq_0_iff abs_mult_self 24 mult_le_0_iff)
   6.251 +have 26: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> \<not> X1 \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> X1"
   6.252 +  by (metis 20 17 25)
   6.253 +have 27: "\<And>X1 X3.
   6.254 +   (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<not> (0\<Colon>'a) \<le> \<bar>X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.255 +  by (metis abs_mult_pos abs_mult 25 mult_cancel_left1 21 12)
   6.256 +have 28: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a)"
   6.257 +  by (metis 27 18 18)
   6.258 +have 29: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> \<not> \<bar>X1\<bar> \<le> (0\<Colon>'a)"
   6.259 +  by (metis 20 28 AC_mult.f.commute)
   6.260 +have 30: "\<And>X3. \<bar>h X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> \<bar>f X3\<bar> \<le> (0\<Colon>'a)"
   6.261 +  by (metis 0 26 18)
   6.262 +have 31: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> (0\<Colon>'a) < \<bar>X1\<bar>"
   6.263 +  by (metis 29 linorder_not_le)
   6.264 +have 32: "(0\<Colon>'a) < \<bar>f x\<bar> \<or> \<not> \<bar>h x\<bar> \<le> (0\<Colon>'a)"
   6.265 +  by (metis 10 31 21 12)
   6.266 +have 33: "\<And>X3. \<bar>h X3\<bar> < (0\<Colon>'a) \<or> \<not> c < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.267 +  by (metis order_le_less_trans 0 mult_less_0_iff)
   6.268 +have 34: "\<And>X3. \<not> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.269 +  by (metis 33 linorder_antisym_conv2 8 1 22 12)
   6.270 +show "False"
   6.271 +  by (metis 34 32 30 linorder_not_le)
   6.272 +qed
   6.273 +
   6.274 +lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
   6.275 +    ALL x. (abs (h x)) <= (c * (abs (f x))))
   6.276 +      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
   6.277 +  apply auto
   6.278 +  apply (case_tac "c = 0", simp)
   6.279 +  apply (rule_tac x = "1" in exI, simp)
   6.280 +  apply (rule_tac x = "abs c" in exI, auto);
   6.281 +ML{*ResReconstruct.modulus:=3*}
   6.282 +proof (neg_clausify)
   6.283 +fix c x
   6.284 +assume 0: "\<And>A\<Colon>'b\<Colon>type.
   6.285 +   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) A\<bar>
   6.286 +   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) A\<bar>"
   6.287 +assume 1: "(c\<Colon>'a\<Colon>ordered_idom) \<noteq> (0\<Colon>'a\<Colon>ordered_idom)"
   6.288 +assume 2: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
   6.289 +  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
   6.290 +have 3: "\<And>X3\<Colon>'a\<Colon>ordered_idom. (1\<Colon>'a\<Colon>ordered_idom) * X3 \<le> X3"
   6.291 +  by (metis mult_le_cancel_right2 order_refl order_refl)
   6.292 +have 4: "\<bar>0\<Colon>'a\<Colon>ordered_idom\<bar> = (0\<Colon>'a\<Colon>ordered_idom)"
   6.293 +  by (metis abs_mult_pos mult_cancel_right1 mult_cancel_right1 order_refl)
   6.294 +have 5: "(0\<Colon>'a\<Colon>ordered_idom) = - ((1\<Colon>'a\<Colon>ordered_idom) * (0\<Colon>'a\<Colon>ordered_idom))"
   6.295 +  by (metis abs_of_nonpos 3 mult_cancel_right1 4)
   6.296 +have 6: "(c\<Colon>'a\<Colon>ordered_idom) \<le> (0\<Colon>'a\<Colon>ordered_idom)"
   6.297 +  by (metis 2 abs_of_nonneg linorder_linear 0)
   6.298 +have 7: "(c\<Colon>'a\<Colon>ordered_idom) < (0\<Colon>'a\<Colon>ordered_idom)"
   6.299 +  by (metis linorder_antisym_conv2 6 1)
   6.300 +have 8: "\<And>X3\<Colon>'a\<Colon>ordered_idom. X3 * (1\<Colon>'a\<Colon>ordered_idom) = X3"
   6.301 +  by (metis mult_cancel_right1 AC_mult.f.commute)
   6.302 +have 9: "\<And>X3\<Colon>'a\<Colon>ordered_idom. (0\<Colon>'a\<Colon>ordered_idom) = X3 \<or> (0\<Colon>'a\<Colon>ordered_idom) \<noteq> - X3"
   6.303 +  by (metis neg_equal_iff_equal 5 mult_cancel_right1)
   6.304 +have 10: "\<And>X3\<Colon>'a\<Colon>ordered_idom. (0\<Colon>'a\<Colon>ordered_idom) = \<bar>X3\<bar> \<or> X3 \<noteq> (0\<Colon>'a\<Colon>ordered_idom)"
   6.305 +  by (metis abs_minus_cancel 9 minus_equation_iff 4)
   6.306 +have 11: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X3\<Colon>'a\<Colon>ordered_idom.
   6.307 +   (0\<Colon>'a\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>X3 * X1\<bar> \<or> X3 \<noteq> (0\<Colon>'a\<Colon>ordered_idom)"
   6.308 +  by (metis abs_mult 10)
   6.309 +have 12: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X3\<Colon>'a\<Colon>ordered_idom.
   6.310 +   X3 * X1 = (0\<Colon>'a\<Colon>ordered_idom) \<or> X3 \<noteq> (0\<Colon>'a\<Colon>ordered_idom)"
   6.311 +  by (metis zero_less_abs_iff 11 mult_cancel_left1 abs_not_less_zero 4)
   6.312 +have 13: "\<And>X3\<Colon>'a\<Colon>ordered_idom. \<bar>X3 * X3\<bar> = X3 * X3"
   6.313 +  by (metis abs_mult_self abs_mult AC_mult.f.commute)
   6.314 +have 14: "\<And>X3\<Colon>'a\<Colon>ordered_idom. (0\<Colon>'a\<Colon>ordered_idom) \<le> \<bar>X3\<bar>"
   6.315 +  by (metis abs_ge_zero abs_mult_pos 8 zero_le_square AC_mult.f.commute mult_cancel_left1)
   6.316 +have 15: "\<And>X3\<Colon>'a\<Colon>ordered_idom.
   6.317 +   X3 = (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.318 +   \<bar>X3\<bar> \<noteq> (0\<Colon>'a\<Colon>ordered_idom) \<or> \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> (1\<Colon>'a\<Colon>ordered_idom)"
   6.319 +  by (metis abs_eq_0 abs_mult_pos 8 8)
   6.320 +have 16: "\<And>X3\<Colon>'a\<Colon>ordered_idom.
   6.321 +   \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> \<or> \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> (1\<Colon>'a\<Colon>ordered_idom)"
   6.322 +  by (metis abs_idempotent abs_mult_pos 8)
   6.323 +have 17: "\<And>X3\<Colon>'a\<Colon>ordered_idom. \<not> \<bar>X3\<bar> < (0\<Colon>'a\<Colon>ordered_idom)"
   6.324 +  by (metis abs_not_less_zero abs_mult_pos 8 zero_le_square AC_mult.f.commute mult_cancel_left1)
   6.325 +have 18: "\<And>X3\<Colon>'a\<Colon>ordered_idom.
   6.326 +   X3 = (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.327 +   \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.328 +   \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> (1\<Colon>'a\<Colon>ordered_idom)"
   6.329 +  by (metis abs_le_zero_iff abs_mult_pos 8 8)
   6.330 +have 19: "\<And>X3\<Colon>'a\<Colon>ordered_idom.
   6.331 +   X3 * X3 = (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.332 +   \<not> X3 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> X3"
   6.333 +  by (metis 18 zero_le_square AC_mult.f.commute mult_cancel_left1 13 mult_le_0_iff)
   6.334 +have 20: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X3\<Colon>'a\<Colon>ordered_idom.
   6.335 +   X3 * X1 = (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.336 +   \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> X1"
   6.337 +  by (metis 15 zero_le_square AC_mult.f.commute mult_cancel_left1 abs_mult AC_mult.f.commute 12 mult_eq_0_iff abs_mult_self 19)
   6.338 +have 21: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X3\<Colon>'a\<Colon>ordered_idom.
   6.339 +   (0\<Colon>'a\<Colon>ordered_idom) = \<bar>X3 * X1\<bar> \<or>
   6.340 +   \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> \<bar>X3\<bar>"
   6.341 +  by (metis abs_mult_pos abs_mult mult_eq_0_iff abs_mult_self 19 mult_cancel_left1 16 zero_le_square AC_mult.f.commute mult_cancel_left1 14)
   6.342 +have 22: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X3\<Colon>'a\<Colon>ordered_idom.
   6.343 +   X3 * X1 = (0\<Colon>'a\<Colon>ordered_idom) \<or> \<not> \<bar>X1\<bar> \<le> (0\<Colon>'a\<Colon>ordered_idom)"
   6.344 +  by (metis 15 zero_le_square AC_mult.f.commute mult_cancel_left1 21 14 AC_mult.f.commute)
   6.345 +have 23: "\<And>X3\<Colon>'b\<Colon>type.
   6.346 +   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X3\<bar> \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.347 +   (0\<Colon>'a\<Colon>ordered_idom) < \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X3\<bar>"
   6.348 +  by (metis 0 20 14 linorder_not_le)
   6.349 +have 24: "(0\<Colon>'a\<Colon>ordered_idom) < \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar> \<or>
   6.350 +\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar> \<le> (0\<Colon>'a\<Colon>ordered_idom)"
   6.351 +  by (metis 2 abs_of_nonpos 6 22 linorder_not_le 16 zero_le_square AC_mult.f.commute mult_cancel_left1)
   6.352 +have 25: "\<And>X3\<Colon>'b\<Colon>type.
   6.353 +   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X3\<bar> < (0\<Colon>'a\<Colon>ordered_idom) \<or>
   6.354 +   \<not> (0\<Colon>'a\<Colon>ordered_idom) < \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X3\<bar>"
   6.355 +  by (metis order_le_less_trans 0 mult_less_0_iff 7)
   6.356 +show "False"
   6.357 +  by (metis 25 17 24 23)
   6.358 +qed
   6.359 +
   6.360 +lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
   6.361 +    ALL x. (abs (h x)) <= (c * (abs (f x))))
   6.362 +      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
   6.363 +  apply auto
   6.364 +  apply (case_tac "c = 0", simp)
   6.365 +  apply (rule_tac x = "1" in exI, simp)
   6.366 +  apply (rule_tac x = "abs c" in exI, auto);
   6.367 +ML{*ResReconstruct.modulus:=4*}
   6.368 +ML{*ResReconstruct.recon_sorts:=false*}
   6.369 +proof (neg_clausify)
   6.370 +fix c x
   6.371 +assume 0: "\<And>A. \<bar>h A\<bar> \<le> c * \<bar>f A\<bar>"
   6.372 +assume 1: "c \<noteq> (0\<Colon>'a)"
   6.373 +assume 2: "\<not> \<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>"
   6.374 +have 3: "\<And>X3. (1\<Colon>'a) * X3 \<le> X3"
   6.375 +  by (metis mult_le_cancel_right2 order_refl order_refl)
   6.376 +have 4: "\<not> (0\<Colon>'a) < (0\<Colon>'a)"
   6.377 +  by (metis abs_not_less_zero abs_mult_pos mult_cancel_right1 mult_cancel_right1 order_refl)
   6.378 +have 5: "c \<le> (0\<Colon>'a)"
   6.379 +  by (metis 2 abs_of_nonneg linorder_linear 0)
   6.380 +have 6: "\<not> \<bar>h x\<bar> \<le> - c * \<bar>f x\<bar>"
   6.381 +  by (metis 2 abs_of_nonpos 5)
   6.382 +have 7: "(0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.383 +  by (metis zero_le_square AC_mult.f.commute mult_cancel_left1)
   6.384 +have 8: "\<And>X3. (0\<Colon>'a) = \<bar>X3\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.385 +  by (metis abs_minus_cancel neg_equal_iff_equal abs_of_nonpos 3 mult_cancel_right1 abs_mult_pos mult_cancel_right1 mult_cancel_right1 order_refl mult_cancel_right1 minus_equation_iff abs_mult_pos mult_cancel_right1 mult_cancel_right1 order_refl)
   6.386 +have 9: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> X3 \<noteq> (0\<Colon>'a)"
   6.387 +  by (metis abs_mult 8 mult_cancel_left1)
   6.388 +have 10: "\<And>X1 X3. (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<bar>X1\<bar> \<noteq> (0\<Colon>'a)"
   6.389 +  by (metis abs_mult AC_mult.f.commute zero_less_abs_iff 9 4)
   6.390 +have 11: "\<And>X3. (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.391 +  by (metis abs_ge_zero abs_mult_pos mult_cancel_right1 AC_mult.f.commute 7)
   6.392 +have 12: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<bar>X3\<bar> \<noteq> (0\<Colon>'a)"
   6.393 +  by (metis abs_eq_0 abs_mult_pos mult_cancel_right1 AC_mult.f.commute mult_cancel_right1 AC_mult.f.commute 7)
   6.394 +have 13: "\<And>X3. \<not> \<bar>X3\<bar> < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.395 +  by (metis abs_not_less_zero abs_mult_pos mult_cancel_right1 AC_mult.f.commute)
   6.396 +have 14: "\<And>X3. X3 = (0\<Colon>'a) \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> (1\<Colon>'a)"
   6.397 +  by (metis abs_le_zero_iff abs_mult_pos mult_cancel_right1 AC_mult.f.commute mult_cancel_right1 AC_mult.f.commute)
   6.398 +have 15: "\<And>X3. \<bar>X3\<bar> = (0\<Colon>'a) \<or> \<not> X3 \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> X3"
   6.399 +  by (metis mult_eq_0_iff abs_mult_self 14 7 abs_mult_self abs_mult AC_mult.f.commute mult_le_0_iff)
   6.400 +have 16: "\<And>X1 X3.
   6.401 +   (0\<Colon>'a) = \<bar>X3 * X1\<bar> \<or> \<not> (0\<Colon>'a) \<le> \<bar>X1\<bar> \<or> \<not> \<bar>X3\<bar> \<le> (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) \<le> \<bar>X3\<bar>"
   6.402 +  by (metis abs_mult_pos abs_mult 15 mult_cancel_left1 abs_idempotent abs_mult_pos mult_cancel_right1 AC_mult.f.commute 7)
   6.403 +have 17: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> \<not> \<bar>X1\<bar> \<le> (0\<Colon>'a)"
   6.404 +  by (metis 12 16 11 11 AC_mult.f.commute)
   6.405 +have 18: "\<And>X1 X3. X3 * X1 = (0\<Colon>'a) \<or> (0\<Colon>'a) < \<bar>X1\<bar>"
   6.406 +  by (metis 17 linorder_not_le)
   6.407 +have 19: "\<And>X3. \<bar>h X3\<bar> < (0\<Colon>'a) \<or> \<not> c < (0\<Colon>'a) \<or> \<not> (0\<Colon>'a) < \<bar>f X3\<bar>"
   6.408 +  by (metis order_le_less_trans 0 mult_less_0_iff)
   6.409 +show "False"
   6.410 +  by (metis 19 linorder_antisym_conv2 5 1 13 7 6 18 abs_idempotent abs_mult_pos mult_cancel_right1 AC_mult.f.commute 7 0 12 10 15 11 linorder_not_le)
   6.411 +qed
   6.412 +
   6.413 +
   6.414 +ML{*ResReconstruct.modulus:=1*}
   6.415 +ML{*ResReconstruct.recon_sorts:=true*}
   6.416 +
   6.417 +lemma bigo_alt_def: "O(f) = 
   6.418 +    {h. EX c. (0 < c & (ALL x. abs (h x) <= c * abs (f x)))}"
   6.419 +by (auto simp add: bigo_def bigo_pos_const)
   6.420 +
   6.421 +ML{*ResAtp.problem_name := "BigO__bigo_elt_subset"*}
   6.422 +lemma bigo_elt_subset [intro]: "f : O(g) ==> O(f) <= O(g)"
   6.423 +  apply (auto simp add: bigo_alt_def)
   6.424 +  apply (rule_tac x = "ca * c" in exI)
   6.425 +  apply (rule conjI)
   6.426 +  apply (rule mult_pos_pos)
   6.427 +  apply (assumption)+ 
   6.428 +(*sledgehammer*);
   6.429 +  apply (rule allI)
   6.430 +  apply (drule_tac x = "xa" in spec)+
   6.431 +  apply (subgoal_tac "ca * abs(f xa) <= ca * (c * abs(g xa))");
   6.432 +  apply (erule order_trans)
   6.433 +  apply (simp add: mult_ac)
   6.434 +  apply (rule mult_left_mono, assumption)
   6.435 +  apply (rule order_less_imp_le, assumption);
   6.436 +done
   6.437 +
   6.438 +
   6.439 +ML{*ResAtp.problem_name := "BigO__bigo_refl"*}
   6.440 +lemma bigo_refl [intro]: "f : O(f)"
   6.441 +  apply(auto simp add: bigo_def)
   6.442 +proof (neg_clausify)
   6.443 +fix x
   6.444 +assume 0: "\<And>mes_pSG\<Colon>'b\<Colon>ordered_idom.
   6.445 +   \<not> \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) mes_pSG)\<bar>
   6.446 +     \<le> mes_pSG * \<bar>f (x mes_pSG)\<bar>"
   6.447 +have 1: "\<And>X3\<Colon>'b. X3 \<le> (1\<Colon>'b) * X3 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
   6.448 +  by (metis Ring_and_Field.mult_le_cancel_right1 order_refl)
   6.449 +have 2: "\<And>X3\<Colon>'b. X3 \<le> (1\<Colon>'b) * X3"
   6.450 +  by (metis 1 order_refl)
   6.451 +show 3: "False"
   6.452 +  by (metis 0 2)
   6.453 +qed
   6.454 +
   6.455 +ML{*ResAtp.problem_name := "BigO__bigo_zero"*}
   6.456 +lemma bigo_zero: "0 : O(g)"
   6.457 +  apply (auto simp add: bigo_def func_zero)
   6.458 +proof (neg_clausify)
   6.459 +fix x
   6.460 +assume 0: "\<And>mes_mVM\<Colon>'b\<Colon>ordered_idom.
   6.461 +   \<not> (0\<Colon>'b\<Colon>ordered_idom)
   6.462 +     \<le> mes_mVM *
   6.463 +       \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom)
   6.464 +         ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) mes_mVM)\<bar>"
   6.465 +have 1: "(0\<Colon>'b\<Colon>ordered_idom) < (0\<Colon>'b\<Colon>ordered_idom)"
   6.466 +  by (metis 0 Ring_and_Field.mult_le_cancel_left1)
   6.467 +show 2: "False"
   6.468 +  by (metis Orderings.linorder_class.neq_iff 1)
   6.469 +qed
   6.470 +
   6.471 +lemma bigo_zero2: "O(%x.0) = {%x.0}"
   6.472 +  apply (auto simp add: bigo_def) 
   6.473 +  apply (rule ext)
   6.474 +  apply auto
   6.475 +done
   6.476 +
   6.477 +lemma bigo_plus_self_subset [intro]: 
   6.478 +  "O(f) + O(f) <= O(f)"
   6.479 +  apply (auto simp add: bigo_alt_def set_plus)
   6.480 +  apply (rule_tac x = "c + ca" in exI)
   6.481 +  apply auto
   6.482 +  apply (simp add: ring_distrib func_plus)
   6.483 +  apply (blast intro:order_trans abs_triangle_ineq add_mono elim:) 
   6.484 +done
   6.485 +
   6.486 +lemma bigo_plus_idemp [simp]: "O(f) + O(f) = O(f)"
   6.487 +  apply (rule equalityI)
   6.488 +  apply (rule bigo_plus_self_subset)
   6.489 +  apply (rule set_zero_plus2) 
   6.490 +  apply (rule bigo_zero)
   6.491 +done
   6.492 +
   6.493 +lemma bigo_plus_subset [intro]: "O(f + g) <= O(f) + O(g)"
   6.494 +  apply (rule subsetI)
   6.495 +  apply (auto simp add: bigo_def bigo_pos_const func_plus set_plus)
   6.496 +  apply (subst bigo_pos_const [symmetric])+
   6.497 +  apply (rule_tac x = 
   6.498 +    "%n. if abs (g n) <= (abs (f n)) then x n else 0" in exI)
   6.499 +  apply (rule conjI)
   6.500 +  apply (rule_tac x = "c + c" in exI)
   6.501 +  apply (clarsimp)
   6.502 +  apply (auto)
   6.503 +  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (f xa)")
   6.504 +  apply (erule_tac x = xa in allE)
   6.505 +  apply (erule order_trans)
   6.506 +  apply (simp)
   6.507 +  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
   6.508 +  apply (erule order_trans)
   6.509 +  apply (simp add: ring_distrib)
   6.510 +  apply (rule mult_left_mono)
   6.511 +  apply assumption
   6.512 +  apply (simp add: order_less_le)
   6.513 +  apply (rule mult_left_mono)
   6.514 +  apply (simp add: abs_triangle_ineq)
   6.515 +  apply (simp add: order_less_le)
   6.516 +  apply (rule mult_nonneg_nonneg)
   6.517 +  apply (rule add_nonneg_nonneg)
   6.518 +  apply auto
   6.519 +  apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
   6.520 +     in exI)
   6.521 +  apply (rule conjI)
   6.522 +  apply (rule_tac x = "c + c" in exI)
   6.523 +  apply auto
   6.524 +  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
   6.525 +  apply (erule_tac x = xa in allE)
   6.526 +  apply (erule order_trans)
   6.527 +  apply (simp)
   6.528 +  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
   6.529 +  apply (erule order_trans)
   6.530 +  apply (simp add: ring_distrib)
   6.531 +  apply (rule mult_left_mono)
   6.532 +  apply (simp add: order_less_le)
   6.533 +  apply (simp add: order_less_le)
   6.534 +  apply (rule mult_left_mono)
   6.535 +  apply (rule abs_triangle_ineq)
   6.536 +  apply (simp add: order_less_le)
   6.537 +  apply (rule mult_nonneg_nonneg)
   6.538 +  apply (rule add_nonneg_nonneg)
   6.539 +  apply (erule order_less_imp_le)+
   6.540 +  apply simp
   6.541 +  apply (rule ext)
   6.542 +  apply (auto simp add: if_splits linorder_not_le)
   6.543 +done
   6.544 +
   6.545 +lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A + B <= O(f)"
   6.546 +  apply (subgoal_tac "A + B <= O(f) + O(f)")
   6.547 +  apply (erule order_trans)
   6.548 +  apply simp
   6.549 +  apply (auto del: subsetI simp del: bigo_plus_idemp)
   6.550 +done
   6.551 +
   6.552 +ML{*ResAtp.problem_name := "BigO__bigo_plus_eq"*}
   6.553 +lemma bigo_plus_eq: "ALL x. 0 <= f x ==> ALL x. 0 <= g x ==> 
   6.554 +  O(f + g) = O(f) + O(g)"
   6.555 +  apply (rule equalityI)
   6.556 +  apply (rule bigo_plus_subset)
   6.557 +  apply (simp add: bigo_alt_def set_plus func_plus)
   6.558 +  apply clarify 
   6.559 +(*sledgehammer*); 
   6.560 +  apply (rule_tac x = "max c ca" in exI)
   6.561 +  apply (rule conjI)
   6.562 +  apply (subgoal_tac "c <= max c ca")
   6.563 +  apply (erule order_less_le_trans)
   6.564 +  apply assumption
   6.565 +  apply (rule le_maxI1)
   6.566 +  apply clarify
   6.567 +  apply (drule_tac x = "xa" in spec)+
   6.568 +  apply (subgoal_tac "0 <= f xa + g xa")
   6.569 +  apply (simp add: ring_distrib)
   6.570 +  apply (subgoal_tac "abs(a xa + b xa) <= abs(a xa) + abs(b xa)")
   6.571 +  apply (subgoal_tac "abs(a xa) + abs(b xa) <= 
   6.572 +      max c ca * f xa + max c ca * g xa")
   6.573 +  apply (blast intro: order_trans)
   6.574 +  defer 1
   6.575 +  apply (rule abs_triangle_ineq)
   6.576 +  apply (rule add_nonneg_nonneg)
   6.577 +  apply assumption+
   6.578 +  apply (rule add_mono)
   6.579 +ML{*ResAtp.problem_name := "BigO__bigo_plus_eq_simpler"*} 
   6.580 +(*sledgehammer...fails*); 
   6.581 +  apply (subgoal_tac "c * f xa <= max c ca * f xa")
   6.582 +  apply (blast intro: order_trans)
   6.583 +  apply (rule mult_right_mono)
   6.584 +  apply (rule le_maxI1)
   6.585 +  apply assumption
   6.586 +  apply (subgoal_tac "ca * g xa <= max c ca * g xa")
   6.587 +  apply (blast intro: order_trans)
   6.588 +  apply (rule mult_right_mono)
   6.589 +  apply (rule le_maxI2)
   6.590 +  apply assumption
   6.591 +done
   6.592 +
   6.593 +ML{*ResAtp.problem_name := "BigO__bigo_bounded_alt"*}
   6.594 +lemma bigo_bounded_alt: "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> 
   6.595 +    f : O(g)" 
   6.596 +  apply (auto simp add: bigo_def)
   6.597 +(*Version 1: one-shot proof*)
   6.598 +  apply (metis OrderedGroup.abs_ge_self  OrderedGroup.abs_le_D1  OrderedGroup.abs_of_nonneg  Orderings.linorder_class.not_less  order_less_le  Orderings.xt1(12)  Ring_and_Field.abs_mult)
   6.599 +  done
   6.600 +
   6.601 +lemma bigo_bounded_alt: "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> 
   6.602 +    f : O(g)" 
   6.603 +  apply (auto simp add: bigo_def)
   6.604 +(*Version 2: single-step proof*)
   6.605 +proof (neg_clausify)
   6.606 +fix x
   6.607 +assume 0: "\<And>mes_mbt\<Colon>'a.
   6.608 +   (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) mes_mbt
   6.609 +   \<le> (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) mes_mbt"
   6.610 +assume 1: "\<And>mes_mbs\<Colon>'b\<Colon>ordered_idom.
   6.611 +   \<not> (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) mes_mbs)
   6.612 +     \<le> mes_mbs * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x mes_mbs)\<bar>"
   6.613 +have 2: "\<And>X3\<Colon>'a.
   6.614 +   (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) X3 =
   6.615 +   (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) X3 \<or>
   6.616 +   \<not> c * g X3 \<le> f X3"
   6.617 +  by (metis Lattices.min_max.less_eq_less_inf.antisym_intro 0)
   6.618 +have 3: "\<And>X3\<Colon>'b\<Colon>ordered_idom.
   6.619 +   \<not> (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>X3\<bar>)
   6.620 +     \<le> \<bar>X3 * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X3\<bar>)\<bar>"
   6.621 +  by (metis 1 Ring_and_Field.abs_mult)
   6.622 +have 4: "\<And>X3\<Colon>'b\<Colon>ordered_idom. (1\<Colon>'b\<Colon>ordered_idom) * X3 = X3"
   6.623 +  by (metis Ring_and_Field.mult_cancel_left2 Finite_Set.AC_mult.f.commute)
   6.624 +have 5: "\<And>X3\<Colon>'b\<Colon>ordered_idom. X3 * (1\<Colon>'b\<Colon>ordered_idom) = X3"
   6.625 +  by (metis Ring_and_Field.mult_cancel_right2 Finite_Set.AC_mult.f.commute)
   6.626 +have 6: "\<And>X3\<Colon>'b\<Colon>ordered_idom. \<bar>X3\<bar> * \<bar>X3\<bar> = X3 * X3"
   6.627 +  by (metis Ring_and_Field.abs_mult_self Finite_Set.AC_mult.f.commute)
   6.628 +have 7: "\<And>X3\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> X3 * X3"
   6.629 +  by (metis Ring_and_Field.zero_le_square Finite_Set.AC_mult.f.commute)
   6.630 +have 8: "(0\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.631 +  by (metis 7 Ring_and_Field.mult_cancel_left2)
   6.632 +have 9: "\<And>X3\<Colon>'b\<Colon>ordered_idom. X3 * X3 = \<bar>X3 * X3\<bar>"
   6.633 +  by (metis Ring_and_Field.abs_mult 6)
   6.634 +have 10: "\<bar>1\<Colon>'b\<Colon>ordered_idom\<bar> = (1\<Colon>'b\<Colon>ordered_idom)"
   6.635 +  by (metis 9 4)
   6.636 +have 11: "\<And>X3\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> * \<bar>1\<Colon>'b\<Colon>ordered_idom\<bar>"
   6.637 +  by (metis Ring_and_Field.abs_mult OrderedGroup.abs_idempotent 5)
   6.638 +have 12: "\<And>X3\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar>"
   6.639 +  by (metis 11 10 5)
   6.640 +have 13: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom.
   6.641 +   X3 * (1\<Colon>'b\<Colon>ordered_idom) \<le> X1 \<or>
   6.642 +   \<not> \<bar>X3\<bar> \<le> X1 \<or> \<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.643 +  by (metis OrderedGroup.abs_le_D1 Ring_and_Field.abs_mult_pos 5)
   6.644 +have 14: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom.
   6.645 +   X3 \<le> X1 \<or> \<not> \<bar>X3\<bar> \<le> X1 \<or> \<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.646 +  by (metis 13 5)
   6.647 +have 15: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> X1 \<or> \<not> \<bar>X3\<bar> \<le> X1"
   6.648 +  by (metis 14 8)
   6.649 +have 16: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> X1 \<or> X1 \<le> \<bar>X3\<bar>"
   6.650 +  by (metis 15 Orderings.linorder_class.less_eq_less.linear)
   6.651 +have 17: "\<And>X3\<Colon>'b\<Colon>ordered_idom.
   6.652 +   X3 * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>X3\<bar>)
   6.653 +   \<le> (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X3\<bar>)"
   6.654 +  by (metis 3 16)
   6.655 +have 18: "(c\<Colon>'b\<Colon>ordered_idom) *
   6.656 +(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>c\<bar>) =
   6.657 +(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>c\<bar>)"
   6.658 +  by (metis 2 17)
   6.659 +have 19: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. \<bar>X3 * X1\<bar> \<le> \<bar>\<bar>X3\<bar>\<bar> * \<bar>\<bar>X1\<bar>\<bar>"
   6.660 +  by (metis 15 Ring_and_Field.abs_le_mult Ring_and_Field.abs_mult)
   6.661 +have 20: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. \<bar>X3 * X1\<bar> \<le> \<bar>X3\<bar> * \<bar>X1\<bar>"
   6.662 +  by (metis 19 12 12)
   6.663 +have 21: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. X3 * X1 \<le> \<bar>X3\<bar> * \<bar>X1\<bar>"
   6.664 +  by (metis 15 20)
   6.665 +have 22: "(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom)
   6.666 + ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>c\<Colon>'b\<Colon>ordered_idom\<bar>)
   6.667 +\<le> \<bar>c\<bar> * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>c\<bar>)\<bar>"
   6.668 +  by (metis 21 18)
   6.669 +show 23: "False"
   6.670 +  by (metis 22 1)
   6.671 +qed
   6.672 +
   6.673 +
   6.674 +text{*So here is the easier (and more natural) problem using transitivity*}
   6.675 +ML{*ResAtp.problem_name := "BigO__bigo_bounded_alt_trans"*}
   6.676 +lemma "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> f : O(g)" 
   6.677 +  apply (auto simp add: bigo_def)
   6.678 +  (*Version 1: one-shot proof*) 
   6.679 +apply (metis Orderings.leD Orderings.leI abs_ge_self abs_le_D1 abs_mult abs_of_nonneg order_le_less xt1(12));
   6.680 +  done
   6.681 +
   6.682 +text{*So here is the easier (and more natural) problem using transitivity*}
   6.683 +ML{*ResAtp.problem_name := "BigO__bigo_bounded_alt_trans"*}
   6.684 +lemma "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> f : O(g)" 
   6.685 +  apply (auto simp add: bigo_def)
   6.686 +(*Version 2: single-step proof*)
   6.687 +proof (neg_clausify)
   6.688 +fix x
   6.689 +assume 0: "\<And>mes_mb9\<Colon>'a.
   6.690 +   (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) mes_mb9
   6.691 +   \<le> (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) mes_mb9"
   6.692 +assume 1: "\<And>mes_mb8\<Colon>'b\<Colon>ordered_idom.
   6.693 +   \<not> (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) mes_mb8)
   6.694 +     \<le> mes_mb8 * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x mes_mb8)\<bar>"
   6.695 +have 2: "\<And>X3\<Colon>'a.
   6.696 +   (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) X3 =
   6.697 +   (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) X3 \<or>
   6.698 +   \<not> c * g X3 \<le> f X3"
   6.699 +  by (metis Lattices.min_max.less_eq_less_inf.antisym_intro 0)
   6.700 +have 3: "\<And>X3\<Colon>'b\<Colon>ordered_idom.
   6.701 +   \<not> (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>X3\<bar>)
   6.702 +     \<le> \<bar>X3 * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X3\<bar>)\<bar>"
   6.703 +  by (metis 1 Ring_and_Field.abs_mult)
   6.704 +have 4: "\<And>X3\<Colon>'b\<Colon>ordered_idom. (1\<Colon>'b\<Colon>ordered_idom) * X3 = X3"
   6.705 +  by (metis Ring_and_Field.mult_cancel_left2 Finite_Set.AC_mult.f.commute)
   6.706 +have 5: "\<And>X3\<Colon>'b\<Colon>ordered_idom. X3 * (1\<Colon>'b\<Colon>ordered_idom) = X3"
   6.707 +  by (metis Ring_and_Field.mult_cancel_right2 Finite_Set.AC_mult.f.commute)
   6.708 +have 6: "\<And>X3\<Colon>'b\<Colon>ordered_idom. \<bar>X3\<bar> * \<bar>X3\<bar> = X3 * X3"
   6.709 +  by (metis Ring_and_Field.abs_mult_self Finite_Set.AC_mult.f.commute)
   6.710 +have 7: "\<And>X3\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> X3 * X3"
   6.711 +  by (metis Ring_and_Field.zero_le_square Finite_Set.AC_mult.f.commute)
   6.712 +have 8: "(0\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.713 +  by (metis 7 Ring_and_Field.mult_cancel_left2)
   6.714 +have 9: "\<And>X3\<Colon>'b\<Colon>ordered_idom. X3 * X3 = \<bar>X3 * X3\<bar>"
   6.715 +  by (metis Ring_and_Field.abs_mult 6)
   6.716 +have 10: "\<bar>1\<Colon>'b\<Colon>ordered_idom\<bar> = (1\<Colon>'b\<Colon>ordered_idom)"
   6.717 +  by (metis 9 4)
   6.718 +have 11: "\<And>X3\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> * \<bar>1\<Colon>'b\<Colon>ordered_idom\<bar>"
   6.719 +  by (metis Ring_and_Field.abs_mult OrderedGroup.abs_idempotent 5)
   6.720 +have 12: "\<And>X3\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar>"
   6.721 +  by (metis 11 10 5)
   6.722 +have 13: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom.
   6.723 +   X3 * (1\<Colon>'b\<Colon>ordered_idom) \<le> X1 \<or>
   6.724 +   \<not> \<bar>X3\<bar> \<le> X1 \<or> \<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.725 +  by (metis OrderedGroup.abs_le_D1 Ring_and_Field.abs_mult_pos 5)
   6.726 +have 14: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom.
   6.727 +   X3 \<le> X1 \<or> \<not> \<bar>X3\<bar> \<le> X1 \<or> \<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.728 +  by (metis 13 5)
   6.729 +have 15: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> X1 \<or> \<not> \<bar>X3\<bar> \<le> X1"
   6.730 +  by (metis 14 8)
   6.731 +have 16: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> X1 \<or> X1 \<le> \<bar>X3\<bar>"
   6.732 +  by (metis 15 Orderings.linorder_class.less_eq_less.linear)
   6.733 +have 17: "\<And>X3\<Colon>'b\<Colon>ordered_idom.
   6.734 +   X3 * (g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>X3\<bar>)
   6.735 +   \<le> (f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X3\<bar>)"
   6.736 +  by (metis 3 16)
   6.737 +have 18: "(c\<Colon>'b\<Colon>ordered_idom) *
   6.738 +(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>c\<bar>) =
   6.739 +(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>c\<bar>)"
   6.740 +  by (metis 2 17)
   6.741 +have 19: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. \<bar>X3 * X1\<bar> \<le> \<bar>\<bar>X3\<bar>\<bar> * \<bar>\<bar>X1\<bar>\<bar>"
   6.742 +  by (metis 15 Ring_and_Field.abs_le_mult Ring_and_Field.abs_mult)
   6.743 +have 20: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. \<bar>X3 * X1\<bar> \<le> \<bar>X3\<bar> * \<bar>X1\<bar>"
   6.744 +  by (metis 19 12 12)
   6.745 +have 21: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X3\<Colon>'b\<Colon>ordered_idom. X3 * X1 \<le> \<bar>X3\<bar> * \<bar>X1\<bar>"
   6.746 +  by (metis 15 20)
   6.747 +have 22: "(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom)
   6.748 + ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) \<bar>c\<Colon>'b\<Colon>ordered_idom\<bar>)
   6.749 +\<le> \<bar>c\<bar> * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>c\<bar>)\<bar>"
   6.750 +  by (metis 21 18)
   6.751 +show 23: "False"
   6.752 +  by (metis 22 1)
   6.753 +qed
   6.754 +
   6.755 +
   6.756 +lemma bigo_bounded: "ALL x. 0 <= f x ==> ALL x. f x <= g x ==> 
   6.757 +    f : O(g)" 
   6.758 +  apply (erule bigo_bounded_alt [of f 1 g])
   6.759 +  apply simp
   6.760 +done
   6.761 +
   6.762 +ML{*ResAtp.problem_name := "BigO__bigo_bounded2"*}
   6.763 +lemma bigo_bounded2: "ALL x. lb x <= f x ==> ALL x. f x <= lb x + g x ==>
   6.764 +    f : lb +o O(g)"
   6.765 +  apply (rule set_minus_imp_plus)
   6.766 +  apply (rule bigo_bounded)
   6.767 +  apply (auto simp add: diff_minus func_minus func_plus)
   6.768 +  prefer 2
   6.769 +  apply (drule_tac x = x in spec)+ 
   6.770 +  apply arith (*not clear that it's provable otherwise*) 
   6.771 +proof (neg_clausify)
   6.772 +fix x
   6.773 +assume 0: "\<And>y. lb y \<le> f y"
   6.774 +assume 1: "\<not> (0\<Colon>'b) \<le> f x + - lb x"
   6.775 +have 2: "\<And>X3. (0\<Colon>'b) + X3 = X3"
   6.776 +  by (metis diff_eq_eq right_minus_eq)
   6.777 +have 3: "\<not> (0\<Colon>'b) \<le> f x - lb x"
   6.778 +  by (metis 1 compare_rls(1))
   6.779 +have 4: "\<not> (0\<Colon>'b) + lb x \<le> f x"
   6.780 +  by (metis 3 le_diff_eq)
   6.781 +show "False"
   6.782 +  by (metis 4 2 0)
   6.783 +qed
   6.784 +
   6.785 +ML{*ResAtp.problem_name := "BigO__bigo_abs"*}
   6.786 +lemma bigo_abs: "(%x. abs(f x)) =o O(f)" 
   6.787 +  apply (unfold bigo_def)
   6.788 +  apply auto
   6.789 +proof (neg_clausify)
   6.790 +fix x
   6.791 +assume 0: "!!mes_o43::'b::ordered_idom.
   6.792 +   ~ abs ((f::'a::type => 'b::ordered_idom)
   6.793 +           ((x::'b::ordered_idom => 'a::type) mes_o43))
   6.794 +     <= mes_o43 * abs (f (x mes_o43))"
   6.795 +have 1: "!!X3::'b::ordered_idom.
   6.796 +   X3 <= (1::'b::ordered_idom) * X3 |
   6.797 +   ~ (1::'b::ordered_idom) <= (1::'b::ordered_idom)"
   6.798 +  by (metis mult_le_cancel_right1 order_refl)
   6.799 +have 2: "!!X3::'b::ordered_idom. X3 <= (1::'b::ordered_idom) * X3"
   6.800 +  by (metis 1 order_refl)
   6.801 +show "False"
   6.802 +  by (metis 0 2)
   6.803 +qed
   6.804 +
   6.805 +ML{*ResAtp.problem_name := "BigO__bigo_abs2"*}
   6.806 +lemma bigo_abs2: "f =o O(%x. abs(f x))"
   6.807 +  apply (unfold bigo_def)
   6.808 +  apply auto
   6.809 +proof (neg_clausify)
   6.810 +fix x
   6.811 +assume 0: "\<And>mes_o4C\<Colon>'b\<Colon>ordered_idom.
   6.812 +   \<not> \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a) mes_o4C)\<bar>
   6.813 +     \<le> mes_o4C * \<bar>f (x mes_o4C)\<bar>"
   6.814 +have 1: "\<And>X3\<Colon>'b\<Colon>ordered_idom.
   6.815 +   X3 \<le> (1\<Colon>'b\<Colon>ordered_idom) * X3 \<or>
   6.816 +   \<not> (1\<Colon>'b\<Colon>ordered_idom) \<le> (1\<Colon>'b\<Colon>ordered_idom)"
   6.817 +  by (metis mult_le_cancel_right1 order_refl)
   6.818 +have 2: "\<And>X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> (1\<Colon>'b\<Colon>ordered_idom) * X3"
   6.819 +  by (metis 1 order_refl)
   6.820 +show "False"
   6.821 +  by (metis 0 2)
   6.822 +qed
   6.823 + 
   6.824 +lemma bigo_abs3: "O(f) = O(%x. abs(f x))"
   6.825 +  apply (rule equalityI)
   6.826 +  apply (rule bigo_elt_subset)
   6.827 +  apply (rule bigo_abs2)
   6.828 +  apply (rule bigo_elt_subset)
   6.829 +  apply (rule bigo_abs)
   6.830 +done
   6.831 +
   6.832 +lemma bigo_abs4: "f =o g +o O(h) ==> 
   6.833 +    (%x. abs (f x)) =o (%x. abs (g x)) +o O(h)"
   6.834 +  apply (drule set_plus_imp_minus)
   6.835 +  apply (rule set_minus_imp_plus)
   6.836 +  apply (subst func_diff)
   6.837 +proof -
   6.838 +  assume a: "f - g : O(h)"
   6.839 +  have "(%x. abs (f x) - abs (g x)) =o O(%x. abs(abs (f x) - abs (g x)))"
   6.840 +    by (rule bigo_abs2)
   6.841 +  also have "... <= O(%x. abs (f x - g x))"
   6.842 +    apply (rule bigo_elt_subset)
   6.843 +    apply (rule bigo_bounded)
   6.844 +    apply force
   6.845 +    apply (rule allI)
   6.846 +    apply (rule abs_triangle_ineq3)
   6.847 +    done
   6.848 +  also have "... <= O(f - g)"
   6.849 +    apply (rule bigo_elt_subset)
   6.850 +    apply (subst func_diff)
   6.851 +    apply (rule bigo_abs)
   6.852 +    done
   6.853 +  also have "... <= O(h)"
   6.854 +    by (rule bigo_elt_subset)
   6.855 +  finally show "(%x. abs (f x) - abs (g x)) : O(h)".
   6.856 +qed
   6.857 +
   6.858 +lemma bigo_abs5: "f =o O(g) ==> (%x. abs(f x)) =o O(g)" 
   6.859 +by (unfold bigo_def, auto)
   6.860 +
   6.861 +lemma bigo_elt_subset2 [intro]: "f : g +o O(h) ==> O(f) <= O(g) + O(h)"
   6.862 +proof -
   6.863 +  assume "f : g +o O(h)"
   6.864 +  also have "... <= O(g) + O(h)"
   6.865 +    by (auto del: subsetI)
   6.866 +  also have "... = O(%x. abs(g x)) + O(%x. abs(h x))"
   6.867 +    apply (subst bigo_abs3 [symmetric])+
   6.868 +    apply (rule refl)
   6.869 +    done
   6.870 +  also have "... = O((%x. abs(g x)) + (%x. abs(h x)))"
   6.871 +    by (rule bigo_plus_eq [symmetric], auto)
   6.872 +  finally have "f : ...".
   6.873 +  then have "O(f) <= ..."
   6.874 +    by (elim bigo_elt_subset)
   6.875 +  also have "... = O(%x. abs(g x)) + O(%x. abs(h x))"
   6.876 +    by (rule bigo_plus_eq, auto)
   6.877 +  finally show ?thesis
   6.878 +    by (simp add: bigo_abs3 [symmetric])
   6.879 +qed
   6.880 +
   6.881 +ML{*ResAtp.problem_name := "BigO__bigo_mult"*}
   6.882 +lemma bigo_mult [intro]: "O(f)*O(g) <= O(f * g)"
   6.883 +  apply (rule subsetI)
   6.884 +  apply (subst bigo_def)
   6.885 +  apply (auto simp del: abs_mult mult_ac
   6.886 +              simp add: bigo_alt_def set_times func_times)
   6.887 +(*sledgehammer*); 
   6.888 +  apply (rule_tac x = "c * ca" in exI)
   6.889 +  apply(rule allI)
   6.890 +  apply(erule_tac x = x in allE)+
   6.891 +  apply(subgoal_tac "c * ca * abs(f x * g x) = 
   6.892 +      (c * abs(f x)) * (ca * abs(g x))")
   6.893 +ML{*ResAtp.problem_name := "BigO__bigo_mult_simpler"*}
   6.894 +prefer 2 
   6.895 +apply (metis  Finite_Set.AC_mult.f.assoc  Finite_Set.AC_mult.f.left_commute  OrderedGroup.abs_of_pos  OrderedGroup.mult_left_commute  Ring_and_Field.abs_mult  Ring_and_Field.mult_pos_pos)
   6.896 +  apply(erule ssubst) 
   6.897 +  apply (subst abs_mult)
   6.898 +(*not qute BigO__bigo_mult_simpler_1 (a hard problem!) as abs_mult has
   6.899 +  just been done*)
   6.900 +proof (neg_clausify)
   6.901 +fix a c b ca x
   6.902 +assume 0: "(0\<Colon>'b\<Colon>ordered_idom) < (c\<Colon>'b\<Colon>ordered_idom)"
   6.903 +assume 1: "\<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
   6.904 +\<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
   6.905 +assume 2: "\<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
   6.906 +\<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
   6.907 +assume 3: "\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> *
   6.908 +  \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
   6.909 +  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> *
   6.910 +    ((ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>)"
   6.911 +have 4: "\<bar>c\<Colon>'b\<Colon>ordered_idom\<bar> = c"
   6.912 +  by (metis OrderedGroup.abs_of_pos 0)
   6.913 +have 5: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (c\<Colon>'b\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>c * X1\<bar>"
   6.914 +  by (metis Ring_and_Field.abs_mult 4)
   6.915 +have 6: "(0\<Colon>'b\<Colon>ordered_idom) = (1\<Colon>'b\<Colon>ordered_idom) \<or>
   6.916 +(0\<Colon>'b\<Colon>ordered_idom) < (1\<Colon>'b\<Colon>ordered_idom)"
   6.917 +  by (metis OrderedGroup.abs_not_less_zero Ring_and_Field.abs_one Ring_and_Field.linorder_neqE_ordered_idom)
   6.918 +have 7: "(0\<Colon>'b\<Colon>ordered_idom) < (1\<Colon>'b\<Colon>ordered_idom)"
   6.919 +  by (metis 6 Ring_and_Field.one_neq_zero)
   6.920 +have 8: "\<bar>1\<Colon>'b\<Colon>ordered_idom\<bar> = (1\<Colon>'b\<Colon>ordered_idom)"
   6.921 +  by (metis OrderedGroup.abs_of_pos 7)
   6.922 +have 9: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>X1\<bar>"
   6.923 +  by (metis OrderedGroup.abs_ge_zero 5)
   6.924 +have 10: "\<And>X1\<Colon>'b\<Colon>ordered_idom. X1 * (1\<Colon>'b\<Colon>ordered_idom) = X1"
   6.925 +  by (metis Ring_and_Field.mult_cancel_right2 Finite_Set.AC_mult.f.commute)
   6.926 +have 11: "\<And>X1\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X1\<bar>\<bar> = \<bar>X1\<bar> * \<bar>1\<Colon>'b\<Colon>ordered_idom\<bar>"
   6.927 +  by (metis Ring_and_Field.abs_mult OrderedGroup.abs_idempotent 10)
   6.928 +have 12: "\<And>X1\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X1\<bar>\<bar> = \<bar>X1\<bar>"
   6.929 +  by (metis 11 8 10)
   6.930 +have 13: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>X1\<bar>"
   6.931 +  by (metis OrderedGroup.abs_ge_zero 12)
   6.932 +have 14: "\<not> (0\<Colon>'b\<Colon>ordered_idom)
   6.933 +  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> \<or>
   6.934 +\<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
   6.935 +\<not> \<bar>b x\<bar> \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
   6.936 +\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<le> c * \<bar>f x\<bar>"
   6.937 +  by (metis 3 Ring_and_Field.mult_mono)
   6.938 +have 15: "\<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> \<or>
   6.939 +\<not> \<bar>b x\<bar> \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
   6.940 +\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
   6.941 +  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
   6.942 +  by (metis 14 9)
   6.943 +have 16: "\<not> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
   6.944 +  \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
   6.945 +\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
   6.946 +  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
   6.947 +  by (metis 15 13)
   6.948 +have 17: "\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
   6.949 +  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
   6.950 +  by (metis 16 2)
   6.951 +show 18: "False"
   6.952 +  by (metis 17 1)
   6.953 +qed
   6.954 +
   6.955 +
   6.956 +ML{*ResAtp.problem_name := "BigO__bigo_mult2"*}
   6.957 +lemma bigo_mult2 [intro]: "f *o O(g) <= O(f * g)"
   6.958 +  apply (auto simp add: bigo_def elt_set_times_def func_times abs_mult)
   6.959 +(*sledgehammer*); 
   6.960 +  apply (rule_tac x = c in exI)
   6.961 +  apply clarify
   6.962 +  apply (drule_tac x = x in spec)
   6.963 +ML{*ResAtp.problem_name := "BigO__bigo_mult2_simpler"*}
   6.964 +(*sledgehammer*); 
   6.965 +  apply (subgoal_tac "abs(f x) * abs(b x) <= abs(f x) * (c * abs(g x))")
   6.966 +  apply (simp add: mult_ac)
   6.967 +  apply (rule mult_left_mono, assumption)
   6.968 +  apply (rule abs_ge_zero)
   6.969 +done
   6.970 +
   6.971 +ML{*ResAtp.problem_name:="BigO__bigo_mult3"*}
   6.972 +lemma bigo_mult3: "f : O(h) ==> g : O(j) ==> f * g : O(h * j)"
   6.973 +by (metis bigo_mult set_times_intro subset_iff)
   6.974 +
   6.975 +ML{*ResAtp.problem_name:="BigO__bigo_mult4"*}
   6.976 +lemma bigo_mult4 [intro]:"f : k +o O(h) ==> g * f : (g * k) +o O(g * h)"
   6.977 +by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
   6.978 +
   6.979 +
   6.980 +lemma bigo_mult5: "ALL x. f x ~= 0 ==>
   6.981 +    O(f * g) <= (f::'a => ('b::ordered_field)) *o O(g)"
   6.982 +proof -
   6.983 +  assume "ALL x. f x ~= 0"
   6.984 +  show "O(f * g) <= f *o O(g)"
   6.985 +  proof
   6.986 +    fix h
   6.987 +    assume "h : O(f * g)"
   6.988 +    then have "(%x. 1 / (f x)) * h : (%x. 1 / f x) *o O(f * g)"
   6.989 +      by auto
   6.990 +    also have "... <= O((%x. 1 / f x) * (f * g))"
   6.991 +      by (rule bigo_mult2)
   6.992 +    also have "(%x. 1 / f x) * (f * g) = g"
   6.993 +      apply (simp add: func_times) 
   6.994 +      apply (rule ext)
   6.995 +      apply (simp add: prems nonzero_divide_eq_eq mult_ac)
   6.996 +      done
   6.997 +    finally have "(%x. (1::'b) / f x) * h : O(g)".
   6.998 +    then have "f * ((%x. (1::'b) / f x) * h) : f *o O(g)"
   6.999 +      by auto
  6.1000 +    also have "f * ((%x. (1::'b) / f x) * h) = h"
  6.1001 +      apply (simp add: func_times) 
  6.1002 +      apply (rule ext)
  6.1003 +      apply (simp add: prems nonzero_divide_eq_eq mult_ac)
  6.1004 +      done
  6.1005 +    finally show "h : f *o O(g)".
  6.1006 +  qed
  6.1007 +qed
  6.1008 +
  6.1009 +ML{*ResAtp.problem_name := "BigO__bigo_mult6"*}
  6.1010 +lemma bigo_mult6: "ALL x. f x ~= 0 ==>
  6.1011 +    O(f * g) = (f::'a => ('b::ordered_field)) *o O(g)"
  6.1012 +by (metis bigo_mult2 bigo_mult5 order_antisym)
  6.1013 +
  6.1014 +(*proof requires relaxing relevance: 2007-01-25*)
  6.1015 +ML{*ResAtp.problem_name := "BigO__bigo_mult7"*}
  6.1016 +  declare bigo_mult6 [simp]
  6.1017 +lemma bigo_mult7: "ALL x. f x ~= 0 ==>
  6.1018 +    O(f * g) <= O(f::'a => ('b::ordered_field)) * O(g)"
  6.1019 +(*sledgehammer*)
  6.1020 +  apply (subst bigo_mult6)
  6.1021 +  apply assumption
  6.1022 +  apply (rule set_times_mono3) 
  6.1023 +  apply (rule bigo_refl)
  6.1024 +done
  6.1025 +  declare bigo_mult6 [simp del]
  6.1026 +
  6.1027 +ML{*ResAtp.problem_name := "BigO__bigo_mult8"*}
  6.1028 +  declare bigo_mult7[intro!]
  6.1029 +lemma bigo_mult8: "ALL x. f x ~= 0 ==>
  6.1030 +    O(f * g) = O(f::'a => ('b::ordered_field)) * O(g)"
  6.1031 +by (metis bigo_mult bigo_mult7 order_antisym_conv)
  6.1032 +
  6.1033 +lemma bigo_minus [intro]: "f : O(g) ==> - f : O(g)"
  6.1034 +  by (auto simp add: bigo_def func_minus)
  6.1035 +
  6.1036 +lemma bigo_minus2: "f : g +o O(h) ==> -f : -g +o O(h)"
  6.1037 +  apply (rule set_minus_imp_plus)
  6.1038 +  apply (drule set_plus_imp_minus)
  6.1039 +  apply (drule bigo_minus)
  6.1040 +  apply (simp add: diff_minus)
  6.1041 +done
  6.1042 +
  6.1043 +lemma bigo_minus3: "O(-f) = O(f)"
  6.1044 +  by (auto simp add: bigo_def func_minus abs_minus_cancel)
  6.1045 +
  6.1046 +lemma bigo_plus_absorb_lemma1: "f : O(g) ==> f +o O(g) <= O(g)"
  6.1047 +proof -
  6.1048 +  assume a: "f : O(g)"
  6.1049 +  show "f +o O(g) <= O(g)"
  6.1050 +  proof -
  6.1051 +    have "f : O(f)" by auto
  6.1052 +    then have "f +o O(g) <= O(f) + O(g)"
  6.1053 +      by (auto del: subsetI)
  6.1054 +    also have "... <= O(g) + O(g)"
  6.1055 +    proof -
  6.1056 +      from a have "O(f) <= O(g)" by (auto del: subsetI)
  6.1057 +      thus ?thesis by (auto del: subsetI)
  6.1058 +    qed
  6.1059 +    also have "... <= O(g)" by (simp add: bigo_plus_idemp)
  6.1060 +    finally show ?thesis .
  6.1061 +  qed
  6.1062 +qed
  6.1063 +
  6.1064 +lemma bigo_plus_absorb_lemma2: "f : O(g) ==> O(g) <= f +o O(g)"
  6.1065 +proof -
  6.1066 +  assume a: "f : O(g)"
  6.1067 +  show "O(g) <= f +o O(g)"
  6.1068 +  proof -
  6.1069 +    from a have "-f : O(g)" by auto
  6.1070 +    then have "-f +o O(g) <= O(g)" by (elim bigo_plus_absorb_lemma1)
  6.1071 +    then have "f +o (-f +o O(g)) <= f +o O(g)" by auto
  6.1072 +    also have "f +o (-f +o O(g)) = O(g)"
  6.1073 +      by (simp add: set_plus_rearranges)
  6.1074 +    finally show ?thesis .
  6.1075 +  qed
  6.1076 +qed
  6.1077 +
  6.1078 +ML{*ResAtp.problem_name:="BigO__bigo_plus_absorb"*}
  6.1079 +lemma bigo_plus_absorb [simp]: "f : O(g) ==> f +o O(g) = O(g)"
  6.1080 +by (metis bigo_plus_absorb_lemma1 bigo_plus_absorb_lemma2 order_eq_iff);
  6.1081 +
  6.1082 +lemma bigo_plus_absorb2 [intro]: "f : O(g) ==> A <= O(g) ==> f +o A <= O(g)"
  6.1083 +  apply (subgoal_tac "f +o A <= f +o O(g)")
  6.1084 +  apply force+
  6.1085 +done
  6.1086 +
  6.1087 +lemma bigo_add_commute_imp: "f : g +o O(h) ==> g : f +o O(h)"
  6.1088 +  apply (subst set_minus_plus [symmetric])
  6.1089 +  apply (subgoal_tac "g - f = - (f - g)")
  6.1090 +  apply (erule ssubst)
  6.1091 +  apply (rule bigo_minus)
  6.1092 +  apply (subst set_minus_plus)
  6.1093 +  apply assumption
  6.1094 +  apply  (simp add: diff_minus add_ac)
  6.1095 +done
  6.1096 +
  6.1097 +lemma bigo_add_commute: "(f : g +o O(h)) = (g : f +o O(h))"
  6.1098 +  apply (rule iffI)
  6.1099 +  apply (erule bigo_add_commute_imp)+
  6.1100 +done
  6.1101 +
  6.1102 +lemma bigo_const1: "(%x. c) : O(%x. 1)"
  6.1103 +by (auto simp add: bigo_def mult_ac)
  6.1104 +
  6.1105 +declare bigo_const1 [skolem]
  6.1106 +
  6.1107 +ML{*ResAtp.problem_name:="BigO__bigo_const2"*}
  6.1108 +lemma (*bigo_const2 [intro]:*) "O(%x. c) <= O(%x. 1)"
  6.1109 +by (metis bigo_const1 bigo_elt_subset);
  6.1110 +
  6.1111 +lemma bigo_const2 [intro]: "O(%x. c) <= O(%x. 1)"; 
  6.1112 +(*??FAILS because the two occurrences of COMBK have different polymorphic types
  6.1113 +proof (neg_clausify)
  6.1114 +assume 0: "\<not> O(COMBK (c\<Colon>'b\<Colon>ordered_idom)) \<subseteq> O(COMBK (1\<Colon>'b\<Colon>ordered_idom))"
  6.1115 +have 1: "COMBK (c\<Colon>'b\<Colon>ordered_idom) \<notin> O(COMBK (1\<Colon>'b\<Colon>ordered_idom))"
  6.1116 +apply (rule notI) 
  6.1117 +apply (rule 0 [THEN notE]) 
  6.1118 +apply (rule bigo_elt_subset) 
  6.1119 +apply assumption; 
  6.1120 +sorry
  6.1121 +  by (metis 0 bigo_elt_subset)  loops??
  6.1122 +show "False"
  6.1123 +  by (metis 1 bigo_const1)
  6.1124 +qed
  6.1125 +*)
  6.1126 +  apply (rule bigo_elt_subset)
  6.1127 +  apply (rule bigo_const1)
  6.1128 +done
  6.1129 +
  6.1130 +declare bigo_const2 [skolem]
  6.1131 +
  6.1132 +ML{*ResAtp.problem_name := "BigO__bigo_const3"*}
  6.1133 +lemma bigo_const3: "(c::'a::ordered_field) ~= 0 ==> (%x. 1) : O(%x. c)"
  6.1134 +apply (simp add: bigo_def)
  6.1135 +proof (neg_clausify)
  6.1136 +assume 0: "(c\<Colon>'a\<Colon>ordered_field) \<noteq> (0\<Colon>'a\<Colon>ordered_field)"
  6.1137 +assume 1: "\<And>mes_md\<Colon>'a\<Colon>ordered_field. \<not> (1\<Colon>'a\<Colon>ordered_field) \<le> mes_md * \<bar>c\<Colon>'a\<Colon>ordered_field\<bar>"
  6.1138 +have 2: "(0\<Colon>'a\<Colon>ordered_field) = \<bar>c\<Colon>'a\<Colon>ordered_field\<bar> \<or>
  6.1139 +\<not> (1\<Colon>'a\<Colon>ordered_field) \<le> (1\<Colon>'a\<Colon>ordered_field)"
  6.1140 +  by (metis 1 field_inverse)
  6.1141 +have 3: "\<bar>c\<Colon>'a\<Colon>ordered_field\<bar> = (0\<Colon>'a\<Colon>ordered_field)"
  6.1142 +  by (metis 2 order_refl)
  6.1143 +have 4: "(0\<Colon>'a\<Colon>ordered_field) = (c\<Colon>'a\<Colon>ordered_field)"
  6.1144 +  by (metis OrderedGroup.abs_eq_0 3)
  6.1145 +show 5: "False"
  6.1146 +  by (metis 4 0)
  6.1147 +qed
  6.1148 +
  6.1149 +lemma bigo_const4: "(c::'a::ordered_field) ~= 0 ==> O(%x. 1) <= O(%x. c)"
  6.1150 +by (rule bigo_elt_subset, rule bigo_const3, assumption)
  6.1151 +
  6.1152 +lemma bigo_const [simp]: "(c::'a::ordered_field) ~= 0 ==> 
  6.1153 +    O(%x. c) = O(%x. 1)"
  6.1154 +by (rule equalityI, rule bigo_const2, rule bigo_const4, assumption)
  6.1155 +
  6.1156 +ML{*ResAtp.problem_name := "BigO__bigo_const_mult1"*}
  6.1157 +lemma bigo_const_mult1: "(%x. c * f x) : O(f)"
  6.1158 +  apply (simp add: bigo_def abs_mult) 
  6.1159 +proof (neg_clausify)
  6.1160 +fix x
  6.1161 +assume 0: "\<And>mes_vAL\<Colon>'b.
  6.1162 +   \<not> \<bar>c\<Colon>'b\<bar> *
  6.1163 +     \<bar>(f\<Colon>'a \<Rightarrow> 'b) ((x\<Colon>'b \<Rightarrow> 'a) mes_vAL)\<bar>
  6.1164 +     \<le> mes_vAL * \<bar>f (x mes_vAL)\<bar>"
  6.1165 +have 1: "\<And>Y\<Colon>'b. Y \<le> Y"
  6.1166 +  by (metis order_refl)
  6.1167 +show 2: "False"
  6.1168 +  by (metis 0 1)
  6.1169 +qed
  6.1170 +
  6.1171 +lemma bigo_const_mult2: "O(%x. c * f x) <= O(f)"
  6.1172 +by (rule bigo_elt_subset, rule bigo_const_mult1)
  6.1173 +
  6.1174 +ML{*ResAtp.problem_name := "BigO__bigo_const_mult3"*}
  6.1175 +lemma bigo_const_mult3: "(c::'a::ordered_field) ~= 0 ==> f : O(%x. c * f x)"
  6.1176 +  apply (simp add: bigo_def)
  6.1177 +(*sledgehammer*); 
  6.1178 +  apply (rule_tac x = "abs(inverse c)" in exI)
  6.1179 +  apply (simp only: abs_mult [symmetric] mult_assoc [symmetric])
  6.1180 +apply (subst left_inverse) 
  6.1181 +apply (auto ); 
  6.1182 +done
  6.1183 +
  6.1184 +lemma bigo_const_mult4: "(c::'a::ordered_field) ~= 0 ==> 
  6.1185 +    O(f) <= O(%x. c * f x)"
  6.1186 +by (rule bigo_elt_subset, rule bigo_const_mult3, assumption)
  6.1187 +
  6.1188 +lemma bigo_const_mult [simp]: "(c::'a::ordered_field) ~= 0 ==> 
  6.1189 +    O(%x. c * f x) = O(f)"
  6.1190 +by (rule equalityI, rule bigo_const_mult2, erule bigo_const_mult4)
  6.1191 +
  6.1192 +ML{*ResAtp.problem_name := "BigO__bigo_const_mult5"*}
  6.1193 +lemma bigo_const_mult5 [simp]: "(c::'a::ordered_field) ~= 0 ==> 
  6.1194 +    (%x. c) *o O(f) = O(f)"
  6.1195 +  apply (auto del: subsetI)
  6.1196 +  apply (rule order_trans)
  6.1197 +  apply (rule bigo_mult2)
  6.1198 +  apply (simp add: func_times)
  6.1199 +  apply (auto intro!: subsetI simp add: bigo_def elt_set_times_def func_times)
  6.1200 +  apply (rule_tac x = "%y. inverse c * x y" in exI)
  6.1201 +apply (rename_tac g d) 
  6.1202 +apply safe;
  6.1203 +apply (rule_tac [2] ext) 
  6.1204 +(*sledgehammer*); 
  6.1205 +  apply (simp_all del: mult_assoc add: mult_assoc [symmetric] abs_mult)
  6.1206 +  apply (rule_tac x = "abs (inverse c) * d" in exI)
  6.1207 +  apply (rule allI)
  6.1208 +  apply (subst mult_assoc)
  6.1209 +  apply (rule mult_left_mono)
  6.1210 +  apply (erule spec)
  6.1211 +apply (simp add: ); 
  6.1212 +done
  6.1213 +
  6.1214 +
  6.1215 +ML{*ResAtp.problem_name := "BigO__bigo_const_mult6"*}
  6.1216 +lemma bigo_const_mult6 [intro]: "(%x. c) *o O(f) <= O(f)"
  6.1217 +  apply (auto intro!: subsetI
  6.1218 +    simp add: bigo_def elt_set_times_def func_times
  6.1219 +    simp del: abs_mult mult_ac)
  6.1220 +(*sledgehammer*); 
  6.1221 +  apply (rule_tac x = "ca * (abs c)" in exI)
  6.1222 +  apply (rule allI)
  6.1223 +  apply (subgoal_tac "ca * abs(c) * abs(f x) = abs(c) * (ca * abs(f x))")
  6.1224 +  apply (erule ssubst)
  6.1225 +  apply (subst abs_mult)
  6.1226 +  apply (rule mult_left_mono)
  6.1227 +  apply (erule spec)
  6.1228 +  apply simp
  6.1229 +  apply(simp add: mult_ac)
  6.1230 +done
  6.1231 +
  6.1232 +lemma bigo_const_mult7 [intro]: "f =o O(g) ==> (%x. c * f x) =o O(g)"
  6.1233 +proof -
  6.1234 +  assume "f =o O(g)"
  6.1235 +  then have "(%x. c) * f =o (%x. c) *o O(g)"
  6.1236 +    by auto
  6.1237 +  also have "(%x. c) * f = (%x. c * f x)"
  6.1238 +    by (simp add: func_times)
  6.1239 +  also have "(%x. c) *o O(g) <= O(g)"
  6.1240 +    by (auto del: subsetI)
  6.1241 +  finally show ?thesis .
  6.1242 +qed
  6.1243 +
  6.1244 +lemma bigo_compose1: "f =o O(g) ==> (%x. f(k x)) =o O(%x. g(k x))"
  6.1245 +by (unfold bigo_def, auto)
  6.1246 +
  6.1247 +lemma bigo_compose2: "f =o g +o O(h) ==> (%x. f(k x)) =o (%x. g(k x)) +o 
  6.1248 +    O(%x. h(k x))"
  6.1249 +  apply (simp only: set_minus_plus [symmetric] diff_minus func_minus
  6.1250 +      func_plus)
  6.1251 +  apply (erule bigo_compose1)
  6.1252 +done
  6.1253 +
  6.1254 +subsection {* Setsum *}
  6.1255 +
  6.1256 +lemma bigo_setsum_main: "ALL x. ALL y : A x. 0 <= h x y ==> 
  6.1257 +    EX c. ALL x. ALL y : A x. abs(f x y) <= c * (h x y) ==>
  6.1258 +      (%x. SUM y : A x. f x y) =o O(%x. SUM y : A x. h x y)"  
  6.1259 +  apply (auto simp add: bigo_def)
  6.1260 +  apply (rule_tac x = "abs c" in exI)
  6.1261 +  apply (subst abs_of_nonneg) back back
  6.1262 +  apply (rule setsum_nonneg)
  6.1263 +  apply force
  6.1264 +  apply (subst setsum_right_distrib)
  6.1265 +  apply (rule allI)
  6.1266 +  apply (rule order_trans)
  6.1267 +  apply (rule setsum_abs)
  6.1268 +  apply (rule setsum_mono)
  6.1269 +apply (blast intro: order_trans mult_right_mono abs_ge_self) 
  6.1270 +done
  6.1271 +
  6.1272 +ML{*ResAtp.problem_name := "BigO__bigo_setsum1"*}
  6.1273 +lemma bigo_setsum1: "ALL x y. 0 <= h x y ==> 
  6.1274 +    EX c. ALL x y. abs(f x y) <= c * (h x y) ==>
  6.1275 +      (%x. SUM y : A x. f x y) =o O(%x. SUM y : A x. h x y)"
  6.1276 +  apply (rule bigo_setsum_main)
  6.1277 +(*sledgehammer*); 
  6.1278 +  apply force
  6.1279 +  apply clarsimp
  6.1280 +  apply (rule_tac x = c in exI)
  6.1281 +  apply force
  6.1282 +done
  6.1283 +
  6.1284 +lemma bigo_setsum2: "ALL y. 0 <= h y ==> 
  6.1285 +    EX c. ALL y. abs(f y) <= c * (h y) ==>
  6.1286 +      (%x. SUM y : A x. f y) =o O(%x. SUM y : A x. h y)"
  6.1287 +by (rule bigo_setsum1, auto)  
  6.1288 +
  6.1289 +ML{*ResAtp.problem_name := "BigO__bigo_setsum3"*}
  6.1290 +lemma bigo_setsum3: "f =o O(h) ==>
  6.1291 +    (%x. SUM y : A x. (l x y) * f(k x y)) =o
  6.1292 +      O(%x. SUM y : A x. abs(l x y * h(k x y)))"
  6.1293 +  apply (rule bigo_setsum1)
  6.1294 +  apply (rule allI)+
  6.1295 +  apply (rule abs_ge_zero)
  6.1296 +  apply (unfold bigo_def)
  6.1297 +  apply (auto simp add: abs_mult);
  6.1298 +(*sledgehammer*); 
  6.1299 +  apply (rule_tac x = c in exI)
  6.1300 +  apply (rule allI)+
  6.1301 +  apply (subst mult_left_commute)
  6.1302 +  apply (rule mult_left_mono)
  6.1303 +  apply (erule spec)
  6.1304 +  apply (rule abs_ge_zero)
  6.1305 +done
  6.1306 +
  6.1307 +lemma bigo_setsum4: "f =o g +o O(h) ==>
  6.1308 +    (%x. SUM y : A x. l x y * f(k x y)) =o
  6.1309 +      (%x. SUM y : A x. l x y * g(k x y)) +o
  6.1310 +        O(%x. SUM y : A x. abs(l x y * h(k x y)))"
  6.1311 +  apply (rule set_minus_imp_plus)
  6.1312 +  apply (subst func_diff)
  6.1313 +  apply (subst setsum_subtractf [symmetric])
  6.1314 +  apply (subst right_diff_distrib [symmetric])
  6.1315 +  apply (rule bigo_setsum3)
  6.1316 +  apply (subst func_diff [symmetric])
  6.1317 +  apply (erule set_plus_imp_minus)
  6.1318 +done
  6.1319 +
  6.1320 +ML{*ResAtp.problem_name := "BigO__bigo_setsum5"*}
  6.1321 +lemma bigo_setsum5: "f =o O(h) ==> ALL x y. 0 <= l x y ==> 
  6.1322 +    ALL x. 0 <= h x ==>
  6.1323 +      (%x. SUM y : A x. (l x y) * f(k x y)) =o
  6.1324 +        O(%x. SUM y : A x. (l x y) * h(k x y))" 
  6.1325 +  apply (subgoal_tac "(%x. SUM y : A x. (l x y) * h(k x y)) = 
  6.1326 +      (%x. SUM y : A x. abs((l x y) * h(k x y)))")
  6.1327 +  apply (erule ssubst)
  6.1328 +  apply (erule bigo_setsum3)
  6.1329 +  apply (rule ext)
  6.1330 +  apply (rule setsum_cong2)
  6.1331 +  apply (thin_tac "f \<in> O(h)") 
  6.1332 +(*sledgehammer*); 
  6.1333 +  apply (subst abs_of_nonneg)
  6.1334 +  apply (rule mult_nonneg_nonneg)
  6.1335 +  apply auto
  6.1336 +done
  6.1337 +
  6.1338 +lemma bigo_setsum6: "f =o g +o O(h) ==> ALL x y. 0 <= l x y ==>
  6.1339 +    ALL x. 0 <= h x ==>
  6.1340 +      (%x. SUM y : A x. (l x y) * f(k x y)) =o
  6.1341 +        (%x. SUM y : A x. (l x y) * g(k x y)) +o
  6.1342 +          O(%x. SUM y : A x. (l x y) * h(k x y))" 
  6.1343 +  apply (rule set_minus_imp_plus)
  6.1344 +  apply (subst func_diff)
  6.1345 +  apply (subst setsum_subtractf [symmetric])
  6.1346 +  apply (subst right_diff_distrib [symmetric])
  6.1347 +  apply (rule bigo_setsum5)
  6.1348 +  apply (subst func_diff [symmetric])
  6.1349 +  apply (drule set_plus_imp_minus)
  6.1350 +  apply auto
  6.1351 +done
  6.1352 +
  6.1353 +subsection {* Misc useful stuff *}
  6.1354 +
  6.1355 +lemma bigo_useful_intro: "A <= O(f) ==> B <= O(f) ==>
  6.1356 +  A + B <= O(f)"
  6.1357 +  apply (subst bigo_plus_idemp [symmetric])
  6.1358 +  apply (rule set_plus_mono2)
  6.1359 +  apply assumption+
  6.1360 +done
  6.1361 +
  6.1362 +lemma bigo_useful_add: "f =o O(h) ==> g =o O(h) ==> f + g =o O(h)"
  6.1363 +  apply (subst bigo_plus_idemp [symmetric])
  6.1364 +  apply (rule set_plus_intro)
  6.1365 +  apply assumption+
  6.1366 +done
  6.1367 +  
  6.1368 +lemma bigo_useful_const_mult: "(c::'a::ordered_field) ~= 0 ==> 
  6.1369 +    (%x. c) * f =o O(h) ==> f =o O(h)"
  6.1370 +  apply (rule subsetD)
  6.1371 +  apply (subgoal_tac "(%x. 1 / c) *o O(h) <= O(h)")
  6.1372 +  apply assumption
  6.1373 +  apply (rule bigo_const_mult6)
  6.1374 +  apply (subgoal_tac "f = (%x. 1 / c) * ((%x. c) * f)")
  6.1375 +  apply (erule ssubst)
  6.1376 +  apply (erule set_times_intro2)
  6.1377 +  apply (simp add: func_times) 
  6.1378 +done
  6.1379 +
  6.1380 +ML{*ResAtp.problem_name := "BigO__bigo_fix"*}
  6.1381 +lemma bigo_fix: "(%x. f ((x::nat) + 1)) =o O(%x. h(x + 1)) ==> f 0 = 0 ==>
  6.1382 +    f =o O(h)"
  6.1383 +  apply (simp add: bigo_alt_def)
  6.1384 +(*sledgehammer*); 
  6.1385 +  apply clarify
  6.1386 +  apply (rule_tac x = c in exI)
  6.1387 +  apply safe
  6.1388 +  apply (case_tac "x = 0")
  6.1389 +prefer 2
  6.1390 +  apply (subgoal_tac "x = Suc (x - 1)")
  6.1391 +  apply (erule ssubst) back
  6.1392 +  apply (erule spec)
  6.1393 +  apply (rule Suc_pred') 
  6.1394 +  apply simp
  6.1395 +apply (metis OrderedGroup.abs_ge_zero  OrderedGroup.abs_zero  order_less_le  Ring_and_Field.split_mult_pos_le) 
  6.1396 +  done
  6.1397 +
  6.1398 +
  6.1399 +lemma bigo_fix2: 
  6.1400 +    "(%x. f ((x::nat) + 1)) =o (%x. g(x + 1)) +o O(%x. h(x + 1)) ==> 
  6.1401 +       f 0 = g 0 ==> f =o g +o O(h)"
  6.1402 +  apply (rule set_minus_imp_plus)
  6.1403 +  apply (rule bigo_fix)
  6.1404 +  apply (subst func_diff)
  6.1405 +  apply (subst func_diff [symmetric])
  6.1406 +  apply (rule set_plus_imp_minus)
  6.1407 +  apply simp
  6.1408 +  apply (simp add: func_diff)
  6.1409 +done
  6.1410 +
  6.1411 +subsection {* Less than or equal to *}
  6.1412 +
  6.1413 +constdefs 
  6.1414 +  lesso :: "('a => 'b::ordered_idom) => ('a => 'b) => ('a => 'b)"
  6.1415 +      (infixl "<o" 70)
  6.1416 +  "f <o g == (%x. max (f x - g x) 0)"
  6.1417 +
  6.1418 +lemma bigo_lesseq1: "f =o O(h) ==> ALL x. abs (g x) <= abs (f x) ==>
  6.1419 +    g =o O(h)"
  6.1420 +  apply (unfold bigo_def)
  6.1421 +  apply clarsimp
  6.1422 +apply (blast intro: order_trans) 
  6.1423 +done
  6.1424 +
  6.1425 +lemma bigo_lesseq2: "f =o O(h) ==> ALL x. abs (g x) <= f x ==>
  6.1426 +      g =o O(h)"
  6.1427 +  apply (erule bigo_lesseq1)
  6.1428 +apply (blast intro: abs_ge_self order_trans) 
  6.1429 +done
  6.1430 +
  6.1431 +lemma bigo_lesseq3: "f =o O(h) ==> ALL x. 0 <= g x ==> ALL x. g x <= f x ==>
  6.1432 +      g =o O(h)"
  6.1433 +  apply (erule bigo_lesseq2)
  6.1434 +  apply (rule allI)
  6.1435 +  apply (subst abs_of_nonneg)
  6.1436 +  apply (erule spec)+
  6.1437 +done
  6.1438 +
  6.1439 +lemma bigo_lesseq4: "f =o O(h) ==>
  6.1440 +    ALL x. 0 <= g x ==> ALL x. g x <= abs (f x) ==>
  6.1441 +      g =o O(h)"
  6.1442 +  apply (erule bigo_lesseq1)
  6.1443 +  apply (rule allI)
  6.1444 +  apply (subst abs_of_nonneg)
  6.1445 +  apply (erule spec)+
  6.1446 +done
  6.1447 +
  6.1448 +ML{*ResAtp.problem_name:="BigO__bigo_lesso1"*}
  6.1449 +lemma bigo_lesso1: "ALL x. f x <= g x ==> f <o g =o O(h)"
  6.1450 +  apply (unfold lesso_def)
  6.1451 +  apply (subgoal_tac "(%x. max (f x - g x) 0) = 0")
  6.1452 +(*
  6.1453 +?? abstractions don't work: abstraction function gets the wrong type?
  6.1454 +proof (neg_clausify)
  6.1455 +assume 0: "llabs_subgoal_1 f g = 0"
  6.1456 +assume 1: "llabs_subgoal_1 f g \<notin> O(h)"
  6.1457 +show "False"
  6.1458 +  by (metis 1 0 bigo_zero)
  6.1459 +*)
  6.1460 +  apply (erule ssubst)
  6.1461 +  apply (rule bigo_zero)
  6.1462 +  apply (unfold func_zero)
  6.1463 +  apply (rule ext)
  6.1464 +  apply (simp split: split_max)
  6.1465 +done
  6.1466 +
  6.1467 +
  6.1468 +ML{*ResAtp.problem_name := "BigO__bigo_lesso2"*}
  6.1469 +lemma bigo_lesso2: "f =o g +o O(h) ==>
  6.1470 +    ALL x. 0 <= k x ==> ALL x. k x <= f x ==>
  6.1471 +      k <o g =o O(h)"
  6.1472 +  apply (unfold lesso_def)
  6.1473 +  apply (rule bigo_lesseq4)
  6.1474 +  apply (erule set_plus_imp_minus)
  6.1475 +  apply (rule allI)
  6.1476 +  apply (rule le_maxI2)
  6.1477 +  apply (rule allI)
  6.1478 +  apply (subst func_diff)
  6.1479 +apply (erule thin_rl)
  6.1480 +(*sledgehammer*);  
  6.1481 +  apply (case_tac "0 <= k x - g x")
  6.1482 +  apply (simp del: compare_rls diff_minus);
  6.1483 +  apply (subst abs_of_nonneg)
  6.1484 +  apply (drule_tac x = x in spec) back
  6.1485 +ML{*ResAtp.problem_name := "BigO__bigo_lesso2_simpler"*}
  6.1486 +(*sledgehammer*);  
  6.1487 +  apply (simp add: compare_rls del: diff_minus)
  6.1488 +  apply (subst diff_minus)+
  6.1489 +  apply (rule add_right_mono)
  6.1490 +  apply (erule spec)
  6.1491 +  apply (rule order_trans) 
  6.1492 +  prefer 2
  6.1493 +  apply (rule abs_ge_zero)
  6.1494 +(*
  6.1495 +  apply (simp only: compare_rls min_max.below_sup.above_sup_conv 
  6.1496 +             linorder_not_le order_less_imp_le)
  6.1497 +*)
  6.1498 +  apply (simp add: compare_rls del: diff_minus)
  6.1499 +done
  6.1500 +
  6.1501 +
  6.1502 +
  6.1503 +ML{*ResAtp.problem_name := "BigO__bigo_lesso3"*}
  6.1504 +lemma bigo_lesso3: "f =o g +o O(h) ==>
  6.1505 +    ALL x. 0 <= k x ==> ALL x. g x <= k x ==>
  6.1506 +      f <o k =o O(h)"
  6.1507 +  apply (unfold lesso_def)
  6.1508 +  apply (rule bigo_lesseq4)
  6.1509 +  apply (erule set_plus_imp_minus)
  6.1510 +  apply (rule allI)
  6.1511 +  apply (rule le_maxI2)
  6.1512 +  apply (rule allI)
  6.1513 +  apply (subst func_diff)
  6.1514 +apply (erule thin_rl) 
  6.1515 +(*sledgehammer*); 
  6.1516 +  apply (case_tac "0 <= f x - k x")
  6.1517 +  apply (simp del: compare_rls diff_minus);
  6.1518 +  apply (subst abs_of_nonneg)
  6.1519 +  apply (drule_tac x = x in spec) back
  6.1520 +ML{*ResAtp.problem_name := "BigO__bigo_lesso3_simpler"*}
  6.1521 +(*sledgehammer*);  
  6.1522 +  apply (simp del: diff_minus)
  6.1523 +  apply (subst diff_minus)+
  6.1524 +  apply (rule add_left_mono)
  6.1525 +  apply (rule le_imp_neg_le)
  6.1526 +  apply (erule spec)
  6.1527 +  apply (rule order_trans) 
  6.1528 +  prefer 2
  6.1529 +  apply (rule abs_ge_zero)
  6.1530 +  apply (simp del: diff_minus)
  6.1531 +done
  6.1532 +
  6.1533 +lemma bigo_lesso4: "f <o g =o O(k::'a=>'b::ordered_field) ==>
  6.1534 +    g =o h +o O(k) ==> f <o h =o O(k)"
  6.1535 +  apply (unfold lesso_def)
  6.1536 +  apply (drule set_plus_imp_minus)
  6.1537 +  apply (drule bigo_abs5) back
  6.1538 +  apply (simp add: func_diff)
  6.1539 +  apply (drule bigo_useful_add)
  6.1540 +  apply assumption
  6.1541 +  apply (erule bigo_lesseq2) back
  6.1542 +  apply (rule allI)
  6.1543 +  apply (auto simp add: func_plus func_diff compare_rls 
  6.1544 +    split: split_max abs_split)
  6.1545 +done
  6.1546 +
  6.1547 +ML{*ResAtp.problem_name := "BigO__bigo_lesso5"*}
  6.1548 +lemma bigo_lesso5: "f <o g =o O(h) ==>
  6.1549 +    EX C. ALL x. f x <= g x + C * abs(h x)"
  6.1550 +  apply (simp only: lesso_def bigo_alt_def)
  6.1551 +  apply clarsimp
  6.1552 +(*sledgehammer*);  
  6.1553 +apply (auto simp add: compare_rls add_ac) 
  6.1554 +done
  6.1555 +
  6.1556 +end
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/MetisExamples/Message.thy	Thu Jun 21 13:23:33 2007 +0200
     7.3 @@ -0,0 +1,810 @@
     7.4 +(*  Title:      HOL/MetisTest/Message.thy
     7.5 +    ID:         $Id$
     7.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     7.7 +
     7.8 +Testing the metis method
     7.9 +*)
    7.10 +
    7.11 +theory Message imports Main begin
    7.12 +
    7.13 +(*Needed occasionally with spy_analz_tac, e.g. in analz_insert_Key_newK*)
    7.14 +lemma strange_Un_eq [simp]: "A \<union> (B \<union> A) = B \<union> A"
    7.15 +by blast
    7.16 +
    7.17 +types 
    7.18 +  key = nat
    7.19 +
    7.20 +consts
    7.21 +  all_symmetric :: bool        --{*true if all keys are symmetric*}
    7.22 +  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
    7.23 +
    7.24 +specification (invKey)
    7.25 +  invKey [simp]: "invKey (invKey K) = K"
    7.26 +  invKey_symmetric: "all_symmetric --> invKey = id"
    7.27 +    by (rule exI [of _ id], auto)
    7.28 +
    7.29 +
    7.30 +text{*The inverse of a symmetric key is itself; that of a public key
    7.31 +      is the private key and vice versa*}
    7.32 +
    7.33 +constdefs
    7.34 +  symKeys :: "key set"
    7.35 +  "symKeys == {K. invKey K = K}"
    7.36 +
    7.37 +datatype  --{*We allow any number of friendly agents*}
    7.38 +  agent = Server | Friend nat | Spy
    7.39 +
    7.40 +datatype
    7.41 +     msg = Agent  agent	    --{*Agent names*}
    7.42 +         | Number nat       --{*Ordinary integers, timestamps, ...*}
    7.43 +         | Nonce  nat       --{*Unguessable nonces*}
    7.44 +         | Key    key       --{*Crypto keys*}
    7.45 +	 | Hash   msg       --{*Hashing*}
    7.46 +	 | MPair  msg msg   --{*Compound messages*}
    7.47 +	 | Crypt  key msg   --{*Encryption, public- or shared-key*}
    7.48 +
    7.49 +
    7.50 +text{*Concrete syntax: messages appear as {|A,B,NA|}, etc...*}
    7.51 +syntax
    7.52 +  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
    7.53 +
    7.54 +syntax (xsymbols)
    7.55 +  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
    7.56 +
    7.57 +translations
    7.58 +  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
    7.59 +  "{|x, y|}"      == "MPair x y"
    7.60 +
    7.61 +
    7.62 +constdefs
    7.63 +  HPair :: "[msg,msg] => msg"                       ("(4Hash[_] /_)" [0, 1000])
    7.64 +    --{*Message Y paired with a MAC computed with the help of X*}
    7.65 +    "Hash[X] Y == {| Hash{|X,Y|}, Y|}"
    7.66 +
    7.67 +  keysFor :: "msg set => key set"
    7.68 +    --{*Keys useful to decrypt elements of a message set*}
    7.69 +  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
    7.70 +
    7.71 +
    7.72 +subsubsection{*Inductive Definition of All Parts" of a Message*}
    7.73 +
    7.74 +consts  parts   :: "msg set => msg set"
    7.75 +inductive "parts H"
    7.76 +  intros 
    7.77 +    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
    7.78 +    Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
    7.79 +    Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
    7.80 +    Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
    7.81 +
    7.82 +
    7.83 +ML{*ResAtp.problem_name := "Message__parts_mono"*}
    7.84 +lemma parts_mono: "G \<subseteq> H ==> parts(G) \<subseteq> parts(H)"
    7.85 +apply auto
    7.86 +apply (erule parts.induct) 
    7.87 +apply (metis Inj set_mp)
    7.88 +apply (metis Fst)
    7.89 +apply (metis Snd)
    7.90 +apply (metis Body)
    7.91 +done
    7.92 +
    7.93 +
    7.94 +text{*Equations hold because constructors are injective.*}
    7.95 +lemma Friend_image_eq [simp]: "(Friend x \<in> Friend`A) = (x:A)"
    7.96 +by auto
    7.97 +
    7.98 +lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
    7.99 +by auto
   7.100 +
   7.101 +lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
   7.102 +by auto
   7.103 +
   7.104 +
   7.105 +subsubsection{*Inverse of keys *}
   7.106 +
   7.107 +ML{*ResAtp.problem_name := "Message__invKey_eq"*}
   7.108 +lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
   7.109 +by (metis invKey)
   7.110 +
   7.111 +
   7.112 +subsection{*keysFor operator*}
   7.113 +
   7.114 +lemma keysFor_empty [simp]: "keysFor {} = {}"
   7.115 +by (unfold keysFor_def, blast)
   7.116 +
   7.117 +lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
   7.118 +by (unfold keysFor_def, blast)
   7.119 +
   7.120 +lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
   7.121 +by (unfold keysFor_def, blast)
   7.122 +
   7.123 +text{*Monotonicity*}
   7.124 +lemma keysFor_mono: "G \<subseteq> H ==> keysFor(G) \<subseteq> keysFor(H)"
   7.125 +by (unfold keysFor_def, blast)
   7.126 +
   7.127 +lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
   7.128 +by (unfold keysFor_def, auto)
   7.129 +
   7.130 +lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
   7.131 +by (unfold keysFor_def, auto)
   7.132 +
   7.133 +lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
   7.134 +by (unfold keysFor_def, auto)
   7.135 +
   7.136 +lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
   7.137 +by (unfold keysFor_def, auto)
   7.138 +
   7.139 +lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
   7.140 +by (unfold keysFor_def, auto)
   7.141 +
   7.142 +lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
   7.143 +by (unfold keysFor_def, auto)
   7.144 +
   7.145 +lemma keysFor_insert_Crypt [simp]: 
   7.146 +    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
   7.147 +by (unfold keysFor_def, auto)
   7.148 +
   7.149 +lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
   7.150 +by (unfold keysFor_def, auto)
   7.151 +
   7.152 +lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
   7.153 +by (unfold keysFor_def, blast)
   7.154 +
   7.155 +
   7.156 +subsection{*Inductive relation "parts"*}
   7.157 +
   7.158 +lemma MPair_parts:
   7.159 +     "[| {|X,Y|} \<in> parts H;        
   7.160 +         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
   7.161 +by (blast dest: parts.Fst parts.Snd) 
   7.162 +
   7.163 +    declare MPair_parts [elim!]  parts.Body [dest!]
   7.164 +text{*NB These two rules are UNSAFE in the formal sense, as they discard the
   7.165 +     compound message.  They work well on THIS FILE.  
   7.166 +  @{text MPair_parts} is left as SAFE because it speeds up proofs.
   7.167 +  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
   7.168 +
   7.169 +lemma parts_increasing: "H \<subseteq> parts(H)"
   7.170 +by blast
   7.171 +
   7.172 +lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
   7.173 +
   7.174 +lemma parts_empty [simp]: "parts{} = {}"
   7.175 +apply safe
   7.176 +apply (erule parts.induct)
   7.177 +apply blast+
   7.178 +done
   7.179 +
   7.180 +lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
   7.181 +by simp
   7.182 +
   7.183 +text{*WARNING: loops if H = {Y}, therefore must not be repeated!*}
   7.184 +lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
   7.185 +apply (erule parts.induct)
   7.186 +apply blast+
   7.187 +done
   7.188 +
   7.189 +
   7.190 +subsubsection{*Unions *}
   7.191 +
   7.192 +lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
   7.193 +by (intro Un_least parts_mono Un_upper1 Un_upper2)
   7.194 +
   7.195 +lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
   7.196 +apply (rule subsetI)
   7.197 +apply (erule parts.induct, blast+)
   7.198 +done
   7.199 +
   7.200 +lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
   7.201 +by (intro equalityI parts_Un_subset1 parts_Un_subset2)
   7.202 +
   7.203 +lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
   7.204 +apply (subst insert_is_Un [of _ H])
   7.205 +apply (simp only: parts_Un)
   7.206 +done
   7.207 +
   7.208 +ML{*ResAtp.problem_name := "Message__parts_insert_two"*}
   7.209 +lemma parts_insert2:
   7.210 +     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
   7.211 +by (metis Un_commute Un_empty_left Un_empty_right Un_insert_left Un_insert_right insert_commute parts_Un)
   7.212 +
   7.213 +
   7.214 +lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
   7.215 +by (intro UN_least parts_mono UN_upper)
   7.216 +
   7.217 +lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
   7.218 +apply (rule subsetI)
   7.219 +apply (erule parts.induct, blast+)
   7.220 +done
   7.221 +
   7.222 +lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
   7.223 +by (intro equalityI parts_UN_subset1 parts_UN_subset2)
   7.224 +
   7.225 +text{*Added to simplify arguments to parts, analz and synth.
   7.226 +  NOTE: the UN versions are no longer used!*}
   7.227 +
   7.228 +
   7.229 +text{*This allows @{text blast} to simplify occurrences of 
   7.230 +  @{term "parts(G\<union>H)"} in the assumption.*}
   7.231 +lemmas in_parts_UnE = parts_Un [THEN equalityD1, THEN subsetD, THEN UnE] 
   7.232 +declare in_parts_UnE [elim!]
   7.233 +
   7.234 +lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
   7.235 +by (blast intro: parts_mono [THEN [2] rev_subsetD])
   7.236 +
   7.237 +subsubsection{*Idempotence and transitivity *}
   7.238 +
   7.239 +lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
   7.240 +by (erule parts.induct, blast+)
   7.241 +
   7.242 +lemma parts_idem [simp]: "parts (parts H) = parts H"
   7.243 +by blast
   7.244 +
   7.245 +ML{*ResAtp.problem_name := "Message__parts_subset_iff"*}
   7.246 +lemma parts_subset_iff [simp]: "(parts G \<subseteq> parts H) = (G \<subseteq> parts H)"
   7.247 +apply (rule iffI) 
   7.248 +apply (metis Un_absorb1 Un_subset_iff parts_Un parts_increasing)
   7.249 +apply (metis parts_Un parts_idem parts_increasing parts_mono)
   7.250 +done
   7.251 +
   7.252 +lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
   7.253 +by (blast dest: parts_mono); 
   7.254 +
   7.255 +
   7.256 +ML{*ResAtp.problem_name := "Message__parts_cut"*}
   7.257 +lemma parts_cut: "[|Y\<in> parts(insert X G);  X\<in> parts H|] ==> Y\<in> parts(G \<union> H)"
   7.258 +by (metis Un_subset_iff Un_upper1 Un_upper2 insert_subset parts_Un parts_increasing parts_trans) 
   7.259 +
   7.260 +
   7.261 +
   7.262 +subsubsection{*Rewrite rules for pulling out atomic messages *}
   7.263 +
   7.264 +lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
   7.265 +
   7.266 +
   7.267 +lemma parts_insert_Agent [simp]:
   7.268 +     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
   7.269 +apply (rule parts_insert_eq_I) 
   7.270 +apply (erule parts.induct, auto) 
   7.271 +done
   7.272 +
   7.273 +lemma parts_insert_Nonce [simp]:
   7.274 +     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
   7.275 +apply (rule parts_insert_eq_I) 
   7.276 +apply (erule parts.induct, auto) 
   7.277 +done
   7.278 +
   7.279 +lemma parts_insert_Number [simp]:
   7.280 +     "parts (insert (Number N) H) = insert (Number N) (parts H)"
   7.281 +apply (rule parts_insert_eq_I) 
   7.282 +apply (erule parts.induct, auto) 
   7.283 +done
   7.284 +
   7.285 +lemma parts_insert_Key [simp]:
   7.286 +     "parts (insert (Key K) H) = insert (Key K) (parts H)"
   7.287 +apply (rule parts_insert_eq_I) 
   7.288 +apply (erule parts.induct, auto) 
   7.289 +done
   7.290 +
   7.291 +lemma parts_insert_Hash [simp]:
   7.292 +     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
   7.293 +apply (rule parts_insert_eq_I) 
   7.294 +apply (erule parts.induct, auto) 
   7.295 +done
   7.296 +
   7.297 +lemma parts_insert_Crypt [simp]:
   7.298 +     "parts (insert (Crypt K X) H) =  
   7.299 +          insert (Crypt K X) (parts (insert X H))"
   7.300 +apply (rule equalityI)
   7.301 +apply (rule subsetI)
   7.302 +apply (erule parts.induct, auto)
   7.303 +apply (blast intro: parts.Body)
   7.304 +done
   7.305 +
   7.306 +lemma parts_insert_MPair [simp]:
   7.307 +     "parts (insert {|X,Y|} H) =  
   7.308 +          insert {|X,Y|} (parts (insert X (insert Y H)))"
   7.309 +apply (rule equalityI)
   7.310 +apply (rule subsetI)
   7.311 +apply (erule parts.induct, auto)
   7.312 +apply (blast intro: parts.Fst parts.Snd)+
   7.313 +done
   7.314 +
   7.315 +lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
   7.316 +apply auto
   7.317 +apply (erule parts.induct, auto)
   7.318 +done
   7.319 +
   7.320 +
   7.321 +ML{*ResAtp.problem_name := "Message__msg_Nonce_supply"*}
   7.322 +lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
   7.323 +apply (induct_tac "msg") 
   7.324 +apply (simp_all add: parts_insert2)
   7.325 +apply (metis Suc_n_not_le_n)
   7.326 +apply (metis le_trans linorder_linear)
   7.327 +done
   7.328 +
   7.329 +subsection{*Inductive relation "analz"*}
   7.330 +
   7.331 +text{*Inductive definition of "analz" -- what can be broken down from a set of
   7.332 +    messages, including keys.  A form of downward closure.  Pairs can
   7.333 +    be taken apart; messages decrypted with known keys.  *}
   7.334 +
   7.335 +consts  analz   :: "msg set => msg set"
   7.336 +inductive "analz H"
   7.337 +  intros 
   7.338 +    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
   7.339 +    Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
   7.340 +    Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
   7.341 +    Decrypt [dest]: 
   7.342 +             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
   7.343 +
   7.344 +
   7.345 +text{*Monotonicity; Lemma 1 of Lowe's paper*}
   7.346 +lemma analz_mono: "G\<subseteq>H ==> analz(G) \<subseteq> analz(H)"
   7.347 +apply auto
   7.348 +apply (erule analz.induct) 
   7.349 +apply (auto dest: analz.Fst analz.Snd) 
   7.350 +done
   7.351 +
   7.352 +text{*Making it safe speeds up proofs*}
   7.353 +lemma MPair_analz [elim!]:
   7.354 +     "[| {|X,Y|} \<in> analz H;        
   7.355 +             [| X \<in> analz H; Y \<in> analz H |] ==> P   
   7.356 +          |] ==> P"
   7.357 +by (blast dest: analz.Fst analz.Snd)
   7.358 +
   7.359 +lemma analz_increasing: "H \<subseteq> analz(H)"
   7.360 +by blast
   7.361 +
   7.362 +lemma analz_subset_parts: "analz H \<subseteq> parts H"
   7.363 +apply (rule subsetI)
   7.364 +apply (erule analz.induct, blast+)
   7.365 +done
   7.366 +
   7.367 +lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
   7.368 +
   7.369 +lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
   7.370 +
   7.371 +
   7.372 +ML{*ResAtp.problem_name := "Message__parts_analz"*}
   7.373 +lemma parts_analz [simp]: "parts (analz H) = parts H"
   7.374 +apply (rule equalityI)
   7.375 +apply (metis analz_subset_parts parts_subset_iff)
   7.376 +apply (metis analz_increasing parts_mono)
   7.377 +done
   7.378 +
   7.379 +
   7.380 +lemma analz_parts [simp]: "analz (parts H) = parts H"
   7.381 +apply auto
   7.382 +apply (erule analz.induct, auto)
   7.383 +done
   7.384 +
   7.385 +lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
   7.386 +
   7.387 +subsubsection{*General equational properties *}
   7.388 +
   7.389 +lemma analz_empty [simp]: "analz{} = {}"
   7.390 +apply safe
   7.391 +apply (erule analz.induct, blast+)
   7.392 +done
   7.393 +
   7.394 +text{*Converse fails: we can analz more from the union than from the 
   7.395 +  separate parts, as a key in one might decrypt a message in the other*}
   7.396 +lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
   7.397 +by (intro Un_least analz_mono Un_upper1 Un_upper2)
   7.398 +
   7.399 +lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
   7.400 +by (blast intro: analz_mono [THEN [2] rev_subsetD])
   7.401 +
   7.402 +subsubsection{*Rewrite rules for pulling out atomic messages *}
   7.403 +
   7.404 +lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
   7.405 +
   7.406 +lemma analz_insert_Agent [simp]:
   7.407 +     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
   7.408 +apply (rule analz_insert_eq_I) 
   7.409 +apply (erule analz.induct, auto) 
   7.410 +done
   7.411 +
   7.412 +lemma analz_insert_Nonce [simp]:
   7.413 +     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
   7.414 +apply (rule analz_insert_eq_I) 
   7.415 +apply (erule analz.induct, auto) 
   7.416 +done
   7.417 +
   7.418 +lemma analz_insert_Number [simp]:
   7.419 +     "analz (insert (Number N) H) = insert (Number N) (analz H)"
   7.420 +apply (rule analz_insert_eq_I) 
   7.421 +apply (erule analz.induct, auto) 
   7.422 +done
   7.423 +
   7.424 +lemma analz_insert_Hash [simp]:
   7.425 +     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
   7.426 +apply (rule analz_insert_eq_I) 
   7.427 +apply (erule analz.induct, auto) 
   7.428 +done
   7.429 +
   7.430 +text{*Can only pull out Keys if they are not needed to decrypt the rest*}
   7.431 +lemma analz_insert_Key [simp]: 
   7.432 +    "K \<notin> keysFor (analz H) ==>   
   7.433 +          analz (insert (Key K) H) = insert (Key K) (analz H)"
   7.434 +apply (unfold keysFor_def)
   7.435 +apply (rule analz_insert_eq_I) 
   7.436 +apply (erule analz.induct, auto) 
   7.437 +done
   7.438 +
   7.439 +lemma analz_insert_MPair [simp]:
   7.440 +     "analz (insert {|X,Y|} H) =  
   7.441 +          insert {|X,Y|} (analz (insert X (insert Y H)))"
   7.442 +apply (rule equalityI)
   7.443 +apply (rule subsetI)
   7.444 +apply (erule analz.induct, auto)
   7.445 +apply (erule analz.induct)
   7.446 +apply (blast intro: analz.Fst analz.Snd)+
   7.447 +done
   7.448 +
   7.449 +text{*Can pull out enCrypted message if the Key is not known*}
   7.450 +lemma analz_insert_Crypt:
   7.451 +     "Key (invKey K) \<notin> analz H 
   7.452 +      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
   7.453 +apply (rule analz_insert_eq_I) 
   7.454 +apply (erule analz.induct, auto) 
   7.455 +
   7.456 +done
   7.457 +
   7.458 +lemma lemma1: "Key (invKey K) \<in> analz H ==>   
   7.459 +               analz (insert (Crypt K X) H) \<subseteq>  
   7.460 +               insert (Crypt K X) (analz (insert X H))" 
   7.461 +apply (rule subsetI)
   7.462 +apply (erule_tac xa = x in analz.induct, auto)
   7.463 +done
   7.464 +
   7.465 +lemma lemma2: "Key (invKey K) \<in> analz H ==>   
   7.466 +               insert (Crypt K X) (analz (insert X H)) \<subseteq>  
   7.467 +               analz (insert (Crypt K X) H)"
   7.468 +apply auto
   7.469 +apply (erule_tac xa = x in analz.induct, auto)
   7.470 +apply (blast intro: analz_insertI analz.Decrypt)
   7.471 +done
   7.472 +
   7.473 +lemma analz_insert_Decrypt:
   7.474 +     "Key (invKey K) \<in> analz H ==>   
   7.475 +               analz (insert (Crypt K X) H) =  
   7.476 +               insert (Crypt K X) (analz (insert X H))"
   7.477 +by (intro equalityI lemma1 lemma2)
   7.478 +
   7.479 +text{*Case analysis: either the message is secure, or it is not! Effective,
   7.480 +but can cause subgoals to blow up! Use with @{text "split_if"}; apparently
   7.481 +@{text "split_tac"} does not cope with patterns such as @{term"analz (insert
   7.482 +(Crypt K X) H)"} *} 
   7.483 +lemma analz_Crypt_if [simp]:
   7.484 +     "analz (insert (Crypt K X) H) =                 
   7.485 +          (if (Key (invKey K) \<in> analz H)                 
   7.486 +           then insert (Crypt K X) (analz (insert X H))  
   7.487 +           else insert (Crypt K X) (analz H))"
   7.488 +by (simp add: analz_insert_Crypt analz_insert_Decrypt)
   7.489 +
   7.490 +
   7.491 +text{*This rule supposes "for the sake of argument" that we have the key.*}
   7.492 +lemma analz_insert_Crypt_subset:
   7.493 +     "analz (insert (Crypt K X) H) \<subseteq>   
   7.494 +           insert (Crypt K X) (analz (insert X H))"
   7.495 +apply (rule subsetI)
   7.496 +apply (erule analz.induct, auto)
   7.497 +done
   7.498 +
   7.499 +
   7.500 +lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
   7.501 +apply auto
   7.502 +apply (erule analz.induct, auto)
   7.503 +done
   7.504 +
   7.505 +
   7.506 +subsubsection{*Idempotence and transitivity *}
   7.507 +
   7.508 +lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
   7.509 +by (erule analz.induct, blast+)
   7.510 +
   7.511 +lemma analz_idem [simp]: "analz (analz H) = analz H"
   7.512 +by blast
   7.513 +
   7.514 +lemma analz_subset_iff [simp]: "(analz G \<subseteq> analz H) = (G \<subseteq> analz H)"
   7.515 +apply (rule iffI)
   7.516 +apply (iprover intro: subset_trans analz_increasing)  
   7.517 +apply (frule analz_mono, simp) 
   7.518 +done
   7.519 +
   7.520 +lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
   7.521 +by (drule analz_mono, blast)
   7.522 +
   7.523 +
   7.524 +ML{*ResAtp.problem_name := "Message__analz_cut"*}
   7.525 +    declare analz_trans[intro]
   7.526 +lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
   7.527 +(*TOO SLOW
   7.528 +by (metis analz_idem analz_increasing analz_mono insert_absorb insert_mono insert_subset) --{*317s*}
   7.529 +??*)
   7.530 +by (erule analz_trans, blast)
   7.531 +
   7.532 +
   7.533 +text{*This rewrite rule helps in the simplification of messages that involve
   7.534 +  the forwarding of unknown components (X).  Without it, removing occurrences
   7.535 +  of X can be very complicated. *}
   7.536 +lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
   7.537 +by (blast intro: analz_cut analz_insertI)
   7.538 +
   7.539 +
   7.540 +text{*A congruence rule for "analz" *}
   7.541 +
   7.542 +ML{*ResAtp.problem_name := "Message__analz_subset_cong"*}
   7.543 +lemma analz_subset_cong:
   7.544 +     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H' |] 
   7.545 +      ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
   7.546 +apply simp
   7.547 +apply (metis Un_absorb2 Un_commute Un_subset_iff Un_upper1 Un_upper2 analz_mono)
   7.548 +done
   7.549 +
   7.550 +
   7.551 +lemma analz_cong:
   7.552 +     "[| analz G = analz G'; analz H = analz H'  
   7.553 +               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
   7.554 +by (intro equalityI analz_subset_cong, simp_all) 
   7.555 +
   7.556 +lemma analz_insert_cong:
   7.557 +     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
   7.558 +by (force simp only: insert_def intro!: analz_cong)
   7.559 +
   7.560 +text{*If there are no pairs or encryptions then analz does nothing*}
   7.561 +lemma analz_trivial:
   7.562 +     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
   7.563 +apply safe
   7.564 +apply (erule analz.induct, blast+)
   7.565 +done
   7.566 +
   7.567 +text{*These two are obsolete (with a single Spy) but cost little to prove...*}
   7.568 +lemma analz_UN_analz_lemma:
   7.569 +     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
   7.570 +apply (erule analz.induct)
   7.571 +apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
   7.572 +done
   7.573 +
   7.574 +lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
   7.575 +by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
   7.576 +
   7.577 +
   7.578 +subsection{*Inductive relation "synth"*}
   7.579 +
   7.580 +text{*Inductive definition of "synth" -- what can be built up from a set of
   7.581 +    messages.  A form of upward closure.  Pairs can be built, messages
   7.582 +    encrypted with known keys.  Agent names are public domain.
   7.583 +    Numbers can be guessed, but Nonces cannot be.  *}
   7.584 +
   7.585 +consts  synth   :: "msg set => msg set"
   7.586 +inductive "synth H"
   7.587 +  intros 
   7.588 +    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
   7.589 +    Agent  [intro]:   "Agent agt \<in> synth H"
   7.590 +    Number [intro]:   "Number n  \<in> synth H"
   7.591 +    Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
   7.592 +    MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
   7.593 +    Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
   7.594 +
   7.595 +text{*Monotonicity*}
   7.596 +lemma synth_mono: "G\<subseteq>H ==> synth(G) \<subseteq> synth(H)"
   7.597 +  by (auto, erule synth.induct, auto)  
   7.598 +
   7.599 +text{*NO @{text Agent_synth}, as any Agent name can be synthesized.  
   7.600 +  The same holds for @{term Number}*}
   7.601 +inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
   7.602 +inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
   7.603 +inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
   7.604 +inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
   7.605 +inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
   7.606 +
   7.607 +
   7.608 +lemma synth_increasing: "H \<subseteq> synth(H)"
   7.609 +by blast
   7.610 +
   7.611 +subsubsection{*Unions *}
   7.612 +
   7.613 +text{*Converse fails: we can synth more from the union than from the 
   7.614 +  separate parts, building a compound message using elements of each.*}
   7.615 +lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
   7.616 +by (intro Un_least synth_mono Un_upper1 Un_upper2)
   7.617 +
   7.618 +
   7.619 +ML{*ResAtp.problem_name := "Message__synth_insert"*}
   7.620 + 
   7.621 +lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
   7.622 +by (metis insert_iff insert_subset subset_insertI synth.Inj synth_mono)
   7.623 +
   7.624 +subsubsection{*Idempotence and transitivity *}
   7.625 +
   7.626 +lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
   7.627 +by (erule synth.induct, blast+)
   7.628 +
   7.629 +lemma synth_idem: "synth (synth H) = synth H"
   7.630 +by blast
   7.631 +
   7.632 +lemma synth_subset_iff [simp]: "(synth G \<subseteq> synth H) = (G \<subseteq> synth H)"
   7.633 +apply (rule iffI)
   7.634 +apply (iprover intro: subset_trans synth_increasing)  
   7.635 +apply (frule synth_mono, simp add: synth_idem) 
   7.636 +done
   7.637 +
   7.638 +lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
   7.639 +by (drule synth_mono, blast)
   7.640 +
   7.641 +ML{*ResAtp.problem_name := "Message__synth_cut"*}
   7.642 +lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
   7.643 +(*TOO SLOW
   7.644 +by (metis insert_absorb insert_mono insert_subset synth_idem synth_increasing synth_mono)
   7.645 +*)
   7.646 +by (erule synth_trans, blast)
   7.647 +
   7.648 +
   7.649 +lemma Agent_synth [simp]: "Agent A \<in> synth H"
   7.650 +by blast
   7.651 +
   7.652 +lemma Number_synth [simp]: "Number n \<in> synth H"
   7.653 +by blast
   7.654 +
   7.655 +lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
   7.656 +by blast
   7.657 +
   7.658 +lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
   7.659 +by blast
   7.660 +
   7.661 +lemma Crypt_synth_eq [simp]:
   7.662 +     "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
   7.663 +by blast
   7.664 +
   7.665 +
   7.666 +lemma keysFor_synth [simp]: 
   7.667 +    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
   7.668 +by (unfold keysFor_def, blast)
   7.669 +
   7.670 +
   7.671 +subsubsection{*Combinations of parts, analz and synth *}
   7.672 +
   7.673 +ML{*ResAtp.problem_name := "Message__parts_synth"*}
   7.674 +lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
   7.675 +apply (rule equalityI)
   7.676 +apply (rule subsetI)
   7.677 +apply (erule parts.induct)
   7.678 +apply (metis UnCI)
   7.679 +apply (metis MPair_synth UnCI UnE insert_absorb insert_subset parts.Fst parts_increasing)
   7.680 +apply (metis MPair_synth UnCI UnE insert_absorb insert_subset parts.Snd parts_increasing)
   7.681 +apply (metis Body Crypt_synth UnCI UnE insert_absorb insert_subset parts_increasing)
   7.682 +apply (metis Un_subset_iff parts_increasing parts_mono synth_increasing)
   7.683 +done
   7.684 +
   7.685 +
   7.686 +
   7.687 +
   7.688 +ML{*ResAtp.problem_name := "Message__analz_analz_Un"*}
   7.689 +lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
   7.690 +apply (rule equalityI);
   7.691 +apply (metis analz_idem analz_subset_cong order_eq_refl)
   7.692 +apply (metis analz_increasing analz_subset_cong order_eq_refl)
   7.693 +done
   7.694 +
   7.695 +ML{*ResAtp.problem_name := "Message__analz_synth_Un"*}
   7.696 +    declare analz_mono [intro] analz.Fst [intro] analz.Snd [intro] Un_least [intro]
   7.697 +lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
   7.698 +apply (rule equalityI)
   7.699 +apply (rule subsetI)
   7.700 +apply (erule analz.induct)
   7.701 +apply (metis UnCI UnE Un_commute analz.Inj)
   7.702 +apply (metis MPair_synth UnCI UnE Un_commute Un_upper1 analz.Fst analz_increasing analz_mono insert_absorb insert_subset)
   7.703 +apply (metis MPair_synth UnCI UnE Un_commute Un_upper1 analz.Snd analz_increasing analz_mono insert_absorb insert_subset)
   7.704 +apply (blast intro: analz.Decrypt)
   7.705 +apply (metis Diff_Int Diff_empty Diff_subset_conv Int_empty_right Un_commute Un_subset_iff Un_upper1 analz_increasing analz_mono synth_increasing)
   7.706 +done
   7.707 +
   7.708 +
   7.709 +ML{*ResAtp.problem_name := "Message__analz_synth"*}
   7.710 +lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
   7.711 +proof (neg_clausify)
   7.712 +assume 0: "analz (synth H) \<noteq> analz H \<union> synth H"
   7.713 +have 1: "\<And>X1 X3. sup (analz (sup X3 X1)) (synth X3) = analz (sup (synth X3) X1)"
   7.714 +  by (metis analz_synth_Un sup_set_eq sup_set_eq sup_set_eq)
   7.715 +have 2: "sup (analz H) (synth H) \<noteq> analz (synth H)"
   7.716 +  by (metis 0 sup_set_eq)
   7.717 +have 3: "\<And>X1 X3. sup (synth X3) (analz (sup X3 X1)) = analz (sup (synth X3) X1)"
   7.718 +  by (metis 1 Un_commute sup_set_eq sup_set_eq)
   7.719 +have 4: "\<And>X3. sup (synth X3) (analz X3) = analz (sup (synth X3) {})"
   7.720 +  by (metis 3 Un_empty_right sup_set_eq)
   7.721 +have 5: "\<And>X3. sup (synth X3) (analz X3) = analz (synth X3)"
   7.722 +  by (metis 4 Un_empty_right sup_set_eq)
   7.723 +have 6: "\<And>X3. sup (analz X3) (synth X3) = analz (synth X3)"
   7.724 +  by (metis 5 Un_commute sup_set_eq sup_set_eq)
   7.725 +show "False"
   7.726 +  by (metis 2 6)
   7.727 +qed
   7.728 +
   7.729 +
   7.730 +subsubsection{*For reasoning about the Fake rule in traces *}
   7.731 +
   7.732 +ML{*ResAtp.problem_name := "Message__parts_insert_subset_Un"*}
   7.733 +lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
   7.734 +proof (neg_clausify)
   7.735 +assume 0: "X \<in> G"
   7.736 +assume 1: "\<not> parts (insert X H) \<subseteq> parts G \<union> parts H"
   7.737 +have 2: "\<not> parts (insert X H) \<subseteq> parts (G \<union> H)"
   7.738 +  by (metis 1 parts_Un)
   7.739 +have 3: "\<not> insert X H \<subseteq> G \<union> H"
   7.740 +  by (metis 2 parts_mono)
   7.741 +have 4: "X \<notin> G \<union> H \<or> \<not> H \<subseteq> G \<union> H"
   7.742 +  by (metis 3 insert_subset)
   7.743 +have 5: "X \<notin> G \<union> H"
   7.744 +  by (metis 4 Un_upper2)
   7.745 +have 6: "X \<notin> G"
   7.746 +  by (metis 5 UnCI)
   7.747 +show "False"
   7.748 +  by (metis 6 0)
   7.749 +qed
   7.750 +
   7.751 +ML{*ResAtp.problem_name := "Message__Fake_parts_insert"*}
   7.752 +lemma Fake_parts_insert:
   7.753 +     "X \<in> synth (analz H) ==>  
   7.754 +      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
   7.755 +proof (neg_clausify)
   7.756 +assume 0: "X \<in> synth (analz H)"
   7.757 +assume 1: "\<not> parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
   7.758 +have 2: "\<And>X3. parts X3 \<union> synth (analz X3) = parts (synth (analz X3))"
   7.759 +  by (metis parts_synth parts_analz)
   7.760 +have 3: "\<And>X3. analz X3 \<union> synth (analz X3) = analz (synth (analz X3))"
   7.761 +  by (metis analz_synth analz_idem)
   7.762 +have 4: "\<And>X3. analz X3 \<subseteq> analz (synth X3)"
   7.763 +  by (metis Un_upper1 analz_synth)
   7.764 +have 5: "\<not> parts (insert X H) \<subseteq> parts H \<union> synth (analz H)"
   7.765 +  by (metis 1 Un_commute)
   7.766 +have 6: "\<not> parts (insert X H) \<subseteq> parts (synth (analz H))"
   7.767 +  by (metis 5 2)
   7.768 +have 7: "\<not> insert X H \<subseteq> synth (analz H)"
   7.769 +  by (metis 6 parts_mono)
   7.770 +have 8: "X \<notin> synth (analz H) \<or> \<not> H \<subseteq> synth (analz H)"
   7.771 +  by (metis 7 insert_subset)
   7.772 +have 9: "\<not> H \<subseteq> synth (analz H)"
   7.773 +  by (metis 8 0)
   7.774 +have 10: "\<And>X3. X3 \<subseteq> analz (synth X3)"
   7.775 +  by (metis analz_subset_iff 4)
   7.776 +have 11: "\<And>X3. X3 \<subseteq> analz (synth (analz X3))"
   7.777 +  by (metis analz_subset_iff 10)
   7.778 +have 12: "\<And>X3. analz (synth (analz X3)) = synth (analz X3) \<or>
   7.779 +     \<not> analz X3 \<subseteq> synth (analz X3)"
   7.780 +  by (metis Un_absorb1 3)
   7.781 +have 13: "\<And>X3. analz (synth (analz X3)) = synth (analz X3)"
   7.782 +  by (metis 12 synth_increasing)
   7.783 +have 14: "\<And>X3. X3 \<subseteq> synth (analz X3)"
   7.784 +  by (metis 11 13)
   7.785 +show "False"
   7.786 +  by (metis 9 14)
   7.787 +qed
   7.788 +
   7.789 +lemma Fake_parts_insert_in_Un:
   7.790 +     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
   7.791 +      ==> Z \<in>  synth (analz H) \<union> parts H";
   7.792 +by (blast dest: Fake_parts_insert  [THEN subsetD, dest])
   7.793 +
   7.794 +ML{*ResAtp.problem_name := "Message__Fake_analz_insert"*}
   7.795 +    declare analz_mono [intro] synth_mono [intro] 
   7.796 +lemma Fake_analz_insert:
   7.797 +     "X\<in> synth (analz G) ==>  
   7.798 +      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
   7.799 +by (metis Un_commute Un_insert_left Un_insert_right Un_upper1 analz_analz_Un analz_mono analz_synth_Un equalityE insert_absorb order_le_less xt1(12))
   7.800 +
   7.801 +ML{*ResAtp.problem_name := "Message__Fake_analz_insert_simpler"*}
   7.802 +(*simpler problems?  BUT METIS CAN'T PROVE
   7.803 +lemma Fake_analz_insert_simpler:
   7.804 +     "X\<in> synth (analz G) ==>  
   7.805 +      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
   7.806 +apply (rule subsetI)
   7.807 +apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
   7.808 +apply (metis Un_commute analz_analz_Un analz_synth_Un)
   7.809 +apply (metis Un_commute Un_upper1 Un_upper2 analz_cut analz_increasing analz_mono insert_absorb insert_mono insert_subset)
   7.810 +done
   7.811 +*)
   7.812 +
   7.813 +end
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/MetisExamples/ROOT.ML	Thu Jun 21 13:23:33 2007 +0200
     8.3 @@ -0,0 +1,14 @@
     8.4 +(*  Title:      HOL/MetisExamples/ROOT.ML
     8.5 +    ID:         $Id$
     8.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     8.7 +
     8.8 +Testing the metis method
     8.9 +*)
    8.10 +
    8.11 +time_use_thy "set";
    8.12 +time_use_thy "BigO";
    8.13 +time_use_thy "Abstraction";
    8.14 +time_use_thy "BT";
    8.15 +time_use_thy "Message";
    8.16 +time_use_thy "Tarski";
    8.17 +time_use_thy "TransClosure";
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/MetisExamples/Tarski.thy	Thu Jun 21 13:23:33 2007 +0200
     9.3 @@ -0,0 +1,1103 @@
     9.4 +(*  Title:      HOL/MetisTest/Tarski.thy
     9.5 +    ID:         $Id$
     9.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     9.7 +
     9.8 +Testing the metis method
     9.9 +*)
    9.10 +
    9.11 +header {* The Full Theorem of Tarski *}
    9.12 +
    9.13 +theory Tarski imports FuncSet begin
    9.14 +
    9.15 +(*Many of these higher-order problems appear to be impossible using the
    9.16 +current linkup. They often seem to need either higher-order unification
    9.17 +or explicit reasoning about connectives such as conjunction. The numerous
    9.18 +set comprehensions are to blame.*)
    9.19 +
    9.20 +
    9.21 +record 'a potype =
    9.22 +  pset  :: "'a set"
    9.23 +  order :: "('a * 'a) set"
    9.24 +
    9.25 +constdefs
    9.26 +  monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool"
    9.27 +  "monotone f A r == \<forall>x\<in>A. \<forall>y\<in>A. (x, y): r --> ((f x), (f y)) : r"
    9.28 +
    9.29 +  least :: "['a => bool, 'a potype] => 'a"
    9.30 +  "least P po == @ x. x: pset po & P x &
    9.31 +                       (\<forall>y \<in> pset po. P y --> (x,y): order po)"
    9.32 +
    9.33 +  greatest :: "['a => bool, 'a potype] => 'a"
    9.34 +  "greatest P po == @ x. x: pset po & P x &
    9.35 +                          (\<forall>y \<in> pset po. P y --> (y,x): order po)"
    9.36 +
    9.37 +  lub  :: "['a set, 'a potype] => 'a"
    9.38 +  "lub S po == least (%x. \<forall>y\<in>S. (y,x): order po) po"
    9.39 +
    9.40 +  glb  :: "['a set, 'a potype] => 'a"
    9.41 +  "glb S po == greatest (%x. \<forall>y\<in>S. (x,y): order po) po"
    9.42 +
    9.43 +  isLub :: "['a set, 'a potype, 'a] => bool"
    9.44 +  "isLub S po == %L. (L: pset po & (\<forall>y\<in>S. (y,L): order po) &
    9.45 +                   (\<forall>z\<in>pset po. (\<forall>y\<in>S. (y,z): order po) --> (L,z): order po))"
    9.46 +
    9.47 +  isGlb :: "['a set, 'a potype, 'a] => bool"
    9.48 +  "isGlb S po == %G. (G: pset po & (\<forall>y\<in>S. (G,y): order po) &
    9.49 +                 (\<forall>z \<in> pset po. (\<forall>y\<in>S. (z,y): order po) --> (z,G): order po))"
    9.50 +
    9.51 +  "fix"    :: "[('a => 'a), 'a set] => 'a set"
    9.52 +  "fix f A  == {x. x: A & f x = x}"
    9.53 +
    9.54 +  interval :: "[('a*'a) set,'a, 'a ] => 'a set"
    9.55 +  "interval r a b == {x. (a,x): r & (x,b): r}"
    9.56 +
    9.57 +declare monotone_def [skolem]
    9.58 +        lub_def [skolem]
    9.59 +        glb_def [skolem]
    9.60 +        isLub_def [skolem]
    9.61 +        isGlb_def [skolem]
    9.62 +        fix_def [skolem]
    9.63 +        interval_def [skolem]
    9.64 +
    9.65 +constdefs
    9.66 +  Bot :: "'a potype => 'a"
    9.67 +  "Bot po == least (%x. True) po"
    9.68 +
    9.69 +  Top :: "'a potype => 'a"
    9.70 +  "Top po == greatest (%x. True) po"
    9.71 +
    9.72 +  PartialOrder :: "('a potype) set"
    9.73 +  "PartialOrder == {P. refl (pset P) (order P) & antisym (order P) &
    9.74 +                       trans (order P)}"
    9.75 +
    9.76 +  CompleteLattice :: "('a potype) set"
    9.77 +  "CompleteLattice == {cl. cl: PartialOrder &
    9.78 +                        (\<forall>S. S \<subseteq> pset cl --> (\<exists>L. isLub S cl L)) &
    9.79 +                        (\<forall>S. S \<subseteq> pset cl --> (\<exists>G. isGlb S cl G))}"
    9.80 +
    9.81 +  CLF :: "('a potype * ('a => 'a)) set"
    9.82 +  "CLF == SIGMA cl: CompleteLattice.
    9.83 +            {f. f: pset cl -> pset cl & monotone f (pset cl) (order cl)}"
    9.84 +
    9.85 +  induced :: "['a set, ('a * 'a) set] => ('a *'a)set"
    9.86 +  "induced A r == {(a,b). a : A & b: A & (a,b): r}"
    9.87 +
    9.88 +declare Bot_def [skolem]
    9.89 +        Top_def [skolem]
    9.90 +        PartialOrder_def [skolem]
    9.91 +        CompleteLattice_def [skolem]
    9.92 +        CLF_def [skolem]
    9.93 +
    9.94 +constdefs
    9.95 +  sublattice :: "('a potype * 'a set)set"
    9.96 +  "sublattice ==
    9.97 +      SIGMA cl: CompleteLattice.
    9.98 +          {S. S \<subseteq> pset cl &
    9.99 +           (| pset = S, order = induced S (order cl) |): CompleteLattice }"
   9.100 +
   9.101 +syntax
   9.102 +  "@SL"  :: "['a set, 'a potype] => bool" ("_ <<= _" [51,50]50)
   9.103 +
   9.104 +translations
   9.105 +  "S <<= cl" == "S : sublattice `` {cl}"
   9.106 +
   9.107 +constdefs
   9.108 +  dual :: "'a potype => 'a potype"
   9.109 +  "dual po == (| pset = pset po, order = converse (order po) |)"
   9.110 +
   9.111 +locale (open) PO =
   9.112 +  fixes cl :: "'a potype"
   9.113 +    and A  :: "'a set"
   9.114 +    and r  :: "('a * 'a) set"
   9.115 +  assumes cl_po:  "cl : PartialOrder"
   9.116 +  defines A_def: "A == pset cl"
   9.117 +     and  r_def: "r == order cl"
   9.118 +
   9.119 +locale (open) CL = PO +
   9.120 +  assumes cl_co:  "cl : CompleteLattice"
   9.121 +
   9.122 +locale (open) CLF = CL +
   9.123 +  fixes f :: "'a => 'a"
   9.124 +    and P :: "'a set"
   9.125 +  assumes f_cl:  "(cl,f) : CLF" (*was the equivalent "f : CLF``{cl}"*)
   9.126 +  defines P_def: "P == fix f A"
   9.127 +
   9.128 +
   9.129 +locale (open) Tarski = CLF +
   9.130 +  fixes Y     :: "'a set"
   9.131 +    and intY1 :: "'a set"
   9.132 +    and v     :: "'a"
   9.133 +  assumes
   9.134 +    Y_ss: "Y \<subseteq> P"
   9.135 +  defines
   9.136 +    intY1_def: "intY1 == interval r (lub Y cl) (Top cl)"
   9.137 +    and v_def: "v == glb {x. ((%x: intY1. f x) x, x): induced intY1 r &
   9.138 +                             x: intY1}
   9.139 +                      (| pset=intY1, order=induced intY1 r|)"
   9.140 +
   9.141 +
   9.142 +subsection {* Partial Order *}
   9.143 +
   9.144 +lemma (in PO) PO_imp_refl: "refl A r"
   9.145 +apply (insert cl_po)
   9.146 +apply (simp add: PartialOrder_def A_def r_def)
   9.147 +done
   9.148 +
   9.149 +lemma (in PO) PO_imp_sym: "antisym r"
   9.150 +apply (insert cl_po)
   9.151 +apply (simp add: PartialOrder_def r_def)
   9.152 +done
   9.153 +
   9.154 +lemma (in PO) PO_imp_trans: "trans r"
   9.155 +apply (insert cl_po)
   9.156 +apply (simp add: PartialOrder_def r_def)
   9.157 +done
   9.158 +
   9.159 +lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
   9.160 +apply (insert cl_po)
   9.161 +apply (simp add: PartialOrder_def refl_def A_def r_def)
   9.162 +done
   9.163 +
   9.164 +lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
   9.165 +apply (insert cl_po)
   9.166 +apply (simp add: PartialOrder_def antisym_def r_def)
   9.167 +done
   9.168 +
   9.169 +lemma (in PO) transE: "[| (a, b) \<in> r; (b, c) \<in> r|] ==> (a,c) \<in> r"
   9.170 +apply (insert cl_po)
   9.171 +apply (simp add: PartialOrder_def r_def)
   9.172 +apply (unfold trans_def, fast)
   9.173 +done
   9.174 +
   9.175 +lemma (in PO) monotoneE:
   9.176 +     "[| monotone f A r;  x \<in> A; y \<in> A; (x, y) \<in> r |] ==> (f x, f y) \<in> r"
   9.177 +by (simp add: monotone_def)
   9.178 +
   9.179 +lemma (in PO) po_subset_po:
   9.180 +     "S \<subseteq> A ==> (| pset = S, order = induced S r |) \<in> PartialOrder"
   9.181 +apply (simp (no_asm) add: PartialOrder_def)
   9.182 +apply auto
   9.183 +-- {* refl *}
   9.184 +apply (simp add: refl_def induced_def)
   9.185 +apply (blast intro: reflE)
   9.186 +-- {* antisym *}
   9.187 +apply (simp add: antisym_def induced_def)
   9.188 +apply (blast intro: antisymE)
   9.189 +-- {* trans *}
   9.190 +apply (simp add: trans_def induced_def)
   9.191 +apply (blast intro: transE)
   9.192 +done
   9.193 +
   9.194 +lemma (in PO) indE: "[| (x, y) \<in> induced S r; S \<subseteq> A |] ==> (x, y) \<in> r"
   9.195 +by (simp add: add: induced_def)
   9.196 +
   9.197 +lemma (in PO) indI: "[| (x, y) \<in> r; x \<in> S; y \<in> S |] ==> (x, y) \<in> induced S r"
   9.198 +by (simp add: add: induced_def)
   9.199 +
   9.200 +lemma (in CL) CL_imp_ex_isLub: "S \<subseteq> A ==> \<exists>L. isLub S cl L"
   9.201 +apply (insert cl_co)
   9.202 +apply (simp add: CompleteLattice_def A_def)
   9.203 +done
   9.204 +
   9.205 +declare (in CL) cl_co [simp]
   9.206 +
   9.207 +lemma isLub_lub: "(\<exists>L. isLub S cl L) = isLub S cl (lub S cl)"
   9.208 +by (simp add: lub_def least_def isLub_def some_eq_ex [symmetric])
   9.209 +
   9.210 +declare isLub_lub [skolem]
   9.211 +
   9.212 +lemma isGlb_glb: "(\<exists>G. isGlb S cl G) = isGlb S cl (glb S cl)"
   9.213 +by (simp add: glb_def greatest_def isGlb_def some_eq_ex [symmetric])
   9.214 +
   9.215 +declare isGlb_glb [skolem]
   9.216 +
   9.217 +lemma isGlb_dual_isLub: "isGlb S cl = isLub S (dual cl)"
   9.218 +by (simp add: isLub_def isGlb_def dual_def converse_def)
   9.219 +
   9.220 +lemma isLub_dual_isGlb: "isLub S cl = isGlb S (dual cl)"
   9.221 +by (simp add: isLub_def isGlb_def dual_def converse_def)
   9.222 +
   9.223 +lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
   9.224 +apply (insert cl_po)
   9.225 +apply (simp add: PartialOrder_def dual_def refl_converse
   9.226 +                 trans_converse antisym_converse)
   9.227 +done
   9.228 +
   9.229 +lemma Rdual:
   9.230 +     "\<forall>S. (S \<subseteq> A -->( \<exists>L. isLub S (| pset = A, order = r|) L))
   9.231 +      ==> \<forall>S. (S \<subseteq> A --> (\<exists>G. isGlb S (| pset = A, order = r|) G))"
   9.232 +apply safe
   9.233 +apply (rule_tac x = "lub {y. y \<in> A & (\<forall>k \<in> S. (y, k) \<in> r)}
   9.234 +                      (|pset = A, order = r|) " in exI)
   9.235 +apply (drule_tac x = "{y. y \<in> A & (\<forall>k \<in> S. (y,k) \<in> r) }" in spec)
   9.236 +apply (drule mp, fast)
   9.237 +apply (simp add: isLub_lub isGlb_def)
   9.238 +apply (simp add: isLub_def, blast)
   9.239 +done
   9.240 +
   9.241 +declare Rdual [skolem]
   9.242 +
   9.243 +lemma lub_dual_glb: "lub S cl = glb S (dual cl)"
   9.244 +by (simp add: lub_def glb_def least_def greatest_def dual_def converse_def)
   9.245 +
   9.246 +lemma glb_dual_lub: "glb S cl = lub S (dual cl)"
   9.247 +by (simp add: lub_def glb_def least_def greatest_def dual_def converse_def)
   9.248 +
   9.249 +lemma CL_subset_PO: "CompleteLattice \<subseteq> PartialOrder"
   9.250 +by (simp add: PartialOrder_def CompleteLattice_def, fast)
   9.251 +
   9.252 +lemmas CL_imp_PO = CL_subset_PO [THEN subsetD]
   9.253 +
   9.254 +declare CL_imp_PO [THEN PO.PO_imp_refl, simp]
   9.255 +declare CL_imp_PO [THEN PO.PO_imp_sym, simp]
   9.256 +declare CL_imp_PO [THEN PO.PO_imp_trans, simp]
   9.257 +
   9.258 +lemma (in CL) CO_refl: "refl A r"
   9.259 +by (rule PO_imp_refl)
   9.260 +
   9.261 +lemma (in CL) CO_antisym: "antisym r"
   9.262 +by (rule PO_imp_sym)
   9.263 +
   9.264 +lemma (in CL) CO_trans: "trans r"
   9.265 +by (rule PO_imp_trans)
   9.266 +
   9.267 +lemma CompleteLatticeI:
   9.268 +     "[| po \<in> PartialOrder; (\<forall>S. S \<subseteq> pset po --> (\<exists>L. isLub S po L));
   9.269 +         (\<forall>S. S \<subseteq> pset po --> (\<exists>G. isGlb S po G))|]
   9.270 +      ==> po \<in> CompleteLattice"
   9.271 +apply (unfold CompleteLattice_def, blast)
   9.272 +done
   9.273 +
   9.274 +declare CompleteLatticeI [skolem]
   9.275 +
   9.276 +lemma (in CL) CL_dualCL: "dual cl \<in> CompleteLattice"
   9.277 +apply (insert cl_co)
   9.278 +apply (simp add: CompleteLattice_def dual_def)
   9.279 +apply (fold dual_def)
   9.280 +apply (simp add: isLub_dual_isGlb [symmetric] isGlb_dual_isLub [symmetric]
   9.281 +                 dualPO)
   9.282 +done
   9.283 +
   9.284 +lemma (in PO) dualA_iff: "pset (dual cl) = pset cl"
   9.285 +by (simp add: dual_def)
   9.286 +
   9.287 +lemma (in PO) dualr_iff: "((x, y) \<in> (order(dual cl))) = ((y, x) \<in> order cl)"
   9.288 +by (simp add: dual_def)
   9.289 +
   9.290 +lemma (in PO) monotone_dual:
   9.291 +     "monotone f (pset cl) (order cl) 
   9.292 +     ==> monotone f (pset (dual cl)) (order(dual cl))"
   9.293 +by (simp add: monotone_def dualA_iff dualr_iff)
   9.294 +
   9.295 +lemma (in PO) interval_dual:
   9.296 +     "[| x \<in> A; y \<in> A|] ==> interval r x y = interval (order(dual cl)) y x"
   9.297 +apply (simp add: interval_def dualr_iff)
   9.298 +apply (fold r_def, fast)
   9.299 +done
   9.300 +
   9.301 +lemma (in PO) interval_not_empty:
   9.302 +     "[| trans r; interval r a b \<noteq> {} |] ==> (a, b) \<in> r"
   9.303 +apply (simp add: interval_def)
   9.304 +apply (unfold trans_def, blast)
   9.305 +done
   9.306 +
   9.307 +lemma (in PO) interval_imp_mem: "x \<in> interval r a b ==> (a, x) \<in> r"
   9.308 +by (simp add: interval_def)
   9.309 +
   9.310 +lemma (in PO) left_in_interval:
   9.311 +     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |] ==> a \<in> interval r a b"
   9.312 +apply (simp (no_asm_simp) add: interval_def)
   9.313 +apply (simp add: PO_imp_trans interval_not_empty)
   9.314 +apply (simp add: reflE)
   9.315 +done
   9.316 +
   9.317 +lemma (in PO) right_in_interval:
   9.318 +     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |] ==> b \<in> interval r a b"
   9.319 +apply (simp (no_asm_simp) add: interval_def)
   9.320 +apply (simp add: PO_imp_trans interval_not_empty)
   9.321 +apply (simp add: reflE)
   9.322 +done
   9.323 +
   9.324 +
   9.325 +subsection {* sublattice *}
   9.326 +
   9.327 +lemma (in PO) sublattice_imp_CL:
   9.328 +     "S <<= cl  ==> (| pset = S, order = induced S r |) \<in> CompleteLattice"
   9.329 +by (simp add: sublattice_def CompleteLattice_def A_def r_def)
   9.330 +
   9.331 +lemma (in CL) sublatticeI:
   9.332 +     "[| S \<subseteq> A; (| pset = S, order = induced S r |) \<in> CompleteLattice |]
   9.333 +      ==> S <<= cl"
   9.334 +by (simp add: sublattice_def A_def r_def)
   9.335 +
   9.336 +
   9.337 +subsection {* lub *}
   9.338 +
   9.339 +lemma (in CL) lub_unique: "[| S \<subseteq> A; isLub S cl x; isLub S cl L|] ==> x = L"
   9.340 +apply (rule antisymE)
   9.341 +apply (auto simp add: isLub_def r_def)
   9.342 +done
   9.343 +
   9.344 +lemma (in CL) lub_upper: "[|S \<subseteq> A; x \<in> S|] ==> (x, lub S cl) \<in> r"
   9.345 +apply (rule CL_imp_ex_isLub [THEN exE], assumption)
   9.346 +apply (unfold lub_def least_def)
   9.347 +apply (rule some_equality [THEN ssubst])
   9.348 +  apply (simp add: isLub_def)
   9.349 + apply (simp add: lub_unique A_def isLub_def)
   9.350 +apply (simp add: isLub_def r_def)
   9.351 +done
   9.352 +
   9.353 +lemma (in CL) lub_least:
   9.354 +     "[| S \<subseteq> A; L \<in> A; \<forall>x \<in> S. (x,L) \<in> r |] ==> (lub S cl, L) \<in> r"
   9.355 +apply (rule CL_imp_ex_isLub [THEN exE], assumption)
   9.356 +apply (unfold lub_def least_def)
   9.357 +apply (rule_tac s=x in some_equality [THEN ssubst])
   9.358 +  apply (simp add: isLub_def)
   9.359 + apply (simp add: lub_unique A_def isLub_def)
   9.360 +apply (simp add: isLub_def r_def A_def)
   9.361 +done
   9.362 +
   9.363 +lemma (in CL) lub_in_lattice: "S \<subseteq> A ==> lub S cl \<in> A"
   9.364 +apply (rule CL_imp_ex_isLub [THEN exE], assumption)
   9.365 +apply (unfold lub_def least_def)
   9.366 +apply (subst some_equality)
   9.367 +apply (simp add: isLub_def)
   9.368 +prefer 2 apply (simp add: isLub_def A_def)
   9.369 +apply (simp add: lub_unique A_def isLub_def)
   9.370 +done
   9.371 +
   9.372 +lemma (in CL) lubI:
   9.373 +     "[| S \<subseteq> A; L \<in> A; \<forall>x \<in> S. (x,L) \<in> r;
   9.374 +         \<forall>z \<in> A. (\<forall>y \<in> S. (y,z) \<in> r) --> (L,z) \<in> r |] ==> L = lub S cl"
   9.375 +apply (rule lub_unique, assumption)
   9.376 +apply (simp add: isLub_def A_def r_def)
   9.377 +apply (unfold isLub_def)
   9.378 +apply (rule conjI)
   9.379 +apply (fold A_def r_def)
   9.380 +apply (rule lub_in_lattice, assumption)
   9.381 +apply (simp add: lub_upper lub_least)
   9.382 +done
   9.383 +
   9.384 +declare (in CL) lubI [skolem]
   9.385 +
   9.386 +lemma (in CL) lubIa: "[| S \<subseteq> A; isLub S cl L |] ==> L = lub S cl"
   9.387 +by (simp add: lubI isLub_def A_def r_def)
   9.388 +
   9.389 +lemma (in CL) isLub_in_lattice: "isLub S cl L ==> L \<in> A"
   9.390 +by (simp add: isLub_def  A_def)
   9.391 +
   9.392 +lemma (in CL) isLub_upper: "[|isLub S cl L; y \<in> S|] ==> (y, L) \<in> r"
   9.393 +by (simp add: isLub_def r_def)
   9.394 +
   9.395 +lemma (in CL) isLub_least:
   9.396 +     "[| isLub S cl L; z \<in> A; \<forall>y \<in> S. (y, z) \<in> r|] ==> (L, z) \<in> r"
   9.397 +by (simp add: isLub_def A_def r_def)
   9.398 +
   9.399 +lemma (in CL) isLubI:
   9.400 +     "[| L \<in> A; \<forall>y \<in> S. (y, L) \<in> r;
   9.401 +         (\<forall>z \<in> A. (\<forall>y \<in> S. (y, z):r) --> (L, z) \<in> r)|] ==> isLub S cl L"
   9.402 +by (simp add: isLub_def A_def r_def)
   9.403 +
   9.404 +declare (in CL) isLub_least [skolem]
   9.405 +declare (in CL) isLubI [skolem]
   9.406 +
   9.407 +
   9.408 +subsection {* glb *}
   9.409 +
   9.410 +lemma (in CL) glb_in_lattice: "S \<subseteq> A ==> glb S cl \<in> A"
   9.411 +apply (subst glb_dual_lub)
   9.412 +apply (simp add: A_def)
   9.413 +apply (rule dualA_iff [THEN subst])
   9.414 +apply (rule CL.lub_in_lattice)
   9.415 +apply (rule dualPO)
   9.416 +apply (rule CL_dualCL)
   9.417 +apply (simp add: dualA_iff)
   9.418 +done
   9.419 +
   9.420 +lemma (in CL) glb_lower: "[|S \<subseteq> A; x \<in> S|] ==> (glb S cl, x) \<in> r"
   9.421 +apply (subst glb_dual_lub)
   9.422 +apply (simp add: r_def)
   9.423 +apply (rule dualr_iff [THEN subst])
   9.424 +apply (rule CL.lub_upper)
   9.425 +apply (rule dualPO)
   9.426 +apply (rule CL_dualCL)
   9.427 +apply (simp add: dualA_iff A_def, assumption)
   9.428 +done
   9.429 +
   9.430 +text {*
   9.431 +  Reduce the sublattice property by using substructural properties;
   9.432 +  abandoned see @{text "Tarski_4.ML"}.
   9.433 +*}
   9.434 +
   9.435 +declare (in CLF) f_cl [simp]
   9.436 +
   9.437 +(*never proved, 2007-01-22: Tarski__CLF_unnamed_lemma
   9.438 +  NOT PROVABLE because of the conjunction used in the definition: we don't
   9.439 +  allow reasoning with rules like conjE, which is essential here.*)
   9.440 +ML{*ResAtp.problem_name:="Tarski__CLF_unnamed_lemma"*}
   9.441 +lemma (in CLF) [simp]:
   9.442 +    "f: pset cl -> pset cl & monotone f (pset cl) (order cl)" 
   9.443 +apply (insert f_cl)
   9.444 +apply (unfold CLF_def)
   9.445 +apply (erule SigmaE2) 
   9.446 +apply (erule CollectE) 
   9.447 +apply assumption; 
   9.448 +done
   9.449 +
   9.450 +lemma (in CLF) f_in_funcset: "f \<in> A -> A"
   9.451 +by (simp add: A_def)
   9.452 +
   9.453 +lemma (in CLF) monotone_f: "monotone f A r"
   9.454 +by (simp add: A_def r_def)
   9.455 +
   9.456 +(*never proved, 2007-01-22*)
   9.457 +ML{*ResAtp.problem_name:="Tarski__CLF_CLF_dual"*}
   9.458 +  declare (in CLF) CLF_def[simp] CL_dualCL[simp] monotone_dual[simp] dualA_iff[simp]
   9.459 +lemma (in CLF) CLF_dual: "(dual cl, f) \<in> CLF" 
   9.460 +apply (simp del: dualA_iff)
   9.461 +apply (simp)
   9.462 +done
   9.463 +  declare  (in CLF) CLF_def[simp del] CL_dualCL[simp del] monotone_dual[simp del]
   9.464 +          dualA_iff[simp del]
   9.465 +
   9.466 +
   9.467 +subsection {* fixed points *}
   9.468 +
   9.469 +lemma fix_subset: "fix f A \<subseteq> A"
   9.470 +by (simp add: fix_def, fast)
   9.471 +
   9.472 +lemma fix_imp_eq: "x \<in> fix f A ==> f x = x"
   9.473 +by (simp add: fix_def)
   9.474 +
   9.475 +lemma fixf_subset:
   9.476 +     "[| A \<subseteq> B; x \<in> fix (%y: A. f y) A |] ==> x \<in> fix f B"
   9.477 +by (simp add: fix_def, auto)
   9.478 +
   9.479 +
   9.480 +subsection {* lemmas for Tarski, lub *}
   9.481 +
   9.482 +(*never proved, 2007-01-22*)
   9.483 +ML{*ResAtp.problem_name:="Tarski__CLF_lubH_le_flubH"*}
   9.484 +  declare CL.lub_least[intro] CLF.f_in_funcset[intro] funcset_mem[intro] CL.lub_in_lattice[intro] PO.transE[intro] PO.monotoneE[intro] CLF.monotone_f[intro] CL.lub_upper[intro] 
   9.485 +lemma (in CLF) lubH_le_flubH:
   9.486 +     "H = {x. (x, f x) \<in> r & x \<in> A} ==> (lub H cl, f (lub H cl)) \<in> r"
   9.487 +apply (rule lub_least, fast)
   9.488 +apply (rule f_in_funcset [THEN funcset_mem])
   9.489 +apply (rule lub_in_lattice, fast)
   9.490 +-- {* @{text "\<forall>x:H. (x, f (lub H r)) \<in> r"} *}
   9.491 +apply (rule ballI)
   9.492 +(*never proved, 2007-01-22*)
   9.493 +ML{*ResAtp.problem_name:="Tarski__CLF_lubH_le_flubH_simpler"*}
   9.494 +apply (rule transE)
   9.495 +-- {* instantiates @{text "(x, ?z) \<in> order cl to (x, f x)"}, *}
   9.496 +-- {* because of the def of @{text H} *}
   9.497 +apply fast
   9.498 +-- {* so it remains to show @{text "(f x, f (lub H cl)) \<in> r"} *}
   9.499 +apply (rule_tac f = "f" in monotoneE)
   9.500 +apply (rule monotone_f, fast)
   9.501 +apply (rule lub_in_lattice, fast)
   9.502 +apply (rule lub_upper, fast)
   9.503 +apply assumption
   9.504 +done
   9.505 +  declare CL.lub_least[rule del] CLF.f_in_funcset[rule del] 
   9.506 +          funcset_mem[rule del] CL.lub_in_lattice[rule del] 
   9.507 +          PO.transE[rule del] PO.monotoneE[rule del] 
   9.508 +          CLF.monotone_f[rule del] CL.lub_upper[rule del] 
   9.509 +
   9.510 +(*never proved, 2007-01-22*)
   9.511 +ML{*ResAtp.problem_name:="Tarski__CLF_flubH_le_lubH"*}
   9.512 +  declare CLF.f_in_funcset[intro] funcset_mem[intro] CL.lub_in_lattice[intro]
   9.513 +       PO.monotoneE[intro] CLF.monotone_f[intro] CL.lub_upper[intro] 
   9.514 +       CLF.lubH_le_flubH[simp]
   9.515 +lemma (in CLF) flubH_le_lubH:
   9.516 +     "[|  H = {x. (x, f x) \<in> r & x \<in> A} |] ==> (f (lub H cl), lub H cl) \<in> r"
   9.517 +apply (rule lub_upper, fast)
   9.518 +apply (rule_tac t = "H" in ssubst, assumption)
   9.519 +apply (rule CollectI)
   9.520 +apply (rule conjI)
   9.521 +ML{*ResAtp.problem_name:="Tarski__CLF_flubH_le_lubH_simpler"*} 
   9.522 +apply (metis CO_refl lubH_le_flubH lub_dual_glb monotoneE monotone_f reflD1 reflD2)
   9.523 +apply (metis CO_refl lubH_le_flubH reflD2)
   9.524 +done
   9.525 +  declare CLF.f_in_funcset[rule del] funcset_mem[rule del] 
   9.526 +          CL.lub_in_lattice[rule del] PO.monotoneE[rule del] 
   9.527 +          CLF.monotone_f[rule del] CL.lub_upper[rule del] 
   9.528 +          CLF.lubH_le_flubH[simp del]
   9.529 +
   9.530 +
   9.531 +(*never proved, 2007-01-22*)
   9.532 +ML{*ResAtp.problem_name:="Tarski__CLF_lubH_is_fixp"*}
   9.533 +(*Single-step version fails. The conjecture clauses refer to local abstraction
   9.534 +functions (Frees), which prevents expand_defs_tac from removing those 
   9.535 +"definitions" at the end of the proof. 
   9.536 +lemma (in CLF) lubH_is_fixp:
   9.537 +     "H = {x. (x, f x) \<in> r & x \<in> A} ==> lub H cl \<in> fix f A"
   9.538 +apply (simp add: fix_def)
   9.539 +apply (rule conjI)
   9.540 + proof (neg_clausify)
   9.541 +assume 0: "H = Collect (llabs_local_Xcl_A_r_f_P_XlubH_le_flubH_1 A f r)"
   9.542 +assume 1: "lub (Collect (llabs_local_Xcl_A_r_f_P_XlubH_le_flubH_1 A f r)) cl \<notin> A"
   9.543 +have 2: "glb H (dual cl) \<notin> A"
   9.544 +  by (metis 0 1 lub_dual_glb)
   9.545 +have 3: "(glb H (dual cl), f (glb H (dual cl))) \<in> r"
   9.546 +  by (metis 0 lubH_le_flubH lub_dual_glb)
   9.547 +have 4: "(f (glb H (dual cl)), glb H (dual cl)) \<in> r"
   9.548 +  by (metis 0 flubH_le_lubH lub_dual_glb)
   9.549 +have 5: "glb H (dual cl) = f (glb H (dual cl)) \<or>
   9.550 +(glb H (dual cl), f (glb H (dual cl))) \<notin> r"
   9.551 +  by (metis 4 antisymE)
   9.552 +have 6: "glb H (dual cl) = f (glb H (dual cl))"
   9.553 +  by (metis 3 5)
   9.554 +have 7: "(glb H (dual cl), glb H (dual cl)) \<in> r"
   9.555 +  by (metis 4 6)
   9.556 +have 8: "\<And>X1. glb H (dual cl) \<in> X1 \<or> \<not> refl X1 r"
   9.557 +  by (metis reflD2 7)
   9.558 +have 9: "\<not> refl A r"
   9.559 +  by (metis 2 8)
   9.560 +show "False"
   9.561 +  by (metis 9 CO_refl)
   9.562 +proof (neg_clausify)
   9.563 +assume 0: "H = Collect (llabs_local_Xcl_A_r_f_P_XlubH_le_flubH_1 A f r)"
   9.564 +assume 1: "f (lub (Collect (llabs_local_Xcl_A_r_f_P_XlubH_le_flubH_1 A f r)) cl) \<noteq>
   9.565 +lub (Collect (llabs_local_Xcl_A_r_f_P_XlubH_le_flubH_1 A f r)) cl"
   9.566 +have 2: "(glb H (dual cl), f (glb H (dual cl))) \<in> r"
   9.567 +  by (metis 0 lubH_le_flubH lub_dual_glb lub_dual_glb)
   9.568 +have 3: "f (glb H (dual cl)) \<noteq> glb H (dual cl)"
   9.569 +  by (metis 0 1 lub_dual_glb)
   9.570 +have 4: "(f (glb H (dual cl)), glb H (dual cl)) \<in> r"
   9.571 +  by (metis lub_dual_glb flubH_le_lubH 0)
   9.572 +have 5: "f (glb H (dual cl)) = glb H (dual cl) \<or>
   9.573 +(f (glb H (dual cl)), glb H (dual cl)) \<notin> r"
   9.574 +  by (metis antisymE 2)
   9.575 +have 6: "f (glb H (dual cl)) = glb H (dual cl)"
   9.576 +  by (metis 5 4)
   9.577 +show "False"
   9.578 +  by (metis 3 6)
   9.579 +*)
   9.580 +
   9.581 +lemma (in CLF) lubH_is_fixp:
   9.582 +     "H = {x. (x, f x) \<in> r & x \<in> A} ==> lub H cl \<in> fix f A"
   9.583 +apply (simp add: fix_def)
   9.584 +apply (rule conjI)
   9.585 +ML{*ResAtp.problem_name:="Tarski__CLF_lubH_is_fixp_simpler"*} 
   9.586 +apply (metis CO_refl Domain_iff lubH_le_flubH reflD1)
   9.587 +apply (metis antisymE flubH_le_lubH lubH_le_flubH)
   9.588 +done
   9.589 +
   9.590 +lemma (in CLF) fix_in_H:
   9.591 +     "[| H = {x. (x, f x) \<in> r & x \<in> A};  x \<in> P |] ==> x \<in> H"
   9.592 +by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl
   9.593 +                    fix_subset [of f A, THEN subsetD])
   9.594 +
   9.595 +
   9.596 +lemma (in CLF) fixf_le_lubH:
   9.597 +     "H = {x. (x, f x) \<in> r & x \<in> A} ==> \<forall>x \<in> fix f A. (x, lub H cl) \<in> r"
   9.598 +apply (rule ballI)
   9.599 +apply (rule lub_upper, fast)
   9.600 +apply (rule fix_in_H)
   9.601 +apply (simp_all add: P_def)
   9.602 +done
   9.603 +
   9.604 +ML{*ResAtp.problem_name:="Tarski__CLF_lubH_least_fixf"*}
   9.605 +lemma (in CLF) lubH_least_fixf:
   9.606 +     "H = {x. (x, f x) \<in> r & x \<in> A}
   9.607 +      ==> \<forall>L. (\<forall>y \<in> fix f A. (y,L) \<in> r) --> (lub H cl, L) \<in> r"
   9.608 +apply (metis P_def lubH_is_fixp)
   9.609 +done
   9.610 +
   9.611 +subsection {* Tarski fixpoint theorem 1, first part *}
   9.612 +ML{*ResAtp.problem_name:="Tarski__CLF_T_thm_1_lub"*}
   9.613 +  declare CL.lubI[intro] fix_subset[intro] CL.lub_in_lattice[intro] 
   9.614 +          CLF.fixf_le_lubH[simp] CLF.lubH_least_fixf[simp]
   9.615 +lemma (in CLF) T_thm_1_lub: "lub P cl = lub {x. (x, f x) \<in> r & x \<in> A} cl"
   9.616 +(*sledgehammer;*)
   9.617 +apply (rule sym)
   9.618 +apply (simp add: P_def)
   9.619 +apply (rule lubI)
   9.620 +ML{*ResAtp.problem_name:="Tarski__CLF_T_thm_1_lub_simpler"*}
   9.621 +apply (metis P_def equalityE fix_subset subset_trans) 
   9.622 +apply (metis P_def fix_subset lubH_is_fixp set_mp subset_refl subset_trans)
   9.623 +apply (metis P_def fixf_le_lubH)
   9.624 +apply (metis P_def lubH_is_fixp)
   9.625 +done
   9.626 +  declare CL.lubI[rule del] fix_subset[rule del] CL.lub_in_lattice[rule del] 
   9.627 +          CLF.fixf_le_lubH[simp del] CLF.lubH_least_fixf[simp del]
   9.628 +
   9.629 +
   9.630 +(*never proved, 2007-01-22*)
   9.631 +ML{*ResAtp.problem_name:="Tarski__CLF_glbH_is_fixp"*}
   9.632 +  declare glb_dual_lub[simp] PO.dualA_iff[intro] CLF.lubH_is_fixp[intro] 
   9.633 +          PO.dualPO[intro] CL.CL_dualCL[intro] PO.dualr_iff[simp]
   9.634 +lemma (in CLF) glbH_is_fixp: "H = {x. (f x, x) \<in> r & x \<in> A} ==> glb H cl \<in> P"
   9.635 +  -- {* Tarski for glb *}
   9.636 +(*sledgehammer;*)
   9.637 +apply (simp add: glb_dual_lub P_def A_def r_def)
   9.638 +apply (rule dualA_iff [THEN subst])
   9.639 +apply (rule CLF.lubH_is_fixp)
   9.640 +apply (rule dualPO)
   9.641 +apply (rule CL_dualCL)
   9.642 +apply (rule CLF_dual)
   9.643 +apply (simp add: dualr_iff dualA_iff)
   9.644 +done
   9.645 +  declare glb_dual_lub[simp del] PO.dualA_iff[rule del] CLF.lubH_is_fixp[rule del] 
   9.646 +          PO.dualPO[rule del] CL.CL_dualCL[rule del] PO.dualr_iff[simp del]
   9.647 +
   9.648 +
   9.649 +(*never proved, 2007-01-22*)
   9.650 +ML{*ResAtp.problem_name:="Tarski__T_thm_1_glb"*}  (*ALL THEOREMS*)
   9.651 +lemma (in CLF) T_thm_1_glb: "glb P cl = glb {x. (f x, x) \<in> r & x \<in> A} cl"
   9.652 +(*sledgehammer;*)
   9.653 +apply (simp add: glb_dual_lub P_def A_def r_def)
   9.654 +apply (rule dualA_iff [THEN subst])
   9.655 +(*never proved, 2007-01-22*)
   9.656 +ML{*ResAtp.problem_name:="Tarski__T_thm_1_glb_simpler"*}  (*ALL THEOREMS*)
   9.657 +(*sledgehammer;*)
   9.658 +apply (simp add: CLF.T_thm_1_lub [of _ f, OF dualPO CL_dualCL]
   9.659 +                 dualPO CL_dualCL CLF_dual dualr_iff)
   9.660 +done
   9.661 +
   9.662 +subsection {* interval *}
   9.663 +
   9.664 +
   9.665 +ML{*ResAtp.problem_name:="Tarski__rel_imp_elem"*}
   9.666 +  declare (in CLF) CO_refl[simp] refl_def [simp]
   9.667 +lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
   9.668 +apply (metis CO_refl reflD1)
   9.669 +done
   9.670 +  declare (in CLF) CO_refl[simp del]  refl_def [simp del]
   9.671 +
   9.672 +ML{*ResAtp.problem_name:="Tarski__interval_subset"*}
   9.673 +  declare (in CLF) rel_imp_elem[intro] 
   9.674 +  declare interval_def [simp]
   9.675 +lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
   9.676 +apply (metis CO_refl interval_imp_mem reflD reflD2 rel_imp_elem subset_def)
   9.677 +done
   9.678 +  declare (in CLF) rel_imp_elem[rule del] 
   9.679 +  declare interval_def [simp del]
   9.680 +
   9.681 +
   9.682 +
   9.683 +lemma (in CLF) intervalI:
   9.684 +     "[| (a, x) \<in> r; (x, b) \<in> r |] ==> x \<in> interval r a b"
   9.685 +by (simp add: interval_def)
   9.686 +
   9.687 +lemma (in CLF) interval_lemma1:
   9.688 +     "[| S \<subseteq> interval r a b; x \<in> S |] ==> (a, x) \<in> r"
   9.689 +by (unfold interval_def, fast)
   9.690 +
   9.691 +lemma (in CLF) interval_lemma2:
   9.692 +     "[| S \<subseteq> interval r a b; x \<in> S |] ==> (x, b) \<in> r"
   9.693 +by (unfold interval_def, fast)
   9.694 +
   9.695 +lemma (in CLF) a_less_lub:
   9.696 +     "[| S \<subseteq> A; S \<noteq> {};
   9.697 +         \<forall>x \<in> S. (a,x) \<in> r; \<forall>y \<in> S. (y, L) \<in> r |] ==> (a,L) \<in> r"
   9.698 +by (blast intro: transE)
   9.699 +
   9.700 +declare (in CLF) a_less_lub [skolem]
   9.701 +
   9.702 +lemma (in CLF) glb_less_b:
   9.703 +     "[| S \<subseteq> A; S \<noteq> {};
   9.704 +         \<forall>x \<in> S. (x,b) \<in> r; \<forall>y \<in> S. (G, y) \<in> r |] ==> (G,b) \<in> r"
   9.705 +by (blast intro: transE)
   9.706 +
   9.707 +declare (in CLF) glb_less_b [skolem]
   9.708 +
   9.709 +lemma (in CLF) S_intv_cl:
   9.710 +     "[| a \<in> A; b \<in> A; S \<subseteq> interval r a b |]==> S \<subseteq> A"
   9.711 +by (simp add: subset_trans [OF _ interval_subset])
   9.712 +
   9.713 +ML{*ResAtp.problem_name:="Tarski__L_in_interval"*}  (*ALL THEOREMS*)
   9.714 +lemma (in CLF) L_in_interval:
   9.715 +     "[| a \<in> A; b \<in> A; S \<subseteq> interval r a b;
   9.716 +         S \<noteq> {}; isLub S cl L; interval r a b \<noteq> {} |] ==> L \<in> interval r a b" 
   9.717 +(*WON'T TERMINATE
   9.718 +apply (metis CO_trans intervalI interval_lemma1 interval_lemma2 isLub_least isLub_upper subset_empty subset_iff trans_def)
   9.719 +*)
   9.720 +apply (rule intervalI)
   9.721 +apply (rule a_less_lub)
   9.722 +prefer 2 apply assumption
   9.723 +apply (simp add: S_intv_cl)
   9.724 +apply (rule ballI)
   9.725 +apply (simp add: interval_lemma1)
   9.726 +apply (simp add: isLub_upper)
   9.727 +-- {* @{text "(L, b) \<in> r"} *}
   9.728 +apply (simp add: isLub_least interval_lemma2)
   9.729 +done
   9.730 +
   9.731 +(*never proved, 2007-01-22*)
   9.732 +ML{*ResAtp.problem_name:="Tarski__G_in_interval"*}  (*ALL THEOREMS*)
   9.733 +lemma (in CLF) G_in_interval:
   9.734 +     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {}; S \<subseteq> interval r a b; isGlb S cl G;
   9.735 +         S \<noteq> {} |] ==> G \<in> interval r a b"
   9.736 +apply (simp add: interval_dual)
   9.737 +apply (simp add: CLF.L_in_interval [of _ f]
   9.738 +                 dualA_iff A_def dualPO CL_dualCL CLF_dual isGlb_dual_isLub)
   9.739 +done
   9.740 +
   9.741 +ML{*ResAtp.problem_name:="Tarski__intervalPO"*}  (*ALL THEOREMS*)
   9.742 +lemma (in CLF) intervalPO:
   9.743 +     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
   9.744 +      ==> (| pset = interval r a b, order = induced (interval r a b) r |)
   9.745 +          \<in> PartialOrder"
   9.746 +proof (neg_clausify)
   9.747 +assume 0: "a \<in> A"
   9.748 +assume 1: "b \<in> A"
   9.749 +assume 2: "\<lparr>pset = interval r a b, order = induced (interval r a b) r\<rparr> \<notin> PartialOrder"
   9.750 +have 3: "\<not> interval r a b \<subseteq> A"
   9.751 +  by (metis 2 po_subset_po)
   9.752 +have 4: "b \<notin> A \<or> a \<notin> A"
   9.753 +  by (metis 3 interval_subset)
   9.754 +have 5: "a \<notin> A"
   9.755 +  by (metis 4 1)
   9.756 +show "False"
   9.757 +  by (metis 5 0)
   9.758 +qed
   9.759 +
   9.760 +lemma (in CLF) intv_CL_lub:
   9.761 + "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
   9.762 +  ==> \<forall>S. S \<subseteq> interval r a b -->
   9.763 +          (\<exists>L. isLub S (| pset = interval r a b,
   9.764 +                          order = induced (interval r a b) r |)  L)"
   9.765 +apply (intro strip)
   9.766 +apply (frule S_intv_cl [THEN CL_imp_ex_isLub])
   9.767 +prefer 2 apply assumption
   9.768 +apply assumption
   9.769 +apply (erule exE)
   9.770 +-- {* define the lub for the interval as *}
   9.771 +apply (rule_tac x = "if S = {} then a else L" in exI)
   9.772 +apply (simp (no_asm_simp) add: isLub_def split del: split_if)
   9.773 +apply (intro impI conjI)
   9.774 +-- {* @{text "(if S = {} then a else L) \<in> interval r a b"} *}
   9.775 +apply (simp add: CL_imp_PO L_in_interval)
   9.776 +apply (simp add: left_in_interval)
   9.777 +-- {* lub prop 1 *}
   9.778 +apply (case_tac "S = {}")
   9.779 +-- {* @{text "S = {}, y \<in> S = False => everything"} *}
   9.780 +apply fast
   9.781 +-- {* @{text "S \<noteq> {}"} *}
   9.782 +apply simp
   9.783 +-- {* @{text "\<forall>y:S. (y, L) \<in> induced (interval r a b) r"} *}
   9.784 +apply (rule ballI)
   9.785 +apply (simp add: induced_def  L_in_interval)
   9.786 +apply (rule conjI)
   9.787 +apply (rule subsetD)
   9.788 +apply (simp add: S_intv_cl, assumption)
   9.789 +apply (simp add: isLub_upper)
   9.790 +-- {* @{text "\<forall>z:interval r a b. (\<forall>y:S. (y, z) \<in> induced (interval r a b) r \<longrightarrow> (if S = {} then a else L, z) \<in> induced (interval r a b) r"} *}
   9.791 +apply (rule ballI)
   9.792 +apply (rule impI)
   9.793 +apply (case_tac "S = {}")
   9.794 +-- {* @{text "S = {}"} *}
   9.795 +apply simp
   9.796 +apply (simp add: induced_def  interval_def)
   9.797 +apply (rule conjI)
   9.798 +apply (rule reflE, assumption)
   9.799 +apply (rule interval_not_empty)
   9.800 +apply (rule CO_trans)
   9.801 +apply (simp add: interval_def)
   9.802 +-- {* @{text "S \<noteq> {}"} *}
   9.803 +apply simp
   9.804 +apply (simp add: induced_def  L_in_interval)
   9.805 +apply (rule isLub_least, assumption)
   9.806 +apply (rule subsetD)
   9.807 +prefer 2 apply assumption
   9.808 +apply (simp add: S_intv_cl, fast)
   9.809 +done
   9.810 +
   9.811 +lemmas (in CLF) intv_CL_glb = intv_CL_lub [THEN Rdual]
   9.812 +
   9.813 +(*never proved, 2007-01-22*)
   9.814 +ML{*ResAtp.problem_name:="Tarski__interval_is_sublattice"*}  (*ALL THEOREMS*)
   9.815 +lemma (in CLF) interval_is_sublattice:
   9.816 +     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
   9.817 +        ==> interval r a b <<= cl"
   9.818 +(*sledgehammer *)
   9.819 +apply (rule sublatticeI)
   9.820 +apply (simp add: interval_subset)
   9.821 +(*never proved, 2007-01-22*)
   9.822 +ML{*ResAtp.problem_name:="Tarski__interval_is_sublattice_simpler"*}  
   9.823 +(*sledgehammer *)
   9.824 +apply (rule CompleteLatticeI)
   9.825 +apply (simp add: intervalPO)
   9.826 + apply (simp add: intv_CL_lub)
   9.827 +apply (simp add: intv_CL_glb)
   9.828 +done
   9.829 +
   9.830 +lemmas (in CLF) interv_is_compl_latt =
   9.831 +    interval_is_sublattice [THEN sublattice_imp_CL]
   9.832 +
   9.833 +
   9.834 +subsection {* Top and Bottom *}
   9.835 +lemma (in CLF) Top_dual_Bot: "Top cl = Bot (dual cl)"
   9.836 +by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff)
   9.837 +
   9.838 +lemma (in CLF) Bot_dual_Top: "Bot cl = Top (dual cl)"
   9.839 +by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff)
   9.840 +
   9.841 +ML{*ResAtp.problem_name:="Tarski__Bot_in_lattice"*}  (*ALL THEOREMS*)
   9.842 +lemma (in CLF) Bot_in_lattice: "Bot cl \<in> A"
   9.843 +(*sledgehammer; *)
   9.844 +apply (simp add: Bot_def least_def)
   9.845 +apply (rule_tac a="glb A cl" in someI2)
   9.846 +apply (simp_all add: glb_in_lattice glb_lower 
   9.847 +                     r_def [symmetric] A_def [symmetric])
   9.848 +done
   9.849 +
   9.850 +(*first proved 2007-01-25 after relaxing relevance*)
   9.851 +ML{*ResAtp.problem_name:="Tarski__Top_in_lattice"*}  (*ALL THEOREMS*)
   9.852 +lemma (in CLF) Top_in_lattice: "Top cl \<in> A"
   9.853 +(*sledgehammer;*)
   9.854 +apply (simp add: Top_dual_Bot A_def)
   9.855 +(*first proved 2007-01-25 after relaxing relevance*)
   9.856 +ML{*ResAtp.problem_name:="Tarski__Top_in_lattice_simpler"*}  (*ALL THEOREMS*)
   9.857 +(*sledgehammer*)
   9.858 +apply (rule dualA_iff [THEN subst])
   9.859 +apply (blast intro!: CLF.Bot_in_lattice dualPO CL_dualCL CLF_dual)
   9.860 +done
   9.861 +
   9.862 +lemma (in CLF) Top_prop: "x \<in> A ==> (x, Top cl) \<in> r"
   9.863 +apply (simp add: Top_def greatest_def)
   9.864 +apply (rule_tac a="lub A cl" in someI2)
   9.865 +apply (rule someI2)
   9.866 +apply (simp_all add: lub_in_lattice lub_upper 
   9.867 +                     r_def [symmetric] A_def [symmetric])
   9.868 +done
   9.869 +
   9.870 +(*never proved, 2007-01-22*)
   9.871 +ML{*ResAtp.problem_name:="Tarski__Bot_prop"*}  (*ALL THEOREMS*) 
   9.872 +lemma (in CLF) Bot_prop: "x \<in> A ==> (Bot cl, x) \<in> r"
   9.873 +(*sledgehammer*) 
   9.874 +apply (simp add: Bot_dual_Top r_def)
   9.875 +apply (rule dualr_iff [THEN subst])
   9.876 +apply (simp add: CLF.Top_prop [of _ f]
   9.877 +                 dualA_iff A_def dualPO CL_dualCL CLF_dual)
   9.878 +done
   9.879 +
   9.880 +ML{*ResAtp.problem_name:="Tarski__Bot_in_lattice"*}  (*ALL THEOREMS*)
   9.881 +lemma (in CLF) Top_intv_not_empty: "x \<in> A  ==> interval r x (Top cl) \<noteq> {}" 
   9.882 +apply (metis Top_in_lattice Top_prop empty_iff intervalI reflE)
   9.883 +done
   9.884 +
   9.885 +ML{*ResAtp.problem_name:="Tarski__Bot_intv_not_empty"*}  (*ALL THEOREMS*)
   9.886 +lemma (in CLF) Bot_intv_not_empty: "x \<in> A ==> interval r (Bot cl) x \<noteq> {}" 
   9.887 +apply (metis Bot_prop ex_in_conv intervalI reflE rel_imp_elem)
   9.888 +done
   9.889 +
   9.890 +
   9.891 +subsection {* fixed points form a partial order *}
   9.892 +
   9.893 +lemma (in CLF) fixf_po: "(| pset = P, order = induced P r|) \<in> PartialOrder"
   9.894 +by (simp add: P_def fix_subset po_subset_po)
   9.895 +
   9.896 +(*first proved 2007-01-25 after relaxing relevance*)
   9.897 +ML{*ResAtp.problem_name:="Tarski__Y_subset_A"*}
   9.898 +  declare (in Tarski) P_def[simp] Y_ss [simp]
   9.899 +  declare fix_subset [intro] subset_trans [intro]
   9.900 +lemma (in Tarski) Y_subset_A: "Y \<subseteq> A"
   9.901 +(*sledgehammer*) 
   9.902 +apply (rule subset_trans [OF _ fix_subset])
   9.903 +apply (rule Y_ss [simplified P_def])
   9.904 +done
   9.905 +  declare (in Tarski) P_def[simp del] Y_ss [simp del]
   9.906 +  declare fix_subset [rule del] subset_trans [rule del]
   9.907 +
   9.908 +
   9.909 +lemma (in Tarski) lubY_in_A: "lub Y cl \<in> A"
   9.910 +  by (rule Y_subset_A [THEN lub_in_lattice])
   9.911 +
   9.912 +(*never proved, 2007-01-22*)
   9.913 +ML{*ResAtp.problem_name:="Tarski__lubY_le_flubY"*}  (*ALL THEOREMS*)
   9.914 +lemma (in Tarski) lubY_le_flubY: "(lub Y cl, f (lub Y cl)) \<in> r"
   9.915 +(*sledgehammer*) 
   9.916 +apply (rule lub_least)
   9.917 +apply (rule Y_subset_A)
   9.918 +apply (rule f_in_funcset [THEN funcset_mem])
   9.919 +apply (rule lubY_in_A)
   9.920 +-- {* @{text "Y \<subseteq> P ==> f x = x"} *}
   9.921 +apply (rule ballI)
   9.922 +ML{*ResAtp.problem_name:="Tarski__lubY_le_flubY_simpler"*}  (*ALL THEOREMS*)
   9.923 +(*sledgehammer *)
   9.924 +apply (rule_tac t = "x" in fix_imp_eq [THEN subst])
   9.925 +apply (erule Y_ss [simplified P_def, THEN subsetD])
   9.926 +-- {* @{text "reduce (f x, f (lub Y cl)) \<in> r to (x, lub Y cl) \<in> r"} by monotonicity *}
   9.927 +ML{*ResAtp.problem_name:="Tarski__lubY_le_flubY_simplest"*}  (*ALL THEOREMS*)
   9.928 +(*sledgehammer*)
   9.929 +apply (rule_tac f = "f" in monotoneE)
   9.930 +apply (rule monotone_f)
   9.931 +apply (simp add: Y_subset_A [THEN subsetD])
   9.932 +apply (rule lubY_in_A)
   9.933 +apply (simp add: lub_upper Y_subset_A)
   9.934 +done
   9.935 +
   9.936 +(*first proved 2007-01-25 after relaxing relevance*)
   9.937 +ML{*ResAtp.problem_name:="Tarski__intY1_subset"*}  (*ALL THEOREMS*)
   9.938 +lemma (in Tarski) intY1_subset: "intY1 \<subseteq> A"
   9.939 +(*sledgehammer*) 
   9.940 +apply (unfold intY1_def)
   9.941 +apply (rule interval_subset)
   9.942 +apply (rule lubY_in_A)
   9.943 +apply (rule Top_in_lattice)
   9.944 +done
   9.945 +
   9.946 +lemmas (in Tarski) intY1_elem = intY1_subset [THEN subsetD]
   9.947 +
   9.948 +(*never proved, 2007-01-22*)
   9.949 +ML{*ResAtp.problem_name:="Tarski__intY1_f_closed"*}  (*ALL THEOREMS*)
   9.950 +lemma (in Tarski) intY1_f_closed: "x \<in> intY1 \<Longrightarrow> f x \<in> intY1"
   9.951 +(*sledgehammer*) 
   9.952 +apply (simp add: intY1_def  interval_def)
   9.953 +apply (rule conjI)
   9.954 +apply (rule transE)
   9.955 +apply (rule lubY_le_flubY)
   9.956 +-- {* @{text "(f (lub Y cl), f x) \<in> r"} *}
   9.957 +ML{*ResAtp.problem_name:="Tarski__intY1_f_closed_simpler"*}  (*ALL THEOREMS*)
   9.958 +(*sledgehammer [has been proved before now...]*)
   9.959 +apply (rule_tac f=f in monotoneE)
   9.960 +apply (rule monotone_f)
   9.961 +apply (rule lubY_in_A)
   9.962 +apply (simp add: intY1_def interval_def  intY1_elem)
   9.963 +apply (simp add: intY1_def  interval_def)
   9.964 +-- {* @{text "(f x, Top cl) \<in> r"} *} 
   9.965 +apply (rule Top_prop)
   9.966 +apply (rule f_in_funcset [THEN funcset_mem])
   9.967 +apply (simp add: intY1_def interval_def  intY1_elem)
   9.968 +done
   9.969 +
   9.970 +ML{*ResAtp.problem_name:="Tarski__intY1_func"*}  (*ALL THEOREMS*)
   9.971 +lemma (in Tarski) intY1_func: "(%x: intY1. f x) \<in> intY1 -> intY1" 
   9.972 +apply (metis intY1_f_closed restrict_in_funcset)
   9.973 +done
   9.974 +
   9.975 +ML{*ResAtp.problem_name:="Tarski__intY1_mono"*}  (*ALL THEOREMS*)
   9.976 +lemma (in Tarski) intY1_mono [skolem]:
   9.977 +     "monotone (%x: intY1. f x) intY1 (induced intY1 r)"
   9.978 +(*sledgehammer *)
   9.979 +apply (auto simp add: monotone_def induced_def intY1_f_closed)
   9.980 +apply (blast intro: intY1_elem monotone_f [THEN monotoneE])
   9.981 +done
   9.982 +
   9.983 +(*proof requires relaxing relevance: 2007-01-25*)
   9.984 +ML{*ResAtp.problem_name:="Tarski__intY1_is_cl"*}  (*ALL THEOREMS*)
   9.985 +lemma (in Tarski) intY1_is_cl:
   9.986 +    "(| pset = intY1, order = induced intY1 r |) \<in> CompleteLattice"
   9.987 +(*sledgehammer*) 
   9.988 +apply (unfold intY1_def)
   9.989 +apply (rule interv_is_compl_latt)
   9.990 +apply (rule lubY_in_A)
   9.991 +apply (rule Top_in_lattice)
   9.992 +apply (rule Top_intv_not_empty)
   9.993 +apply (rule lubY_in_A)
   9.994 +done
   9.995 +
   9.996 +(*never proved, 2007-01-22*)
   9.997 +ML{*ResAtp.problem_name:="Tarski__v_in_P"*}  (*ALL THEOREMS*)
   9.998 +lemma (in Tarski) v_in_P: "v \<in> P"
   9.999 +(*sledgehammer*) 
  9.1000 +apply (unfold P_def)
  9.1001 +apply (rule_tac A = "intY1" in fixf_subset)
  9.1002 +apply (rule intY1_subset)
  9.1003 +apply (simp add: CLF.glbH_is_fixp [OF _ intY1_is_cl, simplified]
  9.1004 +                 v_def CL_imp_PO intY1_is_cl CLF_def intY1_func intY1_mono)
  9.1005 +done
  9.1006 +
  9.1007 +ML{*ResAtp.problem_name:="Tarski__z_in_interval"*}  (*ALL THEOREMS*)
  9.1008 +lemma (in Tarski) z_in_interval:
  9.1009 +     "[| z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r |] ==> z \<in> intY1"
  9.1010 +(*sledgehammer *)
  9.1011 +apply (unfold intY1_def P_def)
  9.1012 +apply (rule intervalI)
  9.1013 +prefer 2
  9.1014 + apply (erule fix_subset [THEN subsetD, THEN Top_prop])
  9.1015 +apply (rule lub_least)
  9.1016 +apply (rule Y_subset_A)
  9.1017 +apply (fast elim!: fix_subset [THEN subsetD])
  9.1018 +apply (simp add: induced_def)
  9.1019 +done
  9.1020 +
  9.1021 +ML{*ResAtp.problem_name:="Tarski__fz_in_int_rel"*}  (*ALL THEOREMS*)
  9.1022 +lemma (in Tarski) f'z_in_int_rel: "[| z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r |]
  9.1023 +      ==> ((%x: intY1. f x) z, z) \<in> induced intY1 r" 
  9.1024 +(*
  9.1025 +  apply (metis P_def UnE Un_absorb contra_subsetD equalityE fix_imp_eq indI intY1_elem intY1_f_closed monotoneE monotone_f reflE rel_imp_elem restrict_apply z_in_interval)
  9.1026 +??unsound??*)
  9.1027 +apply (simp add: induced_def  intY1_f_closed z_in_interval P_def)
  9.1028 +apply (simp add: fix_imp_eq [of _ f A] fix_subset [of f A, THEN subsetD]
  9.1029 +                 reflE)
  9.1030 +done
  9.1031 +
  9.1032 +(*never proved, 2007-01-22*)
  9.1033 +ML{*ResAtp.problem_name:="Tarski__tarski_full_lemma"*}  (*ALL THEOREMS*)
  9.1034 +lemma (in Tarski) tarski_full_lemma:
  9.1035 +     "\<exists>L. isLub Y (| pset = P, order = induced P r |) L"
  9.1036 +apply (rule_tac x = "v" in exI)
  9.1037 +apply (simp add: isLub_def)
  9.1038 +-- {* @{text "v \<in> P"} *}
  9.1039 +apply (simp add: v_in_P)
  9.1040 +apply (rule conjI)
  9.1041 +(*sledgehammer*) 
  9.1042 +-- {* @{text v} is lub *}
  9.1043 +-- {* @{text "1. \<forall>y:Y. (y, v) \<in> induced P r"} *}
  9.1044 +apply (rule ballI)
  9.1045 +apply (simp add: induced_def subsetD v_in_P)
  9.1046 +apply (rule conjI)
  9.1047 +apply (erule Y_ss [THEN subsetD])
  9.1048 +apply (rule_tac b = "lub Y cl" in transE)
  9.1049 +apply (rule lub_upper)
  9.1050 +apply (rule Y_subset_A, assumption)
  9.1051 +apply (rule_tac b = "Top cl" in interval_imp_mem)
  9.1052 +apply (simp add: v_def)
  9.1053 +apply (fold intY1_def)
  9.1054 +apply (rule CL.glb_in_lattice [OF _ intY1_is_cl, simplified])
  9.1055 + apply (simp add: CL_imp_PO intY1_is_cl, force)
  9.1056 +-- {* @{text v} is LEAST ub *}
  9.1057 +apply clarify
  9.1058 +apply (rule indI)
  9.1059 +  prefer 3 apply assumption
  9.1060 + prefer 2 apply (simp add: v_in_P)
  9.1061 +apply (unfold v_def)
  9.1062 +(*never proved, 2007-01-22*)
  9.1063 +ML{*ResAtp.problem_name:="Tarski__tarski_full_lemma_simpler"*} 
  9.1064 +(*sledgehammer*) 
  9.1065 +apply (rule indE)
  9.1066 +apply (rule_tac [2] intY1_subset)
  9.1067 +(*never proved, 2007-01-22*)
  9.1068 +ML{*ResAtp.problem_name:="Tarski__tarski_full_lemma_simplest"*} 
  9.1069 +(*sledgehammer*) 
  9.1070 +apply (rule CL.glb_lower [OF _ intY1_is_cl, simplified])
  9.1071 +  apply (simp add: CL_imp_PO intY1_is_cl)
  9.1072 + apply force
  9.1073 +apply (simp add: induced_def intY1_f_closed z_in_interval)
  9.1074 +apply (simp add: P_def fix_imp_eq [of _ f A] reflE
  9.1075 +                 fix_subset [of f A, THEN subsetD])
  9.1076 +done
  9.1077 +
  9.1078 +lemma CompleteLatticeI_simp:
  9.1079 +     "[| (| pset = A, order = r |) \<in> PartialOrder;
  9.1080 +         \<forall>S. S \<subseteq> A --> (\<exists>L. isLub S (| pset = A, order = r |)  L) |]
  9.1081 +    ==> (| pset = A, order = r |) \<in> CompleteLattice"
  9.1082 +by (simp add: CompleteLatticeI Rdual)
  9.1083 +
  9.1084 +
  9.1085 +(*never proved, 2007-01-22*)
  9.1086 +ML{*ResAtp.problem_name:="Tarski__Tarski_full"*}
  9.1087 +  declare (in CLF) fixf_po[intro] P_def [simp] A_def [simp] r_def [simp]
  9.1088 +               Tarski.tarski_full_lemma [intro] cl_po [intro] cl_co [intro]
  9.1089 +               CompleteLatticeI_simp [intro]
  9.1090 +theorem (in CLF) Tarski_full:
  9.1091 +     "(| pset = P, order = induced P r|) \<in> CompleteLattice"
  9.1092 +(*sledgehammer*) 
  9.1093 +apply (rule CompleteLatticeI_simp)
  9.1094 +apply (rule fixf_po, clarify)
  9.1095 +(*never proved, 2007-01-22*)
  9.1096 +ML{*ResAtp.problem_name:="Tarski__Tarski_full_simpler"*}
  9.1097 +(*sledgehammer*) 
  9.1098 +apply (simp add: P_def A_def r_def)
  9.1099 +apply (blast intro!: Tarski.tarski_full_lemma cl_po cl_co f_cl)
  9.1100 +done
  9.1101 +  declare (in CLF) fixf_po[rule del] P_def [simp del] A_def [simp del] r_def [simp del]
  9.1102 +         Tarski.tarski_full_lemma [rule del] cl_po [rule del] cl_co [rule del]
  9.1103 +         CompleteLatticeI_simp [rule del]
  9.1104 +
  9.1105 +
  9.1106 +end
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/MetisExamples/TransClosure.thy	Thu Jun 21 13:23:33 2007 +0200
    10.3 @@ -0,0 +1,62 @@
    10.4 +(*  Title:      HOL/MetisTest/TransClosure.thy
    10.5 +    ID:         $Id$
    10.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    10.7 +
    10.8 +Testing the metis method
    10.9 +*)
   10.10 +
   10.11 +theory TransClosure
   10.12 +imports Main
   10.13 +begin
   10.14 +
   10.15 +types addr = nat
   10.16 +
   10.17 +datatype val
   10.18 +  = Unit        -- "dummy result value of void expressions"
   10.19 +  | Null        -- "null reference"
   10.20 +  | Bool bool   -- "Boolean value"
   10.21 +  | Intg int    -- "integer value" 
   10.22 +  | Addr addr   -- "addresses of objects in the heap"
   10.23 +
   10.24 +consts R::"(addr \<times> addr) set"
   10.25 +
   10.26 +consts f:: "addr \<Rightarrow> val"
   10.27 +
   10.28 +ML {*ResAtp.problem_name := "TransClosure__test"*}
   10.29 +lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
   10.30 +   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"  
   10.31 +by (metis Transitive_Closure.rtrancl_into_rtrancl converse_rtranclE trancl_reflcl)
   10.32 +
   10.33 +lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
   10.34 +   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"
   10.35 +proof (neg_clausify)
   10.36 +assume 0: "f c = Intg x"
   10.37 +assume 1: "(a, b) \<in> R\<^sup>*"
   10.38 +assume 2: "(b, c) \<in> R\<^sup>*"
   10.39 +assume 3: "f b \<noteq> Intg x"
   10.40 +assume 4: "\<And>A. (b, A) \<notin> R \<or> (a, A) \<notin> R\<^sup>*"
   10.41 +have 5: "b = c \<or> b \<in> Domain R"
   10.42 +  by (metis Not_Domain_rtrancl 2)
   10.43 +have 6: "\<And>X1. (a, X1) \<in> R\<^sup>* \<or> (b, X1) \<notin> R"
   10.44 +  by (metis Transitive_Closure.rtrancl_into_rtrancl 1)
   10.45 +have 7: "\<And>X1. (b, X1) \<notin> R"
   10.46 +  by (metis 6 4)
   10.47 +have 8: "b \<notin> Domain R"
   10.48 +  by (metis 7 DomainE)
   10.49 +have 9: "c = b"
   10.50 +  by (metis 5 8)
   10.51 +have 10: "f b = Intg x"
   10.52 +  by (metis 0 9)
   10.53 +show "False"
   10.54 +  by (metis 10 3)
   10.55 +qed
   10.56 +
   10.57 +ML {*ResAtp.problem_name := "TransClosure__test_simpler"*}
   10.58 +lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
   10.59 +   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"
   10.60 +apply (erule_tac x="b" in converse_rtranclE)
   10.61 +apply (metis rel_pow_0_E rel_pow_0_I)
   10.62 +apply (metis DomainE Domain_iff Transitive_Closure.rtrancl_into_rtrancl)
   10.63 +done
   10.64 +
   10.65 +end
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOL/MetisExamples/set.thy	Thu Jun 21 13:23:33 2007 +0200
    11.3 @@ -0,0 +1,285 @@
    11.4 +(*  Title:      HOL/MetisExamples/set.thy
    11.5 +    ID:         $Id$
    11.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    11.7 +
    11.8 +Testing the metis method
    11.9 +*)
   11.10 +
   11.11 +theory set imports Main
   11.12 +
   11.13 +begin
   11.14 +
   11.15 +lemma "EX x X. ALL y. EX z Z. (~P(y,y) | P(x,x) | ~S(z,x)) &
   11.16 +               (S(x,y) | ~S(y,z) | Q(Z,Z))  &
   11.17 +               (Q(X,y) | ~Q(y,Z) | S(X,X))";
   11.18 +by metis;
   11.19 +
   11.20 +(*??Single-step reconstruction fails due to "assume?"*)
   11.21 +
   11.22 +lemma "P(n::nat) ==> ~P(0) ==> n ~= 0"
   11.23 +by metis
   11.24 +
   11.25 +ML{*ResReconstruct.modulus := 1*}
   11.26 +
   11.27 +(*multiple versions of this example*)
   11.28 +lemma (*equal_union: *)
   11.29 +   "(X = Y \<union> Z) =
   11.30 +    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
   11.31 +proof (neg_clausify)
   11.32 +fix x
   11.33 +assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
   11.34 +assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
   11.35 +assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
   11.36 +assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
   11.37 +assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
   11.38 +assume 5: "\<And>A. ((\<not> Y \<subseteq> A \<or> \<not> Z \<subseteq> A) \<or> X \<subseteq> A) \<or> X = Y \<union> Z"
   11.39 +have 6: "sup Y Z = X \<or> Y \<subseteq> X"
   11.40 +  by (metis 0 sup_set_eq)
   11.41 +have 7: "sup Y Z = X \<or> Z \<subseteq> X"
   11.42 +  by (metis 1 sup_set_eq)
   11.43 +have 8: "\<And>X3. sup Y Z = X \<or> X \<subseteq> X3 \<or> \<not> Y \<subseteq> X3 \<or> \<not> Z \<subseteq> X3"
   11.44 +  by (metis 5 sup_set_eq)
   11.45 +have 9: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
   11.46 +  by (metis 2 sup_set_eq)
   11.47 +have 10: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
   11.48 +  by (metis 3 sup_set_eq)
   11.49 +have 11: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
   11.50 +  by (metis 4 sup_set_eq)
   11.51 +have 12: "Z \<subseteq> X"
   11.52 +  by (metis Un_upper2 sup_set_eq 7)
   11.53 +have 13: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
   11.54 +  by (metis 8 Un_upper2 sup_set_eq)
   11.55 +have 14: "Y \<subseteq> X"
   11.56 +  by (metis Un_upper1 sup_set_eq 6)
   11.57 +have 15: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
   11.58 +  by (metis 10 12)
   11.59 +have 16: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
   11.60 +  by (metis 9 12)
   11.61 +have 17: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X"
   11.62 +  by (metis 11 12)
   11.63 +have 18: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x"
   11.64 +  by (metis 17 14)
   11.65 +have 19: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
   11.66 +  by (metis 15 14)
   11.67 +have 20: "Y \<subseteq> x \<or> sup Y Z \<noteq> X"
   11.68 +  by (metis 16 14)
   11.69 +have 21: "sup Y Z = X \<or> X \<subseteq> sup Y Z"
   11.70 +  by (metis 13 Un_upper1 sup_set_eq)
   11.71 +have 22: "sup Y Z = X \<or> \<not> sup Y Z \<subseteq> X"
   11.72 +  by (metis equalityI 21)
   11.73 +have 23: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
   11.74 +  by (metis 22 Un_least sup_set_eq)
   11.75 +have 24: "sup Y Z = X \<or> \<not> Y \<subseteq> X"
   11.76 +  by (metis 23 12)
   11.77 +have 25: "sup Y Z = X"
   11.78 +  by (metis 24 14)
   11.79 +have 26: "\<And>X3. X \<subseteq> X3 \<or> \<not> Z \<subseteq> X3 \<or> \<not> Y \<subseteq> X3"
   11.80 +  by (metis Un_least sup_set_eq 25)
   11.81 +have 27: "Y \<subseteq> x"
   11.82 +  by (metis 20 25)
   11.83 +have 28: "Z \<subseteq> x"
   11.84 +  by (metis 19 25)
   11.85 +have 29: "\<not> X \<subseteq> x"
   11.86 +  by (metis 18 25)
   11.87 +have 30: "X \<subseteq> x \<or> \<not> Y \<subseteq> x"
   11.88 +  by (metis 26 28)
   11.89 +have 31: "X \<subseteq> x"
   11.90 +  by (metis 30 27)
   11.91 +show "False"
   11.92 +  by (metis 31 29)
   11.93 +qed
   11.94 +
   11.95 +
   11.96 +ML{*ResReconstruct.modulus := 2*}
   11.97 +
   11.98 +lemma (*equal_union: *)
   11.99 +   "(X = Y \<union> Z) =
  11.100 +    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
  11.101 +proof (neg_clausify)
  11.102 +fix x
  11.103 +assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
  11.104 +assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
  11.105 +assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.106 +assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.107 +assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.108 +assume 5: "\<And>A. ((\<not> Y \<subseteq> A \<or> \<not> Z \<subseteq> A) \<or> X \<subseteq> A) \<or> X = Y \<union> Z"
  11.109 +have 6: "sup Y Z = X \<or> Y \<subseteq> X"
  11.110 +  by (metis 0 sup_set_eq)
  11.111 +have 7: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
  11.112 +  by (metis 2 sup_set_eq)
  11.113 +have 8: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
  11.114 +  by (metis 4 sup_set_eq)
  11.115 +have 9: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
  11.116 +  by (metis 5 sup_set_eq Un_upper2 sup_set_eq)
  11.117 +have 10: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
  11.118 +  by (metis 3 sup_set_eq Un_upper2 sup_set_eq 1 sup_set_eq)
  11.119 +have 11: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X"
  11.120 +  by (metis 8 Un_upper2 sup_set_eq 1 sup_set_eq)
  11.121 +have 12: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
  11.122 +  by (metis 10 Un_upper1 sup_set_eq 6)
  11.123 +have 13: "sup Y Z = X \<or> X \<subseteq> sup Y Z"
  11.124 +  by (metis 9 Un_upper1 sup_set_eq)
  11.125 +have 14: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
  11.126 +  by (metis equalityI 13 Un_least sup_set_eq)
  11.127 +have 15: "sup Y Z = X"
  11.128 +  by (metis 14 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 6)
  11.129 +have 16: "Y \<subseteq> x"
  11.130 +  by (metis 7 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 6 15)
  11.131 +have 17: "\<not> X \<subseteq> x"
  11.132 +  by (metis 11 Un_upper1 sup_set_eq 6 15)
  11.133 +have 18: "X \<subseteq> x"
  11.134 +  by (metis Un_least sup_set_eq 15 12 15 16)
  11.135 +show "False"
  11.136 +  by (metis 18 17)
  11.137 +qed
  11.138 +
  11.139 +ML{*ResReconstruct.modulus := 3*}
  11.140 +
  11.141 +lemma (*equal_union: *)
  11.142 +   "(X = Y \<union> Z) =
  11.143 +    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
  11.144 +proof (neg_clausify)
  11.145 +fix x
  11.146 +assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
  11.147 +assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
  11.148 +assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.149 +assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.150 +assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.151 +assume 5: "\<And>A. ((\<not> Y \<subseteq> A \<or> \<not> Z \<subseteq> A) \<or> X \<subseteq> A) \<or> X = Y \<union> Z"
  11.152 +have 6: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
  11.153 +  by (metis 3 sup_set_eq)
  11.154 +have 7: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
  11.155 +  by (metis 5 sup_set_eq Un_upper2 sup_set_eq)
  11.156 +have 8: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
  11.157 +  by (metis 2 sup_set_eq Un_upper2 sup_set_eq 1 sup_set_eq)
  11.158 +have 9: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
  11.159 +  by (metis 6 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq)
  11.160 +have 10: "sup Y Z = X \<or> \<not> sup Y Z \<subseteq> X"
  11.161 +  by (metis equalityI 7 Un_upper1 sup_set_eq)
  11.162 +have 11: "sup Y Z = X"
  11.163 +  by (metis 10 Un_least sup_set_eq Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq)
  11.164 +have 12: "Z \<subseteq> x"
  11.165 +  by (metis 9 11)
  11.166 +have 13: "X \<subseteq> x"
  11.167 +  by (metis Un_least sup_set_eq 11 12 8 Un_upper1 sup_set_eq 0 sup_set_eq 11)
  11.168 +show "False"
  11.169 +  by (metis 13 4 sup_set_eq Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq 11)
  11.170 +qed
  11.171 +
  11.172 +(*Example included in TPHOLs paper*)
  11.173 +
  11.174 +ML{*ResReconstruct.modulus := 4*}
  11.175 +
  11.176 +lemma (*equal_union: *)
  11.177 +   "(X = Y \<union> Z) =
  11.178 +    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
  11.179 +proof (neg_clausify)
  11.180 +fix x
  11.181 +assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
  11.182 +assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
  11.183 +assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.184 +assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.185 +assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
  11.186 +assume 5: "\<And>A. ((\<not> Y \<subseteq> A \<or> \<not> Z \<subseteq> A) \<or> X \<subseteq> A) \<or> X = Y \<union> Z"
  11.187 +have 6: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
  11.188 +  by (metis 4 sup_set_eq)
  11.189 +have 7: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
  11.190 +  by (metis 3 sup_set_eq Un_upper2 sup_set_eq 1 sup_set_eq)
  11.191 +have 8: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
  11.192 +  by (metis 7 Un_upper1 sup_set_eq 0 sup_set_eq)
  11.193 +have 9: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
  11.194 +  by (metis equalityI 5 sup_set_eq Un_upper2 sup_set_eq Un_upper1 sup_set_eq Un_least sup_set_eq)
  11.195 +have 10: "Y \<subseteq> x"
  11.196 +  by (metis 2 sup_set_eq Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq 9 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq)
  11.197 +have 11: "X \<subseteq> x"
  11.198 +  by (metis Un_least sup_set_eq 9 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq 8 9 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq 10)
  11.199 +show "False"
  11.200 +  by (metis 11 6 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq 9 Un_upper2 sup_set_eq 1 sup_set_eq Un_upper1 sup_set_eq 0 sup_set_eq)
  11.201 +qed 
  11.202 +
  11.203 +ML {*ResAtp.problem_name := "set__equal_union"*}
  11.204 +lemma (*equal_union: *)
  11.205 +   "(X = Y \<union> Z) =
  11.206 +    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" 
  11.207 +(*One shot proof: hand-reduced. Metis can't do the full proof any more.*)
  11.208 +by (metis Un_least Un_upper1 Un_upper2 set_eq_subset)
  11.209 +
  11.210 +
  11.211 +ML {*ResAtp.problem_name := "set__equal_inter"*}
  11.212 +lemma "(X = Y \<inter> Z) =
  11.213 +    (X \<subseteq> Y \<and> X \<subseteq> Z \<and> (\<forall>V. V \<subseteq> Y \<and> V \<subseteq> Z \<longrightarrow> V \<subseteq> X))"
  11.214 +by (metis Int_greatest Int_lower1 Int_lower2 set_eq_subset)
  11.215 +
  11.216 +ML {*ResAtp.problem_name := "set__fixedpoint"*}
  11.217 +lemma fixedpoint:
  11.218 +    "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
  11.219 +by metis
  11.220 +
  11.221 +lemma fixedpoint:
  11.222 +    "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
  11.223 +proof (neg_clausify)
  11.224 +fix x xa
  11.225 +assume 0: "f (g x) = x"
  11.226 +assume 1: "\<And>mes_oip. mes_oip = x \<or> f (g mes_oip) \<noteq> mes_oip"
  11.227 +assume 2: "\<And>mes_oio. g (f (xa mes_oio)) = xa mes_oio \<or> g (f mes_oio) \<noteq> mes_oio"
  11.228 +assume 3: "\<And>mes_oio. g (f mes_oio) \<noteq> mes_oio \<or> xa mes_oio \<noteq> mes_oio"
  11.229 +have 4: "\<And>X1. g (f X1) \<noteq> X1 \<or> g x \<noteq> X1"
  11.230 +  by (metis 3 2 1 2)
  11.231 +show "False"
  11.232 +  by (metis 4 0)
  11.233 +qed
  11.234 +
  11.235 +ML {*ResAtp.problem_name := "set__singleton_example"*}
  11.236 +lemma (*singleton_example_2:*)
  11.237 +     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
  11.238 +by (metis Set.subsetI Union_upper insertCI set_eq_subset)
  11.239 +  --{*found by SPASS*}
  11.240 +
  11.241 +lemma (*singleton_example_2:*)
  11.242 +     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
  11.243 +by (metis UnE Un_absorb Un_absorb2 Un_eq_Union Union_insert insertI1 insert_Diff insert_Diff_single subset_def)
  11.244 +  --{*found by Vampire*}
  11.245 +
  11.246 +lemma singleton_example_2:
  11.247 +     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
  11.248 +proof (neg_clausify)
  11.249 +assume 0: "\<And>mes_ojD. \<not> S \<subseteq> {mes_ojD}"
  11.250 +assume 1: "\<And>mes_ojE. mes_ojE \<notin> S \<or> \<Union>S \<subseteq> mes_ojE"
  11.251 +have 2: "\<And>X3. X3 = \<Union>S \<or> \<not> X3 \<subseteq> \<Union>S \<or> X3 \<notin> S"
  11.252 +  by (metis equalityI 1)
  11.253 +have 3: "\<And>X3. S \<subseteq> insert (\<Union>S) X3"
  11.254 +  by (metis Set.subsetI 2 Union_upper Set.subsetI insertCI)
  11.255 +show "False"
  11.256 +  by (metis 0 3)
  11.257 +qed
  11.258 +
  11.259 +
  11.260 +
  11.261 +text {*
  11.262 +  From W. W. Bledsoe and Guohui Feng, SET-VAR. JAR 11 (3), 1993, pages
  11.263 +  293-314.
  11.264 +*}
  11.265 +
  11.266 +ML {*ResAtp.problem_name := "set__Bledsoe_Fung"*}
  11.267 +(*Notes: 1, the numbering doesn't completely agree with the paper. 
  11.268 +2, we must rename set variables to avoid type clashes.*)
  11.269 +lemma "\<exists>B. (\<forall>x \<in> B. x \<le> (0::int))"
  11.270 +      "D \<in> F \<Longrightarrow> \<exists>G. \<forall>A \<in> G. \<exists>B \<in> F. A \<subseteq> B"
  11.271 +      "P a \<Longrightarrow> \<exists>A. (\<forall>x \<in> A. P x) \<and> (\<exists>y. y \<in> A)"
  11.272 +      "a < b \<and> b < (c::int) \<Longrightarrow> \<exists>B. a \<notin> B \<and> b \<in> B \<and> c \<notin> B"
  11.273 +      "P (f b) \<Longrightarrow> \<exists>s A. (\<forall>x \<in> A. P x) \<and> f s \<in> A"
  11.274 +      "P (f b) \<Longrightarrow> \<exists>s A. (\<forall>x \<in> A. P x) \<and> f s \<in> A"
  11.275 +      "\<exists>A. a \<notin> A"
  11.276 +      "(\<forall>C. (0, 0) \<in> C \<and> (\<forall>x y. (x, y) \<in> C \<longrightarrow> (Suc x, Suc y) \<in> C) \<longrightarrow> (n, m) \<in> C) \<and> Q n \<longrightarrow> Q m" 
  11.277 +apply (metis atMost_iff);
  11.278 +apply (metis emptyE)
  11.279 +apply (metis insert_iff singletonE)
  11.280 +apply (metis insertCI singletonE zless_le)
  11.281 +apply (metis insert_iff singletonE)
  11.282 +apply (metis insert_iff singletonE)
  11.283 +apply (metis DiffE)
  11.284 +apply (metis Suc_eq_add_numeral_1 nat_add_commute pair_in_Id_conv) 
  11.285 +done
  11.286 +
  11.287 +end
  11.288 +