(*
    File:        FinBnd.thy
    Time-stamp:  <2020-06-22T03:49:39Z>
    Author:      JRF
    Web:         http://jrf.cocolog-nifty.com/software/2016/01/post.html
    Logic Image: Logics_ZF (of Isabelle2020)
*)

theory FinBnd imports MonoInj begin

definition FinExt :: "[i,i=>i,i]=>i" where
"FinExt(D, h, X) == {0} Un {x: Pow(D). EX z: X. x <= h(z)}"

definition fin_bnd :: "[i, i=>i]=>o" where
"fin_bnd(x, h) == EX n: nat. x <= nat_rec(n, 0, %n r. h(r))"

definition fin_bnd_set :: "[i, i=>i]=>i" where
"fin_bnd_set(D, h) == {x: Pow(D). fin_bnd(x, h)}"

definition bnd_cont :: "[i, i=>i]=>o" where
    "bnd_cont(D, h) ==   h(D) <= D &
                       (ALL X:Pow(Pow(D)). X ~= 0 -->
                                 h(Union(X)) = (UN x: X. h(x)))"

(** bnd_cont(D, h) : h is bound by D and is continuous **)
lemma bnd_contI:
  "[| !!X. [| X <= Pow(D); X ~= 0 |] ==> h(Union(X)) = (UN x: X. h(x));
      h(D) <= D |] ==> bnd_cont(D, h)"
apply (unfold bnd_cont_def)
apply blast
done

lemma bnd_contD1:
    "bnd_cont(D, h) ==> h(D) <= D"
apply (unfold bnd_cont_def)
apply blast
done

lemma bnd_contD2:
    "[| bnd_cont(D, h); X <= Pow(D); X ~= 0 |] ==>
          h(Union(X)) = (UN x: X. h(x))"
apply (unfold bnd_cont_def)
apply blast
done

lemma bnd_cont_upair:
  "[| bnd_cont(D, h); X <= D; Y <= D |] ==> h(X Un Y) = h(X) Un h(Y)"
apply (unfold Un_def)
apply (erule bnd_contD2 [THEN ssubst])
apply (rule subsetI)
apply (rule PowI)
apply (erule UpairE)
apply simp
apply simp
apply (rule not_emptyI)
apply (rule UpairI1)
apply (rule equalityI)
apply (rule Union_mono)
apply (rule subsetI)
apply (erule RepFunE)
apply (erule UpairE)
apply simp
apply simp
apply (rule Union_mono)
apply (rule subsetI)
apply (erule UpairE)
apply hypsubst
apply (rule RepFunI)
apply (rule UpairI1)
apply hypsubst
apply (rule RepFunI)
apply (rule UpairI2)
done

lemma bnd_cont_bnd_mono:
    "bnd_cont(D, h) ==> bnd_mono(D,h)"
apply (rule bnd_monoI)
apply (erule bnd_contD1)
apply (erule_tac P="%x. h(W) <= h(x)" in subset_Un_iff [THEN iffD1, THEN subst])
apply (erule_tac P="%x. h(W) <= x" in bnd_cont_upair [THEN ssubst])
apply (assumption | (rule Un_upper1))+
done

(** fin_bnd(x, h) : x is finitely bound by h **)
lemma fin_bnd_0:
  "fin_bnd(0, h)"
apply (unfold fin_bnd_def)
apply blast
done

lemma fin_bnd_induct:
  assumes major: "fin_bnd(a, h)"
  and P_0: "P(0)"
  and indstep: "!! x y. [| fin_bnd(x,h); y <= h(x); P(x)|]  ==> P(y)"
  shows "P(a)"
apply (rule major [unfolded fin_bnd_def, THEN bexE])
apply (erule_tac P="a <= nat_rec(x, 0, % n r. h(r))" in rev_mp)
apply (rule allE)
prefer 2 apply assumption
apply (erule nat_induct)
apply (rule allI)
apply (rule nat_rec_0 [THEN ssubst])
apply (rule impI)
apply (drule subset_empty_iff [THEN iffD1])
apply (erule ssubst)
apply (rule P_0)
apply (rule allI)
apply (rule nat_rec_succ [THEN ssubst])
apply assumption
apply (rule impI)
apply (rule indstep [unfolded fin_bnd_def])
prefer 2 apply assumption
apply (rule bexI)
apply (rule subset_refl)
apply assumption
apply (erule allE)
apply (erule mp)
apply (rule subset_refl)
done

lemma fin_bnd_lemma1:
  "[| bnd_mono(D, h); n: nat |] ==> nat_rec(n, 0, %n r. h(r)) <= D"
apply (erule nat_induct)
apply (rule nat_rec_0 [THEN ssubst])
apply (rule empty_subsetI)
apply (erule nat_rec_succ [THEN ssubst])
apply (erule bnd_mono_subset)
apply assumption
done

lemma fin_bnd_lemma2:
  assumes hmono: "bnd_mono(D, h)"
  shows "n: nat ==>
    nat_rec(n, 0, %l r. h(r)) <= nat_rec(succ(n), 0, %l r. h(r))"
apply (erule nat_induct)
apply (rule nat_rec_0 [THEN ssubst])
apply (rule empty_subsetI)
apply (simp only: nat_rec_succ)
apply (rule hmono [THEN bnd_monoD2])
apply assumption
apply (rule hmono [THEN bnd_mono_subset])
apply (rule hmono [THEN fin_bnd_lemma1])
apply assumption
done

lemma fin_bnd_lemma3 [rule_format]:
 assumes hmono: "bnd_mono(D,h)"
 shows "ALL m: nat. ALL n: nat. n \<le> m -->
        nat_rec(n, 0, %l r. h(r)) <= nat_rec(m, 0, %l r. h(r))"
apply (rule ballI)
apply (erule nat_induct)
apply (intro impI ballI)
apply (drule le_imp_subset)
apply (drule subset_empty_iff [THEN iffD1])
apply hypsubst
apply (rule subset_refl)
apply (intro impI ballI)
apply (drule le_succ_iff [THEN iffD1])
apply (erule disjE)
apply (rule hmono [THEN fin_bnd_lemma2, THEN [2] subset_trans])
prefer 2 apply assumption
apply (erule ballE)
apply (erule mp)
apply assumption
apply (erule notE)
apply assumption
apply (erule conjE)
apply hypsubst
apply (rule subset_refl)
done

lemma fin_bnd_domain:
    "[| bnd_mono(D, h); fin_bnd(x, h) |] ==> x <= D"
apply (unfold fin_bnd_def)
apply (erule bexE)
apply (erule subset_trans)
apply (erule fin_bnd_lemma1)
apply assumption
done

lemma fin_bnd_succ:
  "[| bnd_mono(D,h); fin_bnd(x, h); y <= h(x) |] ==> fin_bnd(y, h)"
apply (unfold fin_bnd_def)
apply (erule bexE)
apply (rule bexI)
apply (rule nat_rec_succ [THEN ssubst])
apply assumption
apply (erule subset_trans)
apply (rule_tac h="h" in bnd_monoD2)
apply (assumption | (rule nat_succI fin_bnd_lemma1))+
done

lemma fin_bnd_subset:
  "[| bnd_mono(D, h); fin_bnd(x, h); y <= x |] ==> fin_bnd(y, h)"
apply (unfold fin_bnd_def)
apply (elim bexE)
apply (rule bexI)
apply (erule subset_trans)
apply assumption+
done

lemma fin_bnd_Un:
    assumes hmono: "bnd_mono(D, h)"
    shows "[| fin_bnd(x, h); fin_bnd(y, h) |] ==>
                fin_bnd(x Un y, h)"
apply (unfold fin_bnd_def)
apply (elim bexE)
apply (rename_tac m)
apply (rule_tac i="n" and j="m" in Ord_linear_le)
apply (erule nat_into_Ord)+
apply (rule bexI)
apply (rule Un_least)
apply (erule subset_trans)
apply (erule_tac [2] subset_trans)
apply (rule hmono [THEN fin_bnd_lemma3])
prefer 3 apply assumption
apply (rule_tac [3] hmono [THEN fin_bnd_lemma3])
apply (assumption | (rule le_refl) | (erule nat_into_Ord))+
apply (rule bexI)
apply (rule Un_least)
apply (erule subset_trans)
apply (erule_tac [2] subset_trans)
apply (rule hmono [THEN fin_bnd_lemma3])
apply (rule_tac [4] hmono [THEN fin_bnd_lemma3])
prefer 6 apply assumption
apply (assumption | (rule le_refl) | (erule nat_into_Ord))+
done

lemma fin_bnd_bound:
  assumes hmono: "bnd_mono(D, h)"
  and fb_a: "fin_bnd(a, h)"
  and fb_z: "!!z. [| a <= h(z); z <= D; fin_bnd(h(z), h) |] ==> P"
  shows "P"
apply (rule fb_a [unfolded fin_bnd_def, THEN bexE])
apply (rule fb_z [unfolded fin_bnd_def])
apply (erule subset_trans)
apply (rule hmono [THEN fin_bnd_lemma2, THEN subset_trans])
apply assumption
apply (simp only: nat_rec_succ)
apply (rule subset_refl)
apply (rule hmono [THEN fin_bnd_lemma1])
apply assumption
apply (rule_tac x="succ(x)" in bexI)
apply (simp only: nat_rec_succ)
apply (rule subset_refl)
apply (rule nat_succI)
apply assumption
done

lemma fin_bnd_bound2:
  assumes hmono: "bnd_mono(D, h)"
  and fb_a: "fin_bnd(a, h)"
  and fb_z: "!!z. [| a <= z; z <= h(z); z <= D;
               fin_bnd(z, h); fin_bnd(h(z), h) |] ==> P"
  shows "P"
apply (rule fb_a [unfolded fin_bnd_def, THEN bexE])
apply (rule fb_z [unfolded fin_bnd_def])
apply (rule_tac [2]  hmono [THEN fin_bnd_lemma2, THEN subset_trans])
prefer 2 apply assumption
prefer 2 apply (simp only: nat_rec_succ)
apply (rule subset_refl)
apply assumption
apply (rule hmono [THEN fin_bnd_lemma1])
apply assumption
apply (rule_tac x="x" in bexI)
apply (rule subset_refl)
apply assumption
apply (rule_tac x="succ(x)" in bexI)
apply (simp only: nat_rec_succ)
apply (rule subset_refl)
apply (rule nat_succI)
apply assumption
done

(** FinExt(D, h) : the finite extension of h **)
lemma FinExt_bnd_cont:
    "bnd_cont(Pow(D), FinExt(D,h))"
apply (rule bnd_contI)
apply (unfold FinExt_def)
prefer 2 apply blast
apply (rule equalityI)
apply (rule subsetI)
apply (rule_tac [2] subsetI)
apply (erule UnE)
apply (erule not_emptyE)
apply blast
apply (erule CollectE)
apply (erule bexE)
apply (erule UnionE)
apply (erule UN_I)
apply (rule UnI2)
apply (erule CollectI)
apply (erule bexI)
apply assumption
apply (erule UN_E)
apply (erule UnE)
apply (erule UnI1)
apply (rule UnI2)
apply (erule CollectE)
apply (erule bexE)
apply (erule CollectI)
apply (erule bexI)
apply (erule UnionI)
apply assumption
done

lemma FinExt_bnd_mono:
  "bnd_mono(Pow(D), FinExt(D,h))"
apply (rule FinExt_bnd_cont [THEN bnd_cont_bnd_mono])
done

lemma FinExt_lower_Pow_lfp:
  assumes hmono: "bnd_mono(D,h)"
  shows "FinExt(D, h, Pow(lfp(D,h))) <= Pow(lfp(D,h))"
apply (unfold FinExt_def)
apply (rule Un_subset_iff [THEN iffD2])
apply (rule conjI)
apply blast
apply (rule subsetI)
apply (erule CollectE)
apply (erule bexE)
apply ((drule PowD) | (rule PowI))+
apply (erule subset_trans)
apply (rule hmono [THEN lfp_lemma2, THEN [2] subset_trans])
apply (erule hmono [THEN bnd_monoD2])
apply (rule lfp_subset)
done

lemma FinExt_another_def:
  assumes hmono: "bnd_mono(D,h)"
  and dom_X: "X <= Pow(D)"
  shows "FinExt(D, h, X) = {0} Un (UN z: X. Pow(h(z)))"
apply (unfold FinExt_def)
apply (rule equalityI)
apply (rule_tac [2] subset_refl [THEN Un_mono])
apply (rule_tac [1] subset_refl [THEN Un_mono])
apply (rule_tac [2] subsetI)
apply (rule subsetI)
apply (elim CollectE bexE)
apply (erule UN_I)
apply (erule PowI)
apply (erule UN_E)
apply (rule CollectI)
apply (drule dom_X [THEN subsetD])
apply (drule_tac [2] PowD)
apply (drule PowD)+
apply (rule PowI)
apply (erule subset_trans)
apply (erule hmono [THEN bnd_mono_subset])
apply (erule bexI)
apply assumption
done

(** fin_bnd_set and FinExt **)
lemma fin_bnd_set_domain:
    "fin_bnd_set(D, h) <= Pow(D)"
apply (unfold fin_bnd_set_def)
apply (rule Collect_subset)
done

lemma fin_bnd_set_0I:
    "0: fin_bnd_set(D, h)"
apply (unfold fin_bnd_set_def)
apply (rule CollectI)
apply (rule empty_subsetI [THEN PowI])
apply (rule fin_bnd_0)
done

lemma fin_bnd_setI:
  "[| a <= D; fin_bnd(a, h) |] ==> a: fin_bnd_set(D, h)"
apply (unfold fin_bnd_set_def)
apply (erule PowI [THEN CollectI])
apply assumption
done

lemma fin_bnd_setI2:
  "[| bnd_mono(D, h); fin_bnd(a, h) |] ==> a: fin_bnd_set(D, h)"
apply (unfold fin_bnd_set_def)
apply (rule fin_bnd_domain [THEN PowI, THEN CollectI])
apply assumption+
done

lemma fin_bnd_setD1:
    "a: fin_bnd_set(D, h) ==> a <= D"
apply (unfold fin_bnd_set_def)
apply blast
done

lemma fin_bnd_setD2:
    "a: fin_bnd_set(D, h) ==> fin_bnd(a, h)"
apply (unfold fin_bnd_set_def)
apply blast
done

lemma fin_bnd_setE:
    "[| a: fin_bnd_set(D, h);
        [| a <= D; fin_bnd(a, h)|] ==> P |] ==> P"
apply (unfold fin_bnd_set_def)
apply blast
done

lemma fin_bnd_set_subset_lfp_FinExt:
  assumes hmono: "bnd_mono(D,h)"
  shows "fin_bnd_set(D, h) <= lfp(Pow(D), FinExt(D, h))"
apply (unfold fin_bnd_set_def)
apply (rule subsetI)
apply (erule CollectE)
apply (erule fin_bnd_induct)
apply (rule FinExt_bnd_mono [THEN lfp_lemma2, THEN subsetD])
apply (subst hmono [THEN FinExt_another_def])
apply (rule lfp_subset)
apply (rule UnI1)
apply (rule singletonI)
apply (rule FinExt_bnd_mono [THEN lfp_lemma2, THEN subsetD])
apply (subst hmono [THEN FinExt_another_def])
apply (rule lfp_subset)
apply (rule UnI2)
apply (rule UN_I)
apply (rule_tac [2] PowI)
prefer 2 apply assumption
apply assumption
done

