src/HOL/Inductive.thy
author haftmann
Sun Oct 08 22:28:22 2017 +0200 (22 months ago)
changeset 66816 212a3334e7da
parent 64674 ef0a5fd30f3b
child 69593 3dda49e08b9d
permissions -rw-r--r--
more fundamental definition of div and mod on int
wenzelm@7700
     1
(*  Title:      HOL/Inductive.thy
wenzelm@10402
     2
    Author:     Markus Wenzel, TU Muenchen
wenzelm@11688
     3
*)
wenzelm@10727
     4
wenzelm@60758
     5
section \<open>Knaster-Tarski Fixpoint Theorem and inductive definitions\<close>
lcp@1187
     6
blanchet@54398
     7
theory Inductive
wenzelm@63588
     8
  imports Complete_Lattices Ctr_Sugar
wenzelm@63588
     9
  keywords
wenzelm@63588
    10
    "inductive" "coinductive" "inductive_cases" "inductive_simps" :: thy_decl and
wenzelm@63588
    11
    "monos" and
wenzelm@63588
    12
    "print_inductives" :: diag and
wenzelm@63588
    13
    "old_rep_datatype" :: thy_goal and
wenzelm@63588
    14
    "primrec" :: thy_decl
nipkow@15131
    15
begin
wenzelm@10727
    16
wenzelm@63979
    17
subsection \<open>Least fixed points\<close>
haftmann@24915
    18
haftmann@26013
    19
context complete_lattice
haftmann@26013
    20
begin
haftmann@26013
    21
wenzelm@63979
    22
definition lfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a"
wenzelm@63400
    23
  where "lfp f = Inf {u. f u \<le> u}"
haftmann@24915
    24
wenzelm@63400
    25
lemma lfp_lowerbound: "f A \<le> A \<Longrightarrow> lfp f \<le> A"
wenzelm@63981
    26
  unfolding lfp_def by (rule Inf_lower) simp
haftmann@24915
    27
wenzelm@63400
    28
lemma lfp_greatest: "(\<And>u. f u \<le> u \<Longrightarrow> A \<le> u) \<Longrightarrow> A \<le> lfp f"
wenzelm@63981
    29
  unfolding lfp_def by (rule Inf_greatest) simp
haftmann@24915
    30
haftmann@26013
    31
end
haftmann@26013
    32
wenzelm@63979
    33
lemma lfp_fixpoint:
wenzelm@63979
    34
  assumes "mono f"
wenzelm@63979
    35
  shows "f (lfp f) = lfp f"
wenzelm@63979
    36
  unfolding lfp_def
wenzelm@63979
    37
proof (rule order_antisym)
wenzelm@63979
    38
  let ?H = "{u. f u \<le> u}"
wenzelm@63979
    39
  let ?a = "\<Sqinter>?H"
wenzelm@63979
    40
  show "f ?a \<le> ?a"
wenzelm@63979
    41
  proof (rule Inf_greatest)
wenzelm@63979
    42
    fix x
wenzelm@63979
    43
    assume "x \<in> ?H"
wenzelm@63979
    44
    then have "?a \<le> x" by (rule Inf_lower)
wenzelm@63979
    45
    with \<open>mono f\<close> have "f ?a \<le> f x" ..
wenzelm@63979
    46
    also from \<open>x \<in> ?H\<close> have "f x \<le> x" ..
wenzelm@63979
    47
    finally show "f ?a \<le> x" .
wenzelm@63979
    48
  qed
wenzelm@63979
    49
  show "?a \<le> f ?a"
wenzelm@63979
    50
  proof (rule Inf_lower)
wenzelm@63979
    51
    from \<open>mono f\<close> and \<open>f ?a \<le> ?a\<close> have "f (f ?a) \<le> f ?a" ..
wenzelm@63979
    52
    then show "f ?a \<in> ?H" ..
wenzelm@63979
    53
  qed
wenzelm@63979
    54
qed
haftmann@24915
    55
wenzelm@63400
    56
lemma lfp_unfold: "mono f \<Longrightarrow> lfp f = f (lfp f)"
wenzelm@63979
    57
  by (rule lfp_fixpoint [symmetric])
haftmann@24915
    58
haftmann@24915
    59
lemma lfp_const: "lfp (\<lambda>x. t) = t"
wenzelm@63400
    60
  by (rule lfp_unfold) (simp add: mono_def)
haftmann@24915
    61
wenzelm@63588
    62
lemma lfp_eqI: "mono F \<Longrightarrow> F x = x \<Longrightarrow> (\<And>z. F z = z \<Longrightarrow> x \<le> z) \<Longrightarrow> lfp F = x"
wenzelm@63588
    63
  by (rule antisym) (simp_all add: lfp_lowerbound lfp_unfold[symmetric])
Andreas@63561
    64
haftmann@24915
    65
wenzelm@60758
    66
subsection \<open>General induction rules for least fixed points\<close>
haftmann@24915
    67
wenzelm@63400
    68
lemma lfp_ordinal_induct [case_names mono step union]:
wenzelm@61076
    69
  fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
haftmann@26013
    70
  assumes mono: "mono f"
