src/HOL/BNF/BNF_GFP.thy
 author hoelzl Tue Nov 05 09:44:57 2013 +0100 (2013-11-05) changeset 54257 5c7a3b6b05a9 parent 54246 8fdb4dc08ed1 child 54484 ef90494cc827 permissions -rw-r--r--
generalize SUP and INF to the syntactic type classes Sup and Inf
```     1 (*  Title:      HOL/BNF/BNF_GFP.thy
```
```     2     Author:     Dmitriy Traytel, TU Muenchen
```
```     3     Copyright   2012
```
```     4
```
```     5 Greatest fixed point operation on bounded natural functors.
```
```     6 *)
```
```     7
```
```     8 header {* Greatest Fixed Point Operation on Bounded Natural Functors *}
```
```     9
```
```    10 theory BNF_GFP
```
```    11 imports BNF_FP_Base Equiv_Relations_More "~~/src/HOL/Library/Sublist"
```
```    12 keywords
```
```    13   "codatatype" :: thy_decl and
```
```    14   "primcorecursive" :: thy_goal and
```
```    15   "primcorec" :: thy_decl
```
```    16 begin
```
```    17
```
```    18 lemma sum_case_expand_Inr: "f o Inl = g \<Longrightarrow> f x = sum_case g (f o Inr) x"
```
```    19 by (auto split: sum.splits)
```
```    20
```
```    21 lemma sum_case_expand_Inr': "f o Inl = g \<Longrightarrow> h = f o Inr \<longleftrightarrow> sum_case g h = f"
```
```    22 by (metis sum_case_o_inj(1,2) surjective_sum)
```
```    23
```
```    24 lemma converse_Times: "(A \<times> B) ^-1 = B \<times> A"
```
```    25 by auto
```
```    26
```
```    27 lemma equiv_proj:
```
```    28   assumes e: "equiv A R" and "z \<in> R"
```
```    29   shows "(proj R o fst) z = (proj R o snd) z"
```
```    30 proof -
```
```    31   from assms(2) have z: "(fst z, snd z) \<in> R" by auto
```
```    32   with e have "\<And>x. (fst z, x) \<in> R \<Longrightarrow> (snd z, x) \<in> R" "\<And>x. (snd z, x) \<in> R \<Longrightarrow> (fst z, x) \<in> R"
```
```    33     unfolding equiv_def sym_def trans_def by blast+
```
```    34   then show ?thesis unfolding proj_def[abs_def] by auto
```
```    35 qed
```
```    36
```
```    37 (* Operators: *)
```
```    38 definition image2 where "image2 A f g = {(f a, g a) | a. a \<in> A}"
```
```    39
```
```    40
```
```    41 lemma Id_onD: "(a, b) \<in> Id_on A \<Longrightarrow> a = b"
```
```    42 unfolding Id_on_def by simp
```
```    43
```
```    44 lemma Id_onD': "x \<in> Id_on A \<Longrightarrow> fst x = snd x"
```
```    45 unfolding Id_on_def by auto
```
```    46
```
```    47 lemma Id_on_fst: "x \<in> Id_on A \<Longrightarrow> fst x \<in> A"
```
```    48 unfolding Id_on_def by auto
```
```    49
```
```    50 lemma Id_on_UNIV: "Id_on UNIV = Id"
```
```    51 unfolding Id_on_def by auto
```
```    52
```
```    53 lemma Id_on_Comp: "Id_on A = Id_on A O Id_on A"
```
```    54 unfolding Id_on_def by auto
```
```    55
```
```    56 lemma Id_on_Gr: "Id_on A = Gr A id"
```
```    57 unfolding Id_on_def Gr_def by auto
```
```    58
```
```    59 lemma Id_on_UNIV_I: "x = y \<Longrightarrow> (x, y) \<in> Id_on UNIV"
```
```    60 unfolding Id_on_def by auto
```
```    61
```
```    62 lemma image2_eqI: "\<lbrakk>b = f x; c = g x; x \<in> A\<rbrakk> \<Longrightarrow> (b, c) \<in> image2 A f g"
```
```    63 unfolding image2_def by auto
```
```    64
```
```    65 lemma IdD: "(a, b) \<in> Id \<Longrightarrow> a = b"
```
```    66 by auto
```
```    67
```
```    68 lemma image2_Gr: "image2 A f g = (Gr A f)^-1 O (Gr A g)"
```
```    69 unfolding image2_def Gr_def by auto
```
```    70
```
```    71 lemma GrD1: "(x, fx) \<in> Gr A f \<Longrightarrow> x \<in> A"
```
```    72 unfolding Gr_def by simp
```
```    73
```
```    74 lemma GrD2: "(x, fx) \<in> Gr A f \<Longrightarrow> f x = fx"
```
```    75 unfolding Gr_def by simp
```
```    76
```
```    77 lemma Gr_incl: "Gr A f \<subseteq> A <*> B \<longleftrightarrow> f ` A \<subseteq> B"
```
```    78 unfolding Gr_def by auto
```
```    79
```
```    80 lemma in_rel_Collect_split_eq: "in_rel (Collect (split X)) = X"
```
```    81 unfolding fun_eq_iff by auto
```
```    82
```
```    83 lemma Collect_split_in_rel_leI: "X \<subseteq> Y \<Longrightarrow> X \<subseteq> Collect (split (in_rel Y))"
```
```    84 by auto
```
```    85
```
```    86 lemma Collect_split_in_rel_leE: "X \<subseteq> Collect (split (in_rel Y)) \<Longrightarrow> (X \<subseteq> Y \<Longrightarrow> R) \<Longrightarrow> R"
```
```    87 by force
```
```    88
```
```    89 lemma Collect_split_in_relI: "x \<in> X \<Longrightarrow> x \<in> Collect (split (in_rel X))"
```
```    90 by auto
```
```    91
```
```    92 lemma conversep_in_rel: "(in_rel R)\<inverse>\<inverse> = in_rel (R\<inverse>)"
```
```    93 unfolding fun_eq_iff by auto
```
```    94
```
```    95 lemma relcompp_in_rel: "in_rel R OO in_rel S = in_rel (R O S)"
```
```    96 unfolding fun_eq_iff by auto
```
```    97
```
```    98 lemma in_rel_Gr: "in_rel (Gr A f) = Grp A f"
```
```    99 unfolding Gr_def Grp_def fun_eq_iff by auto
```
```   100
```
```   101 lemma in_rel_Id_on_UNIV: "in_rel (Id_on UNIV) = op ="
```
```   102 unfolding fun_eq_iff by auto
```
```   103
```
```   104 definition relImage where
```
```   105 "relImage R f \<equiv> {(f a1, f a2) | a1 a2. (a1,a2) \<in> R}"
```
```   106
```
```   107 definition relInvImage where
```
```   108 "relInvImage A R f \<equiv> {(a1, a2) | a1 a2. a1 \<in> A \<and> a2 \<in> A \<and> (f a1, f a2) \<in> R}"
```
```   109
```
```   110 lemma relImage_Gr:
```
```   111 "\<lbrakk>R \<subseteq> A \<times> A\<rbrakk> \<Longrightarrow> relImage R f = (Gr A f)^-1 O R O Gr A f"
```
```   112 unfolding relImage_def Gr_def relcomp_def by auto
```
```   113
```
```   114 lemma relInvImage_Gr: "\<lbrakk>R \<subseteq> B \<times> B\<rbrakk> \<Longrightarrow> relInvImage A R f = Gr A f O R O (Gr A f)^-1"
```
```   115 unfolding Gr_def relcomp_def image_def relInvImage_def by auto
```
```   116
```
```   117 lemma relImage_mono:
```
```   118 "R1 \<subseteq> R2 \<Longrightarrow> relImage R1 f \<subseteq> relImage R2 f"
```
```   119 unfolding relImage_def by auto
```
```   120
```
```   121 lemma relInvImage_mono:
```
```   122 "R1 \<subseteq> R2 \<Longrightarrow> relInvImage A R1 f \<subseteq> relInvImage A R2 f"
```
```   123 unfolding relInvImage_def by auto
```
```   124
```
```   125 lemma relInvImage_Id_on:
```
```   126 "(\<And>a1 a2. f a1 = f a2 \<longleftrightarrow> a1 = a2) \<Longrightarrow> relInvImage A (Id_on B) f \<subseteq> Id"
```
```   127 unfolding relInvImage_def Id_on_def by auto
```
```   128
```
```   129 lemma relInvImage_UNIV_relImage:
```
```   130 "R \<subseteq> relInvImage UNIV (relImage R f) f"
```
```   131 unfolding relInvImage_def relImage_def by auto
```
```   132
```
```   133 lemma equiv_Image: "equiv A R \<Longrightarrow> (\<And>a b. (a, b) \<in> R \<Longrightarrow> a \<in> A \<and> b \<in> A \<and> R `` {a} = R `` {b})"
```
```   134 unfolding equiv_def refl_on_def Image_def by (auto intro: transD symD)
```
```   135
```
```   136 lemma relImage_proj:
```
```   137 assumes "equiv A R"
```
```   138 shows "relImage R (proj R) \<subseteq> Id_on (A//R)"
```
```   139 unfolding relImage_def Id_on_def
```
```   140 using proj_iff[OF assms] equiv_class_eq_iff[OF assms]
```
```   141 by (auto simp: proj_preserves)
```
```   142
```
```   143 lemma relImage_relInvImage:
```
```   144 assumes "R \<subseteq> f ` A <*> f ` A"
```
```   145 shows "relImage (relInvImage A R f) f = R"
```
```   146 using assms unfolding relImage_def relInvImage_def by fastforce
```
```   147
```
```   148 lemma subst_Pair: "P x y \<Longrightarrow> a = (x, y) \<Longrightarrow> P (fst a) (snd a)"
```
```   149 by simp
```
```   150
```
```   151 lemma fst_diag_id: "(fst \<circ> (%x. (x, x))) z = id z"
```
```   152 by simp
```
```   153
```
```   154 lemma snd_diag_id: "(snd \<circ> (%x. (x, x))) z = id z"
```
```   155 by simp
```
```   156
```
```   157 lemma image_convolD: "\<lbrakk>(a, b) \<in> <f, g> ` X\<rbrakk> \<Longrightarrow> \<exists>x. x \<in> X \<and> a = f x \<and> b = g x"
```
```   158 unfolding convol_def by auto
```
```   159
```
```   160 (*Extended Sublist*)
```
```   161
```
```   162 definition prefCl where
```
```   163   "prefCl Kl = (\<forall> kl1 kl2. prefixeq kl1 kl2 \<and> kl2 \<in> Kl \<longrightarrow> kl1 \<in> Kl)"
```
```   164 definition PrefCl where
```
```   165   "PrefCl A n = (\<forall>kl kl'. kl \<in> A n \<and> prefixeq kl' kl \<longrightarrow> (\<exists>m\<le>n. kl' \<in> A m))"
```
```   166
```
```   167 lemma prefCl_UN:
```
```   168   "\<lbrakk>\<And>n. PrefCl A n\<rbrakk> \<Longrightarrow> prefCl (\<Union>n. A n)"
```
```   169 unfolding prefCl_def PrefCl_def by fastforce
```
```   170
```
```   171 definition Succ where "Succ Kl kl = {k . kl @ [k] \<in> Kl}"
```
```   172 definition Shift where "Shift Kl k = {kl. k # kl \<in> Kl}"
```
```   173 definition shift where "shift lab k = (\<lambda>kl. lab (k # kl))"
```
```   174
```
```   175 lemma empty_Shift: "\<lbrakk>[] \<in> Kl; k \<in> Succ Kl []\<rbrakk> \<Longrightarrow> [] \<in> Shift Kl k"
```
```   176 unfolding Shift_def Succ_def by simp
```
```   177
```
```   178 lemma Shift_clists: "Kl \<subseteq> Field (clists r) \<Longrightarrow> Shift Kl k \<subseteq> Field (clists r)"
```
```   179 unfolding Shift_def clists_def Field_card_of by auto
```
```   180
```
```   181 lemma Shift_prefCl: "prefCl Kl \<Longrightarrow> prefCl (Shift Kl k)"
```
```   182 unfolding prefCl_def Shift_def
```
```   183 proof safe
```
```   184   fix kl1 kl2
```
```   185   assume "\<forall>kl1 kl2. prefixeq kl1 kl2 \<and> kl2 \<in> Kl \<longrightarrow> kl1 \<in> Kl"
```
```   186     "prefixeq kl1 kl2" "k # kl2 \<in> Kl"
```
```   187   thus "k # kl1 \<in> Kl" using Cons_prefixeq_Cons[of k kl1 k kl2] by blast
```
```   188 qed
```
```   189
```
```   190 lemma not_in_Shift: "kl \<notin> Shift Kl x \<Longrightarrow> x # kl \<notin> Kl"
```
```   191 unfolding Shift_def by simp
```
```   192
```
```   193 lemma SuccD: "k \<in> Succ Kl kl \<Longrightarrow> kl @ [k] \<in> Kl"
```
```   194 unfolding Succ_def by simp
```
```   195
```
```   196 lemmas SuccE = SuccD[elim_format]
```
```   197
```
```   198 lemma SuccI: "kl @ [k] \<in> Kl \<Longrightarrow> k \<in> Succ Kl kl"
```
```   199 unfolding Succ_def by simp
```
```   200
```
```   201 lemma ShiftD: "kl \<in> Shift Kl k \<Longrightarrow> k # kl \<in> Kl"
```
```   202 unfolding Shift_def by simp
```
```   203
```
```   204 lemma Succ_Shift: "Succ (Shift Kl k) kl = Succ Kl (k # kl)"
```
```   205 unfolding Succ_def Shift_def by auto
```
```   206
```
```   207 lemma Nil_clists: "{[]} \<subseteq> Field (clists r)"
```
```   208 unfolding clists_def Field_card_of by auto
```
```   209
```
```   210 lemma Cons_clists:
```
```   211   "\<lbrakk>x \<in> Field r; xs \<in> Field (clists r)\<rbrakk> \<Longrightarrow> x # xs \<in> Field (clists r)"
```
```   212 unfolding clists_def Field_card_of by auto
```
```   213
```
```   214 lemma length_Cons: "length (x # xs) = Suc (length xs)"
```
```   215 by simp
```
```   216
```
```   217 lemma length_append_singleton: "length (xs @ [x]) = Suc (length xs)"
```
```   218 by simp
```
```   219
```
```   220 (*injection into the field of a cardinal*)
```
```   221 definition "toCard_pred A r f \<equiv> inj_on f A \<and> f ` A \<subseteq> Field r \<and> Card_order r"
```
```   222 definition "toCard A r \<equiv> SOME f. toCard_pred A r f"
```
```   223
```
```   224 lemma ex_toCard_pred:
```
```   225 "\<lbrakk>|A| \<le>o r; Card_order r\<rbrakk> \<Longrightarrow> \<exists> f. toCard_pred A r f"
```
```   226 unfolding toCard_pred_def
```
```   227 using card_of_ordLeq[of A "Field r"]
```
```   228       ordLeq_ordIso_trans[OF _ card_of_unique[of "Field r" r], of "|A|"]
```
```   229 by blast
```
```   230
```
```   231 lemma toCard_pred_toCard:
```
```   232   "\<lbrakk>|A| \<le>o r; Card_order r\<rbrakk> \<Longrightarrow> toCard_pred A r (toCard A r)"
```
```   233 unfolding toCard_def using someI_ex[OF ex_toCard_pred] .
```
```   234
```
```   235 lemma toCard_inj: "\<lbrakk>|A| \<le>o r; Card_order r; x \<in> A; y \<in> A\<rbrakk> \<Longrightarrow>
```
```   236   toCard A r x = toCard A r y \<longleftrightarrow> x = y"
```
```   237 using toCard_pred_toCard unfolding inj_on_def toCard_pred_def by blast
```
```   238
```
```   239 lemma toCard: "\<lbrakk>|A| \<le>o r; Card_order r; b \<in> A\<rbrakk> \<Longrightarrow> toCard A r b \<in> Field r"
```
```   240 using toCard_pred_toCard unfolding toCard_pred_def by blast
```
```   241
```
```   242 definition "fromCard A r k \<equiv> SOME b. b \<in> A \<and> toCard A r b = k"
```
```   243
```
```   244 lemma fromCard_toCard:
```
```   245 "\<lbrakk>|A| \<le>o r; Card_order r; b \<in> A\<rbrakk> \<Longrightarrow> fromCard A r (toCard A r b) = b"
```
```   246 unfolding fromCard_def by (rule some_equality) (auto simp add: toCard_inj)
```
```   247
```
```   248 (* pick according to the weak pullback *)
```
```   249 definition pickWP where
```
```   250 "pickWP A p1 p2 b1 b2 \<equiv> SOME a. a \<in> A \<and> p1 a = b1 \<and> p2 a = b2"
```
```   251
```
```   252 lemma pickWP_pred:
```
```   253 assumes "wpull A B1 B2 f1 f2 p1 p2" and
```
```   254 "b1 \<in> B1" and "b2 \<in> B2" and "f1 b1 = f2 b2"
```
```   255 shows "\<exists> a. a \<in> A \<and> p1 a = b1 \<and> p2 a = b2"
```
```   256 using assms unfolding wpull_def by blast
```
```   257
```
```   258 lemma pickWP:
```
```   259 assumes "wpull A B1 B2 f1 f2 p1 p2" and
```
```   260 "b1 \<in> B1" and "b2 \<in> B2" and "f1 b1 = f2 b2"
```
```   261 shows "pickWP A p1 p2 b1 b2 \<in> A"
```
```   262       "p1 (pickWP A p1 p2 b1 b2) = b1"
```
```   263       "p2 (pickWP A p1 p2 b1 b2) = b2"
```
```   264 unfolding pickWP_def using assms someI_ex[OF pickWP_pred] by fastforce+
```
```   265
```
```   266 lemma Inl_Field_csum: "a \<in> Field r \<Longrightarrow> Inl a \<in> Field (r +c s)"
```
```   267 unfolding Field_card_of csum_def by auto
```
```   268
```
```   269 lemma Inr_Field_csum: "a \<in> Field s \<Longrightarrow> Inr a \<in> Field (r +c s)"
```
```   270 unfolding Field_card_of csum_def by auto
```
```   271
```
```   272 lemma nat_rec_0: "f = nat_rec f1 (%n rec. f2 n rec) \<Longrightarrow> f 0 = f1"
```
```   273 by auto
```
```   274
```
```   275 lemma nat_rec_Suc: "f = nat_rec f1 (%n rec. f2 n rec) \<Longrightarrow> f (Suc n) = f2 n (f n)"
```
```   276 by auto
```
```   277
```
```   278 lemma list_rec_Nil: "f = list_rec f1 (%x xs rec. f2 x xs rec) \<Longrightarrow> f [] = f1"
```
```   279 by auto
```
```   280
```
```   281 lemma list_rec_Cons: "f = list_rec f1 (%x xs rec. f2 x xs rec) \<Longrightarrow> f (x # xs) = f2 x xs (f xs)"
```
```   282 by auto
```
```   283
```
```   284 lemma not_arg_cong_Inr: "x \<noteq> y \<Longrightarrow> Inr x \<noteq> Inr y"
```
```   285 by simp
```
```   286
```
```   287 lemma Collect_splitD: "x \<in> Collect (split A) \<Longrightarrow> A (fst x) (snd x)"
```
```   288 by auto
```
```   289
```
```   290 definition image2p where
```
```   291   "image2p f g R = (\<lambda>x y. \<exists>x' y'. R x' y' \<and> f x' = x \<and> g y' = y)"
```
```   292
```
```   293 lemma image2pI: "R x y \<Longrightarrow> (image2p f g R) (f x) (g y)"
```
```   294   unfolding image2p_def by blast
```
```   295
```
```   296 lemma image2p_eqI: "\<lbrakk>fx = f x; gy = g y; R x y\<rbrakk> \<Longrightarrow> (image2p f g R) fx gy"
```
```   297   unfolding image2p_def by blast
```
```   298
```
```   299 lemma image2pE: "\<lbrakk>(image2p f g R) fx gy; (\<And>x y. fx = f x \<Longrightarrow> gy = g y \<Longrightarrow> R x y \<Longrightarrow> P)\<rbrakk> \<Longrightarrow> P"
```
```   300   unfolding image2p_def by blast
```
```   301
```
```   302 lemma fun_rel_iff_geq_image2p: "(fun_rel R S) f g = (image2p f g R \<le> S)"
```
```   303   unfolding fun_rel_def image2p_def by auto
```
```   304
```
```   305 lemma convol_image_image2p: "<f o fst, g o snd> ` Collect (split R) \<subseteq> Collect (split (image2p f g R))"
```
```   306   unfolding convol_def image2p_def by fastforce
```
```   307
```
```   308 lemma fun_rel_image2p: "(fun_rel R (image2p f g R)) f g"
```
```   309   unfolding fun_rel_def image2p_def by auto
```
```   310
```
```   311 ML_file "Tools/bnf_gfp_rec_sugar_tactics.ML"
```
```   312 ML_file "Tools/bnf_gfp_rec_sugar.ML"
```
```   313 ML_file "Tools/bnf_gfp_util.ML"
```
```   314 ML_file "Tools/bnf_gfp_tactics.ML"
```
```   315 ML_file "Tools/bnf_gfp.ML"
```
```   316
```
```   317 end
```