lemma fin_bnd_set_pre_fixedpt:
  assumes hmono: "bnd_mono(D, h)"
  shows "FinExt(D, h, fin_bnd_set(D, h)) <= fin_bnd_set(D, h)"
apply (unfold fin_bnd_set_def)
apply (rule Collect_subset
       [THEN hmono
            [THEN FinExt_another_def, THEN ssubst]])
apply (rule subsetI)
apply (erule UnE)
apply (erule singletonE)
apply hypsubst
apply (rule CollectI)
apply (rule empty_subsetI [THEN PowI])
apply (rule fin_bnd_0)
apply (erule UN_E)
apply (erule CollectE)
apply (rule CollectI)
apply (drule PowD)+
apply (rule PowI)
apply (rule hmono [THEN bnd_monoD1, THEN [2] subset_trans])
apply (erule subset_trans)
apply (erule hmono [THEN bnd_monoD2])
apply (rule subset_refl)
apply (drule PowD)+
apply (erule hmono [THEN fin_bnd_succ])
apply assumption
done

lemma fin_bnd_set_lfp_eq:
  assumes hmono: "bnd_mono(D, h)"
  shows "fin_bnd_set(D, h) = lfp(Pow(D), FinExt(D, h))"
apply (rule equalityI)
apply (rule hmono [THEN fin_bnd_set_subset_lfp_FinExt])
apply (rule lfp_lowerbound)
apply (rule hmono [THEN fin_bnd_set_pre_fixedpt])
apply (rule fin_bnd_set_domain)
done

lemma fin_bnd_set_Pow_lfp_lowerbound:
  assumes hmono: "bnd_mono(D,h)"
  shows "fin_bnd_set(D, h) <= Pow(lfp(D,h))"
apply (unfold fin_bnd_set_def)
apply (rule subsetI)
apply (erule CollectE)
apply (rule PowI)
apply (drule PowD)
apply (erule fin_bnd_induct)
apply (rule empty_subsetI)
apply (rule hmono [THEN lfp_lemma2, THEN [2] subset_trans])
apply (erule subset_trans)
apply (erule hmono [THEN bnd_monoD2])
apply (rule lfp_subset)
done

lemma Union_fin_bnd_set_pre_fixedpt:
  assumes hcont: "bnd_cont(D, h)"
  shows "h(Union(fin_bnd_set(D, h))) <= Union(fin_bnd_set(D, h))"
apply (rule_tac P="%y. y <= Union(fin_bnd_set(D,h))" in
        hcont [THEN bnd_contD2, THEN ssubst])
apply (rule_tac [2] not_emptyI)
apply (rule_tac [2] fin_bnd_set_0I)
apply (unfold fin_bnd_set_def)
apply (rule Collect_subset)
apply (rule subsetI)
apply (erule UN_E)
apply (erule CollectE)
apply (rule UnionI)
apply (rule CollectI)
prefer 3 apply assumption
apply (drule PowD)
apply (rule PowI)
apply (erule hcont [THEN bnd_cont_bnd_mono, THEN bnd_mono_subset])
apply (erule hcont [THEN bnd_cont_bnd_mono, THEN fin_bnd_succ])
apply (rule subset_refl)
done

lemma Union_fin_bnd_set_lfp_eq:
  assumes hcont: "bnd_cont(D, h)"
  shows "Union(fin_bnd_set(D, h)) = lfp(D, h)"
apply (rule equalityI)
apply (rule_tac P="%x. Union(fin_bnd_set(D, h)) <= x" in
        Union_Pow_eq [THEN subst])
apply (rule hcont [THEN bnd_cont_bnd_mono,
                   THEN fin_bnd_set_Pow_lfp_lowerbound,
                   THEN Union_mono])
apply (rule lfp_lowerbound)
apply (rule hcont [THEN Union_fin_bnd_set_pre_fixedpt])
apply (rule_tac P="%x. Union(fin_bnd_set(D, h)) <= x" in
        Union_Pow_eq [THEN subst])
apply (rule fin_bnd_set_domain [THEN Union_mono])
done

lemma fin_bnd_set_upper_Fin_lfp:
  assumes hcont: "bnd_cont(D, h)"
  shows "Fin(lfp(D, h)) <= fin_bnd_set(D, h)"
apply (rule subsetI)
apply (erule Fin_induct)
apply (rule fin_bnd_set_0I)
apply (rename_tac v y)
apply (drule_tac P="%x. v: x" in
  hcont [THEN Union_fin_bnd_set_lfp_eq, THEN ssubst])
apply (erule UnionE)
apply (unfold fin_bnd_set_def)
apply (elim CollectE)
apply (drule PowD)+
apply (rule CollectI)
apply blast
apply (rule hcont [THEN bnd_cont_bnd_mono, THEN fin_bnd_subset])
apply (rule_tac x="B" and y="y" in
        hcont [THEN bnd_cont_bnd_mono, THEN fin_bnd_Un])
apply assumption+
apply (rule cons_eq [THEN subst])
apply (rule Un_mono)
apply (erule singleton_subsetI)
apply (rule subset_refl)
done

(** Induction principles on finitely bound set **)
lemma fin_bnd_set_Collect_is_pre_fixedpt:
  assumes hinj: "mono_inj_pair(D,F,G)"
  and hinjp: "mono_inj_pair(F(D),Fp, Gp)"
  and FG0: "F(G(0)) = 0"
  and hmono: "bnd_mono(D,h)"
  and indstep: "!!x. x : FinExt(F(D), %x. F(h(G(x))),
                       {x: fin_bnd_set(F(D), %x. F(h(G(x)))).
                        (ALL y: Pow(Fp(F(G(x)))). P(Gp(y)))}) ==> P(x)"
  shows "FinExt(F(D), %x. F(h(G(x))),
                       {x: fin_bnd_set(F(D), %x. F(h(G(x)))).
                        (ALL y: Pow(Fp(F(G(x)))). P(Gp(y)))})
             <= {x: fin_bnd_set(F(D), %x. F(h(G(x)))).
                        (ALL y: Pow(Fp(F(G(x)))). P(Gp(y)))}"
apply (rule subsetI)
apply (rule CollectI)
apply (rule hmono [THEN hinj [THEN mono_inj_pair_bnd_mono],
                   THEN fin_bnd_set_pre_fixedpt [THEN subsetD]])
apply (rule FinExt_bnd_mono [THEN bnd_monoD2, THEN subsetD])
apply (rule_tac [2] fin_bnd_set_domain)
prefer 2 apply assumption
apply (rule Collect_subset)
apply (rule ballI)
apply (drule PowD)
apply (rule indstep)
apply (unfold FinExt_def)
apply (erule UnE)
apply (erule singletonE)
apply hypsubst
apply (rule UnI1)
apply (simp only: FG0)
apply (drule hinjp [THEN mono_inj_pairD3])
apply (rule hinjp [THEN mono_inj_pairD2])
apply (rule empty_subsetI)
apply (rule subset_refl)
apply (subst (asm) hinjp [THEN mono_inj_pairD1])
apply (rule empty_subsetI)
apply (drule subset_empty_iff [THEN iffD1])
apply (erule ssubst)
apply (rule singletonI)
apply (elim CollectE bexE)
apply (subgoal_tac "F(G(x)) <= F(D)" "h(G(z)) <= D")
apply (rule UnI2)
apply (rule CollectI)
apply (rule_tac [2] bexI)
apply (rule_tac [3] CollectI)
apply (rule_tac [4] ballI)
apply (erule_tac [4] bspec)
prefer 4 apply assumption
apply (rule PowI)
apply (drule PowD)
apply (rule subset_trans)
apply (rule hinjp [THEN mono_inj_pairD3])
apply assumption
apply (rule hinjp [THEN mono_inj_pairD2])
apply assumption
apply (rule subset_refl)
apply (subst hinjp [THEN mono_inj_pairD1])
apply assumption
apply (rule subset_trans)
apply (rule hinjp [THEN mono_inj_pairD3])
apply assumption
apply (rule hinjp [THEN mono_inj_pairD2])
apply assumption
apply (rule subset_refl)
apply (subst hinjp [THEN mono_inj_pairD1])
apply assumption
apply (rule subset_trans)
apply (rule hinj [THEN mono_inj_pairD2])
apply (rule hinj [THEN mono_inj_pairD3])
apply assumption
apply (rule hinj [THEN mono_inj_pairD2])
apply assumption
apply (rule subset_refl)
apply (subst hinj [THEN mono_inj_pairD1])
apply assumption
apply (subst hinj [THEN mono_inj_pairD1])
apply assumption
apply (rule subset_refl)
apply assumption
apply (rule hmono [THEN bnd_mono_subset])
apply (rule_tac P="%x. G(z) <= x" in hinj [THEN mono_inj_pairD1, THEN subst])
apply (rule subset_refl)
apply (rule hinj [THEN mono_inj_pairD3])
apply (erule fin_bnd_set_domain [THEN subsetD, THEN PowD])
apply (rule subset_refl)
apply (rule hinj [THEN mono_inj_pairD2])
apply (rule_tac P="%y. G(x) <= y" in hinj [THEN mono_inj_pairD1, THEN subst])
apply (rule subset_refl)
apply (rule hinj [THEN mono_inj_pairD3])
apply (erule PowD)
apply (rule subset_refl)+
done

lemma fin_bnd_set_induct_lemma1:
  assumes hinj: "mono_inj_pair(D,F,G)"
  and hinjp: "mono_inj_pair(F(D),Fp, Gp)"
  and FG0: "F(G(0)) = 0"
  and hmono: "bnd_mono(D,h)"
  and P0: "P(0)"
  and indstep: "!!x. [| x <= F(D); EX z: fin_bnd_set(F(D), %x. F(h(G(x)))).
                  x <= F(h(G(z))) &
                  (ALL y. y <= Fp(F(G(z))) --> P(Gp(y)))
                |] ==> P(x)"
  shows "fin_bnd_set(F(D), %x. F(h(G(x)))) <=
                    {x: fin_bnd_set(F(D), %x. F(h(G(x)))).
                                     ALL y: Pow(Fp(F(G(x)))). P(Gp(y))}"
apply (rule_tac P="%z. z <= {x: fin_bnd_set(F(D), %x. F(h(G(x)))).
                                     ALL y: Pow(Fp(F(G(x)))). P(Gp(y))}"
          in mono_inj_pair_bnd_mono [OF hinj hmono,
                THEN fin_bnd_set_lfp_eq, THEN ssubst])
apply (rule lfp_lowerbound)
apply (rule_tac [2] Collect_subset [THEN subset_trans])
apply (rule_tac [2] fin_bnd_set_domain)
apply (rule fin_bnd_set_Collect_is_pre_fixedpt
          [OF hinj hinjp FG0 hmono])
apply (unfold FinExt_def)
apply (rule indstep)
apply (erule_tac [2] UnE)
apply (erule UnE)
apply blast
prefer 2 apply (erule singletonE)
apply hypsubst
apply (rule_tac x="0" in bexI)
apply (rule conjI)
apply (rule empty_subsetI)
apply (intro allI impI)
apply (rule ssubst)
apply (rule_tac [2] P0)
apply (subst (asm) FG0)
apply (drule hinjp [THEN mono_inj_pairD3])
apply (rule hinjp [THEN mono_inj_pairD2])
apply (rule empty_subsetI)
apply (rule subset_refl)
apply (subst (asm) hinjp [THEN mono_inj_pairD1])
apply (rule empty_subsetI)
apply (erule subset_empty_iff [THEN iffD1])
apply (rule fin_bnd_set_0I)
apply (elim CollectE bexE)
apply (erule PowD)
apply (elim CollectE bexE)
apply blast
done

lemma mono_inj_pair_fin_bnd_set_induct:
  assumes hinj: "mono_inj_pair(D,F,G)"
  and hinjp: "mono_inj_pair(F(D),Fp, Gp)"
  and FG0: "F(G(0)) = 0"
  and hmono: "bnd_mono(D,h)"
  and a_in_fb: "a: fin_bnd_set(F(D), %x. F(h(G(x))))"
  and P0: "P(0)"
  and indstep:
   "!!x. [| x <= F(D); EX z: fin_bnd_set(F(D), %x. F(h(G(x)))).
               x <= F(h(G(z))) &
          (ALL y. y <= Fp(F(G(z))) --> P(Gp(y)))
    |] ==> P(x)"
  shows "P(a)"
apply (rule hinjp [THEN mono_inj_pairD1, THEN subst])
apply (rule a_in_fb [THEN fin_bnd_set_domain [THEN subsetD], THEN PowD])
apply (rule mono_inj_pair_bnd_mono [THEN fin_bnd_bound,
        OF hinj hmono a_in_fb[unfolded fin_bnd_set_def, THEN CollectD2]])
apply (subgoal_tac "h(G(z)) <= D")
prefer 2
apply (rule hmono [THEN bnd_mono_subset])
apply (rule_tac P="%x. G(z) <= x" in hinj [THEN mono_inj_pairD1, THEN subst])
apply (rule subset_refl)
apply (erule hinj [THEN mono_inj_pairD3])
apply (rule subset_refl)
apply (rule fin_bnd_set_induct_lemma1 [OF hinj hinjp FG0 hmono,
        THEN subsetD, THEN CollectD2, THEN bspec])
apply (rule P0)
prefer 2 apply (rule fin_bnd_setI)
prefer 2 apply assumption
apply (rule mono_inj_pair_bnd_mono [OF hinj hmono, THEN bnd_mono_subset])
apply assumption
prefer 2 apply (rule PowI)
apply (rule hinjp [THEN mono_inj_pairD2])
apply (subst hinj [THEN mono_inj_pairD1])
apply assumption+
apply (subst hinj [THEN mono_inj_pairD1])
apply assumption
apply (rule mono_inj_pair_bnd_mono [OF hinj hmono, THEN bnd_mono_subset])
apply assumption
apply (rule indstep)
apply assumption+
done

lemmas fin_bnd_set_induct = mono_inj_pair_fin_bnd_set_induct
  [OF trivial_mono_inj_pair trivial_mono_inj_pair refl, rule_format]

lemma mono_inj_pair_fin_bnd_lemma:
  assumes hinj: "mono_inj_pair(D, F, G)"
  and hmono: "bnd_mono(D, h)"
  and prem: "fin_bnd(z, %x. F(h(G(x))))"
  shows "fin_bnd(F(G(z)), %x. F(h(G(x))))"
apply (rule fin_bnd_bound2 [OF mono_inj_pair_bnd_mono [OF hinj hmono] prem])
apply (rename_tac v)
apply (subgoal_tac "h(G(v)) <= D")
apply (rule mono_inj_pair_bnd_mono [OF hinj hmono, THEN fin_bnd_succ])
apply (rule_tac [2]  hinj [THEN mono_inj_pairD2])
apply (rule_tac [2] P="%x. G(z) <= x" in hinj [THEN mono_inj_pairD1, THEN subst])
apply (rule_tac [3] hinj [THEN mono_inj_pairD3])
apply (erule_tac [3] subset_trans)
apply (rule_tac [4] hinj [THEN mono_inj_pairD2])
prefer 3 apply assumption
apply (assumption | (rule subset_refl))+
apply (rule hmono [THEN bnd_mono_subset])
apply (rule_tac P="%x. G(v) <= x" in hinj [THEN mono_inj_pairD1, THEN subst])
apply (rule_tac [2] hinj [THEN mono_inj_pairD3])
apply (assumption | (rule subset_refl))+
done