wenzelm@63400
    71
    and P_f: "\<And>S. P S \<Longrightarrow> S \<le> lfp f \<Longrightarrow> P (f S)"
wenzelm@63400
    72
    and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Sup M)"
haftmann@26013
    73
  shows "P (lfp f)"
haftmann@26013
    74
proof -
haftmann@26013
    75
  let ?M = "{S. S \<le> lfp f \<and> P S}"
wenzelm@63588
    76
  from P_Union have "P (Sup ?M)" by simp
haftmann@26013
    77
  also have "Sup ?M = lfp f"
haftmann@26013
    78
  proof (rule antisym)
wenzelm@63588
    79
    show "Sup ?M \<le> lfp f"
wenzelm@63588
    80
      by (blast intro: Sup_least)
wenzelm@63400
    81
    then have "f (Sup ?M) \<le> f (lfp f)"
wenzelm@63400
    82
      by (rule mono [THEN monoD])
wenzelm@63400
    83
    then have "f (Sup ?M) \<le> lfp f"
wenzelm@63400
    84
      using mono [THEN lfp_unfold] by simp
wenzelm@63400
    85
    then have "f (Sup ?M) \<in> ?M"
wenzelm@63400
    86
      using P_Union by simp (intro P_f Sup_least, auto)
wenzelm@63400
    87
    then have "f (Sup ?M) \<le> Sup ?M"
wenzelm@63400
    88
      by (rule Sup_upper)
wenzelm@63400
    89
    then show "lfp f \<le> Sup ?M"
wenzelm@63400
    90
      by (rule lfp_lowerbound)
haftmann@26013
    91
  qed
haftmann@26013
    92
  finally show ?thesis .
wenzelm@63400
    93
qed
haftmann@26013
    94
hoelzl@60174
    95
theorem lfp_induct:
wenzelm@63400
    96
  assumes mono: "mono f"
wenzelm@63400
    97
    and ind: "f (inf (lfp f) P) \<le> P"
hoelzl@60174
    98
  shows "lfp f \<le> P"
wenzelm@63588
    99
proof (induct rule: lfp_ordinal_induct)
wenzelm@63588
   100
  case mono
wenzelm@63588
   101
  show ?case by fact
wenzelm@63588
   102
next
wenzelm@63400
   103
  case (step S)
wenzelm@63400
   104
  then show ?case
hoelzl@60174
   105
    by (intro order_trans[OF _ ind] monoD[OF mono]) auto
wenzelm@63588
   106
next
wenzelm@63588
   107
  case (union M)
wenzelm@63588
   108
  then show ?case
wenzelm@63588
   109
    by (auto intro: Sup_least)
wenzelm@63588
   110
qed
hoelzl@60174
   111
hoelzl@60174
   112
lemma lfp_induct_set:
wenzelm@63400
   113
  assumes lfp: "a \<in> lfp f"
wenzelm@63400
   114
    and mono: "mono f"
wenzelm@63400
   115
    and hyp: "\<And>x. x \<in> f (lfp f \<inter> {x. P x}) \<Longrightarrow> P x"
wenzelm@63400
   116
  shows "P a"
wenzelm@63400
   117
  by (rule lfp_induct [THEN subsetD, THEN CollectD, OF mono _ lfp]) (auto intro: hyp)
hoelzl@60174
   118
wenzelm@63400
   119
lemma lfp_ordinal_induct_set:
haftmann@24915
   120
  assumes mono: "mono f"
wenzelm@63400
   121
    and P_f: "\<And>S. P S \<Longrightarrow> P (f S)"
wenzelm@63400
   122
    and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (\<Union>M)"
wenzelm@63400
   123
  shows "P (lfp f)"
wenzelm@46008
   124
  using assms by (rule lfp_ordinal_induct)
haftmann@24915
   125
haftmann@24915
   126
wenzelm@63400
   127
text \<open>Definition forms of \<open>lfp_unfold\<close> and \<open>lfp_induct\<close>, to control unfolding.\<close>
haftmann@24915
   128
wenzelm@63400
   129
lemma def_lfp_unfold: "h \<equiv> lfp f \<Longrightarrow> mono f \<Longrightarrow> h = f h"
wenzelm@45899
   130
  by (auto intro!: lfp_unfold)
haftmann@24915
   131
wenzelm@63400
   132
lemma def_lfp_induct: "A \<equiv> lfp f \<Longrightarrow> mono f \<Longrightarrow> f (inf A P) \<le> P \<Longrightarrow> A \<le> P"
haftmann@24915
   133
  by (blast intro: lfp_induct)
haftmann@24915
   134
wenzelm@63400
   135
lemma def_lfp_induct_set:
wenzelm@63400
   136
  "A \<equiv> lfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> A \<Longrightarrow> (\<And>x. x \<in> f (A \<inter> {x. P x}) \<Longrightarrow> P x) \<Longrightarrow> P a"
haftmann@24915
   137
  by (blast intro: lfp_induct_set)
haftmann@24915
   138
wenzelm@63400
   139
text \<open>Monotonicity of \<open>lfp\<close>!\<close>
wenzelm@63400
   140