lemma fin_bnd_set_succI:
  assumes hmono: "bnd_mono(D, h)"
  and major: "Y <= h(X)"
  and prem: "X: fin_bnd_set(D, h)"
  shows "Y: fin_bnd_set(D, h)"
apply (rule hmono [THEN fin_bnd_setI2])
apply (rule fin_bnd_succ [OF hmono prem [THEN fin_bnd_setD2]])
apply (rule major)
done

lemma fin_bnd_set_UnI:
  assumes hmono: "bnd_mono(D, h)"
  and prem1: "X: fin_bnd_set(D,h)"
  and prem2: "Y: fin_bnd_set(D, h)"
  shows "X Un Y: fin_bnd_set(D, h)"
apply (rule hmono [THEN fin_bnd_setI2])
apply (rule hmono [THEN fin_bnd_Un])
apply (rule prem1 [THEN fin_bnd_setD2])
apply (rule prem2 [THEN fin_bnd_setD2])
done

lemma fin_bnd_set_subsetI:
  assumes hmono: "bnd_mono(D, h)"
  and major: "Y <= X"
  and prem: "X: fin_bnd_set(D,h)"
  shows "Y: fin_bnd_set(D, h)"
apply (rule hmono [THEN fin_bnd_setI2])
apply (rule fin_bnd_subset [OF hmono prem [THEN fin_bnd_setD2] major])
done

lemma fin_bnd_set_boundE:
  assumes hmono: "bnd_mono(D, h)"
  and major: "a: fin_bnd_set(D, h)"
  and prem: "!!z. [| a <= z; z <= h(z); z: fin_bnd_set(D, h);
               h(z): fin_bnd_set(D, h) |] ==> P"
  shows "P"
apply (rule fin_bnd_bound2 [OF hmono major [THEN fin_bnd_setD2]])
apply (rule prem)
apply (assumption | (rule hmono [THEN fin_bnd_setI2]))+
done

end


section \<open>Well founded and transitive relations\<close>

theory WellFoundedTransitive
imports Main
begin

class transitive = ord +
  assumes order_trans1: "x < y \<Longrightarrow> y < z \<Longrightarrow> x < z"
  and less_eq_def: "x \<le> y \<longleftrightarrow> x = y \<or> x < y"
begin

lemma eq_less_eq [simp]:
  "x = y \<Longrightarrow> x \<le> y"
  by (simp add: less_eq_def)

lemma order_trans2 [simp]:
  "x \<le> y \<Longrightarrow> y < z \<Longrightarrow> x < z"
  apply (simp add: less_eq_def)
  apply auto
  apply (erule less_eq_def order_trans1)
  by assumption

lemma order_trans3:
  "x < y \<Longrightarrow> y \<le> z \<Longrightarrow> x < z"
  apply (simp add: less_eq_def)
  apply auto
  apply (erule less_eq_def order_trans1)
  by assumption
end

class well_founded = ord +
  assumes less_induct1 [case_names less]: "(!!x . (!!y . y < x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a"

class well_founded_transitive = transitive + well_founded

instantiation prod:: (ord, ord) ord
begin

definition
  less_pair_def: "a < b \<longleftrightarrow>  fst a  < fst b \<or> (fst a = fst b \<and> snd a < snd b)"

definition
  less_eq_pair_def: "(a::('a::ord * 'b::ord)) <= b \<longleftrightarrow> a = b \<or> a < b"
instance proof qed
end

instantiation prod:: (transitive, transitive) transitive
begin
instance proof
  fix x y z :: "('a::transitive * 'b::transitive)"
  assume "x < y" and "y < z" then  show  "x < z"
    apply (simp add: less_pair_def)
    apply auto
    apply (drule  order_trans1)
    apply auto
    apply (drule  order_trans1)
    apply auto
    apply (drule  order_trans1)
    apply auto
    done
next
  fix x y :: "'a * 'b"
  show  "x \<le> y \<longleftrightarrow> x = y \<or> x < y"
    by (simp add: less_eq_pair_def)
qed
end

instantiation prod:: (well_founded, well_founded) well_founded
begin
instance proof
  fix P::"('a * 'b) \<Rightarrow> bool"
  have a:  "\<forall>P. (\<forall>x::'a . (\<forall>y. y < x \<longrightarrow> P y) \<longrightarrow> P x) \<longrightarrow> (\<forall>a . P a)"
    apply safe
    apply (rule less_induct1)
    by blast
  have b:  "\<forall>P. (\<forall>x::'b. (\<forall>y . y < x \<longrightarrow> P y) \<longrightarrow> P x) \<longrightarrow> (\<forall>a . P a)"
    apply safe
    apply (rule less_induct1)
    by blast
  from a and b have c: "(\<forall>x. (\<forall>y. y < x \<longrightarrow> P y) \<longrightarrow> P x) \<longrightarrow> (\<forall>a. P a)"
    apply (unfold less_pair_def)
    apply (rule impI)
    apply (simp (no_asm_use) only: split_paired_All)
    apply (unfold fst_conv snd_conv)
    apply (drule spec)
    apply (erule mp)
    apply (rule allI)
    apply (rule impI)
    apply (drule spec)
    apply (erule mp)
    by blast
  assume A: "(!! x. (!! y. y < x \<Longrightarrow> P y) \<Longrightarrow> P x)"
  fix a
  from c A show "P a" by blast
qed
end

instantiation prod:: (well_founded_transitive, well_founded_transitive) well_founded_transitive
begin
instance proof qed
end

instantiation "nat" :: transitive
begin

instance proof
  fix x y z::nat
  assume "x < y" and "y < z" then show "x < z" by simp
  next
  fix x y::nat show "(x \<le> y) \<longleftrightarrow> (x = y \<or> x < y)"
    apply (unfold le_less)
    by safe
  qed
end

instantiation "nat":: well_founded
begin
instance proof
  fix P::"nat \<Rightarrow> bool"
  fix a
  assume A: "(\<And>x . (\<And>y . y < x \<Longrightarrow> P y) \<Longrightarrow> P x)"
  show "P a"
  by (rule less_induct, rule A, simp)
  qed
end

instantiation "nat":: well_founded_transitive
begin
instance proof qed
end

end


theory Submission
  imports Defs "HOL-Library.Sublist"
begin

lemma subseq_only_if: "xs \<sqsubseteq> ys \<Longrightarrow> Sublist.subseq xs ys"
  by (induction xs ys rule: subseq.induct) auto

lemma subseq_if: "Sublist.subseq xs ys \<Longrightarrow> xs \<sqsubseteq> ys"
  by (induction xs ys rule: list_emb.induct) auto

lemma subseq_eq: "xs \<sqsubseteq> ys \<longleftrightarrow> Sublist.subseq xs ys"
  using subseq_only_if subseq_if
  by auto

lemma strict_subseq_eq: "xs \<sqsubset> ys \<longleftrightarrow> Sublist.strict_subseq xs ys"
  unfolding proper_subseq_def subseq_eq
  by auto

lemma aux_def: "aux xs ys \<longleftrightarrow> Sublist.subseq xs ys"
  by (induction xs ys rule: aux.induct) auto

lemma aux2_def: "aux2 ys zs xs \<longleftrightarrow> (\<forall>i < length xs. aux (zs @ take i xs @ drop (Suc i) xs) ys)"
proof (induction ys zs xs rule: aux2.induct)
  case (2 ys acc x xs)
  show ?case
    apply (auto simp: 2)
    subgoal for i
      by (cases i) auto
    done
qed auto

lemma strict_subseq_only_if: "Sublist.subseq xs ys \<Longrightarrow> xs \<noteq> ys \<Longrightarrow>
  \<exists>i < length ys. Sublist.subseq xs (take i ys @ drop (Suc i) ys)"
  by (induction xs ys rule: list_emb.induct) auto