lemma lfp_mono: "(\<And>Z. f Z \<le> g Z) \<Longrightarrow> lfp f \<le> lfp g"
wenzelm@63400
   141
  by (rule lfp_lowerbound [THEN lfp_greatest]) (blast intro: order_trans)
haftmann@24915
   142
haftmann@24915
   143
wenzelm@63979
   144
subsection \<open>Greatest fixed points\<close>
haftmann@24915
   145
wenzelm@63979
   146
context complete_lattice
wenzelm@63979
   147
begin
wenzelm@63979
   148
wenzelm@63979
   149
definition gfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a"
wenzelm@63979
   150
  where "gfp f = Sup {u. u \<le> f u}"
haftmann@24915
   151
wenzelm@63400
   152
lemma gfp_upperbound: "X \<le> f X \<Longrightarrow> X \<le> gfp f"
haftmann@24915
   153
  by (auto simp add: gfp_def intro: Sup_upper)
haftmann@24915
   154
wenzelm@63400
   155
lemma gfp_least: "(\<And>u. u \<le> f u \<Longrightarrow> u \<le> X) \<Longrightarrow> gfp f \<le> X"
haftmann@24915
   156
  by (auto simp add: gfp_def intro: Sup_least)
haftmann@24915
   157
wenzelm@63979
   158
end
wenzelm@63979
   159
wenzelm@63979
   160
lemma lfp_le_gfp: "mono f \<Longrightarrow> lfp f \<le> gfp f"
wenzelm@63979
   161
  by (rule gfp_upperbound) (simp add: lfp_fixpoint)
haftmann@24915
   162
wenzelm@63979
   163
lemma gfp_fixpoint:
wenzelm@63979
   164
  assumes "mono f"
wenzelm@63979
   165
  shows "f (gfp f) = gfp f"
wenzelm@63979
   166
  unfolding gfp_def
wenzelm@63979
   167
proof (rule order_antisym)
wenzelm@63979
   168
  let ?H = "{u. u \<le> f u}"
wenzelm@63979
   169
  let ?a = "\<Squnion>?H"
wenzelm@63979
   170
  show "?a \<le> f ?a"
wenzelm@63979
   171
  proof (rule Sup_least)
wenzelm@63979
   172
    fix x
wenzelm@63979
   173
    assume "x \<in> ?H"
wenzelm@63979
   174
    then have "x \<le> f x" ..
wenzelm@63979
   175
    also from \<open>x \<in> ?H\<close> have "x \<le> ?a" by (rule Sup_upper)
wenzelm@63979
   176
    with \<open>mono f\<close> have "f x \<le> f ?a" ..
wenzelm@63979
   177
    finally show "x \<le> f ?a" .
wenzelm@63979
   178
  qed
wenzelm@63979
   179
  show "f ?a \<le> ?a"
wenzelm@63979
   180
  proof (rule Sup_upper)
wenzelm@63979
   181
    from \<open>mono f\<close> and \<open>?a \<le> f ?a\<close> have "f ?a \<le> f (f ?a)" ..
wenzelm@63979
   182
    then show "f ?a \<in> ?H" ..
wenzelm@63979
   183
  qed
wenzelm@63979
   184
qed
haftmann@24915
   185
wenzelm@63400
   186
lemma gfp_unfold: "mono f \<Longrightarrow> gfp f = f (gfp f)"
wenzelm@63979
   187
  by (rule gfp_fixpoint [symmetric])
haftmann@24915
   188
Andreas@63561
   189
lemma gfp_const: "gfp (\<lambda>x. t) = t"
wenzelm@63588
   190
  by (rule gfp_unfold) (simp add: mono_def)
Andreas@63561
   191
wenzelm@63588
   192
lemma gfp_eqI: "mono F \<Longrightarrow> F x = x \<Longrightarrow> (\<And>z. F z = z \<Longrightarrow> z \<le> x) \<Longrightarrow> gfp F = x"
wenzelm@63588
   193
  by (rule antisym) (simp_all add: gfp_upperbound gfp_unfold[symmetric])
Andreas@63561
   194
haftmann@24915
   195
wenzelm@60758
   196
subsection \<open>Coinduction rules for greatest fixed points\<close>
haftmann@24915
   197
wenzelm@63400
   198
text \<open>Weak version.\<close>
wenzelm@63400
   199
lemma weak_coinduct: "a \<in> X \<Longrightarrow> X \<subseteq> f X \<Longrightarrow> a \<in> gfp f"
wenzelm@45899
   200
  by (rule gfp_upperbound [THEN subsetD]) auto
haftmann@24915
   201
wenzelm@63400
   202
lemma weak_coinduct_image: "a \<in> X \<Longrightarrow> g`X \<subseteq> f (g`X) \<Longrightarrow> g a \<in> gfp f"
wenzelm@45899
   203
  apply (erule gfp_upperbound [THEN subsetD])
wenzelm@45899
   204
  apply (erule imageI)
wenzelm@45899
   205
  done
haftmann@24915
   206
wenzelm@63400
   207
lemma coinduct_lemma: "X \<le> f (sup X (gfp f)) \<Longrightarrow> mono f \<Longrightarrow> sup X (gfp f) \<le> f (sup X (gfp f))"
wenzelm@63979
   208
  apply (frule gfp_unfold [THEN eq_refl])
haftmann@24915
   209
  apply (drule mono_sup)
haftmann@24915
   210
  apply (rule le_supI)
wenzelm@63588
   211
   apply assumption
haftmann@24915
   212
  apply (rule order_trans)
wenzelm@63588
   213
   apply (rule order_trans)
wenzelm@63588
   214
    apply assumption
wenzelm@63588
   215
   apply (rule sup_ge2)
haftmann@24915
   216
  apply assumption
haftmann@24915
   217
  done
haftmann@24915
   218
wenzelm@63400
   219
text \<open>Strong version, thanks to Coen and Frost.\<close>
wenzelm@63400
   220
lemma coinduct_set: "mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (X \<union> gfp f) \<Longrightarrow> a \<in> gfp f"
noschinl@55604
   221
  by (rule weak_coinduct[rotated], rule coinduct_lemma) blast+
haftmann@24915
   222
wenzelm@63400
   223
lemma gfp_fun_UnI2: "mono f \<Longrightarrow> a \<in> gfp f \<Longrightarrow> a \<in> f (X \<union> gfp f)"
wenzelm@63979
   224
  by (blast dest: gfp_fixpoint mono_Un)
haftmann@24915
   225
hoelzl@60174
   226
lemma gfp_ordinal_induct[case_names mono step union]:
wenzelm@61076
   227
  fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
hoelzl@60174
   228
  assumes mono: "mono f"
wenzelm@63400
   229
    and P_f: "\<And>S. P S \<Longrightarrow> gfp f \<le> S \<Longrightarrow> P (f S)"
wenzelm@63400
   230
    and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Inf M)"
hoelzl@60174
   231
  shows "P (gfp f)"
hoelzl@60174
   232
proof -
hoelzl@60174
   233
  let ?M = "{S. gfp f \<le> S \<and> P S}"
wenzelm@63588
   234
  from P_Union have "P (Inf ?M)" by simp
hoelzl@60174
   235
  also have "Inf ?M = gfp f"
hoelzl@60174
   236
  proof (rule antisym)
wenzelm@63400
   237
    show "gfp f \<le> Inf ?M"
wenzelm@63400
   238
      by (blast intro: Inf_greatest)
wenzelm@63400
   239
    then have "f (gfp f) \<le> f (Inf ?M)"
wenzelm@63400
   240
      by (rule mono [THEN monoD])
wenzelm@63400
   241
    then have "gfp f \<le> f (Inf ?M)"
wenzelm@63400
   242
      using mono [THEN gfp_unfold] by simp
wenzelm@63400
   243
    then have "f (Inf ?M) \<in> ?M"
wenzelm@63400
   244
      using P_Union by simp (intro P_f Inf_greatest, auto)
wenzelm@63400
   245
    then have "Inf ?M \<le> f (Inf ?M)"
wenzelm@63400
   246
      by (rule Inf_lower)
wenzelm@63400
   247
    then show "Inf ?M \<le> gfp f"
wenzelm@63400
   248
      by (rule gfp_upperbound)
hoelzl@60174
   249
  qed
hoelzl@60174
   250
  finally show ?thesis .
wenzelm@63400
   251
qed
hoelzl@60174
   252
wenzelm@63400
   253
lemma coinduct:
wenzelm@63400
   254
  assumes mono: "mono f"
wenzelm@63400
   255
    and ind: "X \<le> f (sup X (gfp f))"
wenzelm@63400
   256
  shows "X \<le> gfp f"
wenzelm@63588
   257
proof (induct rule: gfp_ordinal_induct)
wenzelm@63588
   258
  case mono
wenzelm@63588
   259
  then show ?case by fact
wenzelm@63588
   260
next
wenzelm@63588
   261
  case (step S)
wenzelm@63588
   262
  then show ?case
hoelzl@60174
   263
    by (intro order_trans[OF ind _] monoD[OF mono]) auto
wenzelm@63588
   264
next
wenzelm@63588
   265
  case (union M)
wenzelm@63588
   266
  then show ?case
wenzelm@63588
   267
    by (auto intro: mono Inf_greatest)
wenzelm@63588
   268
qed
haftmann@24915
   269
wenzelm@63400
   270
wenzelm@60758
   271
subsection \<open>Even Stronger Coinduction Rule, by Martin Coen\<close>
haftmann@24915
   272
wenzelm@63400
   273
text \<open>Weakens the condition @{term "X \<subseteq> f X"} to one expressed using both
wenzelm@60758
   274
  @{term lfp} and @{term gfp}\<close>
wenzelm@63400
   275
lemma coinduct3_mono_lemma: "mono f \<Longrightarrow> mono (\<lambda>x. f x \<union> X \<union> B)"
wenzelm@63400
   276
  by (iprover intro: subset_refl monoI Un_mono monoD)
haftmann@24915
   277
haftmann@24915
   278
lemma coinduct3_lemma:
wenzelm@63400
   279
  "X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> gfp f)) \<Longrightarrow> mono f \<Longrightarrow>