lemma strict_subseq_if: "i < length ys \<Longrightarrow> Sublist.subseq xs (take i ys @ drop (Suc i) ys) \<Longrightarrow>
  Sublist.strict_subseq xs ys"
  by (auto simp: strict_subseq_def)
     (metis append_Nil append_take_drop_id drop_drop list_emb_Nil plus_1_eq_Suc subseq_append
      subseq_append' subseq_order.dual_order.trans)

lemma strict_subseq_iff: "Sublist.strict_subseq xs ys \<longleftrightarrow>
  (\<exists>i < length ys. Sublist.subseq xs (take i ys @ drop (Suc i) ys))"
  using strict_subseq_only_if strict_subseq_if
  unfolding strict_subseq_def
  by blast

theorem judge1_correct: "judge1 xs ys \<longleftrightarrow> all_proper_subseq xs ys"
  by (auto simp: judge1_def aux2_def aux_def all_proper_subseq_def subseq_eq strict_subseq_eq
      strict_subseq_iff)

definition
  "judge2 xs ys \<longleftrightarrow> judge1 xs ys"

theorem judge2_correct:
  "judge2 xs ys \<longleftrightarrow> all_proper_subseq xs ys"
  unfolding judge2_def by (rule judge1_correct)

theorem judge2_is_executable:
  "judge2 ''ab'' ''ab'' \<longleftrightarrow> True"
  "judge2 ''ba'' ''ab'' \<longleftrightarrow> True"
  "judge2 ''abcd'' ''cdabc'' \<longleftrightarrow> False"
  by eval+

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_list_nat_Interleave
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

(*fun did not finish the proof*)
function interleave :: "'a list => 'a list => 'a list" where
"interleave (nil2) y = y"
| "interleave (cons2 z xs) y = cons2 z (interleave y xs)"
by pat_completeness auto

function evens :: "'a list => 'a list"
         and odds :: "'a list => 'a list" where
"evens (nil2) = nil2"
| "evens (cons2 y xs) = cons2 y (odds xs)"
| "odds (nil2) = nil2"
| "odds (cons2 y xs) = evens xs"
by pat_completeness auto

theorem property0 :
  "((interleave (evens xs) (odds xs)) = xs)"
  oops

end


(*  Title:      HOL/SMT_Examples/SMT_Examples.thy
    Author:     Sascha Boehme, TU Muenchen
*)

section \<open>Examples for the SMT binding\<close>

theory SMT_Examples
imports Complex_Main
begin

declare [[smt_certificates = "SMT_Examples.certs"]]
declare [[smt_read_only_certificates = true]]

section \<open>Propositional and first-order logic\<close>

lemma "True" by smt
lemma "p \<or> \<not>p" by smt
lemma "(p \<and> True) = p" by smt
lemma "(p \<or> q) \<and> \<not>p \<Longrightarrow> q" by smt
lemma "(a \<and> b) \<or> (c \<and> d) \<Longrightarrow> (a \<and> b) \<or> (c \<and> d)" by smt
lemma "(p1 \<and> p2) \<or> p3 \<longrightarrow> (p1 \<longrightarrow> (p3 \<and> p2) \<or> (p1 \<and> p3)) \<or> p1" by smt
lemma "P = P = P = P = P = P = P = P = P = P" by smt

lemma
  assumes "a \<or> b \<or> c \<or> d"
      and "e \<or> f \<or> (a \<and> d)"
      and "\<not> (a \<or> (c \<and> ~c)) \<or> b"
      and "\<not> (b \<and> (x \<or> \<not> x)) \<or> c"
      and "\<not> (d \<or> False) \<or> c"
      and "\<not> (c \<or> (\<not> p \<and> (p \<or> (q \<and> \<not> q))))"
  shows False
  using assms by smt

axiomatization symm_f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  symm_f: "symm_f x y = symm_f y x"

lemma "a = a \<and> symm_f a b = symm_f b a" by (smt symm_f)

(*
Taken from ~~/src/HOL/ex/SAT_Examples.thy.
Translated from TPTP problem library: PUZ015-2.006.dimacs
*)
lemma
  assumes "~x0"
  and "~x30"
  and "~x29"
  and "~x59"
  and "x1 \<or> x31 \<or> x0"
  and "x2 \<or> x32 \<or> x1"
  and "x3 \<or> x33 \<or> x2"
  and "x4 \<or> x34 \<or> x3"
  and "x35 \<or> x4"
  and "x5 \<or> x36 \<or> x30"
  and "x6 \<or> x37 \<or> x5 \<or> x31"
  and "x7 \<or> x38 \<or> x6 \<or> x32"
  and "x8 \<or> x39 \<or> x7 \<or> x33"
  and "x9 \<or> x40 \<or> x8 \<or> x34"
  and "x41 \<or> x9 \<or> x35"
  and "x10 \<or> x42 \<or> x36"
  and "x11 \<or> x43 \<or> x10 \<or> x37"
  and "x12 \<or> x44 \<or> x11 \<or> x38"
  and "x13 \<or> x45 \<or> x12 \<or> x39"
  and "x14 \<or> x46 \<or> x13 \<or> x40"
  and "x47 \<or> x14 \<or> x41"
  and "x15 \<or> x48 \<or> x42"
  and "x16 \<or> x49 \<or> x15 \<or> x43"
  and "x17 \<or> x50 \<or> x16 \<or> x44"
  and "x18 \<or> x51 \<or> x17 \<or> x45"
  and "x19 \<or> x52 \<or> x18 \<or> x46"
  and "x53 \<or> x19 \<or> x47"
  and "x20 \<or> x54 \<or> x48"
  and "x21 \<or> x55 \<or> x20 \<or> x49"
  and "x22 \<or> x56 \<or> x21 \<or> x50"
  and "x23 \<or> x57 \<or> x22 \<or> x51"
  and "x24 \<or> x58 \<or> x23 \<or> x52"
  and "x59 \<or> x24 \<or> x53"
  and "x25 \<or> x54"
  and "x26 \<or> x25 \<or> x55"
  and "x27 \<or> x26 \<or> x56"
  and "x28 \<or> x27 \<or> x57"
  and "x29 \<or> x28 \<or> x58"
  and "~x1 \<or> ~x31"
  and "~x1 \<or> ~x0"
  and "~x31 \<or> ~x0"
  and "~x2 \<or> ~x32"
  and "~x2 \<or> ~x1"
  and "~x32 \<or> ~x1"
  and "~x3 \<or> ~x33"
  and "~x3 \<or> ~x2"
  and "~x33 \<or> ~x2"
  and "~x4 \<or> ~x34"
  and "~x4 \<or> ~x3"
  and "~x34 \<or> ~x3"
  and "~x35 \<or> ~x4"
  and "~x5 \<or> ~x36"
  and "~x5 \<or> ~x30"
  and "~x36 \<or> ~x30"
  and "~x6 \<or> ~x37"
  and "~x6 \<or> ~x5"
  and "~x6 \<or> ~x31"
  and "~x37 \<or> ~x5"
  and "~x37 \<or> ~x31"
  and "~x5 \<or> ~x31"
  and "~x7 \<or> ~x38"
  and "~x7 \<or> ~x6"
  and "~x7 \<or> ~x32"
  and "~x38 \<or> ~x6"
  and "~x38 \<or> ~x32"
  and "~x6 \<or> ~x32"
  and "~x8 \<or> ~x39"
  and "~x8 \<or> ~x7"
  and "~x8 \<or> ~x33"
  and "~x39 \<or> ~x7"
  and "~x39 \<or> ~x33"
  and "~x7 \<or> ~x33"
  and "~x9 \<or> ~x40"
  and "~x9 \<or> ~x8"
  and "~x9 \<or> ~x34"
  and "~x40 \<or> ~x8"
  and "~x40 \<or> ~x34"
  and "~x8 \<or> ~x34"
  and "~x41 \<or> ~x9"
  and "~x41 \<or> ~x35"
  and "~x9 \<or> ~x35"
  and "~x10 \<or> ~x42"
  and "~x10 \<or> ~x36"
  and "~x42 \<or> ~x36"
  and "~x11 \<or> ~x43"
  and "~x11 \<or> ~x10"
  and "~x11 \<or> ~x37"
  and "~x43 \<or> ~x10"
  and "~x43 \<or> ~x37"
  and "~x10 \<or> ~x37"
  and "~x12 \<or> ~x44"
  and "~x12 \<or> ~x11"
  and "~x12 \<or> ~x38"
  and "~x44 \<or> ~x11"
  and "~x44 \<or> ~x38"
  and "~x11 \<or> ~x38"
  and "~x13 \<or> ~x45"
  and "~x13 \<or> ~x12"
  and "~x13 \<or> ~x39"
  and "~x45 \<or> ~x12"
  and "~x45 \<or> ~x39"
  and "~x12 \<or> ~x39"
  and "~x14 \<or> ~x46"
  and "~x14 \<or> ~x13"
  and "~x14 \<or> ~x40"
  and "~x46 \<or> ~x13"
  and "~x46 \<or> ~x40"
  and "~x13 \<or> ~x40"
  and "~x47 \<or> ~x14"
  and "~x47 \<or> ~x41"
  and "~x14 \<or> ~x41"
  and "~x15 \<or> ~x48"
  and "~x15 \<or> ~x42"
  and "~x48 \<or> ~x42"
  and "~x16 \<or> ~x49"
  and "~x16 \<or> ~x15"
  and "~x16 \<or> ~x43"
  and "~x49 \<or> ~x15"
  and "~x49 \<or> ~x43"
  and "~x15 \<or> ~x43"
  and "~x17 \<or> ~x50"
  and "~x17 \<or> ~x16"
  and "~x17 \<or> ~x44"
  and "~x50 \<or> ~x16"
  and "~x50 \<or> ~x44"
  and "~x16 \<or> ~x44"
  and "~x18 \<or> ~x51"
  and "~x18 \<or> ~x17"
  and "~x18 \<or> ~x45"
  and "~x51 \<or> ~x17"
  and "~x51 \<or> ~x45"
  and "~x17 \<or> ~x45"
  and "~x19 \<or> ~x52"
  and "~x19 \<or> ~x18"
  and "~x19 \<or> ~x46"
  and "~x52 \<or> ~x18"
  and "~x52 \<or> ~x46"
  and "~x18 \<or> ~x46"
  and "~x53 \<or> ~x19"
  and "~x53 \<or> ~x47"
  and "~x19 \<or> ~x47"
  and "~x20 \<or> ~x54"
  and "~x20 \<or> ~x48"
  and "~x54 \<or> ~x48"
  and "~x21 \<or> ~x55"
  and "~x21 \<or> ~x20"
  and "~x21 \<or> ~x49"
  and "~x55 \<or> ~x20"
  and "~x55 \<or> ~x49"
  and "~x20 \<or> ~x49"
  and "~x22 \<or> ~x56"
  and "~x22 \<or> ~x21"
  and "~x22 \<or> ~x50"
  and "~x56 \<or> ~x21"
  and "~x56 \<or> ~x50"
  and "~x21 \<or> ~x50"
  and "~x23 \<or> ~x57"
  and "~x23 \<or> ~x22"
  and "~x23 \<or> ~x51"
  and "~x57 \<or> ~x22"
  and "~x57 \<or> ~x51"
  and "~x22 \<or> ~x51"
  and "~x24 \<or> ~x58"
  and "~x24 \<or> ~x23"
  and "~x24 \<or> ~x52"
  and "~x58 \<or> ~x23"
  and "~x58 \<or> ~x52"
  and "~x23 \<or> ~x52"
  and "~x59 \<or> ~x24"
  and "~x59 \<or> ~x53"
  and "~x24 \<or> ~x53"
  and "~x25 \<or> ~x54"
  and "~x26 \<or> ~x25"
  and "~x26 \<or> ~x55"
  and "~x25 \<or> ~x55"
  and "~x27 \<or> ~x26"
  and "~x27 \<or> ~x56"
  and "~x26 \<or> ~x56"
  and "~x28 \<or> ~x27"
  and "~x28 \<or> ~x57"
  and "~x27 \<or> ~x57"
  and "~x29 \<or> ~x28"
  and "~x29 \<or> ~x58"
  and "~x28 \<or> ~x58"
  shows False
  using assms by smt

lemma "\<forall>x::int. P x \<longrightarrow> (\<forall>y::int. P x \<or> P y)"
  by smt

lemma
  assumes "(\<forall>x y. P x y = x)"
  shows "(\<exists>y. P x y) = P x c"
  using assms by smt

lemma
  assumes "(\<forall>x y. P x y = x)"
  and "(\<forall>x. \<exists>y. P x y) = (\<forall>x. P x c)"
  shows "(EX y. P x y) = P x c"
  using assms by smt

lemma
  assumes "if P x then \<not>(\<exists>y. P y) else (\<forall>y. \<not>P y)"
  shows "P x \<longrightarrow> P y"
  using assms by smt

section \<open>Arithmetic\<close>

subsection \<open>Linear arithmetic over integers and reals\<close>

lemma "(3::int) = 3" by smt
lemma "(3::real) = 3" by smt
lemma "(3 :: int) + 1 = 4" by smt
lemma "x + (y + z) = y + (z + (x::int))" by smt
lemma "max (3::int) 8 > 5" by smt
lemma "\<bar>x :: real\<bar> + \<bar>y\<bar> \<ge> \<bar>x + y\<bar>" by smt
lemma "P ((2::int) < 3) = P True" by smt
lemma "x + 3 \<ge> 4 \<or> x < (1::int)" by smt

lemma
  assumes "x \<ge> (3::int)" and "y = x + 4"
  shows "y - x > 0"
  using assms by smt

lemma "let x = (2 :: int) in x + x \<noteq> 5" by smt

lemma
  fixes x :: real
  assumes "3 * x + 7 * a < 4" and "3 < 2 * x"
  shows "a < 0"
  using assms by smt

lemma "(0 \<le> y + -1 * x \<or> \<not> 0 \<le> x \<or> 0 \<le> (x::int)) = (\<not> False)" by smt

lemma "
  (n < m \<and> m < n') \<or> (n < m \<and> m = n') \<or> (n < n' \<and> n' < m) \<or>
  (n = n' \<and> n' < m) \<or> (n = m \<and> m < n') \<or>
  (n' < m \<and> m < n) \<or> (n' < m \<and> m = n) \<or>
  (n' < n \<and> n < m) \<or> (n' = n \<and> n < m) \<or> (n' = m \<and> m < n) \<or>
  (m < n \<and> n < n') \<or> (m < n \<and> n' = n) \<or> (m < n' \<and> n' < n) \<or>
  (m = n \<and> n < n') \<or> (m = n' \<and> n' < n) \<or>
  (n' = m \<and> m = (n::int))"
  by smt

text\<open>
The following example was taken from HOL/ex/PresburgerEx.thy, where it says:

  This following theorem proves that all solutions to the
  recurrence relation $x_{i+2} = |x_{i+1}| - x_i$ are periodic with
  period 9.  The example was brought to our attention by John
  Harrison. It does does not require Presburger arithmetic but merely
  quantifier-free linear arithmetic and holds for the rationals as well.

  Warning: it takes (in 2006) over 4.2 minutes!

There, it is proved by "arith". SMT is able to prove this within a fraction
of one second. With proof reconstruction, it takes about 13 seconds on a Core2
processor.
\<close>

lemma "\<lbrakk> x3 = \<bar>x2\<bar> - x1; x4 = \<bar>x3\<bar> - x2; x5 = \<bar>x4\<bar> - x3;
         x6 = \<bar>x5\<bar> - x4; x7 = \<bar>x6\<bar> - x5; x8 = \<bar>x7\<bar> - x6;
         x9 = \<bar>x8\<bar> - x7; x10 = \<bar>x9\<bar> - x8; x11 = \<bar>x10\<bar> - x9 \<rbrakk>
 \<Longrightarrow> x1 = x10 \<and> x2 = (x11::int)"
  by smt

lemma "let P = 2 * x + 1 > x + (x::real) in P \<or> False \<or> P" by smt

lemma "x + (let y = x mod 2 in 2 * y + 1) \<ge> x + (1::int)"
  using [[z3_extensions]] by smt

lemma "x + (let y = x mod 2 in y + y) < x + (3::int)"
  using [[z3_extensions]] by smt

lemma
  assumes "x \<noteq> (0::real)"
  shows "x + x \<noteq> (let P = (\<bar>x\<bar> > 1) in if P \<or> \<not> P then 4 else 2) * x"
  using assms [[z3_extensions]] by smt

subsection \<open>Linear arithmetic with quantifiers\<close>

lemma "~ (\<exists>x::int. False)" by smt
lemma "~ (\<exists>x::real. False)" by smt

lemma "\<exists>x::int. 0 < x" by smt

lemma "\<exists>x::real. 0 < x"
  using [[smt_oracle=true]] (* no Z3 proof *)
  by smt

lemma "\<forall>x::int. \<exists>y. y > x" by smt

lemma "\<forall>x y::int. (x = 0 \<and> y = 1) \<longrightarrow> x \<noteq> y" by smt
lemma "\<exists>x::int. \<forall>y. x < y \<longrightarrow> y < 0 \<or> y >= 0" by smt
lemma "\<forall>x y::int. x < y \<longrightarrow> (2 * x + 1) < (2 * y)" by smt
lemma "\<forall>x y::int. (2 * x + 1) \<noteq> (2 * y)" by smt
lemma "\<forall>x y::int. x + y > 2 \<or> x + y = 2 \<or> x + y < 2" by smt
lemma "\<forall>x::int. if x > 0 then x + 1 > 0 else 1 > x" by smt
lemma "if (ALL x::int. x < 0 \<or> x > 0) then False else True" by smt
lemma "(if (ALL x::int. x < 0 \<or> x > 0) then -1 else 3) > (0::int)" by smt
lemma "~ (\<exists>x y z::int. 4 * x + -6 * y = (1::int))" by smt
lemma "\<exists>x::int. \<forall>x y. 0 < x \<and> 0 < y \<longrightarrow> (0::int) < x + y" by smt
lemma "\<exists>u::int. \<forall>(x::int) y::real. 0 < x \<and> 0 < y \<longrightarrow> -1 < x" by smt
lemma "\<exists>x::int. (\<forall>y. y \<ge> x \<longrightarrow> y > 0) \<longrightarrow> x > 0" by smt
lemma "\<forall>(a::int) b::int. 0 < b \<or> b < 1" by smt

subsection \<open>Non-linear arithmetic over integers and reals\<close>

lemma "a > (0::int) \<Longrightarrow> a*b > 0 \<Longrightarrow> b > 0"
  using [[smt_oracle, z3_extensions]]
  by smt

lemma  "(a::int) * (x + 1 + y) = a * x + a * (y + 1)"
  using [[z3_extensions]]
  by smt

lemma "((x::real) * (1 + y) - x * (1 - y)) = (2 * x * y)"
  using [[z3_extensions]]
  by smt

lemma
  "(U::int) + (1 + p) * (b + e) + p * d =
   U + (2 * (1 + p) * (b + e) + (1 + p) * d + d * p) - (1 + p) * (b + d + e)"
  using [[z3_extensions]] by smt

lemma [z3_rule]:
  fixes x :: "int"
  assumes "x * y \<le> 0" and "\<not> y \<le> 0" and "\<not> x \<le> 0"
  shows False
  using assms by (metis mult_le_0_iff)

section \<open>Pairs\<close>

lemma "fst (x, y) = a \<Longrightarrow> x = a"
  using fst_conv by smt

lemma "p1 = (x, y) \<and> p2 = (y, x) \<Longrightarrow> fst p1 = snd p2"
  using fst_conv snd_conv by smt

section \<open>Higher-order problems and recursion\<close>

lemma "i \<noteq> i1 \<and> i \<noteq> i2 \<Longrightarrow> (f (i1 := v1, i2 := v2)) i = f i"
  using fun_upd_same fun_upd_apply by smt

lemma "(f g (x::'a::type) = (g x \<and> True)) \<or> (f g x = True) \<or> (g x = True)"
  by smt

lemma "id x = x \<and> id True = True"
  by (smt id_def)

lemma "i \<noteq> i1 \<and> i \<noteq> i2 \<Longrightarrow> ((f (i1 := v1)) (i2 := v2)) i = f i"
  using fun_upd_same fun_upd_apply by smt

lemma
  "f (\<exists>x. g x) \<Longrightarrow> True"
  "f (\<forall>x. g x) \<Longrightarrow> True"
  by smt+

lemma True using let_rsp by smt
lemma "le = op \<le> \<Longrightarrow> le (3::int) 42" by smt
lemma "map (\<lambda>i::int. i + 1) [0, 1] = [1, 2]" by (smt list.map)
lemma "(ALL x. P x) \<or> ~ All P" by smt

fun dec_10 :: "int \<Rightarrow> int" where
  "dec_10 n = (if n < 10 then n else dec_10 (n - 10))"

lemma "dec_10 (4 * dec_10 4) = 6" by (smt dec_10.simps)

axiomatization
  eval_dioph :: "int list \<Rightarrow> int list \<Rightarrow> int"
where
  eval_dioph_mod: "eval_dioph ks xs mod n = eval_dioph ks (map (\<lambda>x. x mod n) xs) mod n"
and
  eval_dioph_div_mult:
  "eval_dioph ks (map (\<lambda>x. x div n) xs) * n +
   eval_dioph ks (map (\<lambda>x. x mod n) xs) = eval_dioph ks xs"

lemma
  "(eval_dioph ks xs = l) =
   (eval_dioph ks (map (\<lambda>x. x mod 2) xs) mod 2 = l mod 2 \<and>
    eval_dioph ks (map (\<lambda>x. x div 2) xs) = (l - eval_dioph ks (map (\<lambda>x. x mod 2) xs)) div 2)"
  using [[smt_oracle = true]] (*FIXME*)
  using [[z3_extensions]]
  by (smt eval_dioph_mod[where n=2] eval_dioph_div_mult[where n=2])

context complete_lattice
begin

lemma
  assumes "Sup {a | i::bool. True} \<le> Sup {b | i::bool. True}"
  and "Sup {b | i::bool. True} \<le> Sup {a | i::bool. True}"
  shows "Sup {a | i::bool. True} \<le> Sup {a | i::bool. True}"
  using assms by (smt order_trans)

end

section \<open>Monomorphization examples\<close>

definition Pred :: "'a \<Rightarrow> bool" where "Pred x = True"

lemma poly_Pred: "Pred x \<and> (Pred [x] \<or> \<not> Pred [x])" by (simp add: Pred_def)

lemma "Pred (1::int)" by (smt poly_Pred)

axiomatization g :: "'a \<Rightarrow> nat"
axiomatization where
  g1: "g (Some x) = g [x]" and
  g2: "g None = g []" and
  g3: "g xs = length xs"

lemma "g (Some (3::int)) = g (Some True)" by (smt g1 g2 g3 list.size)

end


section \<open>LIM is a proper subset of BC\label{s:lim_bc}\<close>

theory LIM_BC
  imports Lemma_R
begin

text \<open>The proper inclusion of LIM in BC has been proved by
Barzdin~\cite{b-ttlsf-74} (see also Case and Smith~\cite{cs-cicmii-83}). The
proof constructs a class $V \in \mathrm{BC} - \mathrm{LIM}$ by
diagonalization against all LIM strategies. Exploiting Lemma~R for LIM, we
can assume that all such strategies are total functions. From the effective
version of this lemma we derive a numbering @{term "\<sigma> \<in>
\<R>\<^sup>2"} such that for all $U \in \mathrm{LIM}$ there is an $i$ with
$U\in \mathrm{LIM}_\varphi(\sigma_i)$. The idea behind $V$
is for every $i$ to construct a class $V_i$ of cardinality one or two such
that $V_i \notin \mathrm{LIM}_\varphi(\sigma_i)$. It then follows that the
union $V := \bigcup_i V_i$ cannot be learned by any $\sigma_i$ and thus $V
\notin \mathrm{LIM}$. At the same time, the construction ensures that the
functions in $V$ are ``predictable enough'' to be learnable in the BC sense.

At the core is a process that maintains a state $(b, k)$ of a list $b$ of
numbers and an index $k < |b|$ into this list. We imagine $b$ to be the
prefix of the function being constructed, except for position $k$ where
we imagine $b$ to have a ``gap''; that is, $b_k$ is not defined yet.
Technically, we will always have $b_k = 0$, so $b$ also represents the prefix
after the ``gap is filled'' with 0, whereas $b_{k:=1}$ represents the prefix
where the gap is filled with 1. For every $i \in \mathbb{N}$, the process
starts in state $(i0, 1)$ and computes the next state from a given state
$(b,k)$ as follows:
\begin{enumerate}
\item if $ \sigma_i(b_{<k}) \neq \sigma_i(b)$ then the next state is $(b0, |b|)$,
\item else if $\sigma_i(b_{<k}) \neq \sigma_i(b_{k:=1})$ then the next state is $(b_{k:=1}0, |b|)$,
\item else the next state is $(b0, k)$.
\end{enumerate}
In other words, if $\sigma_i$ changes its hypothesis when the gap in $b$ is
filled with 0 or 1, then the process fills the gap with 0 or 1, respectively, and
appends a gap to $b$. If, however, a hypothesis change cannot be enforced at
this point, the process appends a 0 to $b$ and leaves the gap alone. Now there
are two cases:
\begin{itemize}
\item[Case 1.] Every gap gets filled eventually. Then the process generates
increasing prefixes of a total function $\tau_i$, on which $\sigma_i$ changes
its hypothesis infinitely often. We set $V_i := \{\tau_i\}$, and have $V_i \notin
\mathrm{LIM}_\varphi(\sigma_i)$.
\item[Case 2.] Some gap never gets filled. That means a state $(b, k)$ is
reached such that $\sigma_i(b0^t) = \sigma_i(b_{k:=1}0^t) = \sigma_i(b_{<k})$
for all $t$. Then the process describes a function $\tau_i = b_{<k}\uparrow0^\infty$,
where the value at the gap $k$ is undefined.
Replacing the value at $k$ by 0 and 1 yields two functions
$\tau_i^{(0)} = b0^\infty$ and $\tau_i^{(1)} = b_{k:=1}0^\infty$, which differ only at $k$ and on
which $\sigma_i$ converges to the same hypothesis. Thus $\sigma_i$ does not learn the
class $V_i := \{\tau_i^{(0)}, \tau_i^{(1)}\}$ in the limit.
\end{itemize}
Both cases combined imply $V \notin \mathrm{LIM}$.

A BC strategy $S$ for $V = \bigcup_i V_i$ works as follows. Let $f\in V$. On input $f^n$ the
strategy outputs a Gödel number of the function
\[
g_n(x) = \left\{\begin{array}{ll}
    f(x) & \mbox{if } x \leq n,\\
    \tau_{f(0)}(x) & \mbox{otherwise}.
\end{array}\right.
\]
By definition of $V$, $f$ is generated by the process running for $i = f(0)$.
If $f(0)$ leads to Case~1 then $f = \tau_{f(0)}$, and
$g_n$ equals $f$ for all $n$. If $f(0)$ leads to Case~2 with
a forever unfilled gap at $k$, then
$g_n$ will be equal to the correct one of $\tau_i^{(0)}$ or $\tau_i^{(1)}$ for all $n
\geq k$. Intuitively, the prefix received by $S$ eventually grows long enough to
reveal the value $f(k)$.
In both cases $S$ converges to $f$, but it outputs a different Gödel number
for every $f^n$ because $g_n$ contains the ``hard-coded'' values
$f(0),\dots,f(n)$. Therefore $S$ is a BC strategy but not a LIM
strategy for $V$.\<close>

subsection \<open>Enumerating enough total strategies\<close>

text \<open>For the construction of $\sigma$ we need the function @{term
r_limr} from the effective version of Lemma~R for LIM.\<close>

definition "r_sigma \<equiv> Cn 2 r_phi [Cn 2 r_limr [Id 2 0], Id 2 1]"

lemma r_sigma_recfn: "recfn 2 r_sigma"
  unfolding r_sigma_def using r_limr_recfn by simp

lemma r_sigma: "eval r_sigma [i, x] = \<phi> (the (eval r_limr [i])) x"
  unfolding r_sigma_def phi_def using r_sigma_recfn r_limr_total r_limr_recfn
  by simp

lemma r_sigma_total: "total r_sigma"
  using r_sigma r_limr r_sigma_recfn totalI2[of r_sigma] by simp

abbreviation sigma :: partial2 ("\<sigma>") where
  "\<sigma> i x \<equiv> eval r_sigma [i, x]"

lemma sigma: "\<sigma> i = \<phi> (the (eval r_limr [i]))"
  using r_sigma by simp

text \<open>The numbering @{term \<sigma>} does indeed enumerate enough total
strategies for every LIM learning problem.\<close>

subsection \<open>The diagonalization process\<close>

text \<open>The following function represents the process described above. It
computes the next state from a given state $(b, k)$.\<close>

definition "r_next \<equiv>
  Cn 1 r_ifeq
   [Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], r_pdec1],
    Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], Cn 1 r_take [r_pdec2, r_pdec1]],
    Cn 1 r_ifeq
     [Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], Cn 1 r_update [r_pdec1, r_pdec2, r_const 1]],
      Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], Cn 1 r_take [r_pdec2, r_pdec1]],
      Cn 1 r_prod_encode [Cn 1 r_snoc [r_pdec1, Z], r_pdec2],
      Cn 1 r_prod_encode
       [Cn 1 r_snoc
         [Cn 1 r_update [r_pdec1, r_pdec2, r_const 1], Z], Cn 1 r_length [r_pdec1]]],
    Cn 1 r_prod_encode [Cn 1 r_snoc [r_pdec1, Z], Cn 1 r_length [r_pdec1]]]"