wenzelm@63400
   280
    lfp (\<lambda>x. f x \<union> X \<union> gfp f) \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> gfp f))"
wenzelm@63400
   281
  apply (rule subset_trans)
wenzelm@63979
   282
   apply (erule coinduct3_mono_lemma [THEN lfp_unfold [THEN eq_refl]])
wenzelm@63400
   283
  apply (rule Un_least [THEN Un_least])
wenzelm@63588
   284
    apply (rule subset_refl, assumption)
wenzelm@63400
   285
  apply (rule gfp_unfold [THEN equalityD1, THEN subset_trans], assumption)
wenzelm@63400
   286
  apply (rule monoD, assumption)
wenzelm@63400
   287
  apply (subst coinduct3_mono_lemma [THEN lfp_unfold], auto)
wenzelm@63400
   288
  done
haftmann@24915
   289
wenzelm@63400
   290
lemma coinduct3: "mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> gfp f)) \<Longrightarrow> a \<in> gfp f"
wenzelm@63400
   291
  apply (rule coinduct3_lemma [THEN [2] weak_coinduct])
wenzelm@63588
   292
    apply (rule coinduct3_mono_lemma [THEN lfp_unfold, THEN ssubst])
wenzelm@63588
   293
     apply simp_all
wenzelm@63400
   294
  done
haftmann@24915
   295
wenzelm@63400
   296
text  \<open>Definition forms of \<open>gfp_unfold\<close> and \<open>coinduct\<close>, to control unfolding.\<close>
haftmann@24915
   297
wenzelm@63400
   298
lemma def_gfp_unfold: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> A = f A"
wenzelm@45899
   299
  by (auto intro!: gfp_unfold)
haftmann@24915
   300
wenzelm@63400
   301
lemma def_coinduct: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> X \<le> f (sup X A) \<Longrightarrow> X \<le> A"
wenzelm@45899
   302
  by (iprover intro!: coinduct)
haftmann@24915
   303
wenzelm@63400
   304
lemma def_coinduct_set: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (X \<union> A) \<Longrightarrow> a \<in> A"
wenzelm@45899
   305
  by (auto intro!: coinduct_set)
haftmann@24915
   306
haftmann@24915
   307
lemma def_Collect_coinduct:
wenzelm@63400
   308
  "A \<equiv> gfp (\<lambda>w. Collect (P w)) \<Longrightarrow> mono (\<lambda>w. Collect (P w)) \<Longrightarrow> a \<in> X \<Longrightarrow>
wenzelm@63400
   309
    (\<And>z. z \<in> X \<Longrightarrow> P (X \<union> A) z) \<Longrightarrow> a \<in> A"
wenzelm@45899
   310
  by (erule def_coinduct_set) auto
haftmann@24915
   311
wenzelm@63400
   312
lemma def_coinduct3: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> A)) \<Longrightarrow> a \<in> A"
wenzelm@45899
   313
  by (auto intro!: coinduct3)
haftmann@24915
   314
wenzelm@63400
   315
text \<open>Monotonicity of @{term gfp}!\<close>
wenzelm@63400
   316
lemma gfp_mono: "(\<And>Z. f Z \<le> g Z) \<Longrightarrow> gfp f \<le> gfp g"
wenzelm@63400
   317
  by (rule gfp_upperbound [THEN gfp_least]) (blast intro: order_trans)
wenzelm@63400
   318
haftmann@24915
   319
wenzelm@60758
   320
subsection \<open>Rules for fixed point calculus\<close>
hoelzl@60173
   321
hoelzl@60173
   322
lemma lfp_rolling:
hoelzl@60173
   323
  assumes "mono g" "mono f"
hoelzl@60173
   324
  shows "g (lfp (\<lambda>x. f (g x))) = lfp (\<lambda>x. g (f x))"
hoelzl@60173
   325
proof (rule antisym)
hoelzl@60173
   326
  have *: "mono (\<lambda>x. f (g x))"
hoelzl@60173
   327
    using assms by (auto simp: mono_def)
hoelzl@60173
   328
  show "lfp (\<lambda>x. g (f x)) \<le> g (lfp (\<lambda>x. f (g x)))"
hoelzl@60173
   329
    by (rule lfp_lowerbound) (simp add: lfp_unfold[OF *, symmetric])
hoelzl@60173
   330
  show "g (lfp (\<lambda>x. f (g x))) \<le> lfp (\<lambda>x. g (f x))"
hoelzl@60173
   331
  proof (rule lfp_greatest)
wenzelm@63400
   332
    fix u
wenzelm@63540
   333
    assume u: "g (f u) \<le> u"
wenzelm@63540
   334
    then have "g (lfp (\<lambda>x. f (g x))) \<le> g (f u)"
hoelzl@60173
   335
      by (intro assms[THEN monoD] lfp_lowerbound)
wenzelm@63540
   336
    with u show "g (lfp (\<lambda>x. f (g x))) \<le> u"
hoelzl@60173
   337
      by auto
hoelzl@60173
   338
  qed
hoelzl@60173
   339
qed
hoelzl@60173
   340
hoelzl@60173
   341