lemma r_next_recfn: "recfn 1 r_next"
  unfolding r_next_def using r_sigma_recfn by simp

text \<open>The three conditions distinguished in @{term r_next} correspond
to Steps 1, 2, and 3 of the process: hypothesis change when the gap is
filled with 0; hypothesis change when the gap is filled with 1; or
no hypothesis change either way.\<close>

abbreviation "change_on_0 b k \<equiv> \<sigma> (e_hd b) b \<noteq> \<sigma> (e_hd b) (e_take k b)"

abbreviation "change_on_1 b k \<equiv>
  \<sigma> (e_hd b) b = \<sigma> (e_hd b) (e_take k b) \<and>
  \<sigma> (e_hd b) (e_update b k 1) \<noteq> \<sigma> (e_hd b) (e_take k b)"

abbreviation "change_on_neither b k \<equiv>
  \<sigma> (e_hd b) b = \<sigma> (e_hd b) (e_take k b) \<and>
  \<sigma> (e_hd b) (e_update b k 1) = \<sigma> (e_hd b) (e_take k b)"

lemma change_conditions:
  obtains
    (on_0) "change_on_0 b k"
  | (on_1) "change_on_1 b k"
  | (neither) "change_on_neither b k"
  by auto

lemma r_next:
  assumes "arg = prod_encode (b, k)"
  shows "change_on_0 b k \<Longrightarrow> eval r_next [arg] \<down>= prod_encode (e_snoc b 0, e_length b)"
    and "change_on_1 b k \<Longrightarrow>
      eval r_next [arg] \<down>= prod_encode (e_snoc (e_update b k 1) 0, e_length b)"
    and "change_on_neither b k \<Longrightarrow> eval r_next [arg] \<down>= prod_encode (e_snoc b 0, k)"
proof -
  let ?bhd = "Cn 1 r_hd [r_pdec1]"
  let ?bup = "Cn 1 r_update [r_pdec1, r_pdec2, r_const 1]"
  let ?bk = "Cn 1 r_take [r_pdec2, r_pdec1]"
  let ?bap = "Cn 1 r_snoc [r_pdec1, Z]"
  let ?len = "Cn 1 r_length [r_pdec1]"
  let ?thenthen = "Cn 1 r_prod_encode [?bap, r_pdec2]"
  let ?thenelse = "Cn 1 r_prod_encode [Cn 1 r_snoc [?bup, Z], ?len]"
  let ?else = "Cn 1 r_prod_encode [?bap, ?len]"
  have bhd: "eval ?bhd [arg] \<down>= e_hd b"
    using assms by simp
  have bup: "eval ?bup [arg] \<down>= e_update b k 1"
    using assms by simp
  have bk: "eval ?bk [arg] \<down>= e_take k b"
    using assms by simp
  have bap: "eval ?bap [arg] \<down>= e_snoc b 0"
    using assms by simp
  have len: "eval ?len [arg] \<down>= e_length b"
    using assms by simp
  have else_: "eval ?else [arg] \<down>= prod_encode (e_snoc b 0, e_length b)"
    using bap len by simp
  have thenthen: "eval ?thenthen [arg] \<down>= prod_encode (e_snoc b 0, k)"
    using bap assms by simp
  have thenelse: "eval ?thenelse [arg] \<down>= prod_encode (e_snoc (e_update b k 1) 0, e_length b)"
    using bup len by simp
  have then_:
    "eval
      (Cn 1 r_ifeq [Cn 1 r_sigma [?bhd, ?bup], Cn 1 r_sigma [?bhd, ?bk], ?thenthen, ?thenelse])
      [arg] \<down>=
    (if the (\<sigma> (e_hd b) (e_update b k 1)) = the (\<sigma> (e_hd b) (e_take k b))
     then prod_encode (e_snoc b 0, k)
     else prod_encode (e_snoc (e_update b k 1) 0, e_length b))"
    (is "eval ?then [arg] \<down>= ?then_eval")
    using bhd bup bk thenthen thenelse r_sigma r_sigma_recfn r_limr R1_imp_total1 by simp
  have *: "eval r_next [arg] \<down>=
    (if the (\<sigma> (e_hd b) b) = the (\<sigma> (e_hd b) (e_take k b))
     then ?then_eval
     else prod_encode (e_snoc b 0, e_length b))"
    unfolding r_next_def
    using bhd bk then_ else_ r_sigma r_sigma_recfn r_limr R1_imp_total1 assms
    by simp
  have r_sigma_neq: "eval r_sigma [x\<^sub>1, y\<^sub>1] \<noteq> eval r_sigma [x\<^sub>2, y\<^sub>2] \<longleftrightarrow>
      the (eval r_sigma [x\<^sub>1, y\<^sub>1]) \<noteq> the (eval r_sigma [x\<^sub>2, y\<^sub>2])"
      for x\<^sub>1 y\<^sub>1 x\<^sub>2 y\<^sub>2
    using r_sigma r_limr totalE[OF r_sigma_total r_sigma_recfn] r_sigma_recfn r_sigma_total
    by (metis One_nat_def Suc_1 length_Cons list.size(3) option.expand)
  {
    assume "change_on_0 b k"
    then show "eval r_next [arg] \<down>= prod_encode (e_snoc b 0, e_length b)"
      using * r_sigma_neq by simp
  next
    assume "change_on_1 b k"
    then show "eval r_next [arg] \<down>= prod_encode (e_snoc (e_update b k 1) 0, e_length b)"
      using * r_sigma_neq by simp
  next
    assume "change_on_neither b k"
    then show "eval r_next [arg] \<down>= prod_encode (e_snoc b 0, k)"
      using * r_sigma_neq by simp
  }
qed

lemma r_next_total: "total r_next"
proof (rule totalI1)
  show "recfn 1 r_next"
    using r_next_recfn by simp
  show "eval r_next [x] \<down>" for x
  proof -
    obtain b k where "x = prod_encode (b, k)"
      using prod_encode_pdec'[of x] by metis
    then show ?thesis using r_next by fast
  qed
qed

text \<open>The next function computes the state of the process after
any number of iterations.\<close>

definition "r_state \<equiv>
  Pr 1
   (Cn 1 r_prod_encode [Cn 1 r_snoc [Cn 1 r_singleton_encode [Id 1 0], Z], r_const 1])
   (Cn 3 r_next [Id 3 1])"

lemma r_state_recfn: "recfn 2 r_state"
  unfolding r_state_def using r_next_recfn by simp

lemma r_state_at_0: "eval r_state [0, i] \<down>= prod_encode (list_encode [i, 0], 1)"
proof -
  let ?f = "Cn 1 r_prod_encode [Cn 1 r_snoc [Cn 1 r_singleton_encode [Id 1 0], Z], r_const 1]"
  have "eval r_state [0, i] = eval ?f [i]"
    unfolding r_state_def using r_next_recfn by simp
  also have "... \<down>= prod_encode (list_encode [i, 0], 1)"
    by (simp add: list_decode_singleton)
  finally show ?thesis .
qed

lemma r_state_total: "total r_state"
  unfolding r_state_def
  using r_next_recfn totalE[OF r_next_total r_next_recfn] totalI3[of "Cn 3 r_next [Id 3 1]"]
  by (intro Pr_total) auto

text \<open>We call the components of a state $(b, k)$ the \emph{block} $b$
and the \emph{gap} $k$.\<close>

definition block :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "block i t \<equiv> pdec1 (the (eval r_state [t, i]))"

definition gap :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "gap i t \<equiv> pdec2 (the (eval r_state [t, i]))"

lemma state_at_0:
  "block i 0 = list_encode [i, 0]"
  "gap i 0 = 1"
  unfolding block_def gap_def r_state_at_0 by simp_all

text \<open>Some lemmas describing the behavior of blocks and gaps in
one iteration of the process:\<close>

lemma state_Suc:
  assumes "b = block i t" and "k = gap i t"
  shows "block i (Suc t) = pdec1 (the (eval r_next [prod_encode (b, k)]))"
    and "gap i (Suc t) = pdec2 (the (eval r_next [prod_encode (b, k)]))"