lemma lfp_lfp:
hoelzl@60173
   342
  assumes f: "\<And>x y w z. x \<le> y \<Longrightarrow> w \<le> z \<Longrightarrow> f x w \<le> f y z"
hoelzl@60173
   343
  shows "lfp (\<lambda>x. lfp (f x)) = lfp (\<lambda>x. f x x)"
hoelzl@60173
   344
proof (rule antisym)
hoelzl@60173
   345
  have *: "mono (\<lambda>x. f x x)"
hoelzl@60173
   346
    by (blast intro: monoI f)
hoelzl@60173
   347
  show "lfp (\<lambda>x. lfp (f x)) \<le> lfp (\<lambda>x. f x x)"
hoelzl@60173
   348
    by (intro lfp_lowerbound) (simp add: lfp_unfold[OF *, symmetric])
hoelzl@60173
   349
  show "lfp (\<lambda>x. lfp (f x)) \<ge> lfp (\<lambda>x. f x x)" (is "?F \<ge> _")
hoelzl@60173
   350
  proof (intro lfp_lowerbound)
hoelzl@60173
   351
    have *: "?F = lfp (f ?F)"
hoelzl@60173
   352
      by (rule lfp_unfold) (blast intro: monoI lfp_mono f)
hoelzl@60173
   353
    also have "\<dots> = f ?F (lfp (f ?F))"
hoelzl@60173
   354
      by (rule lfp_unfold) (blast intro: monoI lfp_mono f)
hoelzl@60173
   355
    finally show "f ?F ?F \<le> ?F"
hoelzl@60173
   356
      by (simp add: *[symmetric])
hoelzl@60173
   357
  qed
hoelzl@60173
   358
qed
hoelzl@60173
   359
hoelzl@60173
   360
lemma gfp_rolling:
hoelzl@60173
   361
  assumes "mono g" "mono f"
hoelzl@60173
   362
  shows "g (gfp (\<lambda>x. f (g x))) = gfp (\<lambda>x. g (f x))"
hoelzl@60173
   363
proof (rule antisym)
hoelzl@60173
   364
  have *: "mono (\<lambda>x. f (g x))"
hoelzl@60173
   365
    using assms by (auto simp: mono_def)
hoelzl@60173
   366
  show "g (gfp (\<lambda>x. f (g x))) \<le> gfp (\<lambda>x. g (f x))"
hoelzl@60173
   367
    by (rule gfp_upperbound) (simp add: gfp_unfold[OF *, symmetric])
hoelzl@60173
   368
  show "gfp (\<lambda>x. g (f x)) \<le> g (gfp (\<lambda>x. f (g x)))"
hoelzl@60173
   369
  proof (rule gfp_least)
wenzelm@63540
   370
    fix u
wenzelm@63540
   371
    assume u: "u \<le> g (f u)"
wenzelm@63540
   372
    then have "g (f u) \<le> g (gfp (\<lambda>x. f (g x)))"
hoelzl@60173
   373
      by (intro assms[THEN monoD] gfp_upperbound)
wenzelm@63540
   374
    with u show "u \<le> g (gfp (\<lambda>x. f (g x)))"
hoelzl@60173
   375
      by auto
hoelzl@60173
   376
  qed
hoelzl@60173
   377
qed
hoelzl@60173
   378
hoelzl@60173
   379
lemma gfp_gfp:
hoelzl@60173
   380
  assumes f: "\<And>x y w z. x \<le> y \<Longrightarrow> w \<le> z \<Longrightarrow> f x w \<le> f y z"
hoelzl@60173
   381
  shows "gfp (\<lambda>x. gfp (f x)) = gfp (\<lambda>x. f x x)"
hoelzl@60173
   382
proof (rule antisym)
hoelzl@60173
   383
  have *: "mono (\<lambda>x. f x x)"
hoelzl@60173
   384
    by (blast intro: monoI f)
hoelzl@60173
   385
  show "gfp (\<lambda>x. f x x) \<le> gfp (\<lambda>x. gfp (f x))"
hoelzl@60173
   386
    by (intro gfp_upperbound) (simp add: gfp_unfold[OF *, symmetric])
hoelzl@60173
   387
  show "gfp (\<lambda>x. gfp (f x)) \<le> gfp (\<lambda>x. f x x)" (is "?F \<le> _")
hoelzl@60173
   388
  proof (intro gfp_upperbound)
hoelzl@60173
   389
    have *: "?F = gfp (f ?F)"
hoelzl@60173
   390
      by (rule gfp_unfold) (blast intro: monoI gfp_mono f)
hoelzl@60173
   391
    also have "\<dots> = f ?F (gfp (f ?F))"
hoelzl@60173
   392
      by (rule gfp_unfold) (blast intro: monoI gfp_mono f)
hoelzl@60173
   393
    finally show "?F \<le> f ?F ?F"
hoelzl@60173
   394
      by (simp add: *[symmetric])
hoelzl@60173
   395
  qed
hoelzl@60173
   396
qed
haftmann@24915
   397
wenzelm@63400
   398
wenzelm@60758
   399
subsection \<open>Inductive predicates and sets\<close>
wenzelm@11688
   400
wenzelm@60758
   401
text \<open>Package setup.\<close>
wenzelm@10402
   402
wenzelm@61337
   403
lemmas basic_monos =
haftmann@22218
   404
  subset_refl imp_refl disj_mono conj_mono ex_mono all_mono if_bool_eq_conj
wenzelm@11688
   405
  Collect_mono in_mono vimage_mono
wenzelm@11688
   406
traytel@63863
   407
lemma le_rel_bool_arg_iff: "X \<le> Y \<longleftrightarrow> X False \<le> Y False \<and> X True \<le> Y True"
traytel@63863
   408
  unfolding le_fun_def le_bool_def using bool_induct by auto
traytel@63863
   409
traytel@63863
   410
lemma imp_conj_iff: "((P \<longrightarrow> Q) \<and> P) = (P \<and> Q)"
traytel@63863
   411
  by blast
traytel@63863
   412
traytel@63863
   413
lemma meta_fun_cong: "P \<equiv> Q \<Longrightarrow> P a \<equiv> Q a"
traytel@63863
   414
  by auto
traytel@63863
   415
wenzelm@48891
   416
ML_file "Tools/inductive.ML"
berghofe@21018
   417
wenzelm@61337
   418
lemmas [mono] =
haftmann@22218
   419
  imp_refl disj_mono conj_mono ex_mono all_mono if_bool_eq_conj
berghofe@33934
   420
  imp_mono not_mono
berghofe@21018
   421
  Ball_def Bex_def
berghofe@21018
   422
  induct_rulify_fallback
berghofe@21018
   423
wenzelm@11688
   424
wenzelm@63980
   425
subsection \<open>The Schroeder-Bernstein Theorem\<close>
wenzelm@63980
   426
wenzelm@63980
   427
text \<open>
wenzelm@63980
   428
  See also:
wenzelm@63980
   429
  \<^item> \<^file>\<open>$ISABELLE_HOME/src/HOL/ex/Set_Theory.thy\<close>
wenzelm@63980
   430
  \<^item> \<^url>\<open>http://planetmath.org/proofofschroederbernsteintheoremusingtarskiknastertheorem\<close>
wenzelm@63980
   431
  \<^item> Springer LNCS 828 (cover page)
wenzelm@63980
   432
\<close>
wenzelm@63980
   433
wenzelm@63980
   434
theorem Schroeder_Bernstein:
wenzelm@63980
   435
  fixes f :: "'a \<Rightarrow> 'b" and g :: "'b \<Rightarrow> 'a"
wenzelm@63980
   436
    and A :: "'a set" and B :: "'b set"
wenzelm@63980
   437
  assumes inj1: "inj_on f A" and sub1: "f ` A \<subseteq> B"
wenzelm@63980
   438
    and inj2: "inj_on g B" and sub2: "g ` B \<subseteq> A"
wenzelm@63980
   439
  shows "\<exists>h. bij_betw h A B"
wenzelm@63980
   440
proof (rule exI, rule bij_betw_imageI)
wenzelm@63980
   441
  define X where "X = lfp (\<lambda>X. A - (g ` (B - (f ` X))))"