proof -
  have "eval r_state [Suc t, i] =
      eval (Cn 3 r_next [Id 3 1]) [t, the (eval r_state [t, i]), i]"
    using r_state_recfn r_next_recfn totalE[OF r_state_total r_state_recfn, of "[t, i]"]
    by (simp add: r_state_def)
  also have "... = eval r_next [the (eval r_state [t, i])]"
    using r_next_recfn by simp
  also have "... = eval r_next [prod_encode (b, k)]"
    using assms block_def gap_def by simp
  finally have "eval r_state [Suc t, i] = eval r_next [prod_encode (b, k)]" .
  then show
    "block i (Suc t) = pdec1 (the (eval r_next [prod_encode (b, k)]))"
    "gap i (Suc t) = pdec2 (the (eval r_next [prod_encode (b, k)]))"
    by (simp add: block_def, simp add: gap_def)
qed

lemma gap_Suc:
  assumes "b = block i t" and "k = gap i t"
  shows "change_on_0 b k \<Longrightarrow> gap i (Suc t) = e_length b"
    and "change_on_1 b k \<Longrightarrow> gap i (Suc t) = e_length b"
    and "change_on_neither b k\<Longrightarrow> gap i (Suc t) = k"
  using assms r_next state_Suc by simp_all

lemma block_Suc:
  assumes "b = block i t" and "k = gap i t"
  shows "change_on_0 b k \<Longrightarrow> block i (Suc t) = e_snoc b 0"
    and "change_on_1 b k \<Longrightarrow> block i (Suc t) = e_snoc (e_update b k 1) 0"
    and "change_on_neither b k\<Longrightarrow> block i (Suc t) = e_snoc b 0"
  using assms r_next state_Suc by simp_all

text \<open>Non-gap positions in the block remain unchanged after an
iteration.\<close>

lemma block_stable:
  assumes "j < e_length (block i t)" and "j \<noteq> gap i t"
  shows "e_nth (block i t) j = e_nth (block i (Suc t)) j"
proof -
  from change_conditions[of "block i t" "gap i t"] show ?thesis
    using assms block_Suc gap_Suc
    by (cases, (simp_all add: nth_append))
qed

text \<open>Next are some properties of @{term block} and @{term gap}.\<close>

lemma gap_in_block: "gap i t < e_length (block i t)"
proof (induction t)
  case 0
  then show ?case by (simp add: state_at_0)
next
  case (Suc t)
  with change_conditions[of "block i t" "gap i t"] show ?case
  proof (cases)
    case on_0
    then show ?thesis by (simp add: block_Suc(1) gap_Suc(1))
  next
    case on_1
    then show ?thesis by (simp add: block_Suc(2) gap_Suc(2))
  next
    case neither
    then show ?thesis using Suc.IH block_Suc(3) gap_Suc(3) by force
  qed
qed

lemma length_block: "e_length (block i t) = Suc (Suc t)"
proof (induction t)
  case 0
  then show ?case by (simp add: state_at_0)
next
  case (Suc t)
  with change_conditions[of "block i t" "gap i t"] show ?case
    by (cases, simp_all add: block_Suc gap_Suc)
qed

lemma gap_gr0: "gap i t > 0"
proof (induction t)
  case 0
  then show ?case by (simp add: state_at_0)
next
  case (Suc t)
  with change_conditions[of "block i t" "gap i t"] show ?case
    using length_block by (cases, simp_all add: block_Suc gap_Suc)
qed

lemma hd_block: "e_hd (block i t) = i"
proof (induction t)
  case 0
  then show ?case by (simp add: state_at_0)
next
  case (Suc t)
  from change_conditions[of "block i t" "gap i t"] show ?case
  proof (cases)
    case on_0
    then show ?thesis
      using Suc block_Suc(1) length_block by (metis e_hd_snoc gap_Suc(1) gap_gr0)
  next
    case on_1
    let ?b = "block i t" and ?k = "gap i t"
    have "?k > 0"
      using gap_gr0 Suc by simp
    then have "e_nth (e_update ?b ?k 1) 0 = e_nth ?b 0"
      by simp
    then have *: "e_hd (e_update ?b ?k 1) = e_hd ?b"
      using e_hd_nth0 gap_Suc(2)[of _ i t] gap_gr0 on_1 by (metis e_length_update)
    from on_1 have "block i (Suc t) = e_snoc (e_update ?b ?k 1) 0"
      by (simp add: block_Suc(2))
    then show ?thesis
      using e_hd_0 e_hd_snoc Suc length_block \<open>?k > 0\<close> *
      by (metis e_length_update gap_Suc(2) gap_gr0 on_1)
  next
    case neither
    then show ?thesis using Suc block_Suc(3) length_block by simp
  qed
qed

text \<open>Formally, a block always ends in zero, even if it ends in a gap.\<close>

lemma last_block: "e_nth (block i t) (gap i t) = 0"
proof (induction t)
  case 0
  then show ?case by (simp add: state_at_0)
next
  case (Suc t)
  from change_conditions[of "block i t" "gap i t"] show ?case
  proof cases
    case on_0
    then show ?thesis using Suc by (simp add: block_Suc(1) gap_Suc(1))
  next
    case on_1
    then show ?thesis using Suc by (simp add: block_Suc(2) gap_Suc(2) nth_append)
  next
    case neither
    then have
      "block i (Suc t) = e_snoc (block i t) 0"
      "gap i (Suc t) = gap i t"
      by (simp_all add: gap_Suc(3) block_Suc(3))
    then show ?thesis
      using Suc gap_in_block by (simp add: nth_append)
  qed
qed

lemma gap_le_Suc: "gap i t \<le> gap i (Suc t)"
  using change_conditions[of "block i t" "gap i t"]
    gap_Suc gap_in_block less_imp_le[of "gap i t" "e_length (block i t)"]
  by (cases) simp_all

lemma gap_monotone:
  assumes "t\<^sub>1 \<le> t\<^sub>2"
  shows "gap i t\<^sub>1 \<le> gap i t\<^sub>2"
proof -
  have "gap i t\<^sub>1 \<le> gap i (t\<^sub>1 + j)" for j
  proof (induction j)
    case 0
    then show ?case by simp
  next
    case (Suc j)
    then show ?case using gap_le_Suc dual_order.trans by fastforce
  qed
  then show ?thesis using assms le_Suc_ex by blast
qed

text \<open>We need some lemmas relating the shape of the next state
to the hypothesis change conditions in Steps 1, 2, and 3.\<close>

lemma state_change_on_neither:
  assumes "gap i (Suc t) = gap i t"
  shows "change_on_neither (block i t) (gap i t)"
    and "block i (Suc t) = e_snoc (block i t) 0"
proof -
  let ?b = "block i t" and ?k = "gap i t"
  have "?k < e_length ?b"
    using gap_in_block by simp
  from change_conditions[of ?b ?k] show "change_on_neither (block i t) (gap i t)"
  proof (cases)
    case on_0
    then show ?thesis
      using \<open>?k < e_length ?b\<close> assms gap_Suc(1) by auto
  next
    case on_1
    then show ?thesis using assms gap_Suc(2) by auto
  next
    case neither
    then show ?thesis by simp
  qed
  then show "block i (Suc t) = e_snoc (block i t) 0"
    using block_Suc(3) by simp
qed

lemma state_change_on_either:
  assumes "gap i (Suc t) \<noteq> gap i t"
  shows "\<not> change_on_neither (block i t) (gap i t)"
    and "gap i (Suc t) = e_length (block i t)"
proof -
  let ?b = "block i t" and ?k = "gap i t"
  show "\<not> change_on_neither (block i t) (gap i t)"
  proof
    assume "change_on_neither (block i t) (gap i t)"
    then have "gap i (Suc t) = ?k"
      by (simp add: gap_Suc(3))
    with assms show False by simp
  qed
  then show "gap i (Suc t) = e_length (block i t)"
    using gap_Suc(1) gap_Suc(2) by blast
qed

text \<open>Next up is the definition of $\tau$. In every iteration the
process determines $\tau_i(x)$ for some $x$ either by appending 0 to the
current block $b$, or by filling the current gap $k$. In the former case,
the value is determined for $x = |b|$, in the latter for $x = k$.\<close>

text \<open>For $i$ and $x$ the function @{term r_dettime} computes in which
iteration the process for $i$ determines the value $\tau_i(x)$. This is the
first iteration in which the block is long enough to contain position $x$ and
in which $x$ is not the gap. If $\tau_i(x)$ is never determined, because Case~2 is
reached with $k = x$, then @{term r_dettime} diverges.\<close>

abbreviation determined :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
  "determined i x \<equiv> \<exists>t. x < e_length (block i t) \<and> x \<noteq> gap i t"

lemma determined_0: "determined i 0"
  using gap_gr0[of i 0] gap_in_block[of i 0] by force

definition "r_dettime \<equiv>
  Mn 2
   (Cn 3 r_and
     [Cn 3 r_less
       [Id 3 2, Cn 3 r_length [Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]]],
      Cn 3 r_neq
       [Id 3 2, Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]]])"

lemma r_dettime_recfn: "recfn 2 r_dettime"
  unfolding r_dettime_def using r_state_recfn by simp

abbreviation dettime :: partial2 where
  "dettime i x \<equiv> eval r_dettime [i, x]"

lemma r_dettime:
  shows "determined i x \<Longrightarrow> dettime i x \<down>= (LEAST t. x < e_length (block i t) \<and> x \<noteq> gap i t)"
    and "\<not> determined i x \<Longrightarrow> dettime i x \<up>"
proof -
  define f where "f =
   (Cn 3 r_and
     [Cn 3 r_less
       [Id 3 2, Cn 3 r_length [Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]]],
      Cn 3 r_neq
       [Id 3 2, Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]]])"
  then have "r_dettime = Mn 2 f"
    unfolding f_def r_dettime_def by simp
  have "recfn 3 f"
    unfolding f_def using r_state_recfn by simp
  then have "total f"
    unfolding f_def using Cn_total r_state_total Mn_free_imp_total by simp
  have f: "eval f [t, i, x] \<down>= (if x < e_length (block i t) \<and> x \<noteq> gap i t then 0 else 1)" for t
  proof -
    let ?b = "Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]"
    let ?k = "Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]"
    have "eval ?b [t, i, x] \<down>= pdec1 (the (eval r_state [t, i]))"
      using r_state_recfn r_state_total by simp
    then have b: "eval ?b [t, i, x] \<down>= block i t"
      using block_def by simp
    have "eval ?k [t, i, x] \<down>= pdec2 (the (eval r_state [t, i]))"
      using r_state_recfn r_state_total by simp
    then have k: "eval ?k [t, i, x] \<down>= gap i t"
      using gap_def by simp
    have "eval
          (Cn 3 r_neq [Id 3 2, Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]])
          [t, i, x] \<down>=
       (if x \<noteq> gap i t then 0 else 1)"
      using b k r_state_recfn r_state_total by simp
    moreover have "eval
          (Cn 3 r_less
            [Id 3 2, Cn 3 r_length [Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]]])
          [t, i, x] \<down>=
       (if x < e_length (block i t) then 0 else 1)"
      using b k r_state_recfn r_state_total by simp
    ultimately show ?thesis
      unfolding f_def using b k r_state_recfn r_state_total by simp
  qed
  {
    assume "determined i x"
    with f have "\<exists>t. eval f [t, i, x] \<down>= 0" by simp
    then have "dettime i x \<down>= (LEAST t. eval f [t, i, x] \<down>= 0)"
      using \<open>total f\<close> \<open>r_dettime = Mn 2 f\<close> r_dettime_recfn \<open>recfn 3 f\<close>
        eval_Mn_total[of 2 f "[i, x]"]
      by simp
    then show "dettime i x \<down>= (LEAST t. x < e_length (block i t) \<and> x \<noteq> gap i t)"
      using f by simp
  next
    assume "\<not> determined i x"
    with f have "\<not> (\<exists>t. eval f [t, i, x] \<down>= 0)" by simp
    then have "dettime i x \<up>"
      using \<open>total f\<close> \<open>r_dettime = Mn 2 f\<close> r_dettime_recfn \<open>recfn 3 f\<close>
        eval_Mn_total[of 2 f "[i, x]"]
      by simp
    with f show "dettime i x \<up>" by simp
  }
qed

lemma r_dettimeI:
  assumes "x < e_length (block i t) \<and> x \<noteq> gap i t"
    and "\<And>T. x < e_length (block i T) \<and> x \<noteq> gap i T \<Longrightarrow> t \<le> T"
  shows "dettime i x \<down>= t"
proof -
  let ?P = "\<lambda>T. x < e_length (block i T) \<and> x \<noteq> gap i T"
  have "determined i x"
    using assms(1) by auto
  moreover have "Least ?P = t"
    using assms Least_equality[of ?P t] by simp
  ultimately show ?thesis using r_dettime by simp
qed

lemma r_dettime_0: "dettime i 0 \<down>= 0"
  using r_dettimeI[of _ i 0] determined_0 gap_gr0[of i 0] gap_in_block[of i 0]
  by fastforce

text \<open>Computing the value of $\tau_i(x)$ works by running the process
@{term r_state} for @{term "dettime i x"} iterations and taking the value at
index $x$ of the resulting block.\<close>

definition "r_tau \<equiv> Cn 2 r_nth [Cn 2 r_pdec1 [Cn 2 r_state [r_dettime, Id 2 0]], Id 2 1]"

lemma r_tau_recfn: "recfn 2 r_tau"
  unfolding r_tau_def using r_dettime_recfn r_state_recfn by simp

abbreviation tau :: partial2 ("\<tau>") where
  "\<tau> i x \<equiv> eval r_tau [i, x]"

lemma tau_in_P2: "\<tau> \<in> \<P>\<^sup>2"
  using r_tau_recfn by auto

lemma tau_diverg:
  assumes "\<not> determined i x"
  shows "\<tau> i x \<up>"
  unfolding r_tau_def using assms r_dettime r_dettime_recfn r_state_recfn by simp

lemma tau_converg:
  assumes "determined i x"
  shows "\<tau> i x \<down>= e_nth (block i (the (dettime i x))) x"
proof -
  from assms obtain t where t: "dettime i x \<down>= t"
    using r_dettime(1) by blast
  then have "eval (Cn 2 r_state [r_dettime, Id 2 0]) [i, x] = eval r_state [t, i]"
    using r_state_recfn r_dettime_recfn by simp
  moreover have "eval r_state [t, i] \<down>"
    using r_state_total r_state_recfn by simp
  ultimately have "eval (Cn 2 r_pdec1 [Cn 2 r_state [r_dettime, Id 2 0]]) [i, x] =
      eval r_pdec1 [the (eval r_state [t, i])]"
    using r_state_recfn r_dettime_recfn by simp
  then show ?thesis
    unfolding r_tau_def using r_state_recfn r_dettime_recfn t block_def by simp
qed

lemma tau_converg':
  assumes "dettime i x \<down>= t"
  shows "\<tau> i x \<down>= e_nth (block i t) x"
  using assms tau_converg[of x i] r_dettime(2)[of x i] by fastforce

lemma tau_at_0: "\<tau> i 0 \<down>= i"
proof -
  have "\<tau> i 0 \<down>= e_nth (block i 0) 0"
    using tau_converg'[OF r_dettime_0] by simp
  then show ?thesis using block_def by (simp add: r_state_at_0)
qed

lemma state_unchanged:
  assumes "gap i t - 1 \<le> y" and "y \<le> t"
  shows "gap i t = gap i y"