wenzelm@63980
   442
  define g' where "g' = the_inv_into (B - (f ` X)) g"
wenzelm@63980
   443
  let ?h = "\<lambda>z. if z \<in> X then f z else g' z"
wenzelm@63980
   444
wenzelm@63980
   445
  have X: "X = A - (g ` (B - (f ` X)))"
wenzelm@63980
   446
    unfolding X_def by (rule lfp_unfold) (blast intro: monoI)
wenzelm@63980
   447
  then have X_compl: "A - X = g ` (B - (f ` X))"
wenzelm@63980
   448
    using sub2 by blast
wenzelm@63980
   449
wenzelm@63980
   450
  from inj2 have inj2': "inj_on g (B - (f ` X))"
wenzelm@63980
   451
    by (rule inj_on_subset) auto
wenzelm@63980
   452
  with X_compl have *: "g' ` (A - X) = B - (f ` X)"
wenzelm@63980
   453
    by (simp add: g'_def)
wenzelm@63980
   454
wenzelm@63980
   455
  from X have X_sub: "X \<subseteq> A" by auto
wenzelm@63980
   456
  from X sub1 have fX_sub: "f ` X \<subseteq> B" by auto
wenzelm@63980
   457
wenzelm@63980
   458
  show "?h ` A = B"
wenzelm@63980
   459
  proof -
wenzelm@63980
   460
    from X_sub have "?h ` A = ?h ` (X \<union> (A - X))" by auto
wenzelm@63980
   461
    also have "\<dots> = ?h ` X \<union> ?h ` (A - X)" by (simp only: image_Un)
wenzelm@63980
   462
    also have "?h ` X = f ` X" by auto
wenzelm@63980
   463
    also from * have "?h ` (A - X) = B - (f ` X)" by auto
wenzelm@63980
   464
    also from fX_sub have "f ` X \<union> (B - f ` X) = B" by blast
wenzelm@63980
   465
    finally show ?thesis .
wenzelm@63980
   466
  qed
wenzelm@63980
   467
  show "inj_on ?h A"
wenzelm@63980
   468
  proof -
wenzelm@63980
   469
    from inj1 X_sub have on_X: "inj_on f X"
wenzelm@63980
   470
      by (rule subset_inj_on)
wenzelm@63980
   471
wenzelm@63980
   472
    have on_X_compl: "inj_on g' (A - X)"
wenzelm@63980
   473
      unfolding g'_def X_compl
wenzelm@63980
   474
      by (rule inj_on_the_inv_into) (rule inj2')
wenzelm@63980
   475
wenzelm@63980
   476
    have impossible: False if eq: "f a = g' b" and a: "a \<in> X" and b: "b \<in> A - X" for a b
wenzelm@63980
   477
    proof -
wenzelm@63980
   478
      from a have fa: "f a \<in> f ` X" by (rule imageI)
wenzelm@63980
   479
      from b have "g' b \<in> g' ` (A - X)" by (rule imageI)
wenzelm@63980
   480
      with * have "g' b \<in> - (f ` X)" by simp
wenzelm@63980
   481
      with eq fa show False by simp
wenzelm@63980
   482
    qed
wenzelm@63980
   483
wenzelm@63980
   484
    show ?thesis
wenzelm@63980
   485
    proof (rule inj_onI)
wenzelm@63980
   486
      fix a b
wenzelm@63980
   487
      assume h: "?h a = ?h b"
wenzelm@63980
   488
      assume "a \<in> A" and "b \<in> A"
wenzelm@63980
   489
      then consider "a \<in> X" "b \<in> X" | "a \<in> A - X" "b \<in> A - X"
wenzelm@63980
   490
        | "a \<in> X" "b \<in> A - X" | "a \<in> A - X" "b \<in> X"
wenzelm@63980
   491
        by blast
wenzelm@63980
   492
      then show "a = b"
wenzelm@63980
   493
      proof cases
wenzelm@63980
   494
        case 1
wenzelm@63980
   495
        with h on_X show ?thesis by (simp add: inj_on_eq_iff)
wenzelm@63980
   496
      next
wenzelm@63980
   497
        case 2
wenzelm@63980
   498
        with h on_X_compl show ?thesis by (simp add: inj_on_eq_iff)
wenzelm@63980
   499
      next
wenzelm@63980
   500
        case 3
wenzelm@63980
   501
        with h impossible [of a b] have False by simp
wenzelm@63980
   502
        then show ?thesis ..
wenzelm@63980
   503
      next
wenzelm@63980
   504
        case 4
wenzelm@63980
   505
        with h impossible [of b a] have False by simp
wenzelm@63980
   506
        then show ?thesis ..
wenzelm@63980
   507
      qed
wenzelm@63980
   508
    qed
wenzelm@63980
   509
  qed
wenzelm@63980
   510
qed
wenzelm@63980
   511
wenzelm@63980
   512
wenzelm@60758
   513
subsection \<open>Inductive datatypes and primitive recursion\<close>
wenzelm@11688
   514
wenzelm@60758
   515
text \<open>Package setup.\<close>
wenzelm@11825
   516
blanchet@58112
   517
ML_file "Tools/Old_Datatype/old_datatype_aux.ML"
blanchet@58112
   518
ML_file "Tools/Old_Datatype/old_datatype_prop.ML"
blanchet@58187
   519
ML_file "Tools/Old_Datatype/old_datatype_data.ML"
blanchet@58112
   520
ML_file "Tools/Old_Datatype/old_rep_datatype.ML"
blanchet@58112
   521
ML_file "Tools/Old_Datatype/old_datatype_codegen.ML"
blanchet@64674
   522
ML_file "Tools/BNF/bnf_fp_rec_sugar_util.ML"
blanchet@58112
   523
ML_file "Tools/Old_Datatype/old_primrec.ML"
blanchet@55575
   524
ML_file "Tools/BNF/bnf_lfp_rec_sugar.ML"
blanchet@55575
   525
wenzelm@61955
   526
text \<open>Lambda-abstractions with pattern matching:\<close>
wenzelm@61955
   527
syntax (ASCII)
wenzelm@61955
   528
  "_lam_pats_syntax" :: "cases_syn \<Rightarrow> 'a \<Rightarrow> 'b"  ("(%_)" 10)
nipkow@23526
   529
syntax
wenzelm@61955
   530
  "_lam_pats_syntax" :: "cases_syn \<Rightarrow> 'a \<Rightarrow> 'b"  ("(\<lambda>_)" 10)
wenzelm@60758
   531
parse_translation \<open>
wenzelm@52143
   532
  let
wenzelm@52143
   533
    fun fun_tr ctxt [cs] =
wenzelm@52143
   534
      let
wenzelm@52143
   535
        val x = Syntax.free (fst (Name.variant "x" (Term.declare_term_frees cs Name.context)));
wenzelm@52143
   536
        val ft = Case_Translation.case_tr true ctxt [x, cs];
wenzelm@52143
   537
      in lambda x ft end
wenzelm@52143
   538
  in [(@{syntax_const "_lam_pats_syntax"}, fun_tr)] end
wenzelm@60758
   539
\<close>
nipkow@23526
   540
nipkow@23526
   541
end