proof -
  have "gap i t = gap i (gap i t - 1)"
  proof (induction t)
    case 0
    then show ?case by (simp add: gap_def r_state_at_0)
  next
    case (Suc t)
    show ?case
    proof (cases "gap i (Suc t) = t + 2")
      case True
      then show ?thesis by simp
    next
      case False
      then show ?thesis
        using Suc state_change_on_either(2) length_block by force
    qed
  qed
  moreover have "gap i (gap i t - 1) \<le> gap i y"
    using assms(1) gap_monotone by simp
  moreover have "gap i y \<le> gap i t"
    using assms(2) gap_monotone by simp
  ultimately show ?thesis by simp
qed

text \<open>The values of the non-gap indices $x$ of every block created in
the diagonalization process equal $\tau_i(x)$.\<close>

lemma tau_eq_state:
  assumes "j < e_length (block i t)" and "j \<noteq> gap i t"
  shows "\<tau> i j \<down>= e_nth (block i t) j"
  using assms
proof (induction t)
  case 0
  then have "j = 0"
    using gap_gr0[of i 0] gap_in_block[of i 0] length_block[of i 0] by simp
  then have "\<tau> (e_hd (block i t)) j \<down>= e_nth (block i (the (dettime i 0))) 0"
    using determined_0 tau_converg hd_block by simp
  then have "\<tau> (e_hd (block i t)) j \<down>= e_nth (block i 0) 0"
    using r_dettime_0 by simp
  then show ?case using \<open>j = 0\<close> r_dettime_0 tau_converg' by simp
next
  case (Suc t)
  let ?b = "block i t"
  let ?bb = "block i (Suc t)"
  let ?k = "gap i t"
  let ?kk = "gap i (Suc t)"
  show ?case
  proof (cases "?kk = ?k")
    case kk_eq_k: True
    then have bb_b0: "?bb = e_snoc ?b 0"
      using state_change_on_neither by simp
    show "\<tau> i j \<down>= e_nth ?bb j"
    proof (cases "j < e_length ?b")
      case True
      then have "e_nth ?bb j = e_nth ?b j"
        using bb_b0 by (simp add: nth_append)
      moreover have "j \<noteq> ?k"
        using Suc kk_eq_k by simp
      ultimately show ?thesis using Suc True by simp
    next
      case False
      then have j: "j = e_length ?b"
        using Suc.prems(1) length_block by auto
      then have "e_nth ?bb j = 0"
        using bb_b0 by simp
      have "dettime i j \<down>= Suc t"
      proof (rule r_dettimeI)
        show "j < e_length ?bb \<and> j \<noteq> ?kk"
          using Suc.prems(1,2) by linarith
        show "\<And>T. j < e_length (block i T) \<and> j \<noteq> gap i T \<Longrightarrow> Suc t \<le> T"
          using length_block j by simp
      qed
      with tau_converg' show ?thesis by simp
    qed
  next
    case False
    then have kk_lenb: "?kk = e_length ?b"
      using state_change_on_either by simp
    then show ?thesis
    proof (cases "j = ?k")
      case j_eq_k: True
      have "dettime i j \<down>= Suc t"
      proof (rule r_dettimeI)
        show "j < e_length ?bb \<and> j \<noteq> ?kk"
          using Suc.prems(1,2) by simp
        show "Suc t \<le> T" if "j < e_length (block i T) \<and> j \<noteq> gap i T" for T
        proof (rule ccontr)
          assume "\<not> (Suc t \<le> T)"
          then have "T < Suc t" by simp
          then show False
          proof (cases "T < ?k - 1")
            case True
            then have "e_length (block i T) = T + 2"
              using length_block by simp
            then have "e_length (block i T) < ?k + 1"
              using True by simp
            then have "e_length (block i T) \<le> ?k" by simp
            then have "e_length (block i T) \<le> j"
              using j_eq_k by simp
            then show False
              using that by simp
          next
            case False
            then have "?k - 1 \<le> T" and "T \<le> t"
              using \<open>T < Suc t\<close> by simp_all
            with state_unchanged have "gap i t = gap i T" by blast
            then show False
              using j_eq_k that by simp
          qed
        qed
      qed
      then show ?thesis using tau_converg' by simp
    next
      case False
      then have "j < e_length ?b"
        using kk_lenb Suc.prems(1,2) length_block by auto
      then show ?thesis using Suc False block_stable by fastforce
    qed
  qed
qed

lemma tau_eq_state':
  assumes "j < t + 2" and " j \<noteq> gap i t"
  shows "\<tau> i j \<down>= e_nth (block i t) j"
  using assms tau_eq_state length_block by simp

text \<open>We now consider the two cases described in the proof sketch.
In Case~2 there is a gap that never gets filled, or equivalently there is
a rightmost gap.\<close>

abbreviation "case_two i \<equiv> (\<exists>t. \<forall>T. gap i T \<le> gap i t)"

abbreviation "case_one i \<equiv> \<not> case_two i"

text \<open>Another characterization of Case~2 is that from some iteration on
only @{term change_on_neither} holds.\<close>

lemma case_two_iff_forever_neither:
  "case_two i \<longleftrightarrow> (\<exists>t. \<forall>T\<ge>t. change_on_neither (block i T) (gap i T))"
proof
  assume "\<exists>t. \<forall>T\<ge>t. change_on_neither (block i T) (gap i T)"
  then obtain t where t: "\<forall>T\<ge>t. change_on_neither (block i T) (gap i T)"
    by auto
  have "(gap i T) \<le> (gap i t)" for T
  proof (cases "T \<le> t")
    case True
    then show ?thesis using gap_monotone by simp
  next
    case False
    then show ?thesis
    proof (induction T)
      case 0
      then show ?case by simp
    next
      case (Suc T)
      with t have "change_on_neither ((block i T)) ((gap i T))"
        by simp
      then show ?case
        using Suc.IH state_change_on_either(1)[of i T] gap_monotone[of T t i]
        by metis
    qed
  qed
  then show "\<exists>t. \<forall>T. gap i T \<le> gap i t"
    by auto
next
  assume "\<exists>t. \<forall>T. gap i T \<le> gap i t"
  then obtain t where t: "\<forall>T. gap i T \<le> gap i t"
    by auto
  have "change_on_neither (block i T) (gap i T)" if "T\<ge>t" for T
  proof -
    have T: "(gap i T) \<ge> (gap i t)"
      using gap_monotone that by simp
    show ?thesis
    proof (rule ccontr)
      assume "\<not> change_on_neither (block i T) (gap i T)"
      then have "change_on_0 (block i T) (gap i T) \<or> change_on_1 (block i T) (gap i T)"
        by simp
      then have "gap i (Suc T) > gap i T"
        using gap_le_Suc[of i] state_change_on_either(2)[of i] state_change_on_neither(1)[of i]
          dual_order.strict_iff_order
        by blast
      with T have "gap i (Suc T) > gap i t" by simp
      with t show False
        using not_le by auto
    qed
  qed
  then show "\<exists>t. \<forall>T\<ge>t. change_on_neither (block i T) (gap i T)"
    by auto
qed

text \<open>In Case~1, $\tau_i$ is total.\<close>

lemma case_one_tau_total:
  assumes "case_one i"
  shows "\<tau> i x \<down>"
proof (cases "x = gap i x")
  case True
  from assms have "\<forall>t. \<exists>T. gap i T > gap i t"
    using le_less_linear gap_def[of i x] by blast
  then obtain T where T: "gap i T > gap i x"
    by auto
  then have "T > x"
    using gap_monotone leD le_less_linear by blast
  then have "x < T + 2" by simp
  moreover from T True have "x \<noteq> gap i T" by simp
  ultimately show ?thesis using tau_eq_state' by simp
next
  case False
  moreover have "x < x + 2" by simp
  ultimately show ?thesis using tau_eq_state' by blast
qed

text \<open>In Case~2, $\tau_i$ is undefined only at the gap that never gets filled.\<close>

lemma case_two_tau_not_quite_total:
  assumes "\<forall>T. gap i T \<le> gap i t"
  shows "\<tau> i (gap i t) \<up>"
    and "x \<noteq> gap i t \<Longrightarrow> \<tau> i x \<down>"
proof -
  let ?k = "gap i t"
  have "\<not> determined i ?k"
  proof
    assume "determined i ?k"
    then obtain T where T: "?k < e_length (block i T) \<and> ?k \<noteq> gap i T"
      by auto
    with assms have snd_le: "gap i T < ?k"
      by (simp add: dual_order.strict_iff_order)
    then have "T < t"
      using gap_monotone by (metis leD le_less_linear)
    from T length_block have "?k < T + 2" by simp
    moreover have "?k \<noteq> T + 1"
      using T state_change_on_either(2) \<open>T < t\<close> state_unchanged
      by (metis Suc_eq_plus1 Suc_leI add_diff_cancel_right' le_add1 nat_neq_iff)
    ultimately have "?k \<le> T" by simp
    then have "gap i T = gap i ?k"
      using state_unchanged[of i T "?k"] \<open>?k < T + 2\<close> snd_le by simp
    then show False
      by (metis diff_le_self state_unchanged leD nat_le_linear gap_monotone snd_le)
  qed
  with tau_diverg show "\<tau> i ?k \<up>" by simp

  assume "x \<noteq> ?k"
  show "\<tau> i x \<down>"
  proof (cases "x < t + 2")
    case True
    with \<open>x \<noteq> ?k\<close> tau_eq_state' show ?thesis by simp
  next
    case False
    then have "gap i x = ?k"
      using assms by (simp add: dual_order.antisym gap_monotone)
    with \<open>x \<noteq> ?k\<close> have "x \<noteq> gap i x" by simp
    then show ?thesis using tau_eq_state'[of x x] by simp
  qed
qed

lemma case_two_tau_almost_total:
  assumes "\<exists>t. \<forall>T. gap i T \<le> gap i t" (is "\<exists>t. ?P t")
  shows "\<tau> i (gap i (Least ?P)) \<up>"
    and "x \<noteq> gap i (Least ?P) \<Longrightarrow> \<tau> i x \<down>"
proof -
  from assms have "?P (Least ?P)"
    using LeastI_ex[of ?P] by simp
  then show "\<tau> i (gap i (Least ?P)) \<up>" and "x \<noteq> gap i (Least ?P) \<Longrightarrow> \<tau> i x \<down>"
    using case_two_tau_not_quite_total by simp_all
qed

text \<open>Some more properties of $\tau$.\<close>

lemma init_tau_gap: "(\<tau> i) \<triangleright> (gap i t - 1) = e_take (gap i t) (block i t)"
proof (intro initI')
  show 1: "e_length (e_take (gap i t) (block i t)) = Suc (gap i t - 1)"
  proof -
    have "gap i t > 0"
      using gap_gr0 by simp
    moreover have "gap i t < e_length (block i t)"
      using gap_in_block by simp
    ultimately have "e_length (e_take (gap i t) (block i t)) = gap i t"
      by simp
    then show ?thesis using gap_gr0 by simp
  qed
  show "\<tau> i x \<down>= e_nth (e_take (gap i t) (block i t)) x" if "x < Suc (gap i t - 1)" for x
  proof -
    have x_le: "x < gap i t"
      using that gap_gr0 by simp
    then have "x < e_length (block i t)"
      using gap_in_block less_trans by blast
    then have *: "\<tau> i x \<down>= e_nth (block i t) x"
      using x_le tau_eq_state by auto
    have "x < e_length (e_take (gap i t) (block i t))"
      using x_le 1 by simp
    then have "e_nth (block i t) x = e_nth (e_take (gap i t) (block i t)) x"
      using x_le by simp
    then show ?thesis using * by simp
  qed
qed

lemma change_on_0_init_tau:
  assumes "change_on_0 (block i t) (gap i t)"
  shows "(\<tau> i) \<triangleright> (t + 1) = block i t"
proof (intro initI')
  let ?b = "block i t" and ?k = "gap i t"
  show "e_length (block i t) = Suc (t + 1)"
    using length_block by simp
  show "(\<tau> i) x \<down>= e_nth (block i t) x" if "x < Suc (t + 1)" for x
  proof (cases "x = ?k")
    case True
    have "gap i (Suc t) = e_length ?b" and b: "block i (Suc t) = e_snoc ?b 0"
      using gap_Suc(1) block_Suc(1) assms by simp_all
    then have "x < e_length (block i (Suc t))" "x \<noteq> gap i (Suc t)"
      using that length_block by simp_all
    then have "\<tau> i x \<down>= e_nth (block i (Suc t)) x"
      using tau_eq_state by simp
    then show ?thesis using that assms b by (simp add: nth_append)
  next
    case False
    then show ?thesis using that assms tau_eq_state' by simp
  qed
qed

lemma change_on_0_hyp_change:
  assumes "change_on_0 (block i t) (gap i t)"
  shows "\<sigma> i ((\<tau> i) \<triangleright> (t + 1)) \<noteq> \<sigma> i ((\<tau> i) \<triangleright> (gap i t - 1))"
  using assms hd_block init_tau_gap change_on_0_init_tau by simp

lemma change_on_1_init_tau:
  assumes "change_on_1 (block i t) (gap i t)"
  shows "(\<tau> i) \<triangleright>  (t + 1) = e_update (block i t) (gap i t) 1"
proof (intro initI')
  let ?b = "block i t" and ?k = "gap i t"
  show "e_length (e_update ?b ?k 1) = Suc (t + 1)"
    using length_block by simp
  show "(\<tau> i) x \<down>= e_nth (e_update ?b ?k 1) x" if "x < Suc (t + 1)" for x
  proof (cases "x = ?k")
    case True
    have "gap i (Suc t) = e_length ?b" and b: "block i (Suc t) = e_snoc (e_update ?b ?k 1) 0"
      using gap_Suc(2) block_Suc(2) assms by simp_all
    then have "x < e_length (block i (Suc t))" "x \<noteq> gap i (Suc t)"
      using that length_block by simp_all
    then have "\<tau> i x \<down>= e_nth (block i (Suc t)) x"
      using tau_eq_state by simp
    then show ?thesis using that assms b nth_append by (simp add: nth_append)
  next
    case False
    then show ?thesis using that assms tau_eq_state' by simp
  qed
qed

lemma change_on_1_hyp_change:
  assumes "change_on_1 (block i t) (gap i t)"
  shows "\<sigma> i ((\<tau> i) \<triangleright> (t + 1)) \<noteq> \<sigma> i ((\<tau> i) \<triangleright> (gap i t - 1))"
  using assms hd_block init_tau_gap change_on_1_init_tau by simp

lemma change_on_either_hyp_change:
  assumes "\<not> change_on_neither (block i t) (gap i t)"
  shows "\<sigma> i ((\<tau> i) \<triangleright> (t + 1)) \<noteq> \<sigma> i ((\<tau> i) \<triangleright> (gap i t - 1))"
  using assms change_on_0_hyp_change change_on_1_hyp_change by auto

lemma filled_gap_0_init_tau:
  assumes "f\<^sub>0 = (\<tau> i)((gap i t):=Some 0)"
  shows "f\<^sub>0 \<triangleright> (t + 1) = block i t"
proof (intro initI')
  show len: "e_length (block i t) = Suc (t + 1)"
    using assms length_block by auto
  show "f\<^sub>0 x \<down>= e_nth (block i t) x" if "x < Suc (t + 1)" for x
  proof (cases "x = gap i t")
    case True
    then show ?thesis using assms last_block by auto
  next
    case False
    then show ?thesis using assms len tau_eq_state that by auto
  qed
qed

lemma filled_gap_1_init_tau:
  assumes "f\<^sub>1 = (\<tau> i)((gap i t):=Some 1)"
  shows "f\<^sub>1 \<triangleright> (t + 1) = e_update (block i t) (gap i t) 1"
proof (intro initI')
  show len: "e_length (e_update (block i t) (gap i t) 1) = Suc (t + 1)"
    using e_length_update length_block by simp
  show "f\<^sub>1 x \<down>= e_nth (e_update (block i t) (gap i t) 1) x" if "x < Suc (t + 1)" for x
  proof (cases "x = gap i t")
    case True
    moreover have "gap i t < e_length (block i t)"
      using gap_in_block by simp
    ultimately show ?thesis using assms by simp
  next
    case False
    then show ?thesis using assms len tau_eq_state that by auto
  qed
qed

subsection \<open>The separating class\<close>

text \<open>Next we define the sets $V_i$ from the introductory proof sketch
(page~\pageref{s:lim_bc}).\<close>

definition V_bclim :: "nat \<Rightarrow> partial1 set" where
  "V_bclim i \<equiv>
    if case_two i
    then let k = gap i (LEAST t. \<forall>T. gap i T \<le> gap i t)
         in {(\<tau> i)(k:=Some 0), (\<tau> i)(k:=Some 1)}
    else {\<tau> i}"

lemma case_one_imp_gap_unbounded:
  assumes "case_one i"
  shows "\<exists>t. gap i t - 1 > n"
proof (induction n)
  case 0
  then show ?case
    using assms gap_gr0[of i] state_at_0(2)[of i] by (metis diff_is_0_eq gr_zeroI)
next
  case (Suc n)
  then obtain t where t: "gap i t - 1 > n"
    by auto
  moreover from assms have "\<forall>t. \<exists>T. gap i T > gap i t"
    using leI by blast
  ultimately obtain T where "gap i T > gap i t"
    by auto
  then have "gap i T - 1 > gap i t - 1"
    using gap_gr0[of i] by (simp add: Suc_le_eq diff_less_mono)
  with t have "gap i T - 1 > Suc n" by simp
  then show ?case by auto
qed

lemma case_one_imp_not_learn_lim_V:
  assumes "case_one i"
  shows "\<not> learn_lim \<phi> (V_bclim i) (\<sigma> i)"
proof -
  have V_bclim: "V_bclim i = {\<tau> i}"
    using assms V_bclim_def by (auto simp add: Let_def)
  have "\<exists>m\<^sub>1>n. \<exists>m\<^sub>2>n. (\<sigma> i) ((\<tau> i) \<triangleright> m\<^sub>1) \<noteq> (\<sigma> i) ((\<tau> i) \<triangleright> m\<^sub>2)" for n
  proof -
    obtain t where t: "gap i t - 1 > n"
      using case_one_imp_gap_unbounded[OF assms] by auto
    moreover have "\<forall>t. \<exists>T\<ge>t. \<not> change_on_neither (block i T) (gap i T)"
      using assms case_two_iff_forever_neither by blast
    ultimately obtain T where T: "T \<ge> t" "\<not> change_on_neither (block i T) (gap i T)"
      by auto
    then have "(\<sigma> i) ((\<tau> i) \<triangleright> (T + 1)) \<noteq> (\<sigma> i) ((\<tau> i) \<triangleright> (gap i T - 1))"
      using change_on_either_hyp_change by simp
    moreover have "gap i T - 1 > n"
      using t T(1) gap_monotone by (simp add: diff_le_mono less_le_trans)
    moreover have "T + 1 > n"
    proof -
      have "gap i T - 1 \<le> T"
        using gap_in_block length_block by (simp add: le_diff_conv less_Suc_eq_le)
      then show ?thesis using \<open>gap i T - 1 > n\<close> by simp
    qed
    ultimately show ?thesis by auto
  qed
  with infinite_hyp_changes_not_Lim V_bclim show ?thesis by simp
qed

lemma case_two_imp_not_learn_lim_V:
  assumes "case_two i"
  shows "\<not> learn_lim \<phi> (V_bclim i) (\<sigma> i)"
proof -
  let ?P = "\<lambda>t. \<forall>T. (gap i T) \<le> (gap i t)"
  let ?t = "LEAST t. ?P t"
  let ?k = "gap i ?t"
  let ?b = "e_take ?k (block i ?t)"
  have t: "\<forall>T. gap i T \<le> gap i ?t"
    using assms LeastI_ex[of ?P] by simp
  then have neither: "\<forall>T\<ge>?t. change_on_neither (block i T) (gap i T)"
    using gap_le_Suc gap_monotone state_change_on_neither(1)
    by (metis (no_types, lifting) antisym)
  have gap_T: "\<forall>T\<ge>?t. gap i T = ?k"
    using t gap_monotone antisym_conv by blast
  define f\<^sub>0 where "f\<^sub>0 = (\<tau> i)(?k:=Some 0)"
  define f\<^sub>1 where "f\<^sub>1 = (\<tau> i)(?k:=Some 1)"
  show ?thesis
  proof (rule same_hyp_for_two_not_Lim)
    show "f\<^sub>0 \<in> V_bclim i" and "f\<^sub>1 \<in> V_bclim i"
      using assms V_bclim_def f\<^sub>0_def f\<^sub>1_def by (simp_all add: Let_def)
    show "f\<^sub>0 \<noteq> f\<^sub>1" using f\<^sub>0_def f\<^sub>1_def by (meson map_upd_eqD1 zero_neq_one)
    show "\<forall>n\<ge>Suc ?t. \<sigma> i (f\<^sub>0 \<triangleright> n) = \<sigma> i ?b"
    proof -
      have "\<sigma> i (block i T) = \<sigma> i (e_take ?k (block i T))" if "T \<ge> ?t" for T
        using that gap_T neither hd_block by metis
      then have "\<sigma> i (block i T) = \<sigma> i ?b" if "T \<ge> ?t" for T
        by (metis (no_types, lifting) init_tau_gap gap_T that)
      then have "\<sigma> i (f\<^sub>0 \<triangleright> (T + 1)) = \<sigma> i ?b" if "T \<ge> ?t" for T
        using filled_gap_0_init_tau[of f\<^sub>0 i T] f\<^sub>0_def gap_T that
        by (metis (no_types, lifting))
      then have "\<sigma> i (f\<^sub>0 \<triangleright> T) = \<sigma> i ?b" if "T \<ge> Suc ?t" for T
        using that by (metis (no_types, lifting) Suc_eq_plus1 Suc_le_D Suc_le_mono)
      then show ?thesis by simp
    qed
    show "\<forall>n\<ge>Suc ?t. \<sigma> i (f\<^sub>1 \<triangleright> n) = \<sigma> i ?b"
    proof -
      have "\<sigma> i (e_update (block i T) ?k 1) = \<sigma> i (e_take ?k (block i T))" if "T \<ge> ?t" for T
        using neither by (metis (no_types, lifting) hd_block gap_T that)
      then have "\<sigma> i (e_update (block i T) ?k 1) = \<sigma> i ?b" if "T \<ge> ?t" for T
        using that init_tau_gap[of i] gap_T by (metis (no_types, lifting))
      then have "\<sigma> i (f\<^sub>1 \<triangleright> (T + 1)) = \<sigma> i ?b" if "T \<ge> ?t" for T
        using filled_gap_1_init_tau[of f\<^sub>1 i T] f\<^sub>1_def gap_T that
        by (metis (no_types, lifting))
      then have "\<sigma> i (f\<^sub>1 \<triangleright> T) = \<sigma> i ?b" if "T \<ge> Suc ?t" for T
        using that by (metis (no_types, lifting) Suc_eq_plus1 Suc_le_D Suc_le_mono)
      then show ?thesis by simp
    qed
  qed
qed

corollary not_learn_lim_V: "\<not> learn_lim \<phi> (V_bclim i) (\<sigma> i)"
  using case_one_imp_not_learn_lim_V case_two_imp_not_learn_lim_V
  by (cases "case_two i") simp_all

text \<open>Next we define the separating class.\<close>

definition V_BCLIM :: "partial1 set" ("V\<^bsub>BC-LIM\<^esub>") where
  "V\<^bsub>BC-LIM\<^esub> \<equiv> \<Union>i. V_bclim i"

lemma V_BCLIM_R1: "V\<^bsub>BC-LIM\<^esub> \<subseteq> \<R>"
  using V_BCLIM_def V_subseteq_R1 by auto

lemma V_BCLIM_not_in_Lim: "V\<^bsub>BC-LIM\<^esub> \<notin> LIM"
proof
  assume "V\<^bsub>BC-LIM\<^esub> \<in> LIM"
  then obtain s where s: "learn_lim \<phi> V\<^bsub>BC-LIM\<^esub> s"
    using learn_lim_wrt_goedel[OF goedel_numbering_phi] Lim_def by blast
  moreover obtain i where "\<phi> i = s"
    using s learn_limE(1) phi_universal by blast
  ultimately have "learn_lim \<phi> V\<^bsub>BC-LIM\<^esub> (\<lambda>x. eval r_sigma [i, x])"
    using learn_lim_sigma by simp
  moreover have "V_bclim i \<subseteq> V\<^bsub>BC-LIM\<^esub>"
    using V_BCLIM_def by auto
  ultimately have "learn_lim \<phi> (V_bclim i) (\<lambda>x. eval r_sigma [i, x])"
    using learn_lim_closed_subseteq by simp
  then show False
    using not_learn_lim_V by simp
qed

subsection \<open>The separating class is in BC\<close>

text \<open>In order to show @{term "V\<^bsub>BC-LIM\<^esub> \<in> BC"} we
define a hypothesis space that for every function $\tau_i$ and every list $b$
of numbers contains a copy of $\tau_i$ with the first $|b|$ values replaced
by $b$.\<close>

definition psitau :: partial2 ("\<psi>\<^sup>\<tau>") where
  "\<psi>\<^sup>\<tau> b x \<equiv> (if x < e_length b then Some (e_nth b x) else \<tau> (e_hd b) x)"

lemma psitau_in_P2: "\<psi>\<^sup>\<tau> \<in> \<P>\<^sup>2"
proof -
  define r where "r \<equiv>
    Cn 2
     (r_lifz r_nth (Cn 2 r_tau [Cn 2 r_hd [Id 2 0], Id 2 1]))
     [Cn 2 r_less [Id 2 1, Cn 2 r_length [Id 2 0]], Id 2 0, Id 2 1]"
  then have "recfn 2 r"
    using r_tau_recfn by simp
  moreover have "eval r [b, x] = \<psi>\<^sup>\<tau> b x" for b x
  proof -
    let ?f = "Cn 2 r_tau [Cn 2 r_hd [Id 2 0], Id 2 1]"
    have "recfn 2 r_nth" "recfn 2 ?f"
      using r_tau_recfn by simp_all
    then have "eval (r_lifz r_nth ?f) [c, b, x] =
        (if c = 0 then eval r_nth [b, x] else eval ?f [b, x])" for c
      by simp
    moreover have "eval r_nth [b, x] \<down>= e_nth b x"
      by simp
    moreover have "eval ?f [b, x] = \<tau> (e_hd b) x"
      using r_tau_recfn by simp
    ultimately have "eval (r_lifz r_nth ?f) [c, b, x] =
        (if c = 0 then Some (e_nth b x) else \<tau> (e_hd b) x)" for c
      by simp
    moreover have "eval (Cn 2 r_less [Id 2 1, Cn 2 r_length [Id 2 0]]) [b, x] \<down>=
        (if x < e_length b then 0 else 1)"
      by simp
    ultimately show ?thesis
      unfolding r_def psitau_def using r_tau_recfn by simp
  qed
  ultimately show ?thesis by auto
qed

lemma psitau_init:
  "\<psi>\<^sup>\<tau> (f \<triangleright> n) x = (if x < Suc n then Some (the (f x)) else \<tau> (the (f 0)) x)"
proof -
  let ?e = "f \<triangleright> n"
  have "e_length ?e = Suc n" by simp
  moreover have "x < Suc n \<Longrightarrow> e_nth ?e x = the (f x)" by simp
  moreover have "e_hd ?e = the (f 0)"
    using hd_init by simp
  ultimately show ?thesis using psitau_def by simp
qed

text \<open>The class @{term V_BCLIM} can be learned BC-style in the
hypothesis space @{term psitau} by the identity function.\<close>

lemma learn_bc_V_BCLIM: "learn_bc \<psi>\<^sup>\<tau> V\<^bsub>BC-LIM\<^esub> Some"
proof (rule learn_bcI)
  show "environment \<psi>\<^sup>\<tau> V\<^bsub>BC-LIM\<^esub> Some"
    using identity_in_R1 V_BCLIM_R1 psitau_in_P2 by auto
  show "\<exists>n\<^sub>0. \<forall>n\<ge>n\<^sub>0. \<psi>\<^sup>\<tau> (the (Some (f \<triangleright> n))) = f" if "f \<in> V\<^bsub>BC-LIM\<^esub>" for f
  proof -
    from that V_BCLIM_def obtain i where i: "f \<in> V_bclim i"
      by auto
    show ?thesis
    proof (cases "case_two i")
      case True
      let ?P = "\<lambda>t. \<forall>T. (gap i T) \<le> (gap i t)"
      let ?lmin = "LEAST t. ?P t"
      define k where "k \<equiv> gap i ?lmin"
      have V_bclim: "V_bclim i = {(\<tau> i)(k:=Some 0), (\<tau> i)(k:=Some 1)}"
        using True V_bclim_def k_def by (simp add: Let_def)
      moreover have "0 < k"
        using gap_gr0[of i] k_def by simp
      ultimately have "f 0 \<down>= i"
        using tau_at_0[of i] i by auto
      have "\<psi>\<^sup>\<tau> (f \<triangleright> n) = f" if "n \<ge> k" for n
      proof
        fix x
        show "\<psi>\<^sup>\<tau> (f \<triangleright> n) x = f x"
        proof (cases "x \<le> n")
          case True
          then show ?thesis
            using R1_imp_total1 V_subseteq_R1 i psitau_init by fastforce
        next
          case False
          then have "\<psi>\<^sup>\<tau> (f \<triangleright> n) x = \<tau> (the (f 0)) x"
            using psitau_init by simp
          then have "\<psi>\<^sup>\<tau> (f \<triangleright> n) x = \<tau> i x"
            using \<open>f 0 \<down>= i\<close> by simp
          moreover have "f x = \<tau> i x"
            using False V_bclim i that by auto
          ultimately show ?thesis by simp
        qed
      qed
      then show ?thesis by auto
    next
      case False
      then have "V_bclim i = {\<tau> i}"
        using V_bclim_def by (auto simp add: Let_def)
      then have f: "f = \<tau> i"
        using i by simp
      have "\<psi>\<^sup>\<tau> (f \<triangleright> n) = f" for n
      proof
        fix x
        show "\<psi>\<^sup>\<tau> (f \<triangleright> n) x = f x"
        proof (cases "x \<le> n")
          case True
          then show ?thesis
            using R1_imp_total1 V_BCLIM_R1 psitau_init that by auto
        next
          case False
          then show ?thesis by (simp add: f psitau_init tau_at_0)
        qed
      qed
      then show ?thesis by simp
    qed
  qed
qed

text \<open>Finally, the main result of this section:\<close>

theorem Lim_subset_BC: "LIM \<subset> BC"
  using learn_bc_V_BCLIM BC_def Lim_subseteq_BC V_BCLIM_not_in_Lim by auto

end