Theory Countable_Multiset

theory Countable_Multiset
  imports
    "HOL-Library.Countable_Set_Type"
    "HOL-Library.Extended_Nat"
    "Coinductive.Coinductive_List"
    "HOL-Library.BNF_Corec"
    Infinite_Sums_Enat
begin

section ‹Miscellaneous (Mostly About Lazy Lists)›

lemma bij_betw_singl_remap: ‹bij_betw π A B ⟹ x ∈ A ⟹ y ∈ B ⟹
  bij_betw (π(inv_into A π y := π x)) (A - {x}) (B - {y})›
  by (auto simp: bij_betw_def inj_on_def image_iff)

lemma ldropWhile_eq_LCons_iff: ‹ldropWhile P lxs = LCons x lxs' ⟷ (¬ P x ∧
  (∃xs. lxs = lappend (llist_of xs) (LCons x lxs') ∧ (∀x ∈ set xs. P x)))›
proof -
  have False
    if ‹ldropWhile P lxs = LCons x lxs'› and ‹P x›
    using that by (metis lhd_LCons lhd_ldropWhile llist.disc(2) lnull_ldropWhile)
  moreover have ‹∃xs. lxs = lappend (llist_of xs) (LCons x lxs') ∧ (∀x∈set xs. P x)›
    if ‹ldropWhile P lxs = LCons x lxs'›
    using that by (metis eq_LConsD in_lset_lappend_iff lappend_ltakeWhile_ldropWhile
        ldropWhile_eq_LNil_iff llist_of_list_of lset_llist_of lset_ltakeWhileD)
  ultimately show ?thesis
    by (auto simp: ldropWhile_lappend)
qed

lemma ltakeWhile_ldropWhile_decomp:
  assumes ‹x ∈ lset lxs›
  shows ‹lxs = lappend (ltakeWhile ((≠) x) lxs) (LCons x (ltl (ldropWhile ((≠) x) lxs)))›
proof (subst lappend_ltakeWhile_ldropWhile[symmetric, of lxs ‹(≠) x›], rule arg_cong[where f=‹lappend _›])
  from assms show ‹ldropWhile ((≠) x) lxs = LCons x (ltl (ldropWhile ((≠) x) lxs))›
    by (cases ‹ldropWhile ((≠) x) lxs›)
      (auto simp: ldropWhile_eq_LNil_iff lhd_ldropWhile[where P=‹(≠) x›, simplified, symmetric]  dest!: eq_LConsD)
qed

lemma lzip_lmap_same: ‹lzip (lmap f lxs) (lmap g lxs) = lmap (λx. (f x, g x)) lxs›
  by (coinduction arbitrary: lxs) auto

lemma llength_not_lnull: ‹¬ lnull lxs ⟹ llength lxs = eSuc (llength (ltl lxs))›
  by (auto simp: lnull_def neq_LNil_conv)

primrec ltaken :: ‹nat ⇒ 'a llist ⇒ 'a list› where
  ‹ltaken 0 lxs = []›
| ‹ltaken (Suc i) lxs = (case lxs of LNil ⇒ [] | LCons x lxs ⇒ x # ltaken i lxs)›

lemma nth_ltaken: ‹m < n ⟹ n ≤ llength lxs ⟹ nth (ltaken n lxs) m = lnth lxs m›
  by (induct n arbitrary: m lxs) (auto simp: nth_Cons' gr0_conv_Suc simp flip: eSuc_enat split: llist.splits)

lemma set_ltaken: ‹set (ltaken n lxs) ⊆ lset lxs›
  by (induct n arbitrary: lxs) (force split: llist.splits)+

lemma length_ltaken: ‹length (ltaken n lxs) = (if enat n ≤ llength lxs then n else the_enat (llength lxs))›
  by (induct n arbitrary: lxs)
    (auto simp: enat_0 min_def not_le eSuc_enat enat_0_iff eSuc_enat_iff elim!: less_enatE split: llist.splits)

lemma set_ltaken_conv: ‹n ≤ llength lxs ⟹ set (ltaken n lxs) = lnth lxs ` {0..<n}›
proof (induct n arbitrary: lxs)
  case (Suc n)
  then show ?case
    by (cases lxs)
      (force simp flip: eSuc_enat simp: image_iff lnth_LCons' dest: bspec[of _ _ ‹Suc _›])+
qed simp

lemma ltaken_lappend:
  ‹ltaken n (lappend lxs lys) = (case llength lxs of ∞ ⇒ ltaken n lxs | enat m ⇒ ltaken n lxs @ ltaken (n - m) lys)›
  by (induct n arbitrary: lxs) (auto split: enat.splits simp: enat_0_iff eSuc_enat_iff eSuc_eq_infinity_iff split: llist.splits)

lemma ltaken_LNil[simp]: ‹ltaken i LNil = []›
  by (cases i) auto


section ‹enat as a Codatatype›

codatatype en = eZ | eS (ep: en)
  where ‹ep eZ = eZ›

coinductive is_einf where
  ‹is_einf n ⟹ is_einf (eS n)›

inductive is_fin where
  ‹is_fin eZ›
| ‹is_fin n ⟹ is_fin (eS n)›

lemma not_is_fin_is_einf: ‹¬ is_fin n ⟹ is_einf n›
proof (coinduction arbitrary: n)
  case is_einf
  then show ?case
    by (cases n) (auto intro: is_fin.intros)
qed

lemma is_fin_not_is_einf: ‹is_fin n ⟹ ¬ is_einf n›
  by (induct n pred: is_fin) (auto elim: is_einf.cases)

primcorec einf where
  ‹einf = eS einf›

lemma einf_eS_iff: ‹einf = eS x ⟷ x = einf›
  by (subst einf.code) auto

lemma is_einf_einf: ‹is_einf einf›
  by (coinduction; subst einf.code) auto

lemma is_einf_eq_einf: ‹is_einf n ⟹ n = einf›
  by (coinduction arbitrary: n) (auto elim: is_einf.cases)

fun nat_to_en where
  ‹nat_to_en 0 = eZ›
| ‹nat_to_en (Suc n) = eS (nat_to_en n)›

lemma is_fin_ex_nat_to_en: ‹is_fin n ⟹ ∃m. n = nat_to_en m›
  by (induct n pred: is_fin) (auto intro: exI[of _ 0] exI[of _ ‹Suc _›])

lemma inj_nat_to_en: ‹nat_to_en x = nat_to_en y ⟹ x = y›
proof (induct x arbitrary: y)
  case 0
  then show ?case
    by (cases y; simp)
next
  case (Suc x)
  then show ?case 
    by (cases y; simp)
qed

lemma nat_to_en_not_einf: ‹nat_to_en n = einf ⟹ False›
  by (induct n; subst (asm) einf.code) auto

definition enat_to_en where
  ‹enat_to_en n = (case n of enat n ⇒ nat_to_en n | _ ⇒ einf)›

lemma inj_enat_to_en: ‹inj enat_to_en›
  by (auto simp: inj_on_def enat_to_en_def inj_nat_to_en
      intro: nat_to_en_not_einf nat_to_en_not_einf[OF sym] split: enat.splits)

lemma range_enat_to_en: ‹n ∈ range enat_to_en›
proof (cases ‹n = einf›)
  case True
  then show ?thesis by (intro image_eqI[of _ _ ∞]) (auto simp: enat_to_en_def)
next
  case False
  then have ‹is_fin n›
    using is_einf_eq_einf not_is_fin_is_einf by auto
  then obtain m where ‹n = nat_to_en m›
    using is_fin_ex_nat_to_en by blast
  then show ?thesis
    by (intro image_eqI[of _ _ ‹enat m›]) (auto simp: enat_to_en_def)
qed

lemma type_definition_enat: ‹type_definition enat_to_en (inv enat_to_en) UNIV›
  by standard (auto intro: inv_f_f f_inv_into_f inj_enat_to_en simp: range_enat_to_en)

setup_lifting type_definition_enat

lift_definition corec_enat :: ‹('a ⇒ bool) ⇒ ('a ⇒ bool) ⇒ ('a ⇒ enat) ⇒ ('a ⇒ 'a) ⇒ 'a ⇒ enat›
  is corec_en .

lemma eZ_transfer[transfer_rule]: ‹pcr_enat eZ 0›
  by (auto simp: pcr_enat_def cr_enat_def enat_to_en_def enat_0[symmetric])

lemma eS_transfer[transfer_rule]: ‹rel_fun pcr_enat pcr_enat eS eSuc›
  by (auto simp: pcr_enat_def cr_enat_def enat_to_en_def rel_fun_def eSuc_enat einf.code[symmetric]
      eq_OO split: enat.splits)

lemma ep_nat_to_en: ‹ep (nat_to_en n) = nat_to_en (n - Suc 0)›
  by (induct n) (auto)

lemma ep_transfer[transfer_rule]: ‹rel_fun pcr_enat pcr_enat ep epred›
  by (auto simp: pcr_enat_def cr_enat_def enat_to_en_def rel_fun_def eSuc_enat einf.code[symmetric]
      eq_OO ep_nat_to_en split: enat.splits)

lemma corec_enat_code[code]:
  ‹corec_enat zer stop end cnt a =
   (if zer a then 0 else eSuc (if stop a then end a else corec_enat zer stop end cnt (cnt a)))›
  by transfer (rule en.corec_code)

instantiation en :: comm_monoid_add
begin

definition zero_en where ‹zero_en = eZ›

primcorec plus_en where
  ‹plus_en e1 e2 = (case e1 of eZ ⇒ e2 | eS e1' ⇒ eS (plus_en e1' e2))›

friend_of_corec plus :: ‹en ⇒ en ⇒ en› where
  ‹e1 + e2 = (case e1 of eZ ⇒ (case e2 of eZ ⇒ eZ | eS e2' ⇒ eS e2') | eS e1' ⇒ eS (e1' + e2))›
  by (subst plus_en.code; simp split: en.splits) transfer_prover

lemma plus_einf_left[simp]: ‹einf + e = einf›
  by (coinduction arbitrary: e, subst (5) einf.code) (auto split: en.splits)

lemma eZ_left_neutral[simp]: ‹eZ + e = e›
  by (simp add: plus_en.code)
lemma eZ_right_neutral[simp]: ‹e + eZ = e›
  by (coinduction arbitrary: e) (auto split: en.splits)
lemma plus_eS_left[simp]: ‹eS e1 + e2 = eS (e1 + e2)›
  by (simp add: plus_en.code)
lemma plus_eS_right[simp]: ‹e1 + eS e2 = eS (e1 + e2)›
  by (coinduction arbitrary: e1 e2 rule: en.coinduct_strong) (auto split: en.splits)

instance
proof
  fix n m q :: en
  show ‹n + m + q = n + (m + q)›
    by (coinduction arbitrary: n m q rule: en.coinduct_strong)
      (force split: en.splits intro: exI[of _ eZ] exI[of _ ‹eS _›])
  show ‹n + m = m + n›
    by (coinduction arbitrary: n m rule: en.coinduct_strong)
      (force split: en.splits intro: exI[of _ ‹eS _›])
  show ‹0 + n = n›
    by (coinduction arbitrary: n) (auto simp: zero_en_def split: en.splits)
qed

end

lemma plus_einf_right[simp]: ‹e + einf = einf›
  by (simp add: add.commute)

lemma nat_to_en_plus[simp]: ‹nat_to_en (m + n) = nat_to_en m + nat_to_en n›
  by (induct m) auto

lemma ezero_transfer[transfer_rule]: ‹pcr_enat 0 0›
  by (auto simp: zero_en_def eZ_transfer)

lemma eplus_transfer[transfer_rule]: ‹rel_fun pcr_enat (rel_fun pcr_enat pcr_enat) (+) (+)›
  by (auto simp: pcr_enat_def cr_enat_def enat_to_en_def rel_fun_def eSuc_enat einf.code[symmetric]
      eq_OO ep_nat_to_en split: enat.splits)

lemma case_en_transfer[transfer_rule]: ‹rel_fun R (rel_fun (rel_fun pcr_enat R) (rel_fun pcr_enat R)) case_en co.case_enat›
  by (auto simp: pcr_enat_def cr_enat_def enat_to_en_def rel_fun_def eSuc_enat einf.code[symmetric]
      eq_OO ep_nat_to_en enat_0_iff enat_eSuc_iff infinity_eq_eSuc_iff einf_eS_iff split: enat.splits en.splits co.enat.splits)

corec lsum_en where
  ‹lsum_en lxs = (case ldropWhile ((=) 0) lxs of LNil ⇒ 0 | LCons e lxs ⇒ eS (ep e + lsum_en lxs))›

lift_definition lsum :: ‹enat llist ⇒ enat›
  is lsum_en .

lemmas lsum_code[code] = lsum_en.code[transferred]

lemma lsum_code_alt:
  ‹lsum lxs = (case ldropWhile ((=) 0) lxs of LNil ⇒ 0 | LCons e lxs ⇒ e + lsum lxs)›
  by (subst lsum_code, cases ‹lhd (ldropWhile ((=) 0) lxs)› rule: co.enat.exhaust)
    (auto simp: iadd_Suc dest: ldropWhile_eq_LCons_iff[THEN iffD1] split: llist.splits)

section ‹Counting in Lazy Lists›

primcorec count_llist_en where
  ‹count_llist_en lxs x  = (if x ∈ lset lxs then eS (count_llist_en (ltl (ldropWhile ((≠) x) lxs)) x) else eZ)›

lift_definition count_llist :: ‹'a llist ⇒ 'a ⇒ enat›
  is count_llist_en .

lemmas count_llist_code[code] = count_llist_en.code[transferred]
lemmas count_llist_sel[simp] = count_llist_en.sel[transferred]
lemmas count_llist_ctr = count_llist_en.ctr[transferred]
lemmas enat_coinduct_strong[case_names eq_enat, coinduct type] = en.coinduct_strong[transferred]

lift_definition enat_cong :: ‹(enat ⇒ enat ⇒ bool) ⇒ enat ⇒ enat ⇒ bool› is ‹en.congclp› .
lemmas enat_coinduct_upto[case_names eq_enat] = en.coinduct_upto[transferred]
lemmas enat_cong_intros = en.cong_intros[transferred]

lifting_update enat.lifting
lifting_forget enat.lifting

lemma in_lset_iff_count_llist: ‹x ∈ lset lxs ⟷ count_llist lxs x ≠ 0›
  by (subst count_llist_code) auto

lemma count_llist_zero_iff:  ‹count_llist lxs x = 0 ⟷ x ∉ lset lxs›
  by (metis in_lset_iff_count_llist)

lemma count_llist_alt: ‹count_llist lxs x = llength (lfilter ((=) x) lxs)›
  by (coinduction arbitrary: lxs) (auto simp: count_llist_zero_iff epred_llength ltl_lfilter)

lemma count_llist_lappend: 
  ‹count_llist (lappend lxs lys) x = count_llist lxs x + (if lfinite lxs then count_llist lys x else 0)›
proof (coinduction arbitrary: lxs lys)
  case eq_enat
  then show ?case
    by (auto simp: count_llist_zero_iff epred_iadd1 lset_lappend_conv lappend_inf ldropWhile_lappend
        lfinite_ldropWhile count_llist_ctr(1)[of x lxs])
qed

lemma count_llist_LNil[simp]: ‹count_llist LNil x = 0›
  by (subst count_llist_code) auto

lemma count_llist_LCons[simp]: ‹count_llist (LCons y lxs) x = 
  (if x = y then eSuc (count_llist lxs x) else count_llist lxs x)›
  by (subst (1 3) count_llist_code) (auto simp: count_llist_zero_iff)

section ‹Lazy Lists of Natural Numbers›

primcorec lupt where
  ‹lupt i j = (if enat i ≥ j then LNil else LCons i (lupt (Suc i) j))›

lemma lset_luptD[OF _ refl]:
  assumes ‹k ∈ lset lxs› ‹lxs = lupt i j›
  shows ‹i ≤ k› ‹k < j›
  using assms
proof (induct k lxs arbitrary: i rule: llist.set_induct)
  case (LCons1 z1 z2)
  {
    case 1
    then show ?case
      by (subst (asm) lupt.code) (auto split: if_splits)
  next
    case 2
    then show ?case
      by (subst (asm) lupt.code) (auto split: if_splits)
  }
next
  case (LCons2 z1 z2 k)
  {
    case 1
    with LCons2(2,3)[of ‹Suc i›] show ?case
      by (subst (asm) (3) lupt.code) (auto split: if_splits)
  next
    case 2
    with LCons2(2,3)[of ‹Suc i›] show ?case
      by (subst (asm) (3) lupt.code) (auto split: if_splits)
  }
qed

lemma lset_luptI: ‹i ≤ k ⟹ enat k < j ⟹ k ∈ lset (lupt i j)›
proof (induct ‹k - i› arbitrary: i)
  case 0
  then show ?case
    by (subst lupt.code) auto
next
  case (Suc x)
  then have ‹enat i < j›
    by (meson enat_ord_simps(1) order.strict_trans1)
  from Suc(2) have ‹x = k - Suc i›
    by force
  with Suc(1)[OF this] Suc(2-4) ‹enat i < j› show ?case
    by (subst lupt.code) (auto simp: Suc_le_eq)
qed

lemma lset_lupt: ‹lset (lupt i j) = {k. i ≤ k ∧ enat k < j}›
  by (auto intro: lset_luptI dest: lset_luptD)

lemma llength_lupt[simp]: ‹llength (lupt i j) = j - i›
proof (coinduction arbitrary: i)
  case eq_enat
  then show ?case
  proof (cases j)
    case (enat nat)
    then show ?thesis
      by (subst (3) lupt.code) (auto simp: enat_0 enat_0_iff)
  next
    case infinity
    then show ?thesis
      by (subst (3) lupt.code) auto
  qed
qed

lemma lnth_lupt: ‹k < j - enat i ⟹ lnth (lupt i j) k = i + k›
proof (induct k arbitrary: i)
  case 0
  then show ?case by (cases j) (auto simp add: lnth_0_conv_lhd)
next
  case (Suc k)
  from Suc(2) have ‹enat k < j - Suc i›
    by (cases j) auto
  with Suc(1)[OF this] Suc(2) show ?case
    by (subst lupt.code; cases j) auto
qed

lemma lmap_lupt_Suc: ‹lmap f (lupt (Suc i) (eSuc j)) = lmap (f o Suc) (lupt i j)›
  by (coinduction arbitrary: i j) (auto simp: eSuc_def split: enat.splits)

lemma llist_conv_lmap_lupt:
  ‹lxs = lmap (lnth lxs) (lupt 0 (llength lxs))›
  by (coinduction arbitrary: lxs)
    (auto simp: enat_0 lnth_0_conv_lhd llength_not_lnull lmap_lupt_Suc lnth_ltl)

lemma ldistinct_lupt[simp]: ‹ldistinct (lupt i j)›
  by (coinduction arbitrary: i) (auto simp: lset_lupt)

lemma lzip_lupt: ‹lzip (lupt i j) (lupt i k) = lmap (λx. (x, x)) (lupt i (min j k))›
  by (coinduction arbitrary: i) (auto simp: min_def)

section ‹Permutations of Lazy Lists›

definition ‹lpermute π lxs = lmap (λi. lnth lxs (π i)) (lupt 0 (llength lxs))›

abbreviation ‹lbij_on π lxs ≡ bij_betw π {k. enat k < llength lxs} {k. enat k < llength lxs}›

lemma lset_lpermute:
  assumes ‹lbij_on π lxs›
  shows ‹lset (lpermute π lxs) = lset lxs›
proof -
  have ‹∃m. lnth lxs n = lnth (lmap (λi. lnth lxs (π i)) (lupt 0 (llength lxs))) m ∧ enat m < llength lxs›
    if ‹enat n < llength lxs›
    for n :: nat
    using that assms bij_betw_inv_into_right[OF assms, of n]
    by (intro exI[of _ ‹inv_into {k. enat k < llength lxs} π n›])
      (auto 0 3 simp: lnth_lupt elim: bij_betwE[OF bij_betw_inv_into, THEN bspec, elim_format])
  with assms show ?thesis
    by (auto 0 3 simp: lpermute_def image_iff lset_lupt lset_conv_lnth lnth_lupt dest: bij_betwE)
qed

lemma llength_lpermute[simp]: ‹llength (lpermute π lxs) = llength lxs›
  by (auto simp: lpermute_def)

lemma lnth_lpermute[simp]: ‹lbij_on π lxs ⟹ i < llength lxs ⟹ lnth (lpermute π lxs) i = lnth lxs (π i)›
  by (simp add: lnth_lupt lpermute_def)

lemma lfilter_permute: ‹ldistinct lxs ⟹ ldistinct lys ⟹ bij_betw π (lset lxs) (lset lys) ⟹ ∀x ∈ lset lxs. P x ⟷ Q (π x) ⟹
  llength (lfilter P lxs) = llength (lfilter Q lys)›
proof (coinduction arbitrary: lxs lys π)
  case eq_enat
  then have ‹llength (lfilter P lxs) = 0 ⟷ llength (lfilter Q lys) = 0›
    by (force simp: bij_betw_iff_bijections)
  moreover
  { assume *: ‹llength (lfilter P lxs) ≠ 0› ‹llength (lfilter Q lys) ≠ 0›
    then have lfin[unfolded comp_def, simp]: ‹lfinite (ltakeWhile (Not o P) lxs)› ‹lfinite (ltakeWhile (Not o Q) lys)›
      by (simp_all add: lfinite_ltakeWhile)
    let ?lxs = ‹lappend (ltakeWhile (Not o P) lxs) (ltl (ldropWhile (Not o P) lxs))›
    let ?lys = ‹lappend (ltakeWhile (Not o Q) lys) (ltl (ldropWhile (Not o Q) lys))›
    define x where ‹x = lhd (ldropWhile (Not o P) lxs)›
    with *(1) have ‹P x› using lhd_ldropWhile by force
    from *(1) have ‹x ∈ lset lxs› unfolding x_def
      by (metis in_lset_ldropWhileD lfilter_eq_LCons lhd_lfilter llength_eq_0 llist.exhaust_sel llist.set_intros(1) llist.set_sel(1))
    define y where ‹y = lhd (ldropWhile (Not o Q) lys)›
    with *(2) have ‹Q y› using lhd_ldropWhile by force
    from *(2) have ‹y ∈ lset lys› unfolding y_def
      by (metis in_lset_ldropWhileD lfilter_eq_LCons lhd_lfilter llength_eq_0 llist.exhaust_sel llist.set_intros(1) llist.set_sel(1))
    let ?π = ‹π(inv_into (lset lxs) π y := π x)›
    have
      ‹epred (llength (lfilter P lxs)) = llength (lfilter P ?lxs)›
      ‹epred (llength (lfilter Q lys)) = llength (lfilter Q ?lys)›
      by (auto simp add: epred_llength ltl_lfilter dest: lset_ltakeWhileD)
    moreover from eq_enat(1,2)
      lappend_ltakeWhile_ldropWhile[symmetric, of lxs ‹Not o P›, THEN arg_cong, of ldistinct, THEN iffD1, OF eq_enat(1)]
      lappend_ltakeWhile_ldropWhile[symmetric, of lys ‹Not o Q›, THEN arg_cong, of ldistinct, THEN iffD1, OF eq_enat(2)]
    have ‹ldistinct ?lxs› ‹ldistinct ?lys›
      by (auto simp add: ldistinct_lappend ldistinct_ldrop ldistinct_ltlI
          ldistinct_lprefix lprefix_ltakeWhile ldropWhile_eq_ldrop dest!: in_lset_ltlD)
    moreover
    have ‹lxs = lappend (ltakeWhile (Not ∘ P) lxs) (LCons x (ltl (ldropWhile (Not ∘ P) lxs)))›
      ‹lys = lappend (ltakeWhile (Not ∘ Q) lys) (LCons y (ltl (ldropWhile (Not ∘ Q) lys)))›
      using *(1,2) x_def y_def by force+
    with ‹P x› ‹x ∈ lset lxs› ‹Q y› ‹y ∈ lset lys›  eq_enat(1,2)
    have ‹lset ?lxs = lset lxs - {x}› ‹lset ?lys = lset lys - {y}›
      by (smt (verit, ccfv_SIG) Diff_insert_absorb Un_insert_right comp_eq_dest_lhs lset_ltakeWhileD
          in_lset_lappend_iff ldistinct_LCons ldistinct_lappend lset_LCons lset_lappend_conv)+
    with eq_enat(3,4) ‹x ∈ lset lxs› ‹y ∈ lset lys› have ‹bij_betw ?π (lset ?lxs) (lset ?lys)›
      by (auto elim!: bij_betw_singl_remap)
    moreover from eq_enat(4) ‹P x› ‹Q y› ‹x ∈ lset lxs› ‹y ∈ lset lys› have ‹∀x ∈ lset ?lxs. P x ⟷ Q (?π x)›
      using bij_betw_inv_into_right[OF eq_enat(3), of y]
      by (auto simp: in_lset_lappend_iff lhd_ldropWhile_in_lset
          dest!: lset_ltakeWhileD in_lset_ldropWhileD in_lset_ltlD)
    note * = calculation this
  }
  ultimately show ?case
    by blast
qed

lemma count_llist_lpermute:
  ‹lbij_on π lxs ⟹ count_llist (lpermute π lxs) x = count_llist lxs x›
  unfolding count_llist_alt
  by (subst (2) llist_conv_lmap_lupt[of lxs]) (auto simp: lpermute_def lfilter_lmap lset_lupt
      lfilter_permute[of ‹lupt 0 (llength lxs)› ‹lupt 0 (llength lxs)› π ‹λi. x = lnth lxs (π i)› ‹λi. x = lnth lxs i›])

lemma lpermute_lzip: ‹lbij_on π lxs ⟹ llength lys = llength lxs ⟹ lpermute π (lzip lxs lys) = lzip (lpermute π lxs) (lpermute π lys)›
  by (auto simp: lpermute_def lzip_lmap_same lzip_lupt llist.map_comp lset_lupt lnth_lzip bij_betw_iff_bijections intro!: llist.map_cong)

lemma exist_nth_occurrence_in_llist:
  ‹count_llist lxs x > n ⟹ ∃i < llength lxs. lnth lxs i = x ∧ count_list (ltaken i lxs) x = n›
proof (induct n arbitrary: lxs)
  case 0
  then have ex: ‹∃i < llength lxs. lnth lxs i = x›
    by (metis in_lset_conv_lnth in_lset_iff_count_llist not_gr_zero zero_enat_def)
  define i where ‹i = (LEAST i. enat i < llength lxs ∧ lnth lxs i = x)›
  have i: ‹enat i < llength lxs› ‹lnth lxs i = x›
    ‹⋀j. enat j < llength lxs ⟹ lnth lxs j = x ⟹ i ≤ j›
    unfolding i_def using LeastI2_wellorder_ex[OF ex]
    by (force simp: Least_le)+
  moreover have ‹lnth lxs i = lnth lxs j ⟹ j < i ⟹ False› for j
    using i by (metis order.strict_trans enat_ord_simps(2) less_le_not_le)
  ultimately show ?case
    by (force simp: count_list_0_iff set_ltaken_conv intro!: exI[of _ i])
next
  case (Suc n)
  let ?lxs = ‹ltl (ldropWhile ((≠) x) lxs)›
  from Suc(2) have ‹enat n < count_llist ?lxs x›
    by (metis Suc_ile_eq count_llist_code iless_Suc_eq not_less_zero)
  with Suc(1) obtain i where i: ‹enat i < llength ?lxs›
    ‹lnth ?lxs i = x› ‹count_list (ltaken i ?lxs) x = n›
    by blast
  from Suc(2) obtain k where k: ‹llength (ltakeWhile ((≠) x) lxs) = enat k›
    by (metis (full_types) enat_the_enat in_lset_iff_count_llist llength_ltakeWhile_eq_infinity
        lset_ltakeWhileD not_less_zero)
  then have klen: ‹enat k < llength lxs›
    by (metis gr_implies_not_zero i(1) ldropWhile_eq_ldrop ldrop_eq_LNil llength_LNil
        lprefix_llength_le lprefix_ltakeWhile ltl_simps(1) order_neq_le_trans)
  let ?i = ‹k + Suc i›
  have lxs: ‹lxs = lappend (ltakeWhile ((≠) x) lxs) (LCons x ?lxs)›
    by (metis Suc(2) in_lset_iff_count_llist ltakeWhile_ldropWhile_decomp not_less_zero)
  have ‹enat ?i < llength lxs›
    by (subst lxs) (metis eSuc_enat enat_less_enat_plusI2 i(1) ileI1 iless_Suc_eq k llength_LCons
        llength_lappend)
  moreover from k i(2) have ‹lnth lxs ?i = x›
    by (subst lxs) (auto simp: lnth_lappend)
  moreover have x: ‹x ∉ lset (ltakeWhile ((≠) x) lxs)›
    by (metis (full_types) lset_ltakeWhileD)
  with k llength_ltakeWhile_le[of ‹(≠) x› lxs] have ‹x ∉ set (ltaken k lxs)›
    by (subst set_ltaken_conv) (auto simp: in_lset_conv_lnth ltakeWhile_nth)
  with k klen i(3) x have ‹count_list (ltaken ?i lxs) x = Suc n›
    using [[simproc del: list_to_set_comprehension]]
    by (subst lxs) (auto simp: ltaken_lappend dest!: set_mp[OF set_ltaken] intro!: count_notin split: llist.splits)
  ultimately show ?case by blast
qed

function lfind_index where
  ‹lfind_index n x i lxs = (if count_llist lxs x ≤ enat n then i else
    if lhd lxs = x then case n of 0 ⇒ i | Suc m ⇒ lfind_index m x (Suc i) (ltl lxs)
    else lfind_index n x (Suc i) (ltl lxs))›
  by auto
termination
proof (relation ‹measure (λ(n, x, _, lxs). LEAST i. enat i < llength lxs ∧ lnth lxs i = x ∧ count_list (ltaken i lxs) x = n)›)
  fix n x i and lxs :: ‹'a llist› and m
  assume hlt: ‹¬ count_llist lxs x ≤ enat n›
  assume hlhd: ‹lhd lxs = x›
  assume hn: ‹n = Suc m›
  let ?PP = ‹λx lxs k n. enat k < llength lxs ∧ lnth lxs k = x ∧ count_list (ltaken k lxs) x = n›
  let ?P = ‹?PP x›
  from hlt hn have hcount: ‹enat (Suc m) < count_llist lxs x›
    by (simp add: not_le)
  obtain j where hj1: ‹enat j < llength lxs› and hj2: ‹lnth lxs j = x›
      and hj3: ‹enat (count_list (ltaken j lxs) x) = enat (Suc m)›
    using exist_nth_occurrence_in_llist[OF hcount] by blast
  have hj3': ‹count_list (ltaken j lxs) x = Suc m›
    using hj3 by simp
  have rhs_eq: ‹(LEAST k. ?P lxs k (Suc m)) = Suc (LEAST k. ?P lxs (Suc k) (Suc m))›
  proof (rule Least_Suc)
    show ‹?P lxs j (Suc m)›
      using hj1 hj2 hj3' by simp
    show ‹¬ ?P lxs 0 (Suc m)›
      by simp
  qed
  have lhs_eq: ‹(LEAST k. ?P (ltl lxs) k m) = (LEAST k. ?P lxs (Suc k) (Suc m))›
    using hlhd by (cases lxs) (auto simp: Suc_ile_eq lnth_LCons' fun_eq_iff gr0_conv_Suc)
  have key2: ‹(LEAST k. ?P lxs k (Suc m)) = Suc (LEAST k. ?P (ltl lxs) k m)›
    using rhs_eq lhs_eq by simp
  show ‹((m, x, Suc i, ltl lxs), n, x, i, lxs) ∈ measure (λ(n, x, _, lxs). LEAST i. ?PP x lxs i n)›
    by (simp add: hn key2)
next
  fix n x i and lxs :: ‹'a llist›
  assume hlt: ‹¬ count_llist lxs x ≤ enat n›
  assume hlhd: ‹lhd lxs ≠ x›
  let ?PP = ‹λx lxs k n. enat k < llength lxs ∧ lnth lxs k = x ∧ count_list (ltaken k lxs) x = n›
  let ?P = ‹?PP x›
  from hlt have hcount: ‹enat n < count_llist lxs x›
    by (simp add: not_le)
  obtain j where hj1: ‹enat j < llength lxs› and hj2: ‹lnth lxs j = x›
      and hj3: ‹enat (count_list (ltaken j lxs) x) = enat n›
    using exist_nth_occurrence_in_llist[OF hcount] by blast
  have hj3': ‹count_list (ltaken j lxs) x = n›
    using hj3 by simp
  have rhs_eq: ‹(LEAST k. ?P lxs k n) = Suc (LEAST k. ?P lxs (Suc k) n)›
  proof (rule Least_Suc)
    show ‹?P lxs j n›
      using hj1 hj2 hj3' by simp
    show ‹¬ ?P lxs 0 n›
      using hlhd by (cases lxs) (auto simp: lhd_conv_lnth enat_0)
  qed
  have lhs_eq: ‹(LEAST k. ?P (ltl lxs) k n) = (LEAST k. ?P lxs (Suc k) n)›
    using hlhd by (cases lxs) (auto simp: Suc_ile_eq lnth_LCons' fun_eq_iff gr0_conv_Suc)
  show ‹((n, x, Suc i, ltl lxs), n, x, i, lxs) ∈ measure (λ(n, x, _, lxs). LEAST i. ?PP x lxs i n)›
    by (simp add: lhs_eq rhs_eq less_Suc_eq_le)
qed simp
declare lfind_index.simps[simp del]

lemma lfind_index_ge[simp]: ‹lfind_index n x j lxs ≥ j›
proof (induct n x j lxs rule: lfind_index.induct)
  case (1 n x i lxs)
  then show ?case 
    by (subst lfind_index.simps) (auto dest: Suc_leD split: nat.splits)
qed

lemma lfind_index_less[simp]: ‹count_llist lxs x > enat n ⟹ lfind_index n x j lxs < llength lxs + j›
proof (induct n x j lxs rule: lfind_index.induct)
  case (1 n x i lxs)
  then show ?case 
    by (subst lfind_index.simps; cases lxs)
      (auto split: nat.splits simp: enat_0 count_llist_zero_iff Suc_ile_eq eSuc_plus iadd_Suc_right
        simp flip: eSuc_enat)
qed

lemma lfind_index_lnth:
  ‹count_llist lxs x > enat n ⟹ lnth lxs (lfind_index n x j lxs - j) = x›
proof (induct n x j lxs rule: lfind_index.induct)
  case (1 n x i lxs)
  show ?case
  proof -
    note IH1 = 1(1)
    note IH2 = 1(2)
    from 1(3) have hcount: ‹enat n < count_llist lxs x› by simp
    have hlt: ‹¬ count_llist lxs x ≤ enat n› using hcount by simp
    obtain h t where hlxs: ‹lxs = LCons h t›
      using hcount by (cases lxs) (auto simp: count_llist_zero_iff)
    have step1: ‹lfind_index n x i lxs =
      (if lhd lxs = x then case n of 0 ⇒ i | Suc m ⇒ lfind_index m x (Suc i) (ltl lxs)
       else lfind_index n x (Suc i) (ltl lxs))›
      by (subst lfind_index.simps) (simp add: hlt)
    show ?thesis
    proof (cases ‹h = x›)
      case hx: True
      show ?thesis
      proof (cases n)
        case 0
        with hx hlxs hlt step1 show ?thesis by simp
      next
        case (Suc m)
        have cnt_t: ‹enat m < count_llist t x›
          using hcount hlxs hx Suc by (simp add: Suc_ile_eq)
        have ih: ‹lnth t (lfind_index m x (Suc i) t - Suc i) = x›
          using IH1[of m] hlt hlxs hx Suc cnt_t by simp
        have ‹Suc i ≤ lfind_index m x (Suc i) t› by simp
        then have ‹¬ lfind_index m x (Suc i) t ≤ i› by linarith
        then show ?thesis
          using ih hx hlxs Suc step1 by (simp add: lnth_LCons')
      qed
    next
      case hx: False
      have cnt_t: ‹enat n < count_llist t x›
        using hcount hlxs hx by simp
      have ih: ‹lnth t (lfind_index n x (Suc i) t - Suc i) = x›
        using IH2 hlt hlxs hx cnt_t by simp
      have ‹Suc i ≤ lfind_index n x (Suc i) t› by simp
      then have ‹¬ lfind_index n x (Suc i) t ≤ i› by linarith
      then show ?thesis
        using ih hx hlxs step1 by (simp add: lnth_LCons')
    qed
  qed
qed

lemma ltaken_LCons:
  ‹ltaken i (LCons x lxs) = (case i of 0 ⇒ [] | Suc j ⇒ x # ltaken j lxs)›
  by (cases i; simp)

lemma lfind_index_count_list:
  ‹count_llist lxs x > n ⟹ count_list (ltaken (lfind_index n x j lxs - j) lxs) x = n›
proof (induct n x j lxs rule: lfind_index.induct)
  case (1 n x i lxs)
  show ?case
  proof -
    note IH1 = 1(1)
    note IH2 = 1(2)
    from 1(3) have hcount: ‹enat n < count_llist lxs x› by simp
    have hlt: ‹¬ count_llist lxs x ≤ enat n› using hcount by simp
    obtain h t where hlxs: ‹lxs = LCons h t›
      using hcount by (cases lxs) (auto simp: count_llist_zero_iff)
    have step1: ‹lfind_index n x i lxs =
      (if lhd lxs = x then case n of 0 ⇒ i | Suc m ⇒ lfind_index m x (Suc i) (ltl lxs)
       else lfind_index n x (Suc i) (ltl lxs))›
      by (subst lfind_index.simps) (simp add: hlt)
    show ?thesis
    proof (cases ‹h = x›)
      case hx: True
      show ?thesis
      proof (cases n)
        case 0
        with hx hlxs step1 show ?thesis by (simp add: ltaken_LCons)
      next
        case (Suc m)
        have cnt_t: ‹enat m < count_llist t x›
          using hcount hlxs hx Suc by (simp add: Suc_ile_eq)
        have ih: ‹count_list (ltaken (lfind_index m x (Suc i) t - Suc i) t) x = m›
          using IH1[of m] hlt hlxs hx Suc cnt_t by simp
        have ge: ‹Suc i ≤ lfind_index m x (Suc i) t› by simp
        have nle: ‹¬ lfind_index m x (Suc i) t ≤ i› using ge by linarith
        have diff_eq: ‹lfind_index m x (Suc i) t - i = Suc (lfind_index m x (Suc i) t - Suc i)›
          using ge by arith
        show ?thesis
          using ih nle hx hlxs Suc step1 diff_eq by (simp add: ltaken_LCons)
      qed
    next
      case hx: False
      have cnt_t: ‹enat n < count_llist t x›
        using hcount hlxs hx by simp
      have ih: ‹count_list (ltaken (lfind_index n x (Suc i) t - Suc i) t) x = n›
        using IH2 hlt hlxs hx cnt_t by simp
      have ge: ‹Suc i ≤ lfind_index n x (Suc i) t› by simp
      have nle: ‹¬ lfind_index n x (Suc i) t ≤ i› using ge by linarith
      have diff_eq: ‹lfind_index n x (Suc i) t - i = Suc (lfind_index n x (Suc i) t - Suc i)›
        using ge by arith
      show ?thesis
        using ih nle hx hlxs step1 diff_eq by (simp add: ltaken_LCons)
    qed
  qed
qed

lemma lnth_equalityI: ‹llength lxs = llength lys ⟹ (⋀i. enat i < llength lxs ⟹ lnth lxs i = lnth lys i) ⟹ lxs = lys›
  by (metis (full_types) llist.rel_eq llist_all2_all_lnthI)

lemma lfind_index_inject:
  ‹count_llist lxs x > enat n ⟹ count_llist lxs y > enat m ⟹
   lfind_index n x j lxs = lfind_index m y j lxs ⟹ n = m ∧ x = y›
  by (metis lfind_index_count_list lfind_index_lnth)

lemma count_list_ltaken_less:
  ‹i < llength lxs ⟹ count_list (ltaken i lxs) (lnth lxs i) < count_llist lxs (lnth lxs i)›
proof (induct i arbitrary: lxs)
  case 0
  then show ?case
    by (auto simp: enat_0 count_llist_zero_iff lnth_0_conv_lhd)
next
  case (Suc i)
  then show ?case
    by (cases lxs) (auto simp flip: eSuc_enat)
qed

lemma count_list_inject:
  ‹enat i < llength lxs ⟹ enat j < llength lxs ⟹
  count_list (ltaken i lxs) (lnth lxs j) = count_list (ltaken j lxs) (lnth lxs j) ⟹
  lnth lxs i = lnth lxs j ⟹ i = j›
  by (induct i arbitrary: j lxs)
    (auto simp: count_list_0_iff set_ltaken_conv image_iff ltaken_LCons Suc_ile_eq Ball_def split: llist.splits if_splits nat.splits)

section ‹Same-Count Equivalence Relation›

definition ‹eq_cmset lxs lys = (∀x. count_llist lxs x = count_llist lys x)›

lemma lset_eq_cmset: ‹eq_cmset lxs lys ⟹ lset lxs = lset lys›
  by (auto simp: eq_cmset_def in_lset_iff_count_llist)

lemma eq_cmset_llength: ‹eq_cmset lxs lys ⟹ llength lxs = llength lys›
  unfolding eq_cmset_def
proof (coinduction arbitrary: lxs lys)
  case eq_enat
  then have heq: ‹∀x. count_llist lxs x = count_llist lys x› by blast
  have lnull_iff: ‹lnull lxs ⟷ lnull lys›
    using heq by (auto simp: lnull_def count_llist_zero_iff)
  show ?case
  proof (cases ‹lnull lxs›)
    case True
    then show ?thesis using lnull_iff by (auto simp: epred_llength)
  next
    case lxs_ne: False
    then obtain h t where hlxs: ‹lxs = LCons h t› by (cases lxs) auto
    from lnull_iff lxs_ne have ‹¬ lnull lys› by simp
    then have h_in_lys: ‹h ∈ lset lys›
    proof -
      have hpos: ‹0 < count_llist lxs h› by (simp add: hlxs)
      have ‹0 < count_llist lys h› using heq hpos by simp
      then show ?thesis by (simp add: in_lset_iff_count_llist)
    qed
    let ?lys' = ‹lappend (ltakeWhile ((≠) h) lys) (ltl (ldropWhile ((≠) h) lys))›
    have lys_decomp: ‹lys = lappend (ltakeWhile ((≠) h) lys) (LCons h (ltl (ldropWhile ((≠) h) lys)))›
      using h_in_lys by (metis ltakeWhile_ldropWhile_decomp)
    have epred_lxs: ‹epred (llength lxs) = llength t›
      by (simp add: hlxs epred_llength)
    have epred_lys: ‹epred (llength lys) = llength ?lys'›
      by (subst lys_decomp) (simp add: iadd_Suc_right)
    have lfinite_take: ‹lfinite (ltakeWhile ((≠) h) lys)›
      by (simp add: lfinite_ltakeWhile) (use h_in_lys in blast)
    have h_not_in_take: ‹count_llist (ltakeWhile ((≠) h) lys) h = 0›
      by (force simp: count_llist_zero_iff dest: lset_ltakeWhileD)
    have heq': ‹∀x. count_llist t x = count_llist ?lys' x›
    proof
      fix x
      have hx: ‹count_llist (LCons h t) x = count_llist lys x›
        using heq hlxs by blast
      have lys_x: ‹count_llist lys x =
          count_llist (ltakeWhile ((≠) h) lys) x +
          count_llist (LCons h (ltl (ldropWhile ((≠) h) lys))) x›
        by (subst lys_decomp) (simp add: count_llist_lappend lfinite_take)
      show ‹count_llist t x = count_llist ?lys' x›
        using hx lys_x h_not_in_take lfinite_take
        by (simp add: count_llist_lappend split: if_splits)
    qed
    show ?thesis
      using lnull_iff epred_lxs epred_lys heq'
      using llength_eq_0 by blast
  qed
qed

lemma eq_cmset_alt: ‹eq_cmset lxs' lxs ⟷ (∃π. lbij_on π lxs ∧ lpermute π lxs = lxs')›
proof
  assume h: ‹∃π. lbij_on π lxs ∧ lpermute π lxs = lxs'›
  then obtain π where hπ: ‹lbij_on π lxs› ‹lpermute π lxs = lxs'› by blast
  then show ‹eq_cmset lxs' lxs›
    unfolding eq_cmset_def by (auto simp: count_llist_lpermute fun_eq_iff)
next
  assume h: ‹eq_cmset lxs' lxs›
  then have hlen: ‹llength lxs = llength lxs'›
    using eq_cmset_llength[of lxs' lxs, symmetric] by blast
  then have hcount: ‹∀x. count_llist lxs' x = count_llist lxs x›
    using h unfolding eq_cmset_def by (auto simp: fun_eq_iff)
  define f where ‹f = (λi. let x = lnth lxs' i in lfind_index (count_list (ltaken i lxs') x) x 0 lxs)›
  have hgt: ‹⋀i. enat i < llength lxs ⟹
      enat (count_list (ltaken i lxs') (lnth lxs' i)) < count_llist lxs (lnth lxs' i)›
    using hlen hcount by (metis count_list_ltaken_less)
  show ‹∃π. lbij_on π lxs ∧ lpermute π lxs = lxs'›
  proof (intro exI[of _ f] conjI)
    show ‹lbij_on f lxs›
    proof (rule bij_betwI'[where f = f and X = ‹{k. enat k < llength lxs}› and Y = ‹{k. enat k < llength lxs}›])
      fix i j
      assume hi: ‹i ∈ {k. enat k < llength lxs}› and hj: ‹j ∈ {k. enat k < llength lxs}›
      show ‹(f i = f j) = (i = j)›
      proof
        assume hfij: ‹f i = f j›
        have hi': ‹enat (count_list (ltaken i lxs') (lnth lxs' i)) < count_llist lxs (lnth lxs' i)›
          using hgt hi by simp
        have hj': ‹enat (count_list (ltaken j lxs') (lnth lxs' j)) < count_llist lxs (lnth lxs' j)›
          using hgt hj by simp
        have heq: ‹lfind_index (count_list (ltaken i lxs') (lnth lxs' i)) (lnth lxs' i) 0 lxs =
                   lfind_index (count_list (ltaken j lxs') (lnth lxs' j)) (lnth lxs' j) 0 lxs›
          using hfij unfolding f_def Let_def by simp
        from lfind_index_inject[OF hi' hj' heq]
        have heqx: ‹lnth lxs' i = lnth lxs' j›
          and heqn: ‹count_list (ltaken i lxs') (lnth lxs' i) = count_list (ltaken j lxs') (lnth lxs' j)›
          by auto
        show ‹i = j›
          using hi hj hlen heqx heqn by (metis count_list_inject mem_Collect_eq)
      next
        assume ‹i = j› then show ‹f i = f j› by simp
      qed
    next
      fix i assume hi: ‹i ∈ {k. enat k < llength lxs}›
      show ‹f i ∈ {k. enat k < llength lxs}›
        unfolding f_def Let_def
        using hgt[OF] hi
        by (metis add.right_neutral lfind_index_less mem_Collect_eq zero_enat_def)
    next
      fix k assume hk: ‹k ∈ {k. enat k < llength lxs}›
      show ‹∃i ∈ {k. enat k < llength lxs}. k = f i›
        unfolding f_def Let_def
        by (metis add.right_neutral count_list_inject count_list_ltaken_less diff_zero hcount hk
            hlen lfind_index_count_list lfind_index_less lfind_index_lnth mem_Collect_eq zero_enat_def)
    qed
  next
    show ‹lpermute f lxs = lxs'›
    proof (intro lnth_equalityI)
      show ‹llength (lpermute f lxs) = llength lxs'›
        by (simp add: lpermute_def hlen)
    next
      fix i
      assume hi: ‹enat i < llength (lpermute f lxs)›
      then have hi': ‹enat i < llength lxs› by (simp add: lpermute_def lnth_lupt)
      have ‹lnth (lpermute f lxs) i = lnth lxs (f i)›
        by (simp add: lpermute_def lnth_lupt hi' f_def Let_def)
      also have ‹… = lnth lxs' i›
      proof -
        have hlt: ‹enat (count_list (ltaken i lxs') (lnth lxs' i)) < count_llist lxs (lnth lxs' i)›
          using hgt hi' by blast
        from lfind_index_lnth[OF hlt, of 0] show ?thesis
          unfolding f_def Let_def by simp
      qed
      finally show ‹lnth (lpermute f lxs) i = lnth lxs' i› .
    qed
  qed
qed

lemma eq_cmset_lzip_left:
  assumes ‹eq_cmset lxs' lxs› ‹llength lys = llength lxs›
  shows ‹∃lys'. eq_cmset (lzip lxs' lys') (lzip lxs lys) ∧ llength lys' = llength lxs'›
proof -
  from assms(1) obtain π where ‹lbij_on π lxs› ‹lpermute π lxs = lxs'› unfolding eq_cmset_alt
    by blast
  with assms(2) show ?thesis
    by (intro exI[of _ ‹lpermute π lys›]) (auto simp: lpermute_lzip eq_cmset_alt intro!: exI[of _ π])
qed

lemma eq_cmset_lmap:
  assumes ‹eq_cmset lxs lys›
  shows ‹eq_cmset (lmap f lxs) (lmap f lys)›
proof -
  from assms obtain π where ‹lbij_on π lys› ‹lpermute π lys = lxs› unfolding eq_cmset_alt
    by blast
  then show ?thesis
    by (force simp: lpermute_def llist.map_comp lset_lupt eq_cmset_alt
        dest: bij_betwE intro!: llist.map_cong exI[where x = π] lnth_lmap)
qed

lemma llist_all2_reorder_left_invariance:
  assumes rel: ‹llist_all2 R lxs lys› and ms_x: ‹eq_cmset lxs' lxs›
  shows ‹∃lys'. llist_all2 R lxs' lys' ∧ eq_cmset lys' lys›
proof -
  from ms_x rel[THEN llist_all2_llengthD] obtain lys' where
    ms_xy: ‹eq_cmset (lzip lxs' lys') (lzip lxs lys)› and len: ‹llength lys' = llength lxs'›
    by (metis eq_cmset_lzip_left)
  with rel have rel': ‹llist_all2 R lxs' lys'› unfolding llist_all2_conv_lzip
    by (auto simp: lset_eq_cmset)
  moreover from eq_cmset_lmap[OF ms_xy, of snd]
  have ‹eq_cmset (lmap snd (lzip lxs' lys')) (lmap snd (lzip lxs lys))› .
  with rel[THEN llist_all2_llengthD] rel'[THEN llist_all2_llengthD] have ‹eq_cmset lys' lys›
    by (auto simp: lmap_snd_lzip_conv_ltake ltake_all)
  ultimately show ?thesis
    by blast
qed

section ‹Countable Multisets as a Quotient›

quotient_type 'a cmset = ‹'a llist› / eq_cmset
  by (auto simp: eq_cmset_def intro!: equivpI reflpI sympI transpI)

lift_bnf (cmset: 'a) cmset
  for map: cmimage rel: cmrel
proof -
  fix P :: ‹'a ⇒ 'b ⇒ bool› and Q :: ‹'b ⇒ 'c ⇒ bool›
  show ‹llist_all2 P OO eq_cmset OO llist_all2 Q
       ≤ eq_cmset OO llist_all2 (P OO Q) OO eq_cmset›
  proof safe
    fix l r l' r'
    assume ‹llist_all2 P l l'› ‹eq_cmset l' r'› ‹llist_all2 Q r' r›
    with llist_all2_reorder_left_invariance[OF this(3,2)]
    show ‹(eq_cmset OO llist_all2 (P OO Q) OO eq_cmset) l r›
      by (auto intro!: relcomppI[of _ _ l] simp: eq_cmset_def llist.rel_compp)
  qed
next
  fix S :: ‹'a set set›
  assume ‹S ≠ {}›
  then show ‹(⋂As∈S. {(x, x'). eq_cmset x x'} `` {x. lset x ⊆ As})
          ⊆ {(x, x'). eq_cmset x x'} `` {x. lset x ⊆ ⋂ S}›
    using Inter_greatest[of S ‹lset _›] lset_eq_cmset
    unfolding subset_eq Ball_def Bex_def INT_iff Image_iff mem_Collect_eq prod.case
    by (metis cmset.abs_eq_iff)
qed

section ‹Lazy List Interleaving›

context notes [[function_internals]]
begin
partial_function (llist) lflat where
  ‹lflat lxss = (case lxss of LNil ⇒ LNil | LCons xs lxss ⇒ lappend (llist_of xs) (lflat lxss))›
end

lemma ltaken_ldropn_decomp: ‹lxs = lappend (llist_of (ltaken n lxs)) (ldropn n lxs)›
  by (induct n arbitrary: lxs) (auto split: llist.splits)

lemma count_llist_llist_of[simp]: ‹count_llist (llist_of xs) x = count_list xs x›
  by (induct xs) (auto simp: enat_0 simp flip: eSuc_enat)

lemma lmap_lfilter_swap: ‹∀x ∈ lset lxs. P x ⟷ Q (f x) ⟹ lmap f (lfilter P lxs) = lfilter Q (lmap f lxs)›
  by (induct lxs) auto


lemma lsum_lmap_zero: ‹lsum (lmap (λz. 0) lxs) = 0›
proof -
  have ‹lset (lmap (λz. 0::enat) lxs) ⊆ {0}› by fastforce
  then have ‹ldropWhile ((=) 0) (lmap (λz. 0) lxs) = LNil›
    by (simp add: ldropWhile_eq_LNil_iff)
  then show ?thesis
    by (metis llist.case(1) lsum_code_alt)
qed

lemma lsum_LNil[simp]: ‹lsum LNil = 0›
  by (simp add: lsum_code_alt)

lemma lsum_LCons[simp]: ‹lsum (LCons x lxs) = x + lsum lxs›
  by (simp add: lsum_code_alt)

lemma count_llist_lmap_const:
  ‹count_llist (lmap (λz. a) lxs) x = (if x = a then llength lxs else 0)›
  unfolding count_llist_alt
  by (auto simp: lfilter_lmap)

lemma lsum_lmap_all_but_one_0: ‹x ∈ lset lxs ⟹ ldistinct lxs ⟹ lsum (lmap (λz. if z = x then y else 0) lxs) = y›
proof (induct x lxs rule: llist.set_induct)
  case (LCons1 x' lxs)
  then have ‹lmap (λz. if z = x' then y else 0) lxs = lmap (λ_. 0) lxs›
    by (intro llist.map_cong) auto
  then show ?case
    by (auto simp: lsum_lmap_zero)
next
  case (LCons2 x' lxs x)
  then show ?case
    by auto
qed

lemma ltaken_Suc:
  ‹ltaken (Suc i) lxs = (if i < llength lxs then ltaken i lxs @ [lnth lxs i] else ltaken i lxs)›
proof (induct i arbitrary: lxs)
  case 0
  then show ?case
    by (auto simp: enat_0 Suc_ile_eq split: if_splits llist.splits)
next
  case (Suc i)
  then show ?case
    by (cases lxs) (auto simp: enat_0 Suc_ile_eq split: if_splits llist.splits)
qed

lemma ltaken_all_same: ‹enat n ≥ llength lxs ⟹ enat m ≥ llength lxs ⟹ ltaken n lxs = ltaken m lxs›
  by (metis lappend_LNil2 ldropn_eq_LNil llist_of_inject ltaken_ldropn_decomp)

lemma lsum_mono: ‹lprefix lxs lys ⟹ lsum lxs ≤ lsum lys›
proof -
  assume ‹lprefix lxs lys›
  show ‹lsum lxs ≤ lsum lys›
  proof (cases ‹lfinite lxs›)
    case True
    then show ?thesis 
      using `lprefix lxs lys` `lfinite lxs`
      by (induct lxs arbitrary: lys rule: lfinite.induct) (auto simp: LCons_lprefix_conv)
  next
    case False
    then show ?thesis 
      using `lprefix lxs lys`
      by (simp add: not_lfinite_lprefix_conv_eq)
  qed
qed

lemma Sup_enat_remove0: ‹∃x ∈ X. x > 0 ⟹ Sup (X :: enat set) = Sup (X - {0})›
proof -
  assume ex: ‹(∃x ∈ X. x > 0)›
  show ‹Sup (X :: enat set) = Sup (X - {0})›
    unfolding Sup_enat_def
    by (smt (verit, ccfv_threshold) Diff_empty Diff_insert0 Max.remove empty_iff finite.emptyI
        finite_Diff_insert max_enat_simps(3))
qed

lemma lSup_eq_lappend: ‹Complete_Partial_Order.chain lprefix Y ⟹ ∃lys ∈ Y. lprefix (llist_of xs) lys ⟹
  lSup Y = lappend (llist_of xs) (lSup (ldropn (length xs) ` Y))›
proof (induct xs arbitrary: Y)
  case (Cons a xs)
  from Cons(3) obtain lys where lys: ‹¬ lnull lys› ‹lys ∈ Y› ‹lhd lys = a› ‹lprefix (llist_of xs) (ltl lys)›
    by (metis eq_LConsD llist_of.simps(2) llist_of_eq_LNil_conv lnull_llist_of lprefix.cases
        lprefix_not_lnullD)
  from Cons(2-) have lhd_Y: ‹lys ∈ Y ⟹ ¬ lnull lys ==> lhd lys = a› for lys
    by (metis eq_LConsD lhd_lSup_eq llist.disc(2) llist_of.simps(2) lprefix_lhdD
        lprefix_not_lnullD)
  from Cons(2-) have lhd_lSup[simp]: ‹lhd (lSup Y) = a›
    by (metis lhd_LCons lhd_lSup_eq llist.disc(2) llist_of.simps(2) lprefix_lhdD lprefix_lnull)
  moreover have ‹lSup (ltl ` (Y ∩ {l. ¬ lnull l})) =
          lappend (llist_of xs) (lSup (ldropn (Suc (length xs)) ` Y))›
  proof -
    have ‹ldropn (Suc (length xs)) ` (Y ∩ {l. ¬ lnull l}) ⊆ ldropn (Suc (length xs)) ` Y›
      (is ‹?lhs ⊆ ?rhs›) by auto
    moreover have ‹?rhs  - {LNil} ⊆ ?lhs›
      by auto
    ultimately have ‹lSup ?lhs = lSup ?rhs›
      by (metis Int_Diff inf.absorb_iff2 inf.order_iff lSup_minus_LNil)
    moreover have chain_ltl: ‹Complete_Partial_Order.chain lprefix (ltl ` (Y ∩ {l. ¬ lnull l}))›
      by (metis chain_lprefix_ltl Cons.prems(1))
    moreover have ‹Bex (ltl ` (Y ∩ {l. ¬ lnull l})) (lprefix (llist_of xs))›
      by (auto intro!: bexI[of _ lys] simp: lys)
    ultimately show ?thesis
      by (subst Cons(1)) (auto simp: image_image ldropn_ltl)
  qed
  ultimately show ?case
    by (subst lSup.code)
      (auto simp: LCons_lprefix_conv lhd_Y lys intro!: the1_equality bexI[of _ lys])
qed simp

lemma lsum_0D: ‹x ∈ lset lxs ⟹ lsum lxs = 0 ⟹ x = 0›
  by (induct x lxs rule: llist.set_induct) auto

lemma lsum_0I: ‹∀x∈lset lxs. x = 0 ⟹ lsum lxs = 0›
  by (subst lsum_code_alt) auto

lemma lsum_0_iff: ‹lsum lxs = 0 ⟷ (∀x ∈ lset lxs. x = 0)›
  by (metis lsum_0I lsum_0D)

lemma lsum_lappend_lfinite: ‹lfinite lxs ⟹ lsum (lappend lxs lys) = lsum lxs + lsum lys›
  by (induct lxs rule: lfinite.induct) auto

lemma lsum_lappend: ‹lsum (lappend lxs lys) = (if lfinite lxs then lsum lxs + lsum lys else lsum lxs)›
  by (auto simp: lappend_inf lsum_lappend_lfinite)

lemma lsum_llist_of[simp]: ‹lsum (llist_of xs) = sum_list xs›
  by (induct xs) auto

lemma lsum_cont:
  ‹Complete_Partial_Order.chain lprefix Y ⟹ Y ≠ {} ⟹ lsum (lSup Y) = ⨆ (lsum ` Y)›
proof (coinduction arbitrary: Y rule: enat_coinduct)
  case Eq_enat
  then show ?case
  proof (intro allI impI conjI disjI1)
    show ‹Complete_Partial_Order.chain lprefix Y ⟹ Y ≠ {} ⟹ (lsum (lSup Y) = 0) = (⨆ (lsum ` Y) = 0)›
      by (simp add: Sup_eq_0_iff lset_lSup lsum_0_iff)
  next
    assume hn0_lsum: ‹lsum (lSup Y) ≠ 0› and hn0_Sup: ‹⨆ (lsum ` Y) ≠ 0›
    show ‹(∃Y'. epred (lsum (lSup Y)) = lsum (lSup Y') ∧ epred (⨆ (lsum ` Y)) = ⨆ (lsum ` Y') ∧
                Complete_Partial_Order.chain lprefix Y' ∧ Y' ≠ {})›
    proof -
      have lnth_eq_Y: ‹lnth lxs i = lnth lys i›
        if ‹enat i < llength lxs› ‹lxs ∈ Y› ‹enat i < llength lys› ‹lys ∈ Y› for lxs lys i
        using Eq_enat(1) that by (force simp: chain_def dest: lprefix_lnthD[of _ _ i])
      obtain lys z where hlys: ‹lys ∈ Y› and hz: ‹z ∈ lset lys› ‹z ≠ 0›
        using hn0_lsum Eq_enat(1) by (auto simp: lsum_0_iff lset_lSup)
      define A where ‹A = {i. ∀lys ∈ Y. ltaken i lys = replicate (case llength lys of enat j ⇒ min i j | _ ⇒ i) 0}›
      define i where ‹i = Max A›
      have ne: ‹A ≠ {}›
        using Eq_enat(2) ‹lys ∈ Y› by (auto simp: A_def enat_0 intro!: exI[of _ 0] split: enat.splits)
      have fin: ‹finite A›
      proof -
        from hn0_lsum Eq_enat(1) obtain lys' where hlys': ‹lys' ∈ Y› and hn0: ‹lsum lys' ≠ 0›
          by (auto simp: lset_lSup lsum_0_iff)
        from hn0 obtain n where hn: ‹enat n < llength lys'› ‹lnth lys' n ≠ 0›
          by (auto simp: lsum_0_iff in_lset_conv_lnth dest: lsum_0D)
        show ‹finite A›
        proof (rule finite_subset[of _ ‹{0..n}›])
          show ‹A ⊆ {0..n}›
          proof
            fix k assume hk: ‹k ∈ A›
            have hkprop: ‹ltaken k lys' = replicate (case llength lys' of enat j ⇒ min k j | _ ⇒ k) 0›
              using hk hlys' by (auto simp: A_def)
            have ‹n < k ⟹ False›
            proof -
              assume hnk: ‹n < k›
              have ‹nth (ltaken k lys') n = lnth lys' n›
              proof (cases ‹enat k ≤ llength lys'›)
                case True
                thus ?thesis using hnk by (simp add: nth_ltaken)
              next
                case False
                hence hlt: ‹llength lys' < enat k› by simp
                then obtain m where hm: ‹llength lys' = enat m›
                  by (cases ‹llength lys'›) (auto simp: enat_def)
                have hmk: ‹m ≤ k› using hlt hm by auto
                have hnm: ‹n < m› using hn(1) hm by auto
                have ‹ltaken k lys' = ltaken m lys'›
                  by (rule ltaken_all_same) (simp_all add: hm hmk)
                thus ?thesis using hnm hm by (simp add: nth_ltaken)
              qed
              moreover have ‹nth (replicate (case llength lys' of enat j ⇒ min k j | _ ⇒ k) 0) n = 0›
                using hn(1) hnk by (auto simp: min_def split: enat.splits)
              ultimately show False using hkprop hn(2) by metis
            qed
            thus ‹k ∈ {0..n}› by (force simp: not_less)
          qed
        qed simp
      qed
      have iA: ‹∀lys ∈ Y. ltaken i lys = replicate (case llength lys of enat j ⇒ min i j | _ ⇒ i) 0›
        using Max_in[OF fin ne] unfolding i_def A_def by blast
      from iA[THEN bspec, of lys] hlys ‹z ∈ lset lys› ‹z ≠ 0› have hi: ‹enat i < llength lys›
      proof -
        have hiA: ‹ltaken i lys = replicate (case llength lys of enat j ⇒ min i j | _ ⇒ i) 0›
          using iA hlys by blast
        obtain n0 where hn0_len: ‹enat n0 < llength lys› and hn0_nth: ‹lnth lys n0 = z›
          using ‹z ∈ lset lys› by (auto simp: in_lset_conv_lnth)
        show ‹enat i < llength lys›
        proof (rule ccontr)
          assume h: ‹¬ enat i < llength lys›
          hence hfin: ‹llength lys ≠ ∞› by (cases ‹llength lys›) auto
          then obtain m where hm: ‹llength lys = enat m› by (cases ‹llength lys›) auto
          from h hm have him: ‹m ≤ i› by auto
          have hn0m: ‹n0 < m› using hn0_len hm by auto
          have ‹nth (ltaken i lys) n0 = lnth lys n0›
          proof (cases ‹enat i ≤ llength lys›)
            case True
            thus ?thesis using hn0m him hm by (simp add: nth_ltaken)
          next
            case False
            hence ‹ltaken i lys = ltaken m lys›
              by (rule_tac ltaken_all_same) (simp_all add: hm him)
            thus ?thesis using hn0m hm by (simp add: nth_ltaken)
          qed
          moreover have ‹nth (ltaken i lys) n0 = 0›
            using hiA hm him hn0m by (auto simp: min_def)
          ultimately show False using hn0_nth ‹z ≠ 0› by auto
        qed
      qed
      with iA hlys have hpref: ‹lprefix (llist_of (replicate i 0)) lys›
        by (metis length_ltaken length_replicate lprefix_conv_lappend ltaken_ldropn_decomp nless_le)
      obtain n where hn: ‹∀lys ∈ Y. enat i ≥ llength lys ∨ lnth lys i = n›
        using lnth_eq_Y by (meson linorder_not_le)
      have hn0: ‹n = 0 ⟹ Suc i ∈ A›
      proof -
        assume hn0_eq: ‹n = 0›
        show ‹Suc i ∈ A›
          unfolding A_def mem_Collect_eq
        proof
          fix lys' assume hlys'_Y: ‹lys' ∈ Y›
          show ‹ltaken (Suc i) lys' = replicate (case llength lys' of enat j ⇒ min (Suc i) j | _ ⇒ Suc i) 0›
          proof (cases ‹enat i < llength lys'›)
            case True
            hence hstep: ‹ltaken (Suc i) lys' = ltaken i lys' @ [lnth lys' i]›
              by (metis ltaken_Suc)
            have ‹lnth lys' i = 0›
              using hn hlys'_Y hn0_eq True by auto
            moreover have ‹ltaken i lys' = replicate (case llength lys' of enat j ⇒ min i j | _ ⇒ i) 0›
              using iA hlys'_Y by blast
            ultimately show ?thesis
              using hstep ‹enat i < llength lys'›
              by (subst hstep, auto simp: min_def replicate_append_same Suc_ile_eq split: enat.splits)
          next
            case False
            hence ‹ltaken (Suc i) lys' = ltaken i lys'›
              by (metis ltaken_Suc)
            moreover have ‹ltaken i lys' = replicate (case llength lys' of enat j ⇒ min i j | _ ⇒ i) 0›
              using iA hlys'_Y by blast
            ultimately show ?thesis
              using False
              by (auto simp: min_def not_less split: enat.splits)
          qed
        qed
      qed
      have hnn: ‹n ≠ 0›
        using Max_eq_iff[OF fin ne, of i, THEN iffD1, OF i_def[symmetric], THEN conjunct2, rule_format, of ‹Suc i›]
          hn0 by fastforce
      have ldropn_cases: ‹lys = LNil ∨ (∃lys'. lys = LCons n lys')›
        if ‹lys ∈ ldropn i ` Y› for lys
        using that hn
        by (metis (mono_tags, lifting) image_iff ldropn_Suc_conv_ldropn ldropn_eq_LNil linorder_not_le)
      have hTHE: ‹(THE x. x ∈ lhd ` (ldropn i ` Y ∩ {xs. ¬ lnull xs})) = n›
      proof (intro the_equality)
        show ‹n ∈ lhd ` (ldropn i ` Y ∩ {xs. ¬ lnull xs})›
          by (metis IntI hi hlys image_eqI ldropn_Suc_conv_ldropn lhd_LCons linorder_not_le
              llist.disc(2) mem_Collect_eq hn)
        show ‹⋀x. x ∈ lhd ` (ldropn i ` Y ∩ {xs. ¬ lnull xs}) ⟹ x = n›
        proof -
          fix x assume ‹x ∈ lhd ` (ldropn i ` Y ∩ {xs. ¬ lnull xs})›
          then obtain lxs where hlxs: ‹lxs ∈ Y› ‹¬ lnull (ldropn i lxs)› ‹x = lhd (ldropn i lxs)›
            by auto
          from hlxs(2) have hlen: ‹enat i < llength lxs›
            by (simp add: lnull_def ldropn_eq_LNil not_less)
          from hlxs(3) have ‹x = lnth lxs i›
            by (simp add: lhd_ldropn hlen)
          with hn hlxs(1) hlen show ‹x = n›
            by auto
        qed
      qed
      have hLCons: ‹(λx. LCons (epred n) (ltl x)) ` X ∩ {xs. ¬ lnull xs} =
            (λx. LCons (epred n) (ltl x)) ` X› for X
        by auto
      have h4: ‹ldropn i lys ∈ ldropn i ` Y ∩ {xs. ¬ lnull xs}›
        using hi hlys by auto
      define Y' where ‹Y' = (LCons (epred n) ∘ ltl) ` (ldropn i ` Y ∩ {xs. ¬ lnull xs})›
      show ?thesis
      proof (intro disjI1 exI[of _ Y'] conjI)
        show ‹Y' ≠ {}›
          unfolding Y'_def using h4 by force
      next
        show ‹Complete_Partial_Order.chain lprefix Y'›
          unfolding Y'_def chain_def
        proof (intro ballI)
          fix lxs' lys'
          assume hm1: ‹lxs' ∈ (LCons (epred n) ∘ ltl) ` (ldropn i ` Y ∩ {xs. ¬ lnull xs})›
            and hm2: ‹lys' ∈ (LCons (epred n) ∘ ltl) ` (ldropn i ` Y ∩ {xs. ¬ lnull xs})›
          from hm1 obtain lxs0 where hlxs0: ‹lxs0 ∈ ldropn i ` Y› ‹¬ lnull lxs0›
            ‹lxs' = LCons (epred n) (ltl lxs0)› by auto
          from hm2 obtain lys0 where hlys0: ‹lys0 ∈ ldropn i ` Y› ‹¬ lnull lys0›
            ‹lys' = LCons (epred n) (ltl lys0)› by auto
          from hlxs0(1) obtain lxs1 where hlxs1: ‹lxs1 ∈ Y› ‹lxs0 = ldropn i lxs1› by auto
          from hlys0(1) obtain lys1 where hlys1: ‹lys1 ∈ Y› ‹lys0 = ldropn i lys1› by auto
          from Eq_enat(1) hlxs1(1) hlys1(1) have ‹lprefix lxs1 lys1 ∨ lprefix lys1 lxs1›
            by (auto simp: chain_def)
          thus ‹lprefix lxs' lys' ∨ lprefix lys' lxs'›
            using hlxs0(3) hlys0(3) hlxs1(2) hlys1(2)
            by (auto intro: lprefix_ltlI monotone_ldropn'[THEN monotoneD])
        qed
      next
        let ?S = ‹ldropn i ` Y ∩ {xs. ¬ lnull xs}›
        have hS_ne: ‹?S ≠ {}› using h4 by force
        have lSup_ldropn: ‹lSup (ldropn i ` Y) = LCons n (lSup (ltl ` ?S))›
        proof (subst lSup.code, auto simp: hTHE h4)
          show ‹∃x∈Y. ¬ llength x ≤ enat i›
            using hlys hi by (intro bexI[OF _ hlys]) auto
        qed
        have lSup_Y': ‹lSup Y' = LCons (epred n) (lSup (ltl ` ?S))›
        proof -
          have hne: ‹ltl ` ?S ≠ {}› using hS_ne by auto
          have ‹Y' = LCons (epred n) ` ltl ` ?S›
            by (simp add: Y'_def image_image)
          thus ?thesis using hne by (simp add: lSup_LCons)
        qed
        have lSup_Y_eq: ‹lSup Y = lappend (llist_of (replicate i 0)) (lSup (ldropn i ` Y))›
          using lSup_eq_lappend[OF Eq_enat(1), of ‹replicate i 0›] hlys hpref by auto
        show ‹epred (lsum (lSup Y)) = lsum (lSup Y')›
          using lSup_Y_eq lSup_ldropn lSup_Y' hnn
          by (simp add: lsum_lappend sum_list_replicate epred_iadd1)
      next
        let ?S = ‹ldropn i ` Y ∩ {xs. ¬ lnull xs}›
        have hS_ne: ‹?S ≠ {}› using h4 by force
        have lSup_Y': ‹lSup Y' = LCons (epred n) (lSup (ltl ` ?S))›
        proof -
          have hne: ‹ltl ` ?S ≠ {}› using hS_ne by auto
          have ‹Y' = LCons (epred n) ` ltl ` ?S›
            by (simp add: Y'_def image_image)
          thus ?thesis using hne by (simp add: lSup_LCons)
        qed
        have lsum_lzs: ‹lsum lzs = lsum (ldropn i lzs)› if ‹lzs ∈ Y› for lzs
          using iA[rule_format, OF that]
          by (subst ltaken_ldropn_decomp[of _ i]) (auto simp: lsum_lappend)
        have lsum_eq_sets: ‹(epred ∘ lsum) ` (Y ∩ {lzs. lsum lzs ≠ 0}) =
                            lsum ` Y'›
        proof (rule set_eqI)
          fix v
          show ‹v ∈ (epred ∘ lsum) ` (Y ∩ {lzs. lsum lzs ≠ 0}) ⟷ v ∈ lsum ` Y'›
          proof
            assume ‹v ∈ (epred ∘ lsum) ` (Y ∩ {lzs. lsum lzs ≠ 0})›
            then obtain lzs where hlzs: ‹lzs ∈ Y› ‹lsum lzs ≠ 0› ‹v = epred (lsum lzs)› by auto
            have hnd: ‹ldropn i lzs ≠ LNil›
              using hlzs(1,2) lsum_lzs by (auto simp: lsum_0_iff)
            then obtain lzs' where hlzs': ‹ldropn i lzs = LCons n lzs'›
              using ldropn_cases[of ‹ldropn i lzs›] hlzs(1) by auto
            have ‹LCons (epred n) (ltl (ldropn i lzs)) ∈ Y'›
              using hlzs(1) hnd by (auto simp: Y'_def)
            moreover have ‹v = lsum (LCons (epred n) (ltl (ldropn i lzs)))›
              using hlzs(3) hlzs'(1) lsum_lzs[OF hlzs(1)] hnn
              by (simp add: epred_iadd1)
            ultimately show ‹v ∈ lsum ` Y'›
              by blast
          next
            assume ‹v ∈ lsum ` Y'›
            then obtain ya where hya: ‹ya ∈ Y'› ‹v = lsum ya› by auto
            from hya(1) obtain lzs where hlzs: ‹lzs ∈ Y› ‹ldropn i lzs ∈ ?S›
              ‹ya = LCons (epred n) (ltl (ldropn i lzs))› by (auto simp: Y'_def)
            from hlzs(2) have hnd: ‹¬ lnull (ldropn i lzs)› by auto
            then obtain lzs' where hlzs': ‹ldropn i lzs = LCons n lzs'›
              using ldropn_cases[of ‹ldropn i lzs›] hlzs(1) by fastforce
            have ‹lsum lzs = n + lsum lzs'›
              using lsum_lzs[OF hlzs(1)] hlzs' by simp
            hence ‹lsum lzs ≠ 0› using hnn by auto
            moreover have ‹v = epred (lsum lzs)›
              using hya(2) hlzs(3) hlzs' lsum_lzs[OF hlzs(1)] hnn
              by (simp add: epred_iadd1)
            ultimately show ‹v ∈ (epred ∘ lsum) ` (Y ∩ {lzs. lsum lzs ≠ 0})›
              using hlzs(1) by auto
          qed
        qed
        show ‹epred (⨆ (lsum ` Y)) = ⨆ (lsum ` Y')›
        proof -
          have ‹⨆ (lsum ` Y) = ⨆ (lsum ` (Y ∩ {lzs. lsum lzs ≠ 0}))›
            using hlys hz(1,2)
            by (subst Sup_enat_remove0) (auto dest: lsum_0D intro!: arg_cong[where f=Sup])
          moreover have ‹epred (⨆ (lsum ` (Y ∩ {lzs. lsum lzs ≠ 0}))) =
                         ⨆ (epred ` (lsum ` (Y ∩ {lzs. lsum lzs ≠ 0})))›
            by (rule epred_Sup)
          moreover have ‹epred ` (lsum ` (Y ∩ {lzs. lsum lzs ≠ 0})) =
                         (epred ∘ lsum) ` (Y ∩ {lzs. lsum lzs ≠ 0})›
            by (simp add: image_image)
          ultimately show ?thesis
            using lsum_eq_sets by simp
        qed
      qed
    qed
  qed
qed

lemma mcont2mcont_lsum[THEN lfp.mcont2mcont, simp, cont_intro]:
  shows mcont_lsum: ‹mcont lSup (lprefix) Sup (≤) lsum›
  by (auto simp: mcont_def monotone_def lsum_mono cont_def lsum_cont)


lemma lsum_lfilter_nonzero: ‹lsum (lfilter ((≠) 0) lxs) = lsum lxs›
  by (induct lxs) auto

abbreviation ‹LSUM lxs f ≡ lsum (lmap f lxs)›

abbreviation ‹lenats ≡ lupt 0 ∞›

lemma LSUM_lfilter: ‹LSUM (lfilter (λx. f x ≠ 0) lxs) f = LSUM lxs f›
  by (induct lxs) auto

lemma LSUM_count_llist_lfilter:
  ‹lsum (lmap (λlxs. count_llist lxs x) (lfilter (λx. ¬ lnull x) lxss)) =
  lsum (lmap (λlxs. count_llist lxs x) lxss)›
proof (induct lxss)
  case LNil
  then show ?case by (auto simp: count_llist_zero_iff)
next
  case (LCons lxs lxss)
  then show ?case by (auto simp: count_llist_zero_iff, metis lnull_def empty_iff lset_LNil)
qed simp

lemma lflat_LNil[simp]: ‹lflat LNil = LNil›
  by (subst lflat.simps) auto

lemma lflat_LCons[simp]: ‹lflat (LCons xs lxss) = lappend (llist_of xs) (lflat lxss)›
  by (subst lflat.simps) auto

lemma count_llist_mono:
  assumes ‹lprefix lxs lys›
  shows ‹count_llist lxs x ≤ count_llist lys x›
proof (cases ‹lfinite lxs›)
  case True
  then show ?thesis using assms
    by (induct lxs arbitrary: lys pred: lfinite) (auto simp: LCons_lprefix_conv)
next
  case False
  then show ?thesis using assms
    by (simp add: not_lfinite_lprefix_conv_eq)
qed

lemma ldropWhile_not_lnull_alt:
  ‹ldropWhile ((≠) x) ` Y ∩ {lxs. ¬ lnull lxs} = ldropWhile ((≠) x) ` {lxs ∈ Y. x ∈ lset lxs}›
  by auto

lemma count_llist_cont: ‹Complete_Partial_Order.chain lprefix Y ⟹ Y ≠ {} ⟹
  count_llist (lSup Y) x = (⨆lxs∈Y. count_llist lxs x)›
proof (coinduction arbitrary: Y)
  case (eq_enat Y)
  then have chain_Y: ‹Complete_Partial_Order.chain lprefix Y› and ne_Y: ‹Y ≠ {}› by auto
  show ?case
  proof (rule conjI)
    from chain_Y ne_Y show ‹(count_llist (lSup Y) x = 0) = ((⨆lxs∈Y. count_llist lxs x) = 0)›
      by (auto simp: count_llist_zero_iff Sup_eq_0_iff lset_lSup)
  next
    show ‹count_llist (lSup Y) x ≠ 0 ⟶ (⨆lxs∈Y. count_llist lxs x) ≠ 0 ⟶
      (∃Z. epred (count_llist (lSup Y) x) = count_llist (lSup Z) x ∧
            epred (⨆lxs∈Y. count_llist lxs x) = (⨆lxs∈Z. count_llist lxs x) ∧
            Complete_Partial_Order.chain lprefix Z ∧ Z ≠ {}) ∨
      epred (count_llist (lSup Y) x) = epred (⨆lxs∈Y. count_llist lxs x)›
    proof (intro impI disjI1)
      assume h1: ‹count_llist (lSup Y) x ≠ 0› and h2: ‹(⨆lxs∈Y. count_llist lxs x) ≠ 0›
      define Z where ‹Z ≡ ltl ` (ldropWhile ((≠) x) ` Y ∩ {lxs. ¬ lnull lxs})›
      have chain_Z: ‹Complete_Partial_Order.chain lprefix Z›
        unfolding Z_def using chain_Y
        by (auto simp: chain_def ldropWhile_not_lnull_alt
            intro!: lprefix_ltlI mcont_monoD[OF mcont_ldropWhile])
      have ne_Yx: ‹{lxs∈Y. x∈lset lxs} ≠ {}›
        using chain_Y ne_Y h1 by (auto simp: lset_lSup count_llist_zero_iff)
      have ne_Z: ‹Z ≠ {}›
        unfolding Z_def
        using ne_Yx by (auto simp: ldropWhile_not_lnull_alt)
      have x_lset: ‹x ∈ lset (lSup Y)›
        using h1 by (simp add: count_llist_zero_iff)
      have drop_cont: ‹ldropWhile ((≠) x) (lSup Y) = lSup (ldropWhile ((≠) x) ` Y)›
        using chain_Y ne_Y by (rule mcont_contD[OF mcont_ldropWhile])
      have eq1: ‹epred (count_llist (lSup Y) x) = count_llist (lSup Z) x›
      proof -
        have ‹epred (count_llist (lSup Y) x) = count_llist (ltl (ldropWhile ((≠) x) (lSup Y))) x›
          using x_lset by (rule count_llist_sel)
        also have ‹ltl (ldropWhile ((≠) x) (lSup Y)) = lSup Z›
          by (simp add: drop_cont image_image Z_def)
        finally show ?thesis .
      qed
      have eq2: ‹epred (⨆lxs∈Y. count_llist lxs x) = (⨆lxs∈Z. count_llist lxs x)›
      proof -
        have aux: ‹(⨆lxs∈Y. epred (count_llist lxs x)) = (⨆lxs∈{lxs∈Y. x∈lset lxs}. count_llist (ltl (ldropWhile ((≠) x) lxs)) x)›
        proof (rule antisym)
          show ‹(⨆lxs∈Y. epred (count_llist lxs x)) ≤ (⨆lxs∈{lxs∈Y. x∈lset lxs}. count_llist (ltl (ldropWhile ((≠) x) lxs)) x)›
          proof (rule cSUP_mono[OF ne_Y])
            show ‹bdd_above ((λlxs. count_llist (ltl (ldropWhile ((≠) x) lxs)) x) ` {lxs∈Y. x∈lset lxs})›
              by (auto simp: bdd_above_def)
            fix lxs assume lxs_Y: ‹lxs ∈ Y›
            show ‹∃ya ∈ {lxs∈Y. x∈lset lxs}. epred (count_llist lxs x) ≤ count_llist (ltl (ldropWhile ((≠) x) ya)) x›
            proof (cases ‹x ∈ lset lxs›)
              case True
              with lxs_Y show ?thesis by auto
            next
              case False
              with ne_Yx obtain ya where ya_Y: ‹ya ∈ Y› and x_ya: ‹x ∈ lset ya› by blast
              from False have ‹count_llist lxs x = 0› by (simp add: count_llist_zero_iff)
              then show ?thesis using ya_Y x_ya by auto
            qed
          qed
          show ‹(⨆lxs∈{lxs∈Y. x∈lset lxs}. count_llist (ltl (ldropWhile ((≠) x) lxs)) x) ≤ (⨆lxs∈Y. epred (count_llist lxs x))›
          proof (rule cSUP_mono[OF ne_Yx])
            show ‹bdd_above ((λlxs. epred (count_llist lxs x)) ` Y)›
              by (auto simp: bdd_above_def)
            fix lxs assume ‹lxs ∈ {lxs∈Y. x∈lset lxs}›
            then have lxs_Y: ‹lxs ∈ Y› and x_lxs: ‹x ∈ lset lxs› by auto
            show ‹∃m ∈ Y. count_llist (ltl (ldropWhile ((≠) x) lxs)) x ≤ epred (count_llist m x)›
              using lxs_Y x_lxs
              by (auto intro!: bexI[of _ lxs])
          qed
        qed
        then show ?thesis
          by (simp add: epred_Sup image_image ldropWhile_not_lnull_alt Z_def)
      qed
      show ‹∃Z. epred (count_llist (lSup Y) x) = count_llist (lSup Z) x ∧
            epred (⨆lxs∈Y. count_llist lxs x) = (⨆lxs∈Z. count_llist lxs x) ∧
            Complete_Partial_Order.chain lprefix Z ∧ Z ≠ {}›
        by (rule exI[of _ Z]) (use eq1 eq2 chain_Z ne_Z in simp)
    qed
  qed
qed

lemma mcont2mcont_count_llist[THEN lfp.mcont2mcont, simp, cont_intro]:
  shows mcont_count_llist: ‹mcont lSup (lprefix) Sup (≤) (λlxs. count_llist lxs x)›
  by (auto simp: mcont_def cont_def monotone_def count_llist_mono count_llist_cont)

lemma mono2mono_lflat[THEN llist.mono2mono, simp, cont_intro]:
  shows mono_lflat: ‹monotone lprefix lprefix lflat›
  by (rule llist.fixp_preserves_mono1[OF lflat.mono lflat_def]) simp

lemma mcont2mcont_lflat[THEN llist.mcont2mcont, simp, cont_intro]:
  shows mcont_lflat: ‹mcont lSup lprefix lSup lprefix lflat›
  by (rule llist.fixp_preserves_mcont1[OF lflat.mono lflat_def]) simp

lemma lflat_LNil_iff: ‹lflat lxss = LNil ⟷ (∀xs ∈ lset lxss. xs = [])›
  by (induct lxss) (auto simp: llist_of_eq_LNil_conv lappend_eq_LNil_iff)

lemma count_llist_lflat: ‹count_llist (lflat lxss) x = lsum (lmap (λxs. count_list xs x) lxss)›
  by (induct lxss) (auto simp: count_llist_lappend)

lemma lset_lflat: ‹lset (lflat lxss) = (⋃xs ∈ lset lxss. set xs)›
  unfolding in_lset_iff_count_llist set_eq_iff
  by (auto simp: count_llist_zero_iff count_llist_lflat lsum_0_iff count_list_0_iff enat_0_iff)

definition ‹lvertical lxss i = (if enat i < llength lxss then ltaken (Suc i) (lnth lxss i) else [])›
definition ‹lhorizontal lxss j = List.map_filter (λlxs. if enat j < llength lxs then Some (lnth lxs j) else None) (ltaken j lxss)›
definition lmerge where
  ‹lmerge lxss = lflat (lmap (λi. lvertical lxss i @ lhorizontal lxss i) (lupt 0 ∞))›

lemma set_ltaken_conv': ‹set (ltaken n lxs) = (case llength lxs of enat m ⇒ lnth lxs ` {0..<min n m} | _ ⇒ lnth lxs ` {0 ..< n})›
proof -
  show ?thesis
  proof -
    { fix m x
      assume ‹m < n› ‹llength lxs = enat m› ‹x ∈ set (ltaken n lxs)›
      then have ‹x ∈ lnth lxs ` {0..<m}›
        by (metis enat_ord_simps(1) linorder_not_le ltaken_all_same nle_le set_ltaken_conv)
    }
    moreover
    { fix m l
      assume ‹m < n› ‹llength lxs = enat m› ‹l < m›
      then have ‹lnth lxs l ∈ set (ltaken n lxs)›
        by (metis enat_ord_simps(2) in_lset_conv_lnth ltaken_ldropn_decomp linorder_not_le
              lset_llist_of order_le_less ldropn_eq_LNil lappend_LNil2)
    }
    ultimately show ?thesis
      by (auto simp: set_ltaken_conv min_def not_le split: enat.splits)
  qed
qed

lemma lset_lmerge: ‹lset (lmerge lxss) = (⋃lxs ∈ lset lxss. lset lxs)›
proof safe
  fix x
  assume ‹x ∈ lset (lmerge lxss)›
  then show ‹x ∈ ⋃ (lset ` lset lxss)›
  proof -
    have vert: ‹⋀i. set (lvertical lxss i) ⊆ ⋃ (lset ` lset lxss)›
    proof
      fix i y assume hy: ‹y ∈ set (lvertical lxss i)›
      show ‹y ∈ ⋃ (lset ` lset lxss)›
      proof (cases ‹enat i < llength lxss›)
        case True
        have hsub: ‹set (lvertical lxss i) ⊆ lset (lnth lxss i)›
          using True set_ltaken[of ‹Suc i› ‹lnth lxss i›]
          by (auto simp: lvertical_def intro: lset_intros dest: set_mp[OF set_ltaken])
        have hmem: ‹lnth lxss i ∈ lset lxss›
          using True by (auto simp: in_lset_conv_lnth)
        show ?thesis using hy hsub hmem by blast
      next
        case False
        then have ‹set (lvertical lxss i) = {}› by (simp add: lvertical_def)
        then show ?thesis using hy by simp
      qed
    qed
    have horiz: ‹⋀j. set (lhorizontal lxss j) ⊆ ⋃ (lset ` lset lxss)›
    proof
      fix j y assume hy: ‹y ∈ set (lhorizontal lxss j)›
      then obtain n where hn: ‹enat n < llength lxss› and hjn: ‹enat j < llength (lnth lxss n)›
          and yj: ‹y = lnth (lnth lxss n) j›
        by (auto simp: lhorizontal_def map_filter_def in_lset_conv_lnth not_less not_le
            enat_0_iff min_def split: enat.splits if_splits dest!: set_mp[OF set_ltaken])
      have hmem: ‹lnth lxss n ∈ lset lxss›
        using hn by (auto simp: in_lset_conv_lnth)
      have hin: ‹y ∈ lset (lnth lxss n)›
        using hjn yj by (auto simp: in_lset_conv_lnth)
      show ‹y ∈ ⋃ (lset ` lset lxss)›
        using hmem hin by blast
    qed
    from ‹x ∈ lset (lmerge lxss)›
    obtain i where ‹x ∈ set (lvertical lxss i) ∨ x ∈ set (lhorizontal lxss i)›
      unfolding lmerge_def lset_lflat
      by (auto simp: lset_lupt)
    then show ?thesis
      using vert horiz by blast
  qed
next
  fix x lxs
  assume xlxss: ‹lxs ∈ lset lxss› and xlxs: ‹x ∈ lset lxs›
  from xlxss obtain i where hi: ‹enat i < llength lxss› and lxi: ‹lnth lxss i = lxs›
    by (auto simp: in_lset_conv_lnth)
  from xlxs obtain j where hj: ‹enat j < llength lxs› and xj: ‹lnth lxs j = x›
    by (auto simp: in_lset_conv_lnth)
  show ‹x ∈ lset (lmerge lxss)›
  proof (cases ‹j ≤ i›)
    case jle: True
    have x_in_vert: ‹x ∈ set (lvertical lxss i)›
    proof (cases ‹enat (Suc i) ≤ llength lxs›)
      case leq: True
      have ji_lt: ‹j < Suc i› using le_imp_less_Suc jle by blast
      have nth_eq: ‹ltaken (Suc i) lxs ! j = lnth lxs j›
        by (rule nth_ltaken) (fact ji_lt, fact leq)
      have jlt: ‹j < length (ltaken (Suc i) lxs)›
        using leq ji_lt by (metis length_ltaken)
      show ?thesis
        using hi hj xj lxi nth_eq jlt
        by (auto simp: lvertical_def in_set_conv_nth simp del: ltaken.simps)
    next
      case nleq: False
      obtain k where fin: ‹llength lxs = enat k›
        by (meson less_enatE linorder_not_le nleq)
      have len_eq: ‹length (ltaken (Suc i) lxs) = k›
        using nleq fin by (metis length_ltaken the_enat.simps)
      have jltk: ‹j < k›
        using hj fin by simp
      have nth_eq: ‹ltaken (Suc i) lxs ! j = lnth lxs j›
        by (metis len_eq jltk lnth_lappend_llist_of ltaken_ldropn_decomp)
      show ?thesis
        using hi hj xj lxi nth_eq jltk len_eq
        by (auto simp: lvertical_def in_set_conv_nth simp del: ltaken.simps)
    qed
    show ?thesis
      unfolding lmerge_def lset_lflat
      using x_in_vert by (auto simp: lset_lupt)
  next
    case False
    have x_in_horiz: ‹x ∈ set (lhorizontal lxss j)›
      using hi hj xj lxi False
      by (auto simp: not_le lhorizontal_def map_filter_def set_ltaken_conv' split: enat.splits)
    show ?thesis
      unfolding lmerge_def lset_lflat
      using x_in_horiz by (auto simp: lset_lupt)
  qed
qed

lemma lsum_lmap_add: ‹lsum (lmap (λx. f x + g x) lxs) = lsum (lmap f lxs) + lsum (lmap g lxs)›
  by (induct lxs) auto

lemma count_list_alt: ‹count_list xs x = card {j. j < length xs ∧ xs ! j = x}›
proof (induct xs)
  case (Cons a xs)
  then show ?case
  proof (cases ‹a = x›)
    case True
    with Cons show ?thesis
    proof -
      have eq: ‹{j. j < Suc (length xs) ∧ (x # xs) ! j = x} = insert 0 (Suc ` {j. j < length xs ∧ xs ! j = x})›
        by (auto simp: nth_Cons' less_Suc_eq_0_disj)
      have fin: ‹finite {j. j < length xs ∧ xs ! j = x}› by simp
      have notin: ‹0 ∉ Suc ` {j. j < length xs ∧ xs ! j = x}› by simp
      have inj: ‹inj_on Suc {j. j < length xs ∧ xs ! j = x}› by (rule inj_onI) simp
      show ?thesis
        using Cons True
        by (simp add: eq fin notin card_image inj)
    qed
  next
    case False
    with Cons show ?thesis
      by (auto simp: nth_Cons' gr0_conv_Suc intro!: bij_betw_same_card[of Suc])
  qed
qed simp

lemma count_list_lvertical: 
  ‹count_list (lvertical lxss i) x = (if i < llength lxss then card {j. j ≤ i ∧ j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x} else 0)›
proof (cases ‹enat i < llength lxss›)
  case False
  then show ?thesis by (simp add: lvertical_def)
next
  case ili: True
  have lv: ‹lvertical lxss i = ltaken (Suc i) (lnth lxss i)›
    using ili by (simp add: lvertical_def)
  show ?thesis
  proof (cases ‹enat (Suc i) ≤ llength (lnth lxss i)›)
    case leq: True
    have len: ‹length (ltaken (Suc i) (lnth lxss i)) = Suc i›
      by (simp del: ltaken.simps add: length_ltaken leq)
    have nth: ‹⋀j. j < Suc i ⟹ ltaken (Suc i) (lnth lxss i) ! j = lnth (lnth lxss i) j›
      by (metis leq nth_ltaken)
    have li: ‹⋀j. j ≤ i ⟹ enat j < llength (lnth lxss i)›
    proof -
      fix j assume hj: ‹j ≤ i›
      have ‹enat (Suc j) ≤ enat (Suc i)› using hj by simp
      also have ‹enat (Suc i) ≤ llength (lnth lxss i)› using leq by (simp add: Suc_ile_eq)
      finally show ‹enat j < llength (lnth lxss i)› by (simp add: Suc_ile_eq)
    qed
    have set_eq: ‹{j. j < length (ltaken (Suc i) (lnth lxss i)) ∧ ltaken (Suc i) (lnth lxss i) ! j = x}
      = {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      by (auto simp del: ltaken.simps simp add: len nth li less_Suc_eq_le)
    have key: ‹count_list (ltaken (Suc i) (lnth lxss i)) x =
        card {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      by (simp only: count_list_alt set_eq)
    have ‹count_list (lvertical lxss i) x = count_list (ltaken (Suc i) (lnth lxss i)) x›
      by (simp only: lv)
    also have ‹… = card {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      by (rule key)
    also have ‹… = (if enat i < llength lxss
        then card {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x} else 0)›
      by (simp add: ili)
    finally show ?thesis .
  next
    case nleq: False
    then obtain k where fin: ‹llength (lnth lxss i) = enat k›
      by (meson less_enatE linorder_not_le)
    from nleq fin have klt: ‹k < Suc i› by (simp add: Suc_ile_eq)
    have len_eq: ‹length (ltaken (Suc i) (lnth lxss i)) = k›
      using nleq fin by (simp del: ltaken.simps add: length_ltaken)
    have nth_eq: ‹⋀m. m < k ⟹ ltaken (Suc i) (lnth lxss i) ! m = lnth (lnth lxss i) m›
      by (metis len_eq lnth_lappend_llist_of ltaken_ldropn_decomp)
    have li: ‹⋀j. j < k ⟹ enat j < llength (lnth lxss i)›
      by (simp add: fin)
    have le_i: ‹k ≤ i› using klt by simp
    have set_eq: ‹{j. j < length (ltaken (Suc i) (lnth lxss i)) ∧ ltaken (Suc i) (lnth lxss i) ! j = x}
      = {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      by (auto simp del: ltaken.simps simp add: len_eq nth_eq li fin
          dest: order_less_le_trans[OF _ le_i])
    have key: ‹count_list (ltaken (Suc i) (lnth lxss i)) x =
        card {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      by (simp only: count_list_alt set_eq)
    have ‹count_list (lvertical lxss i) x = count_list (ltaken (Suc i) (lnth lxss i)) x›
      by (simp only: lv)
    also have ‹… = card {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      by (rule key)
    also have ‹… = (if enat i < llength lxss
        then card {j. j ≤ i ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x} else 0)›
      by (simp add: ili)
    finally show ?thesis .
  qed
qed

lemma llength_less_lfinite[simp]: ‹llength lxss < enat j ⟹ lfinite lxss›
  using enat_iless lfinite_conv_llength_enat by blast

lemma ltaken_all: ‹llength lxss < enat j ⟹ ltaken j lxss = list_of lxss›
  by (metis enat_iless length_ltaken linorder_not_le list_of_llist_of
      llength_llist_of lnth_equalityI lnth_lappend1 ltaken_ldropn_decomp
      the_enat.simps)

lemma count_list_map_filter:
  ‹count_list (List.map_filter f xs) x = card {i. i < length xs ∧ f (xs ! i) = Some x}›
proof (induct xs)
  case Nil
  show ?case by simp
next
  case (Cons a xs)
  note IH = Cons.hyps
  show ?case
  proof (cases ‹f a›)
    case None
    have set_eq: ‹{i. i < Suc (length xs) ∧ f ((a # xs) ! i) = Some x} =
        Suc ` {i. i < length xs ∧ f (xs ! i) = Some x}›
      by (auto simp: None nth_Cons' gr0_conv_Suc)
    have ‹count_list (List.map_filter f (a # xs)) x = count_list (List.map_filter f xs) x›
      by (simp add: None)
    also have ‹… = card {i. i < length xs ∧ f (xs ! i) = Some x}› by (rule IH)
    also have ‹… = card {i. i < Suc (length xs) ∧ f ((a # xs) ! i) = Some x}›
      using set_eq by (simp add: card_image)
    finally show ?thesis by simp
  next
    case (Some y)
    show ?thesis
    proof (cases ‹y = x›)
      case True
      have set_eq: ‹{i. i < Suc (length xs) ∧ f ((a # xs) ! i) = Some x} =
          insert 0 (Suc ` {i. i < length xs ∧ f (xs ! i) = Some x})›
        by (auto simp: True Some nth_Cons' less_Suc_eq_0_disj)
      have fin: ‹finite {i. i < length xs ∧ f (xs ! i) = Some x}› by simp
      have notin: ‹0 ∉ Suc ` {i. i < length xs ∧ f (xs ! i) = Some x}› by simp
      have ‹count_list (List.map_filter f (a # xs)) x =
          Suc (count_list (List.map_filter f xs) x)›
        by (simp add: Some True)
      also have ‹… = Suc (card {i. i < length xs ∧ f (xs ! i) = Some x})› by (simp add: IH)
      also have ‹… = card (insert 0 (Suc ` {i. i < length xs ∧ f (xs ! i) = Some x}))›
        by (simp add: fin notin card_image)
      also have ‹… = card {i. i < Suc (length xs) ∧ f ((a # xs) ! i) = Some x}›
        by (simp only: set_eq)
      finally show ?thesis by simp
    next
      case False
      have set_eq: ‹{i. i < Suc (length xs) ∧ f ((a # xs) ! i) = Some x} =
          Suc ` {i. i < length xs ∧ f (xs ! i) = Some x}›
        by (auto simp: Some False nth_Cons' gr0_conv_Suc)
      have ‹count_list (List.map_filter f (a # xs)) x = count_list (List.map_filter f xs) x›
        by (simp add: Some False)
      also have ‹… = card {i. i < length xs ∧ f (xs ! i) = Some x}› by (rule IH)
      also have ‹… = card {i. i < Suc (length xs) ∧ f ((a # xs) ! i) = Some x}›
        using set_eq by (simp add: card_image)
      finally show ?thesis by simp
    qed
  qed
qed

lemma count_list_lhorizontal: 
  ‹count_list (lhorizontal lxss j) x = card {i. i < j ∧ i < llength lxss ∧ j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
  unfolding lhorizontal_def count_list_map_filter
proof (rule arg_cong[where f=card])
  show ‹{i. i < length (ltaken j lxss) ∧ (if enat j < llength (ltaken j lxss ! i) then Some (lnth (ltaken j lxss ! i) j) else None) = Some x} =
        {i. i < j ∧ enat i < llength lxss ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
  proof (rule set_eqI, rule iffI)
    fix i
    assume ‹i ∈ {i. i < length (ltaken j lxss) ∧ (if enat j < llength (ltaken j lxss ! i) then Some (lnth (ltaken j lxss ! i) j) else None) = Some x}›
    hence h_lt: ‹i < length (ltaken j lxss)› and h_if: ‹enat j < llength (ltaken j lxss ! i)›
      and h_x: ‹lnth (ltaken j lxss ! i) j = x›
      by (auto split: if_splits)
    have h_i_lt: ‹enat i < llength lxss›
    proof (cases ‹enat j ≤ llength lxss›)
      case True
      with h_lt have ‹i < j› by (simp add: length_ltaken)
      with True show ?thesis by (simp add: order_less_le_subst2)
    next
      case False
      with h_lt have ‹i < the_enat (llength lxss)› by (simp add: length_ltaken)
      then show ?thesis
        by (metis False enat_iless enat_ord_simps(2) linorder_not_less the_enat.simps)
    qed
    have h_key: ‹ltaken j lxss ! i = lnth lxss i›
      by (metis h_lt length_ltaken linorder_not_le llength_less_lfinite ltaken_all nth_list_of nth_ltaken)
    show ‹i ∈ {i. i < j ∧ enat i < llength lxss ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
      using h_lt h_if h_x h_i_lt h_key
      by (smt (verit, del_insts) order.strict_trans enat_ord_simps(2) length_ltaken
          linorder_less_linear mem_Collect_eq order.strict_iff_order)
  next
    fix i
    assume ‹i ∈ {i. i < j ∧ enat i < llength lxss ∧ enat j < llength (lnth lxss i) ∧ lnth (lnth lxss i) j = x}›
    hence h_j: ‹i < j› and h_lt: ‹enat i < llength lxss›
      and h_llength: ‹enat j < llength (lnth lxss i)› and h_x: ‹lnth (lnth lxss i) j = x›
      by auto
    have h_key: ‹ltaken j lxss ! i = lnth lxss i›
      by (metis h_j llength_less_lfinite ltaken_all not_le_imp_less nth_list_of nth_ltaken)
    show ‹i ∈ {i. i < length (ltaken j lxss) ∧ (if enat j < llength (ltaken j lxss ! i) then Some (lnth (ltaken j lxss ! i) j) else None) = Some x}›
      using h_j h_lt h_llength h_x h_key
      by (smt (verit, best) enat_ord_simps(2) length_list_of length_ltaken linorder_less_linear
          llength_less_lfinite ltaken_all mem_Collect_eq order_le_less)
  qed
qed

lemma LSUM_extend: assumes ‹lprefix lxs lys›
  ‹∀i < llength lxs. f (lnth lxs i) = g (lnth lys i)›
  ‹∀i < llength lys. i ≥ llength lxs ⟶ g (lnth lys i) = 0›
  shows ‹LSUM lxs f = LSUM lys g›
proof -
  have key: ‹LSUM lxs f = LSUM lys g› if ‹lfinite lxs›
    using that assms
  proof (induct lxs arbitrary: lys rule: lfinite.induct)
    case (lfinite_LNil lys)
    have ‹∀x ∈ lset lys. g x = 0›
      using lfinite_LNil(3) by (auto simp: in_lset_conv_lnth)
    then have ‹LSUM lys g = 0› by (simp add: lsum_0_iff)
    then show ?case by simp
  next
    case (lfinite_LConsI xs x lys_outer)
    obtain ys' where ys_eq: ‹lys_outer = LCons x ys'› and pre: ‹lprefix xs ys'›
      using lfinite_LConsI(3) by (auto simp: LCons_lprefix_conv)
    have eq_x: ‹f x = g x›
      using spec[OF lfinite_LConsI(4), of 0] unfolding ys_eq
      by (simp add: zero_enat_def[symmetric])
    have IH5: ‹∀i. enat i < llength xs ⟶ f (lnth xs i) = g (lnth ys' i)›
    proof (intro allI impI)
      fix i assume hlt: ‹enat i < llength xs›
      then have hi: ‹enat (Suc i) < llength (LCons x xs)› by (simp add: Suc_ile_eq)
      have h5i: ‹enat (Suc i) < llength (LCons x xs) ⟶
          f (lnth (LCons x xs) (Suc i)) = g (lnth lys_outer (Suc i))›
        by (rule spec[OF lfinite_LConsI(4), of ‹Suc i›])
      show ‹f (lnth xs i) = g (lnth ys' i)›
        using h5i hi unfolding ys_eq by simp
    qed
    have IH6: ‹∀i. enat i < llength ys' ⟶ llength xs ≤ enat i ⟶ g (lnth ys' i) = 0›
    proof (intro allI impI)
      fix i assume hi: ‹enat i < llength ys'› and hi2: ‹llength xs ≤ enat i›
      have h1: ‹enat (Suc i) < llength lys_outer›
        unfolding ys_eq by (simp add: Suc_ile_eq hi)
      have h2: ‹llength (LCons x xs) ≤ enat (Suc i)›
        by (simp add: eSuc_enat[symmetric] hi2)
      have h6i: ‹enat (Suc i) < llength lys_outer ⟶
          llength (LCons x xs) ≤ enat (Suc i) ⟶ g (lnth lys_outer (Suc i)) = 0›
        by (rule spec[OF lfinite_LConsI(5), of ‹Suc i›])
      show ‹g (lnth ys' i) = 0›
        using h6i h1 h2 unfolding ys_eq by simp
    qed
    have eq_tails: ‹LSUM xs f = LSUM ys' g›
      by (rule lfinite_LConsI(2)[of ys', OF pre IH5 IH6])
    show ?case unfolding ys_eq using eq_x eq_tails by simp
  qed
  show ?thesis
  proof (cases ‹lfinite lxs›)
    case True show ?thesis using key[OF True] .
  next
    case False then show ?thesis using assms
      by (metis in_lset_conv_lnth llist.map_cong not_lfinite_lprefix_conv_eq)
  qed
qed

lemma lupt_0[simp]: ‹lupt i 0 = LNil›
  by (cases i) auto

lemma lprefix_lupt: ‹j ≤ k ⟹ lprefix (lupt i j) (lupt i k)›
proof (cases ‹enat i ≤ j›)
  case False
  then show ?thesis by (simp add: lnull_lprefix)
next
  case True
  assume jk: ‹j ≤ k›
  show ?thesis
  proof (cases j)
    case (enat m)
    have split: ‹lupt i k = lappend (lupt i (enat m)) (lupt m k)›
      using True[unfolded enat] jk[unfolded enat]
      by (coinduction arbitrary: i m k)
         (force simp: Suc_ile_eq not_le order_less_le_subst2 dual_order.strict_trans1 lappend_lnull1)
    then show ?thesis
      unfolding enat lprefix_conv_lappend by blast
  next
    case infinity
    then show ?thesis using True jk by simp
  qed
qed

lemma if_card_else_0: ‹(if P z then card {x. Q x z} else 0) = card {x. P z ∧ Q x z}›
  by auto

lemma LSUM_llist_of[simp]: ‹LSUM (llist_of xs) f = sum_list (map f xs)›
  by (induct xs) auto

lemma card_sum_list: ‹(⋀i. P i ⟹ i ≤ n) ⟹
  card {i :: nat. P i} = sum_list (map (λi. if P i then 1 else 0) [0 ..< Suc n])›
proof (induct n arbitrary: P)
  case 0
  then show ?case by (auto simp: card_eq_0_iff card_1_singleton_iff)
next
  case (Suc n P)
  have bound: ‹⋀i. (P i ∧ i ≠ Suc n) ⟹ i ≤ n›
    using Suc.prems by (force simp: le_Suc_eq)
  have IH: ‹card {i. P i ∧ i ≠ Suc n} =
      sum_list (map (λi. if P i ∧ i ≠ Suc n then 1 else 0) [0..<Suc n])›
    by (rule Suc.hyps[of ‹λi. P i ∧ i ≠ Suc n›, OF bound])
  have sum_eq: ‹sum_list (map (λi. if P i ∧ i ≠ Suc n then 1 else 0) [0..<Suc n]) =
      sum_list (map (λi. if P i then 1 else 0) [0..<Suc n])›
    by (intro arg_cong[where f=sum_list] map_cong refl)
       (auto simp: le_Suc_eq dest: Suc.prems)
  show ?case
  proof (cases ‹P (Suc n)›)
    case True
    have fin: ‹finite {i. P i ∧ i ≠ Suc n}›
      by (rule finite_subset[of _ ‹{0..<Suc n}›])
         (auto simp: le_Suc_eq dest: Suc.prems)
    have notin: ‹Suc n ∉ {i. P i ∧ i ≠ Suc n}› by simp
    have insert_eq: ‹{i. P i} = insert (Suc n) {i. P i ∧ i ≠ Suc n}›
      using True by auto
    have ‹card {i. P i} = Suc (card {i. P i ∧ i ≠ Suc n})›
      unfolding insert_eq using fin notin by simp
    also have ‹… = Suc (sum_list (map (λi. if P i then 1 else 0) [0..<Suc n]))›
      by (metis (mono_tags, lifting) IH sum_eq)
    also have ‹… = sum_list (map (λi. if P i then 1 else 0) [0..<Suc (Suc n)])›
      using True by simp
    finally show ?thesis .
  next
    case False
    have eq: ‹{i. P i} = {i. P i ∧ i ≠ Suc n}› using False by auto
    have ‹card {i. P i} = sum_list (map (λi. if P i then 1 else 0) [0..<Suc n])›
      unfolding eq by (metis (mono_tags, lifting) IH sum_eq)
    also have ‹… = sum_list (map (λi. if P i then 1 else 0) [0..<Suc (Suc n)])›
      using False by simp
    finally show ?thesis .
  qed
qed

lemma llist_of_lupt: ‹llist_of [i ..< j] = lupt i j›
  by (coinduction arbitrary: i j) auto

lemma enat_sum_list: ‹enat (sum_list xs) = sum_list (map enat xs)›
  by (induct xs) (auto simp: enat_0 simp flip: plus_enat_simps)

lemma card_LSUM: 
  assumes ‹(⋀i. P i ⟹ i ≤ n)›
  shows ‹enat (card {i :: nat. P i}) = LSUM lenats (λi. if P i then 1 else 0)›
proof -
  have ‹enat (card {i :: nat. P i}) =
      enat (∑i←[0..<Suc n]. if P i then 1 else 0)›
    using card_sum_list[OF assms] by simp
  also have ‹… = sum_list (map (enat ∘ (λi. if P i then 1 else 0)) [0..<Suc n])›
    by (simp only: enat_sum_list list.map_comp)
  also have ‹… = LSUM (llist_of [0..<Suc n]) (enat ∘ (λi. if P i then 1 else 0))›
    by (simp only: LSUM_llist_of)
  also have ‹… = LSUM lenats (λi. if P i then 1 else 0)›
  proof (rule LSUM_extend)
    show ‹lprefix (llist_of [0..<Suc n]) lenats›
      by (simp add: llist_of_lupt lprefix_lupt del: upt.simps)
    show ‹∀i < llength (llist_of [0..<Suc n]).
        (enat ∘ (λi. if P i then 1 else 0)) (lnth (llist_of [0..<Suc n]) i) =
        (λi. if P i then 1 else 0) (lnth lenats i)›
      by (simp add: lnth_lupt one_enat_def enat_0 del: upt.simps)
    show ‹∀i < llength lenats.
        llength (llist_of [0..<Suc n]) ≤ enat i ⟶
        (λi. if P i then 1 else 0) (lnth lenats i) = 0›
      by (simp add: lnth_lupt del: upt.simps) (metis assms not_less_eq_eq)
  qed
  finally show ?thesis .
qed

lemma LSUM_extend_lenats:
  ‹LSUM lxs f =  LSUM lenats (λi. if enat i < llength lxs then f (lnth lxs i) else 0)›
proof -
  have step1: ‹LSUM (lupt 0 (llength lxs)) (f ∘ lnth lxs) =
    LSUM lenats (λi. if enat i < llength lxs then f (lnth lxs i) else 0)›
  proof (rule LSUM_extend)
    show ‹lprefix (lupt 0 (llength lxs)) lenats›
      by (simp add: lprefix_lupt)
  next
    show ‹∀i. enat i < llength (lupt 0 (llength lxs)) ⟶
      (f ∘ lnth lxs) (lnth (lupt 0 (llength lxs)) i) =
      (λi. if enat i < llength lxs then f (lnth lxs i) else 0) (lnth lenats i)›
      by (simp add: lnth_lupt)
  next
    show ‹∀i. enat i < llength lenats ⟶ llength (lupt 0 (llength lxs)) ≤ enat i ⟶
      (λi. if enat i < llength lxs then f (lnth lxs i) else 0) (lnth lenats i) = 0›
      by (fastforce simp: lnth_lupt)
  qed
  show ?thesis
    by (subst llist_conv_lmap_lupt) (simp add: llist.map_comp flip: step1)
qed

lemma LCons_eq_lmap_conv:
  ‹(LCons y lys = lmap f lxs) = (∃x lxs'. lxs = LCons x lxs' ∧ y = f x ∧ lys = lmap f lxs')›
  using lmap_eq_LCons_conv by fastforce

lemma lmap_eq_lappend: ‹lfinite lys ⟹ lmap f lxs = lappend lys lzs ⟷
  (∃lus lvs. lxs = lappend lus lvs ∧ lys = lmap f lus ∧ lzs = lmap f lvs)›
proof (induct lys arbitrary: lxs rule: lfinite_induct)
  case LNil
  then show ?case
    by (auto simp: lnull_def LNil_eq_lmap)
next
  case (LCons lys lxs)
  from LCons(3)[of ‹ltl lxs›] LCons(1,2) show ?case
    by (cases lxs; cases lys)
      (fastforce simp: lnull_def lmap_eq_LCons_conv LCons_eq_lmap_conv lmap_lappend_distrib
         intro: exI[of _ ‹LCons _ _›])+
qed

lemma llist_of_eq_lmap_conv: 
  ‹llist_of xs = lmap f lxs ⟷ (∃ys. lxs = llist_of ys ∧ map f ys = xs)›
  by (induct xs arbitrary: lxs) (force simp: LNil_eq_lmap LCons_eq_lmap_conv map_eq_Cons_conv)+

lemma neq_LCons_conv: ‹(∀x lxs. lys ≠ LCons x lxs) ⟷ lys = LNil›
  by (cases lys; simp)

lemma epred_iadd: ‹epred (a + b) = (if a = 0 then epred b else epred a + b)›
  by (cases a rule: co.enat.exhaust) (auto simp: epred_iadd1)

lemma LSUM_isum: ‹ldistinct lxs ⟹ LSUM lxs f = isum f (lset lxs)›
proof (coinduction arbitrary: lxs f)
  case eq_enat
  show ?case
  proof (intro conjI impI disjI1)
    show ‹(LSUM lxs f = 0) = (isum f (lset lxs) = 0)›
      by (auto simp: lsum_0_iff isum_eq_0_iff)
  next
    assume hne1: ‹LSUM lxs f ≠ 0› and hne2: ‹isum f (lset lxs) ≠ 0›
    have hexists: ‹∃x ∈ lset (lmap f lxs). x ≠ 0›
      using hne1 by (auto simp: lsum_0_iff)
    have hfin: ‹lfinite (ltakeWhile ((=) 0) (lmap f lxs))›
      using hexists by (auto simp: lfinite_ltakeWhile)
    have hnotnil: ‹ldropWhile ((=) 0) (lmap f lxs) ≠ LNil›
      using hexists by (auto simp: ldropWhile_eq_LNil_iff)
    obtain z lzs where hlws: ‹ldropWhile ((=) 0) (lmap f lxs) = LCons z lzs›
      using hnotnil by (cases ‹ldropWhile ((=) 0) (lmap f lxs)›) auto
    have hnz: ‹z ≠ 0›
      using hexists hlws by (simp add: ldropWhile_eq_LCons_iff)
    define zs where ‹zs = list_of (ltakeWhile ((=) 0) (lmap f lxs))›
    have hlmap: ‹lmap f lxs = lappend (llist_of zs) (LCons z lzs)›
      unfolding zs_def using hfin hlws
      by (metis lappend_ltakeWhile_ldropWhile llist_of_list_of)
    have hzeros: ‹∀x ∈ set zs. x = 0›
      using hfin lset_ltakeWhileD zs_def by fastforce
    let ?f = ‹λy. if y = lnth lxs (length zs) then epred (f y) else f y›
    have hep1: ‹epred (LSUM lxs f) = LSUM lxs ?f›
    proof -
      { fix ys :: ‹'a list› and x :: ‹'a› and lxs' :: ‹'a llist›
        assume hall: ‹∀z∈set ys. f z = 0› and hfx: ‹f x ≠ 0›
          and hnotinys: ‹x ∉ set ys› and hnotinlxs': ‹x ∉ lset lxs'›
        have hsum0: ‹sum_list (map f ys) = 0›
          using hall by simp
        have hsum_if0: ‹(∑z←ys. if z = x then epred (f z) else f z) = 0›
          using hnotinys hall by (auto intro!: sum_list_0 split: if_splits)
        have hLSUM_eq: ‹LSUM lxs' (λz. if z = x then epred (f z) else f z) = LSUM lxs' f›
          by (rule arg_cong[where f=‹lsum›], rule llist.map_cong0) (use hnotinlxs' in auto)
        have ‹epred (sum_list (map f ys) + (f x + LSUM lxs' f)) =
          (∑z←ys. if z = x then epred (f z) else f z) + (epred (f x) + LSUM lxs' (λz. if z = x then epred (f z) else f z))›
          using hfx hsum0 hsum_if0 hLSUM_eq by (simp add: epred_iadd1 hsum0 hsum_if0)
      }
      thus ?thesis
        using hlmap hzeros hnz eq_enat
        by (auto simp: lmap_eq_lappend lmap_lappend_distrib lsum_lappend LCons_eq_lmap_conv
            llist_of_eq_lmap_conv ldistinct_lappend lnth_lappend2)
    qed
    have hep2: ‹epred (isum f (lset lxs)) = isum ?f (lset lxs)›
    proof -
      { fix ys :: ‹'a list› and x :: ‹'a› and lxs' :: ‹'a llist›
        assume hall: ‹∀z∈set ys. f z = 0› and hfx: ‹f x ≠ 0›
          and hnotinys: ‹x ∉ set ys› and hnotinlxs': ‹x ∉ lset lxs'›
          and hdist: ‹distinct ys› and hsep: ‹set ys ∩ lset lxs' = {}›
        have hisum_ys0: ‹isum f (set ys) = 0›
          using hall by (simp add: isum_eq_0_iff)
        have hisum_ys_if0: ‹isum (λy. if y = x then epred (f y) else f y) (set ys) = 0›
          using hnotinys hall by (auto simp: isum_eq_0_iff)
        have hisum_lxs'_eq: ‹isum (λy. if y = x then epred (f y) else f y) (lset lxs') = isum f (lset lxs')›
          using hnotinlxs' by (intro isum_cong) auto
        have ‹epred (isum f (set ys) + isum f (lset lxs') + f x) =
          isum (λy. if y = x then epred (f y) else f y) (set ys) +
          isum (λy. if y = x then epred (f y) else f y) (lset lxs') + epred (f x)›
          using hfx hisum_ys0 hisum_ys_if0 hisum_lxs'_eq
          by (simp add: epred_iadd hisum_ys0 hisum_ys_if0 add.commute add.assoc)
      }
      thus ?thesis
        using hlmap hzeros hnz eq_enat
        by (auto simp: lmap_eq_lappend lmap_lappend_distrib lsum_lappend LCons_eq_lmap_conv
            llist_of_eq_lmap_conv ldistinct_lappend lnth_lappend2)
    qed
    show ‹∃(lxs' :: 'a llist) f'. epred (LSUM lxs f) = LSUM lxs' f' ∧
      epred (isum f (lset lxs)) = isum f' (lset lxs') ∧ ldistinct lxs'›
      by (intro disjI1 exI[of _ lxs] exI[of _ ‹?f›]) (auto simp: hep1 hep2 eq_enat)
  qed
qed

lemma set_partition_subset: ‹A ⊆ B ⟹ B = A ∪ (B - A)›
  by auto

lemma count_llist_isum: ‹count_llist lxs x = isum (λi. if enat i < llength lxs ∧ lnth lxs i = x then 1 else 0) UNIV›
proof (coinduction arbitrary: lxs)
  case eq_enat
  show ?case
  proof -
    have h0: ‹(count_llist lxs x = 0) = (isum (λi. if enat i < llength lxs ∧ lnth lxs i = x then 1 else 0) UNIV = 0)›
      by (auto simp: count_llist_zero_iff isum_eq_0_iff in_lset_conv_lnth)
    show ?thesis
    proof (cases ‹count_llist lxs x = 0›)
      case True
      then show ?thesis using h0 by simp
    next
      case False
      have hx_lset: ‹x ∈ lset lxs›
        using False by (simp add: count_llist_zero_iff)
      have htw_fin: ‹lfinite (ltakeWhile ((≠) x) lxs)›
        using hx_lset by (simp add: lfinite_ltakeWhile)
      obtain n where hlen_enat: ‹llength (ltakeWhile ((≠) x) lxs) = enat n›
        using lfinite_llength_enat[OF htw_fin] by blast
      have hlt_tw: ‹llength (ltakeWhile ((≠) x) lxs) < llength lxs›
        using hx_lset by (simp add: llength_ltakeWhile_lt_iff)
      have hx_at_n: ‹lnth lxs n = x›
      proof -
        have h1: ‹¬ ((≠) x) (lnth lxs (the_enat (llength (ltakeWhile ((≠) x) lxs))))›
          by (rule lnth_llength_ltakeWhile[OF hlt_tw])
        show ?thesis using h1 hlen_enat by simp
      qed
      have hn_lt: ‹enat n < llength lxs›
        using hlt_tw hlen_enat by auto
      have hdrop_eq: ‹ldropWhile ((≠) x) lxs = ldropn n lxs›
        by (simp add: ldropWhile_eq_ldrop hlen_enat ldrop_enat)
      define lxs' where hlxs': ‹lxs' = ltl (ldropWhile ((≠) x) lxs)›
      have hlxs'_eq: ‹lxs' = ldropn (Suc n) lxs›
      proof -
        have ‹ldropn n lxs = LCons (lnth lxs n) (ldropn (Suc n) lxs)›
          using ldropn_Suc_conv_ldropn[OF hn_lt] by simp
        then show ?thesis by (simp add: hlxs' hdrop_eq)
      qed
      define f where f_def: ‹f = (λi. if enat i < llength lxs ∧ lnth lxs i = x then 1 else (0 :: enat))›
      define g where g_def: ‹g = (λi. if enat i < llength lxs' ∧ lnth lxs' i = x then 1 else (0 :: enat))›
      have hsel: ‹epred (count_llist lxs x) = count_llist lxs' x›
        unfolding hlxs' by (rule count_llist_sel[OF hx_lset])
      have hfbefore: ‹∀i < n. f i = 0›
      proof (intro allI impI)
        fix i assume hi: ‹i < n›
        have hilt: ‹enat i < llength (ltakeWhile ((≠) x) lxs)›
          using hlen_enat hi by simp
        have hmem: ‹lnth (ltakeWhile ((≠) x) lxs) i ∈ lset (ltakeWhile ((≠) x) lxs)›
          by (rule iffD2[OF in_lset_conv_lnth]) (use hilt in auto)
        have hne: ‹lnth (ltakeWhile ((≠) x) lxs) i ≠ x›
          using lset_ltakeWhileD[OF hmem] by auto
        have heq2: ‹lnth (ltakeWhile ((≠) x) lxs) i = lnth lxs i›
          using ltakeWhile_nth[OF hilt] .
        show ‹f i = 0›
          unfolding f_def using hne heq2 hn_lt hlen_enat by simp
      qed
      have hfn: ‹f n = 1›
        unfolding f_def using hn_lt hx_at_n by simp
      have hfUNIV: ‹isum f UNIV = isum f {0..<Suc n} + isum f {Suc n..}›
      proof -
        have huniv: ‹UNIV = {0..<Suc n} ∪ ({Suc n..} :: nat set)› by auto
        show ?thesis by (subst huniv, rule isum_Un) auto
      qed
      have hfin_n: ‹isum f {0..<Suc n} = 1›
      proof -
        have ‹isum f {0..<Suc n} = sum f {0..<Suc n}›
          by (rule isum_eq_sum) simp
        also have ‹… = sum f {0..<n} + f n›
          by (rule sum.atLeastLessThan_Suc) simp
        also have ‹sum f {0..<n} = 0›
          by (rule sum.neutral) (use hfbefore in auto)
        finally show ?thesis using hfn by simp
      qed
      have hfg_len: ‹enat (k + Suc n) < llength lxs ⟷ enat k < llength lxs'› for k
        by (metis hlxs'_eq ldropn_Suc_conv_ldropn ldropn_eq_LConsD ldropn_ldropn)
      have hfg_lnth: ‹lnth lxs (k + Suc n) = lnth lxs' k› if ‹enat k < llength lxs'› for k
        unfolding hlxs'_eq using that hfg_len[of k]
        by (subst lnth_ldropn) (auto simp: add.commute)
      have hfg_eq: ‹f (k + Suc n) = g k› for k
        using hfg_lnth hfg_len by (auto simp: f_def g_def)
      have hfg: ‹isum f {Suc n..} = isum g UNIV›
      proof (rule isum_reindex_cong[where l = ‹λk. k + Suc n›])
        show ‹inj_on (λk. k + Suc n) UNIV› by (simp add: inj_on_def)
        show ‹{Suc n..} = (λk. k + Suc n) ` UNIV›
          by (metis (no_types, lifting) ext add.commute add.right_neutral atLeast_0 image_add_atLeast)
        fix k show ‹f (k + Suc n) = g k› using hfg_eq by simp
      qed
      have heq: ‹epred (isum f UNIV) = isum g UNIV›
        by (simp add: hfUNIV hfin_n hfg epred_iadd1)
      then show ?thesis using h0 False hsel heq
        by (auto simp: f_def g_def intro: exI[of _ lxs'])
    qed
  qed
qed

lemma count_llist_lmerge: ‹count_llist (lmerge lxss) x = lsum (lmap (λlxs. count_llist lxs x) lxss)›
proof -
  let ?LSUM = ‹λP. LSUM lenats (λi. if P i then 1 else 0)›
  let ?isum = ‹λP. isum (λi. if P i then 1 else 0) UNIV›
  have vert: ‹enat (card {xa. enat z < llength lxss ∧ xa ≤ z ∧ enat xa < llength (lnth lxss z) ∧ lnth (lnth lxss z) xa = x}) =
    ?LSUM (λi. enat z < llength lxss ∧ i ≤ z ∧ enat i < llength (lnth lxss z) ∧ lnth (lnth lxss z) i = x)› for z
    by (rule card_LSUM) blast
  have horiz: ‹enat (card {i. i < z ∧ enat i < llength lxss ∧ enat z < llength (lnth lxss i) ∧ lnth (lnth lxss i) z = x}) =
    ?LSUM (λi. i < z ∧ enat i < llength lxss ∧ enat z < llength (lnth lxss i) ∧ lnth (lnth lxss i) z = x)› for z
    by (rule card_LSUM) (rule less_imp_le, blast)
  have lset_lenats: ‹lset lenats = (UNIV :: nat set)›
    by (simp add: lset_lupt)
  have LSUM_len_isum: ‹LSUM lenats f = isum f UNIV› for f :: ‹nat ⇒ enat›
    by (simp only: LSUM_isum[OF ldistinct_lupt] lset_lenats)
  have rhs_eq: ‹lsum (lmap (λlxs. count_llist lxs x) lxss) =
      isum (λa. if enat a < llength lxss then
                  isum (λb. if enat b < llength (lnth lxss a) ∧ lnth (lnth lxss a) b = x then 1 else 0) UNIV
                else 0) UNIV›
    by (subst LSUM_extend_lenats)
      (auto simp add: LSUM_len_isum count_llist_isum intro: isum_cong)
  have lhs_step1: ‹LSUM lenats (λi. count_list (lvertical lxss i @ lhorizontal lxss i) x) =
      LSUM lenats (λz.
        ?LSUM (λi. enat z < llength lxss ∧ i ≤ z ∧ enat i < llength (lnth lxss z) ∧ lnth (lnth lxss z) i = x) +
        ?LSUM (λi. i < z ∧ enat i < llength lxss ∧ enat z < llength (lnth lxss i) ∧ lnth (lnth lxss i) z = x))›
    unfolding plus_enat_simps(1)[symmetric] lsum_lmap_add count_list_append
      count_list_lvertical count_list_lhorizontal
    by (subst if_card_else_0) (auto simp: vert horiz)
  also have lhs_step2: ‹… =
      isum (λz.
        ?isum (λi. enat z < llength lxss ∧ i ≤ z ∧ enat i < llength (lnth lxss z) ∧ lnth (lnth lxss z) i = x) +
        ?isum (λi. i < z ∧ enat i < llength lxss ∧ enat z < llength (lnth lxss i) ∧ lnth (lnth lxss i) z = x)) UNIV›
    by (simp only: LSUM_len_isum)
  also have lhs_step3: ‹… =
      isum (λz. ?isum (λi. enat z < llength lxss ∧ i ≤ z ∧ enat i < llength (lnth lxss z) ∧ lnth (lnth lxss z) i = x)) UNIV +
      isum (λz. ?isum (λi. i < z ∧ enat i < llength lxss ∧ enat z < llength (lnth lxss i) ∧ lnth (lnth lxss i) z = x)) UNIV›
    by (rule isum_plus)
  also have lhs_step4: ‹isum (λz. ?isum (λi. i < z ∧ enat i < llength lxss ∧ enat z < llength (lnth lxss i) ∧ lnth (lnth lxss i) z = x)) UNIV =
      isum (λa. ?isum (λz. a < z ∧ enat a < llength lxss ∧ enat z < llength (lnth lxss a) ∧ lnth (lnth lxss a) z = x)) UNIV›
    by (rule isum_swap)
  finally have lhs_eq: ‹LSUM lenats (λi. count_list (lvertical lxss i @ lhorizontal lxss i) x) =
      isum (λa. if enat a < llength lxss then
                  isum (λb. if enat b < llength (lnth lxss a) ∧ lnth (lnth lxss a) b = x then 1 else 0) UNIV
                else 0) UNIV›
    by (unfold isum_plus[symmetric]) (auto intro!: isum_cong)
  show ?thesis
    unfolding lmerge_def count_llist_lflat
    using lhs_eq rhs_eq by (auto simp: llist.map_comp)
qed

section ‹Countable Multisets as a Subtype›

lift_definition cmcount :: ‹'a cmset ⇒ 'a ⇒ enat› is count_llist
  by (auto simp: eq_cmset_def)

lift_definition cmempty :: ‹'a cmset› is LNil .

lemma cmcount_cmempty[simp]: ‹cmcount cmempty x = 0›
  by transfer auto

lemma countable_nonzero_cmcount:
  fixes M :: ‹'a cmset›
  shows ‹countable {x. cmcount M x ≠ 0}›
proof (transfer)
  fix lxs :: ‹'a llist›
  show ‹countable {x. count_llist lxs x ≠ 0}›
  proof (rule countable_subset[of _ ‹lset lxs›])
    show ‹{x. count_llist lxs x ≠ 0} ⊆ lset lxs›
      by (auto simp: count_llist_zero_iff)
    have ‹countable {i. enat i < llength lxs}›
      by simp
    from countable_image[OF this, where f=‹lnth lxs›] show ‹countable (lset lxs)›
      by (elim countable_subset[rotated]) (auto simp: lset_conv_lnth)
  qed
qed

lemma countable_exists_llist:
  assumes ‹countable X›
  shows ‹∃lxs. lset lxs = X ∧ ldistinct lxs›
proof (cases ‹finite X›)
  case True
  then show ?thesis
  proof (induct X)
    case empty
    then show ?case
      by (auto intro: exI[of _ LNil])
  next
    case (insert x F)
    then show ?case
      by (auto intro: exI[of _ ‹LCons x _›])
  qed
next
  case False
  with assms obtain g where g: ‹bij_betw (g :: nat ⇒ 'a) UNIV X›
    using bij_betw_from_nat_into by blast
  then show ?thesis
    by (intro exI[of _ ‹lmap g lenats›])
      (auto simp: bij_betw_def image_iff inj_on_def lset_lupt)
qed

lemma in_range_cmcount:
  assumes ‹countable {x :: 'a. f x ≠ 0}›
  shows ‹f ∈ range cmcount›
proof -
  from assms obtain lxs where lxs: ‹ldistinct lxs› ‹lset lxs = {x :: 'a. f x ≠ 0}›
    using countable_exists_llist by blast
  define lys where ‹lys = lmerge (lmap (λx. lmap (λ_. x) (lupt 0 (f x))) lxs)›
  have ‹count_llist lys x = f x› for x
    unfolding lys_def count_llist_lmerge
    by (cases ‹f x = 0›) (auto simp: llist.map_comp LSUM_isum lxs count_llist_lmap_const isum_eq_0_iff
       intro: isum_eq_singl cong: if_cong)
  then show ?thesis
    by (intro image_eqI[of _ _ ‹abs_cmset lys›]) (auto simp: cmcount.abs_eq)
qed

lemma inj_cmcount: ‹inj cmcount›
  unfolding inj_on_def
  by transfer (auto simp: eq_cmset_def)

lemma type_definition_cmset: ‹type_definition cmcount (inv cmcount) {f. countable {x. f x ≠ 0}}›
  by standard (auto simp: inj_cmcount in_range_cmcount inv_f_f f_inv_into_f countable_nonzero_cmcount)

corec (friend) linterleave where
  ‹linterleave lxs lys = (case (lxs, lys) of
     (LCons x lxs', LCons y lys') ⇒ LCons x (LCons y (linterleave lxs' lys'))
   | (LCons x lxs', LNil) ⇒ LCons x lxs'
   | (LNil, LCons y lys') ⇒ LCons y lys'
   | (LNil, LNil) ⇒ LNil)›
simps_of_case linterleave_simps[simp]: linterleave.code[unfolded prod.case]

lemma linterleave_LNil[simp]:
  ‹linterleave LNil lys = lys›
  ‹linterleave lys LNil = lys›
  by (cases lys; simp)+ 

lemma linterleave_LCons1[simp]:
  ‹linterleave (LCons x lxs) lys = LCons x (linterleave lys lxs)›
proof (coinduction arbitrary: x lxs lys rule: llist.coinduct_upto)
  case Eq_llist
  then show ?case
    by (subst (9 10) linterleave.code)
      (auto 5 0 split: llist.splits intro: llist.cong_intros)
qed

lemma lset_linterleave1:
  ‹x ∈ lset (linterleave lxs lys) ⟹
   x ∈ lset lxs ∪ lset lys›
proof (induct ‹linterleave lxs lys› arbitrary: lxs lys rule: lset_induct)
  case (find lxs' lxs)
  then show ?case
    by (cases lxs) auto
next
  case (step x' lxs' lxs)
  then show ?case
    by (cases lxs) auto
qed

lemma lset_linterleave2:
  ‹x ∈ lset lxs ⟹ x ∈ lset (linterleave lxs lys)›
proof (induct lxs arbitrary: lys rule: lset_induct)
  case (find lxs)
  then show ?case
    by auto
next
  case (step x' lxs')
  then show ?case
    by (cases lys) (auto split: llist.splits)
qed

lemma lset_linterleave3:
  ‹x ∈ lset lys ⟹
   x ∈ lset (linterleave lxs lys)›
proof (induct lys arbitrary: lxs rule: lset_induct)
  case (find lys)
  then show ?case
    by (cases lxs) auto
next
  case (step x' lxs')
  then show ?case
    by (cases lxs) (auto split: llist.splits)
qed

lemma lset_linterleave[simp]:
  ‹lset (linterleave lxs lys) = lset lxs ∪ lset lys›
  by (auto dest: lset_linterleave1 lset_linterleave2 lset_linterleave3)

lemma ldistinct_linterleave: ‹ldistinct lxs ⟹ ldistinct lys ⟹ lset lxs ∩ lset lys = {} ⟹ ldistinct (linterleave lxs lys)›
proof (coinduction arbitrary: lxs lys)
  case (ldistinct lxs lys)
  then show ?case
    by (cases lxs; cases lys; force intro!: linterleave_LCons1[symmetric])
qed

coinductive linfinite where
  ‹linfinite lxs ⟹ linfinite (LCons x lxs)›

inductive linfinite_cong for R where
  ‹R lxs ⟹ linfinite_cong R lxs›
| ‹linfinite lxs ⟹ linfinite_cong R lxs›
| ‹linfinite_cong R lxs ⟹ linfinite_cong R (LCons x lxs)›

lemma linfinite_coinduct_upto[consumes 1, case_names linfinite]:
  assumes ‹X lxs› ‹⋀lys. X lys ⟹ ∃lxs x. lys = LCons x lxs ∧ linfinite_cong X lxs›
  shows ‹linfinite lxs›
proof (rule linfinite.coinduct[of ‹linfinite_cong X›])
  show ‹linfinite_cong X lxs› by (rule linfinite_cong.intros(1)) (rule assms(1))
next
  fix lxs
  assume ‹linfinite_cong X lxs›
  then show ‹∃lxs' x. lxs = LCons x lxs' ∧ (linfinite_cong X lxs' ∨ linfinite lxs')›
  proof (induct lxs rule: linfinite_cong.induct)
    case (1 lxs)
    from assms(2)[OF 1] show ?case by (auto intro: linfinite_cong.intros(3))
  next
    case (2 lxs)
    then show ?case by (auto elim: linfinite.cases intro: linfinite_cong.intros(2))
  next
    case (3 lxs y)
    then show ?case by (auto intro: linfinite_cong.intros)
  qed
qed


inductive_cases linfinite_LNilE[elim!]: ‹linfinite LNil›
inductive_cases linfinite_LConsE[elim!]: ‹linfinite (LCons x lxs)›

lemma linfinite_linterleaveL: ‹linfinite lxs ⟹ linfinite (linterleave lxs lys)›
proof (coinduction arbitrary: lxs lys rule: linfinite_coinduct_upto)
  case (linfinite lxs lys)
  then show ?case by (cases lxs; cases lys; auto intro: linfinite_cong.intros)
qed

lemma linfinite_linterleaveR: ‹linfinite lys ⟹ linfinite (linterleave lxs lys)›
proof (coinduction arbitrary: lxs lys rule: linfinite_coinduct_upto)
  case (linfinite lxs lys)
  then show ?case by (cases lxs; cases lys; auto intro: linfinite_cong.intros)
qed

lemma lfinite_imp_not_linfinite: ‹lfinite lxs ⟹ ¬ linfinite lxs›
  by (induct lxs rule: lfinite_induct) (auto simp: lnull_def neq_LNil_conv)

lemma not_lfinite_imp_linfinite: ‹¬ lfinite lxs ⟹ linfinite lxs›
proof (coinduction arbitrary: lxs)
  case (linfinite lxs)
  then show ?case by (cases lxs) auto
qed

lemma linfinite_eq_not_lfinite: ‹linfinite lxs ⟷ ¬ lfinite lxs›
  using lfinite_imp_not_linfinite not_lfinite_imp_linfinite by blast
lemma linfinite_eq_llength: ‹linfinite lxs ⟷ llength lxs = ∞›
  using lfinite_imp_not_linfinite llength_eq_infty_conv_lfinite not_lfinite_imp_linfinite by blast

lemma llength_linterleave[simp]: ‹llength (linterleave lxs lys) = llength lxs + llength lys›
proof (cases ‹linfinite lxs›)
  case True
  then show ?thesis
  proof (cases ‹linfinite lys›)
    case True
    then show ?thesis
      by (metis ‹linfinite lxs› linfinite_eq_llength linfinite_linterleaveL plus_enat_simps(3))
  next
    case False
    then show ?thesis
      by (metis ‹linfinite lxs› linfinite_eq_llength linfinite_linterleaveL plus_enat_simps(2))
  qed
next
  case False
  then have hlxs: ‹lfinite lxs› by (simp add: linfinite_eq_not_lfinite)
  show ?thesis
  proof (cases ‹linfinite lys›)
    case True
    then show ?thesis by (metis linfinite_eq_llength linfinite_linterleaveR plus_enat_simps(3))
  next
    case False
    then have hlys: ‹lfinite lys› by (simp add: linfinite_eq_not_lfinite)
    from hlxs hlys show ?thesis
    proof (induct lxs arbitrary: lys rule: lfinite_induct)
      case (LNil xs)
      then show ?case by (auto simp: lnull_def neq_LNil_conv)
    next
      case (LCons lxs)
      note outer_IH = ‹⋀lys. lfinite lys ⟹ llength (linterleave (ltl lxs) lys) = llength (ltl lxs) + llength lys›
      from ‹lfinite lys› show ?case
      proof (induct lys rule: lfinite_induct)
        case LNil
        with ‹¬ lnull lxs› show ?case by (auto simp: lnull_def neq_LNil_conv add.commute iadd_Suc_right)
      next
        case (LCons lys)
        show ?case
        proof -
          from ‹¬ lnull lxs› obtain x xs' where lxs_eq: ‹lxs = LCons x xs'›
            by (cases lxs) (auto simp: lnull_def)
          from ‹¬ lnull lys› obtain y lys' where lys_eq: ‹lys = LCons y lys'›
            by (cases lys) (auto simp: lnull_def)
          from ‹lfinite lys› have fin_lys': ‹lfinite lys'›
            by (simp add: lys_eq)
          from fin_lys' have ih_lys': ‹llength (linterleave xs' lys') = llength xs' + llength lys'›
            using outer_IH[of lys'] lxs_eq by simp
          show ?case
            by (simp only: lxs_eq lys_eq linterleave_simps llength_LCons ih_lys' iadd_Suc_right add.commute)
        qed
      qed
    qed
  qed
qed

lemma lnth_linterleave_swap: 
  ‹lnth (linterleave lxs lys) i ∉ lset lys ⟹ i < llength (linterleave lxs lys) ⟹
   ∃j < min (Suc i) (llength lxs). lnth (linterleave lxs lys) i = lnth lxs j›
proof (induct i arbitrary: lxs lys rule: less_induct)
  case (less i lxs lys)
  show ?case
  proof (cases i)
    case 0
    with less.prems show ?thesis
      by (cases lxs; cases lys) (auto simp: enat_0)
  next
    case (Suc j)
    with less.prems less.hyps show ?thesis
    proof (cases lxs)
      case LNil
      then show ?thesis
      proof (cases lys)
        case LNil
        with less.prems ‹lxs = LNil› show ?thesis by (auto simp: Suc_ile_eq)
      next
        case (LCons b lys')
        with less.prems ‹lxs = LNil› ‹i = Suc j› show ?thesis
          by (auto simp: in_lset_conv_lnth lnth_LCons' Suc_ile_eq)
      qed
    next
      case (LCons a lxs')
      show ?thesis
      proof (cases lys)
        case LNil
        with less.prems less.hyps ‹lxs = LCons a lxs'› show ?thesis
          by (auto simp: Suc_ile_eq in_lset_conv_lnth lnth_LCons' gr0_conv_Suc less_Suc_eq_le)
      next
        case (LCons b lys')
        note lxs_eq = ‹lxs = LCons a lxs'› and lys_eq = ‹lys = LCons b lys'›
        show ?thesis
        proof (cases j)
          case 0
          with less.prems lxs_eq lys_eq ‹i = Suc j› show ?thesis
            by (auto simp: Suc_ile_eq in_lset_conv_lnth lnth_LCons')
        next
          case (Suc m)
          with less.prems less.hyps lxs_eq lys_eq ‹i = Suc j› have
            IH: ‹lnth (linterleave lxs' lys') m ∉ lset lys' ⟹
                 enat m < llength (linterleave lxs' lys') ⟹
                 ∃j'. enat j' < min (enat (Suc m)) (llength lxs') ∧
                      lnth (linterleave lxs' lys') m = lnth lxs' j'›
            by (auto simp: Suc_ile_eq less_Suc_eq_le)
          from less.prems lxs_eq lys_eq ‹i = Suc j› ‹j = Suc m›
          have notin: ‹lnth (linterleave lxs' lys') m ∉ lset lys'›
            by (auto simp: Suc_ile_eq in_lset_conv_lnth lnth_LCons')
          from less.prems lxs_eq lys_eq ‹i = Suc j› ‹j = Suc m›
          have len: ‹enat m < llength (linterleave lxs' lys')›
            by (auto simp: Suc_ile_eq)
          from IH[OF notin len] obtain j' where
            j'_bound: ‹enat j' < min (enat (Suc m)) (llength lxs')›
            and j'_eq: ‹lnth (linterleave lxs' lys') m = lnth lxs' j'›
            by blast
          from j'_bound j'_eq ‹i = Suc j› ‹j = Suc m› lxs_eq lys_eq less.prems
          show ?thesis
            by (auto simp: Suc_ile_eq in_lset_conv_lnth lnth_LCons' intro!: exI[of _ ‹Suc j'›])
        qed
      qed
    qed
  qed
qed

lemma ldropWhile_eq_ldropn:
  ‹∃x ∈ lset lxs. ¬ P x ⟹ ∃n. enat n = llength (ltakeWhile P lxs) ∧ ldropWhile P lxs = ldropn n lxs›
  by (metis ldropWhile_eq_ldrop ldrop_enat lfinite_llength_enat lfinite_ltakeWhile)

lemma ltl_linterleave[simp]: ‹¬lnull lxs ⟹ ltl (linterleave lxs lys) = linterleave lys (ltl lxs)›
  by (cases lxs) auto

lemma linfinite_ltl[simp]: ‹linfinite lxs ⟹ linfinite (ltl lxs)›
  by (cases lxs) auto

lemma linfinite_ldropn[simp]: ‹linfinite lxs ⟹ linfinite (ldropn n lxs)›
  by (induct n arbitrary: lxs) (auto simp: ldropn_Suc split: llist.splits)

lemma linfinite_not_lnull: ‹linfinite lxs ⟹ ¬ lnull lxs›
  by (cases lxs) auto

lemma ldropn_linterleave: ‹linfinite lxs ⟹ linfinite lys ⟹ ldropn n (linterleave lxs lys) = 
  (if ∃m. n = 2 * m then linterleave (ldropn (n div 2) lxs) (ldropn (n div 2) lys) else
  linterleave (ldropn (n div 2) lys) (ldropn (Suc (n div 2)) lxs))›
proof (induct n arbitrary: lxs lys)
  case 0
  then show ?case by simp
next
  case (Suc n lxs lys)
  from Suc.prems(1) obtain a lxs' where lxs_eq: ‹lxs = LCons a lxs'› and linf_lxs': ‹linfinite lxs'›
    by (cases lxs) (auto dest: linfinite_not_lnull)
  have step: ‹ldropn (Suc n) (linterleave lxs lys) = ldropn n (linterleave lys lxs')›
    unfolding lxs_eq by (simp add: ldropn_Suc)
  have IH: ‹ldropn n (linterleave lys lxs') =
    (if ∃m. n = 2 * m then linterleave (ldropn (n div 2) lys) (ldropn (n div 2) lxs')
     else linterleave (ldropn (n div 2) lxs') (ldropn (Suc (n div 2)) lys))›
    by (rule Suc.hyps[OF Suc.prems(2) linf_lxs'])
  show ?case
    unfolding step lxs_eq linterleave_LCons1 ldropn_Suc_LCons IH
    by (metis even_Suc even_Suc_div_two even_mult_iff even_two_times_div_two ldropn_Suc_LCons odd_Suc_div_two)
qed

lemma llength_ltakeWhile_linterleave_ge:
  ‹enat (2 * m) ≤ llength (ltakeWhile ((≠) x) (linterleave lxs lys)) ⟹
  x ∉ set (ltaken m lxs) ∧ x ∉ set (ltaken m lys)›
proof (induct m arbitrary: lxs lys)
  case 0
  then show ?case by simp
next
  case (Suc m lxs lys)
  show ?case
  proof (cases lxs)
    case LNil
    then have hlen_lys: ‹enat (2 * Suc m) ≤ llength (ltakeWhile ((≠) x) lys)›
      using Suc.prems by simp
    have xnot: ‹x ∉ lset (ltakeWhile ((≠) x) lys)› by (metis (full_types) lset_ltakeWhileD)
    with hlen_lys llength_ltakeWhile_le[of ‹(≠) x› lys] have ‹x ∉ set (ltaken (Suc m) lys)›
    proof -
      have hlys_len: ‹enat (Suc m) ≤ llength lys›
        by (rule order_trans[OF _ llength_ltakeWhile_le[of ‹(≠) x› lys]])
           (rule order_trans[OF _ hlen_lys], simp)
      have neq: ‹⋀i. i < Suc m ⟹ lnth lys i ≠ x›
      proof (intro notI)
        fix i assume h_i: ‹i < Suc m› ‹lnth lys i = x›
        have ‹enat i < enat (2 * Suc m)› using h_i(1) by simp
        hence hi_lt: ‹enat i < llength (ltakeWhile ((≠) x) lys)›
          using hlen_lys by (rule order_less_le_trans)
        hence ‹lnth lys i ∈ lset (ltakeWhile ((≠) x) lys)›
          by (auto simp: in_lset_conv_lnth ltakeWhile_nth)
        then have ‹lnth lys i ≠ x› using lset_ltakeWhileD by fastforce
        with h_i(2) show False by simp
      qed
      show ?thesis
        unfolding set_ltaken_conv[OF hlys_len]
        by (clarsimp; use neq in fastforce)
    qed
    then show ?thesis using LNil by simp
  next
    case (LCons a lxs') note lxs_eq = this
    show ?thesis
    proof (cases lys)
      case LNil
      then have hlen_lxs: ‹enat (2 * Suc m) ≤ llength (ltakeWhile ((≠) x) lxs)›
        using Suc.prems lxs_eq by simp
      have xnot: ‹x ∉ lset (ltakeWhile ((≠) x) lxs)› by (metis (full_types) lset_ltakeWhileD)
      with hlen_lxs llength_ltakeWhile_le[of ‹(≠) x› lxs] have ‹x ∉ set (ltaken (Suc m) lxs)›
      proof -
        have hlxs_len: ‹enat (Suc m) ≤ llength lxs›
          by (rule order_trans[OF _ llength_ltakeWhile_le[of ‹(≠) x› lxs]])
             (rule order_trans[OF _ hlen_lxs], simp)
        have neq: ‹⋀i. i < Suc m ⟹ lnth lxs i ≠ x›
        proof (intro notI)
          fix i assume h_i: ‹i < Suc m› ‹lnth lxs i = x›
          have ‹enat i < enat (2 * Suc m)› using h_i(1) by simp
          hence hi_lt: ‹enat i < llength (ltakeWhile ((≠) x) lxs)›
            using hlen_lxs by (rule order_less_le_trans)
          hence ‹lnth lxs i ∈ lset (ltakeWhile ((≠) x) lxs)›
            by (auto simp: in_lset_conv_lnth ltakeWhile_nth)
          then have ‹lnth lxs i ≠ x› using lset_ltakeWhileD by fastforce
          with h_i(2) show False by simp
        qed
        show ?thesis
          unfolding set_ltaken_conv[OF hlxs_len]
          by (clarsimp; use neq in fastforce)
      qed
      then show ?thesis using LNil lxs_eq by simp
    next
      case (LCons b lys') note lys_eq = this
      have hlen: ‹enat (2 * Suc m) ≤ llength (ltakeWhile ((≠) x)
            (LCons a (LCons b (linterleave lxs' lys'))))›
        using Suc.prems unfolding lxs_eq lys_eq by simp
      have ha: ‹a ≠ x›
        using hlen by (auto simp: Suc_ile_eq enat_0_iff split: if_splits)
      have hlen': ‹enat (2 * Suc m - 1) ≤ llength (ltakeWhile ((≠) x)
            (LCons b (linterleave lxs' lys')))›
        using hlen ha by (simp add: Suc_ile_eq)
      have hb: ‹b ≠ x›
        using hlen' by (auto simp: Suc_ile_eq enat_0_iff split: if_splits)
      have hlen'': ‹enat (2 * m) ≤ llength (ltakeWhile ((≠) x) (linterleave lxs' lys'))›
        using hlen' hb by (simp add: Suc_ile_eq)
      note IH = Suc.hyps[OF hlen'']
      show ?thesis using ha hb IH unfolding lxs_eq lys_eq by simp
    qed
  qed
qed

lemma llength_ltakeWhile_linterleave_eq:
  ‹enat (2 * m) = llength (ltakeWhile ((≠) x) (linterleave lxs lys)) ⟹
  x ∉ set (ltaken m lxs) ∧ x ∉ set (ltaken m lys)›
  by (rule llength_ltakeWhile_linterleave_ge) auto

lemma llength_ltakeWhile_linterleave_ge_Suc:
  ‹linfinite lxs ⟹ linfinite lys ⟹
   enat (Suc (2 * m)) ≤ llength (ltakeWhile ((≠) x) (linterleave lxs lys)) ⟹
  x ∉ set (ltaken (Suc m) lxs) ∧ x ∉ set (ltaken m lys)›
proof (induct m arbitrary: lxs lys)
  case 0
  then show ?case by (auto simp: enat_0_iff Suc_ile_eq split: if_splits)
next
  case (Suc m lxs lys)
  from Suc.prems(1) obtain a lxs' where lxs_eq: ‹lxs = LCons a lxs'›
    by (cases lxs) (auto dest: linfinite_not_lnull)
  from Suc.prems(2) obtain b lys' where lys_eq: ‹lys = LCons b lys'›
    by (cases lys) (auto dest: linfinite_not_lnull)
  from Suc.prems lxs_eq lys_eq have linf_tails: ‹linfinite lxs'› ‹linfinite lys'›
    by auto
  from Suc.prems lxs_eq lys_eq have prems': ‹x ≠ a› ‹x ≠ b›
    ‹enat (Suc (2 * m)) ≤ llength (ltakeWhile ((≠) x) (linterleave lxs' lys'))›
    by (auto simp: Suc_ile_eq split: if_splits)
  from Suc.hyps[OF linf_tails(1) linf_tails(2) prems'(3)]
  have IH: ‹x ∉ set (ltaken (Suc m) lxs') ∧ x ∉ set (ltaken m lys')› .
  from IH prems' lxs_eq lys_eq show ?case
    by (auto simp: Suc_ile_eq split: if_splits)
qed

lemma llength_ltakeWhile_linterleave_eq_Suc:
  ‹linfinite lxs ⟹ linfinite lys ⟹
   enat (Suc (2 * m)) = llength (ltakeWhile ((≠) x) (linterleave lxs lys)) ⟹
  x ∉ set (ltaken (Suc m) lxs) ∧ x ∉ set (ltaken m lys)›
  by (rule llength_ltakeWhile_linterleave_ge_Suc) auto

lemma count_llist_linterleave: 
  ‹count_llist (linterleave lxs lys) x = count_llist lxs x + count_llist lys x›
proof ((cases ‹lfinite lxs›; cases ‹lfinite lys›), goal_cases FF FI IF II)
  case FF
  then show ?case
  proof (induct lxs arbitrary: lys)
    case (lfinite_LConsI lxs x)
    then show ?case
      by (cases lys) (auto simp: iadd_Suc_right ac_simps)
  qed simp
next
  case FI
  then show ?case
  proof (induct lxs arbitrary: lys)
    case (lfinite_LConsI lxs x)
    then show ?case
      by (cases lys) (auto simp: iadd_Suc_right ac_simps)
  qed simp
next
  case IF
  from IF(2,1) show ?case
  proof (induct lys arbitrary: lxs)
    case (lfinite_LConsI lxs x)
    then show ?case
      by (cases lxs) (auto simp: iadd_Suc_right ac_simps)
  qed simp
next
  case II
  then show ?case
  proof (coinduction arbitrary: lxs lys)
    case eq_enat
    show ?case
    proof (cases ‹x ∈ lset (linterleave lxs lys)›)
      case False
      then show ?thesis
        using eq_enat by (auto simp: count_llist_zero_iff linfinite_eq_not_lfinite)
    next
      case True
      then have hin: ‹x ∈ lset (linterleave lxs lys)› .
      obtain n where
        h_len: ‹enat n = llength (ltakeWhile ((≠) x) (linterleave lxs lys))› and
        h_drop: ‹ldropWhile ((≠) x) (linterleave lxs lys) = ldropn n (linterleave lxs lys)›
        using ldropWhile_eq_ldropn[of ‹linterleave lxs lys› ‹(≠) x›] hin by auto
      have h_lhd: ‹lhd (ldropWhile ((≠) x) (linterleave lxs lys)) = x›
      proof -
        have hlt: ‹llength (ltakeWhile ((≠) x) (linterleave lxs lys)) < llength (linterleave lxs lys)›
          by (subst llength_ltakeWhile_lt_iff) (use hin in auto)
        have h1: ‹lhd (ldropWhile ((≠) x) (linterleave lxs lys)) =
            lnth (linterleave lxs lys) (the_enat (llength (ltakeWhile ((≠) x) (linterleave lxs lys))))›
          by (rule lhd_ldropWhile_conv_lnth) (use hin in auto)
        have h2: ‹¬ ((≠) x) (lnth (linterleave lxs lys)
            (the_enat (llength (ltakeWhile ((≠) x) (linterleave lxs lys)))))›
          by (rule lnth_llength_ltakeWhile[OF hlt])
        from h1 h2 show ?thesis by simp
      qed

      show ?thesis
      proof (cases ‹∃m. n = 2 * m›)
        case True
        then obtain m :: nat where hm: ‹n = 2 * m› by auto
        have h_drop2: ‹ldropWhile ((≠) x) (linterleave lxs lys) =
            linterleave (ldropn m lxs) (ldropn m lys)›
          using h_drop hm eq_enat
          by (simp add: ldropn_linterleave linfinite_eq_not_lfinite)
        have h_hd_lxs: ‹lhd (ldropn m lxs) = x›
        proof -
          have hnn: ‹¬ lnull (ldropn m lxs)›
            by (metis eq_enat(1) linfinite_ldropn linfinite_not_lnull linfinite_eq_not_lfinite)
          have ‹lhd (linterleave (ldropn m lxs) (ldropn m lys)) = lhd (ldropn m lxs)›
            by (cases ‹ldropn m lxs›) (use hnn in auto)
          with h_lhd h_drop2 show ?thesis by simp
        qed
        have h_taken: ‹x ∉ set (ltaken m lxs) ∧ x ∉ set (ltaken m lys)›
          by (rule llength_ltakeWhile_linterleave_eq[of m]) (simp add: h_len[symmetric] hm)
        have h_lxs_eq: ‹ldropn m lxs = LCons x (ltl (ldropn m lxs))›
        proof -
          have hnn: ‹¬ lnull (ldropn m lxs)›
            by (metis eq_enat(1) linfinite_ldropn linfinite_not_lnull linfinite_eq_not_lfinite)
          from lhd_LCons_ltl[OF hnn] h_hd_lxs show ?thesis by simp
        qed
        have h_lxs_cnt: ‹count_llist lxs x = eSuc (count_llist (ltl (ldropn m lxs)) x)›
        proof -
          have heq_lxs: ‹lxs = lappend (llist_of (ltaken m lxs)) (ldropn m lxs)›
            by (rule ltaken_ldropn_decomp)
          have hcnt_lxs: ‹count_llist lxs x = count_llist (ldropn m lxs) x›
            by (subst heq_lxs, simp only: count_llist_lappend lfinite_llist_of if_True,
                simp add: h_taken count_list_0_iff zero_enat_def)
          show ?thesis
            by (simp only: hcnt_lxs, subst h_lxs_eq, simp)
        qed
        have h_lys_cnt: ‹count_llist lys x = count_llist (ldropn m lys) x›
        proof -
          have heq_lys: ‹lys = lappend (llist_of (ltaken m lys)) (ldropn m lys)›
            by (rule ltaken_ldropn_decomp)
          show ?thesis
            by (subst heq_lys, simp only: count_llist_lappend lfinite_llist_of if_True,
                simp add: h_taken count_list_0_iff zero_enat_def)
        qed
        have h_inter_cnt: ‹count_llist (linterleave lxs lys) x =
            eSuc (count_llist (linterleave (ldropn m lys) (ltl (ldropn m lxs))) x)›
        proof -
          have heq: ‹ldropWhile ((≠) x) (linterleave lxs lys) =
              LCons x (linterleave (ldropn m lys) (ltl (ldropn m lxs)))›
            by (subst h_drop2, subst h_lxs_eq, simp)
          have h_tl: ‹ltl (ldropWhile ((≠) x) (linterleave lxs lys)) =
              linterleave (ldropn m lys) (ltl (ldropn m lxs))›
            by (simp add: heq)
          from count_llist_ctr(2)[OF hin] h_tl show ?thesis
            by simp
        qed
        show ?thesis
        proof (rule conjI)
          show ‹(count_llist (linterleave lxs lys) x = 0) = (count_llist lxs x + count_llist lys x = 0)›
            by (simp add: h_inter_cnt h_lxs_cnt)
        next
          show ‹count_llist (linterleave lxs lys) x ≠ 0 ⟶ count_llist lxs x + count_llist lys x ≠ 0 ⟶
            (∃lxs' lys'. epred (count_llist (linterleave lxs lys) x) = count_llist (linterleave lxs' lys') x ∧
                         epred (count_llist lxs x + count_llist lys x) = count_llist lxs' x + count_llist lys' x ∧
                         ¬ lfinite lxs' ∧ ¬ lfinite lys') ∨
            epred (count_llist (linterleave lxs lys) x) = epred (count_llist lxs x + count_llist lys x)›
          proof (intro impI disjI1)
            show ‹∃lxs' lys'. epred (count_llist (linterleave lxs lys) x) = count_llist (linterleave lxs' lys') x ∧
                         epred (count_llist lxs x + count_llist lys x) = count_llist lxs' x + count_llist lys' x ∧
                         ¬ lfinite lxs' ∧ ¬ lfinite lys'›
            proof (rule exI[of _ ‹ldropn m lys›], rule exI[of _ ‹ltl (ldropn m lxs)›], intro conjI)
              show ‹epred (count_llist (linterleave lxs lys) x) = count_llist (linterleave (ldropn m lys) (ltl (ldropn m lxs))) x›
                by (simp add: h_inter_cnt)
              show ‹epred (count_llist lxs x + count_llist lys x) = count_llist (ldropn m lys) x + count_llist (ltl (ldropn m lxs)) x›
                by (simp add: h_lxs_cnt h_lys_cnt iadd_Suc_right add.commute)
              show ‹¬ lfinite (ldropn m lys)›
                using eq_enat by (simp add: linfinite_eq_not_lfinite)
              show ‹¬ lfinite (ltl (ldropn m lxs))›
                using eq_enat by (simp add: linfinite_eq_not_lfinite)
            qed
          qed
        qed
      next
        case False
        have hodd: ‹¬ (∃m. n = 2 * m)› using False .
        have hm: ‹n = 2 * (n div 2) + 1›
          using hodd by arith
        have h_drop2: ‹ldropWhile ((≠) x) (linterleave lxs lys) =
            linterleave (ldropn (n div 2) lys) (ldropn (Suc (n div 2)) lxs)›
          using h_drop hodd eq_enat
          by (simp add: ldropn_linterleave linfinite_eq_not_lfinite)
        have h_hd_lys: ‹lhd (ldropn (n div 2) lys) = x›
        proof -
          have hnn: ‹¬ lnull (ldropn (n div 2) lys)›
            using eq_enat by (metis linfinite_ldropn linfinite_not_lnull linfinite_eq_not_lfinite)
          have ‹lhd (linterleave (ldropn (n div 2) lys) (ldropn (Suc (n div 2)) lxs)) =
              lhd (ldropn (n div 2) lys)›
            by (cases ‹ldropn (n div 2) lys›) (use hnn in auto)
          with h_lhd h_drop2 show ?thesis by simp
        qed
        have h_taken: ‹x ∉ set (ltaken (Suc (n div 2)) lxs) ∧ x ∉ set (ltaken (n div 2) lys)›
        proof -
          have hlinf_lxs: ‹linfinite lxs› using eq_enat by (simp add: linfinite_eq_not_lfinite)
          have hlinf_lys: ‹linfinite lys› using eq_enat by (simp add: linfinite_eq_not_lfinite)
          have hlen: ‹enat (Suc (2 * (n div 2))) = llength (ltakeWhile ((≠) x) (linterleave lxs lys))›
            using h_len hm by simp
          from llength_ltakeWhile_linterleave_eq_Suc[OF hlinf_lxs hlinf_lys hlen] show ?thesis .
        qed
        have h_lys_eq: ‹ldropn (n div 2) lys = LCons x (ltl (ldropn (n div 2) lys))›
        proof -
          have hnn: ‹¬ lnull (ldropn (n div 2) lys)›
            using eq_enat by (metis linfinite_ldropn linfinite_not_lnull linfinite_eq_not_lfinite)
          from lhd_LCons_ltl[OF hnn] h_hd_lys show ?thesis by simp
        qed
        have h_lys_cnt: ‹count_llist lys x = eSuc (count_llist (ltl (ldropn (n div 2) lys)) x)›
        proof -
          have heq: ‹lys = lappend (llist_of (ltaken (n div 2) lys)) (ldropn (n div 2) lys)›
            by (rule ltaken_ldropn_decomp)
          have hcnt: ‹count_llist lys x = count_llist (ldropn (n div 2) lys) x›
            by (subst heq, simp only: count_llist_lappend lfinite_llist_of if_True,
                simp add: h_taken count_list_0_iff zero_enat_def)
          show ?thesis
            by (simp only: hcnt, subst h_lys_eq, simp)
        qed
        have h_lxs_cnt: ‹count_llist lxs x = count_llist (ldropn (Suc (n div 2)) lxs) x›
        proof -
          have hx: ‹x ∉ set (ltaken (Suc (n div 2)) lxs)› using h_taken by blast
          have heq: ‹lxs = lappend (llist_of (ltaken (Suc (n div 2)) lxs)) (ldropn (Suc (n div 2)) lxs)›
            by (rule ltaken_ldropn_decomp)
          have hA: ‹count_llist (llist_of (ltaken (Suc (n div 2)) lxs)) x = 0›
            by (simp del: ltaken.simps add: count_list_0_iff hx zero_enat_def)
          show ?thesis
            by (subst heq, simp only: count_llist_lappend lfinite_llist_of if_True hA add_0_left)
        qed
        have h_inter_cnt: ‹count_llist (linterleave lxs lys) x =
            eSuc (count_llist (linterleave (ldropn (Suc (n div 2)) lxs) (ltl (ldropn (n div 2) lys))) x)›
        proof -
          have heq: ‹ldropWhile ((≠) x) (linterleave lxs lys) =
              LCons x (linterleave (ldropn (Suc (n div 2)) lxs) (ltl (ldropn (n div 2) lys)))›
            by (subst h_drop2, subst h_lys_eq, simp)
          have h_tl: ‹ltl (ldropWhile ((≠) x) (linterleave lxs lys)) =
              linterleave (ldropn (Suc (n div 2)) lxs) (ltl (ldropn (n div 2) lys))›
            by (simp add: heq)
          from count_llist_ctr(2)[OF hin] h_tl show ?thesis
            by simp
        qed
        show ?thesis
        proof (rule conjI)
          show ‹(count_llist (linterleave lxs lys) x = 0) = (count_llist lxs x + count_llist lys x = 0)›
            by (simp add: h_inter_cnt h_lys_cnt)
        next
          show ‹count_llist (linterleave lxs lys) x ≠ 0 ⟶ count_llist lxs x + count_llist lys x ≠ 0 ⟶
            (∃lxs' lys'. epred (count_llist (linterleave lxs lys) x) = count_llist (linterleave lxs' lys') x ∧
                         epred (count_llist lxs x + count_llist lys x) = count_llist lxs' x + count_llist lys' x ∧
                         ¬ lfinite lxs' ∧ ¬ lfinite lys') ∨
            epred (count_llist (linterleave lxs lys) x) = epred (count_llist lxs x + count_llist lys x)›
          proof (intro impI disjI1)
            show ‹∃lxs' lys'. epred (count_llist (linterleave lxs lys) x) = count_llist (linterleave lxs' lys') x ∧
                         epred (count_llist lxs x + count_llist lys x) = count_llist lxs' x + count_llist lys' x ∧
                         ¬ lfinite lxs' ∧ ¬ lfinite lys'›
            proof (rule exI[of _ ‹ldropn (Suc (n div 2)) lxs›],
                   rule exI[of _ ‹ltl (ldropn (n div 2) lys)›], intro conjI)
              show ‹epred (count_llist (linterleave lxs lys) x) = count_llist (linterleave (ldropn (Suc (n div 2)) lxs) (ltl (ldropn (n div 2) lys))) x›
                by (simp add: h_inter_cnt)
              show ‹epred (count_llist lxs x + count_llist lys x) = count_llist (ldropn (Suc (n div 2)) lxs) x + count_llist (ltl (ldropn (n div 2) lys)) x›
                by (simp add: h_lxs_cnt h_lys_cnt iadd_Suc_right)
              show ‹¬ lfinite (ldropn (Suc (n div 2)) lxs)›
                using eq_enat by (simp add: linfinite_eq_not_lfinite)
              show ‹¬ lfinite (ltl (ldropn (n div 2) lys))›
                using eq_enat by (simp add: linfinite_eq_not_lfinite)
            qed
          qed
        qed
      qed
    qed
  qed
qed




lemma lfinite_linterleave[simp]: ‹lfinite (linterleave lxs lys) ⟷ lfinite lxs ∧ lfinite lys›
  by (metis enat_add_left_cancel llength_eq_infty_conv_lfinite llength_linterleave plus_enat_simps(3))

lift_definition cmadd :: ‹'a cmset ⇒ 'a cmset ⇒ 'a cmset› is linterleave
  by (auto simp: eq_cmset_def count_llist_linterleave)

lemma cmcount_cmadd[simp]: ‹cmcount (cmadd M N) x = cmcount M x + cmcount N x›
  by transfer (auto simp: count_llist_linterleave)

lemma count_llist_lmap: ‹count_llist (lmap f lxs) b = isum (count_llist lxs) {a. f a = b}›
proof -
  have h_ind: ‹⋀i. isum (λa. if enat i < llength lxs ∧ lnth lxs i = a then 1 else 0) {a. f a = b} =
              (if enat i < llength lxs ∧ f (lnth lxs i) = b then 1 else 0)›
  proof -
    fix i
    show ‹isum (λa. if enat i < llength lxs ∧ lnth lxs i = a then 1 else 0) {a. f a = b} =
          (if enat i < llength lxs ∧ f (lnth lxs i) = b then 1 else 0)›
    proof (cases ‹enat i < llength lxs ∧ f (lnth lxs i) = b›)
      case True
      then have himem: ‹lnth lxs i ∈ {a. f a = b}› by simp
      have ‹isum (λa. if lnth lxs i = a then 1 else 0) {a. f a = b} =
                 isum (λa. if lnth lxs i = a then 1 else 0) ({a. f a = b} - {lnth lxs i}) + 1›
        by (subst insert_Diff[OF himem, symmetric], subst isum_insert) (auto simp: isum_eq_0_iff)
      also have ‹isum (λa. if lnth lxs i = a then 1 else 0) ({a. f a = b} - {lnth lxs i}) = 0›
        by (auto simp: isum_eq_0_iff)
      finally show ?thesis using True by simp
    next
      case False
      then show ?thesis by (auto simp: isum_eq_0_iff)
    qed
  qed
  have step1: ‹count_llist (lmap f lxs) b = isum (λi. if enat i < llength lxs ∧ f (lnth lxs i) = b then 1 else 0) UNIV›
    by (subst count_llist_isum, rule isum_cong) auto
  have step2: ‹isum (count_llist lxs) {a. f a = b} =
    isum (λi. if enat i < llength lxs ∧ f (lnth lxs i) = b then 1 else 0) UNIV›
  proof -
    have ‹isum (count_llist lxs) {a. f a = b} =
      isum (λa. isum (λi. if enat i < llength lxs ∧ lnth lxs i = a then 1 else 0) UNIV) {a. f a = b}›
      by (rule isum_cong) (auto simp: count_llist_isum)
    also have ‹… = isum (λi. isum (λa. if enat i < llength lxs ∧ lnth lxs i = a then 1 else 0) {a. f a = b}) UNIV›
      by (rule isum_swap)
    also have ‹… = isum (λi. if enat i < llength lxs ∧ f (lnth lxs i) = b then 1 else 0) UNIV›
    proof (rule isum_cong, simp)
      fix x
      show ‹isum (λa. if enat x < llength lxs ∧ lnth lxs x = a then 1 else 0) {a. f a = b} =
            (if enat x < llength lxs ∧ f (lnth lxs x) = b then 1 else 0)›
        by (rule h_ind)
    qed
    finally show ?thesis .
  qed
  show ?thesis by (simp only: step1 step2)
qed

lemma cmcount_cmimage[simp]: ‹cmcount (cmimage f M) b = isum (cmcount M) {a. f a = b}›
  by transfer (simp add: count_llist_lmap)

lift_definition cminfinite :: ‹'a cmset ⇒ bool› is linfinite
  by (metis eq_cmset_def eq_cmset_llength linfinite_eq_llength)

lemma Sup_enat_eq_inf: ‹Sup (A :: enat set) = ∞ ⟷ ∞ ∈ A ∨ infinite A›
  by (auto simp: Sup_enat_def Max_eqI dest: Max_in)

lemma sum_eq_inf: ‹finite A ⟹ sum (f :: _ ⇒ enat) A = ∞ ⟷ (∃a ∈ A. f a = ∞)›
  by (induct A rule: finite_induct) auto

lemma inf_eq_sum: ‹finite A ⟹ ∞ = sum (f :: _ ⇒ enat) A ⟷ (∃a ∈ A. f a = ∞)›
  by (metis sum_eq_inf)

primcorec mk_chain where
  ‹mk_chain A C = (let a = (SOME a. a ∈ A) in LCons C (mk_chain (A - {a}) (insert a C)))›

lemma in_lset_mk_chainD: ‹X ∈ lset (mk_chain A C) ⟹ infinite A ⟹ ∃B ⊆ A. finite B ∧ X = C ∪ B›
proof (induct X ‹mk_chain A C› arbitrary: A C rule: llist.set_induct)
  case (LCons1 A C)
  then show ?case
    by (subst (asm) mk_chain.code) blast
next
  case (LCons2 x lxs X A C)
  let ?a = ‹SOME a. a ∈ A›
  have a_in_A: ‹?a ∈ A› using LCons2.prems by (auto simp: some_in_eq)
  have lxs_eq: ‹lxs = mk_chain (A - {?a}) (insert ?a C)›
    using LCons2.hyps(1,3) by (metis llist.inject mk_chain.code)
  have inf': ‹infinite (A - {?a})› using LCons2.prems by simp
  obtain B where B_sub: ‹B ⊆ A - {?a}› and B_fin: ‹finite B› and X_eq: ‹X = insert ?a C ∪ B›
    using LCons2.hyps(2)[unfolded lxs_eq, OF _ inf'] by blast
  show ?case using B_sub
    by (intro exI[of _ ‹insert ?a B›]) (auto simp: a_in_A B_fin X_eq)
qed

lemma linfinite_mk_chain[simp]: ‹linfinite (mk_chain A C)›
proof (coinduction arbitrary: A C)
  case (linfinite A C)
  then show ?case
    by (subst mk_chain.code) blast
qed

coinductive chain for R where
  ‹chain R LNil›
| ‹chain R (LCons x LNil)›
| ‹R x y ⟹ chain R (LCons y lxs) ⟹ chain R (LCons x (LCons y lxs))›

inductive_cases chain_LConsE: ‹chain R (LCons x lxs)›

lemma chain_mk_chain: ‹infinite A ⟹ A ∩ C = {} ⟹ chain (⊂) (mk_chain A C)›
proof (coinduction arbitrary: A C)
  case (chain A C)
  let ?a = ‹SOME a. a ∈ A›
  have ha: ‹?a ∈ A›
    using ‹infinite A› infinite_imp_nonempty by (metis some_in_eq)
  have ha_notin: ‹?a ∉ C›
    using ‹A ∩ C = {}› ha by blast
  let ?a' = ‹SOME a. a ∈ A - {?a}›
  have expand1: ‹mk_chain A C = LCons C (mk_chain (A - {?a}) (insert ?a C))›
    by (subst mk_chain.code) simp
  have expand2: ‹mk_chain (A - {?a}) (insert ?a C) =
      LCons (insert ?a C) (mk_chain (A - {?a} - {?a'}) (insert ?a' (insert ?a C)))›
    by (subst mk_chain.code) simp
  show ?case
  proof (intro disjI2)
    show ‹∃x y lxs. mk_chain A C = LCons x (LCons y lxs) ∧ x ⊂ y ∧
            ((∃A C. LCons y lxs = mk_chain A C ∧ infinite A ∧ A ∩ C = {}) ∨ chain (⊂) (LCons y lxs))›
    proof (intro exI conjI)
      show ‹mk_chain A C =
          LCons C (LCons (insert ?a C) (mk_chain (A - {?a} - {?a'}) (insert ?a' (insert ?a C))))›
        by (simp only: expand1 expand2)
      show ‹C ⊂ insert ?a C›
        using ha_notin by blast
      show ‹(∃A' C'. LCons (insert ?a C) (mk_chain (A - {?a} - {?a'}) (insert ?a' (insert ?a C))) =
              mk_chain A' C' ∧ infinite A' ∧ A' ∩ C' = {}) ∨
            chain (⊂) (LCons (insert ?a C) (mk_chain (A - {?a} - {?a'}) (insert ?a' (insert ?a C))))›
      proof (intro disjI1 exI conjI)
        show ‹LCons (insert ?a C) (mk_chain (A - {?a} - {?a'}) (insert ?a' (insert ?a C))) =
            mk_chain (A - {?a}) (insert ?a C)›
          by (rule expand2[symmetric])
        show ‹infinite (A - {?a})›
          using ‹infinite A› by simp
        show ‹(A - {?a}) ∩ (insert ?a C) = {}›
          using ‹A ∩ C = {}› ha by (auto simp: disjoint_iff)
      qed
    qed
  qed
qed

lemma chainD:
  ‹chain R lxs ⟹ enat (Suc i) < llength lxs ⟹ R (lnth lxs i) (lnth lxs (Suc i))›
proof (induct i arbitrary: lxs)
  case 0
  then show ?case by (auto simp add: zero_enat_def elim: chain.cases)
next
  case (Suc i)
  then show ?case by (fastforce simp add: zero_enat_def Suc_ile_eq elim: chain.cases)
qed

lemma chain_transD:
  assumes ‹transp R›
  shows ‹chain R lxs ⟹ i < j ⟹ enat j < llength lxs ⟹ R (lnth lxs i) (lnth lxs j)›
proof (induct ‹j - i› arbitrary: i j lxs)
  case 0
  then show ?case by simp
next
  case (Suc x)
  note IH = Suc.hyps(1)
  show ?case
  proof (cases j)
    case 0
    with Suc.prems show ?thesis by simp
  next
    case (Suc j')
    show ?thesis
    proof (cases ‹i < j'›)
      case True
      have xeq: ‹x = j' - i› using Suc.hyps(2) Suc by simp
      have lt: ‹enat j' < llength lxs›
        using Suc.prems(3) Suc by (metis enat_ord_simps(2) lessI less_trans)
      have mid: ‹R (lnth lxs i) (lnth lxs j')›
        using IH[of j' i lxs] xeq Suc.prems(1) True lt by blast
      have step: ‹R (lnth lxs j') (lnth lxs (Suc j'))›
        using chainD[OF Suc.prems(1)] Suc.prems(3) Suc by (simp add: Suc_ile_eq)
      with mid show ?thesis using assms Suc unfolding transp_def by blast
    next
      case False
      then have ‹i = j'› using Suc.prems(2) Suc by simp
      with Suc show ?thesis
        using chainD[OF Suc.prems(1)] Suc.prems(3) by (simp add: Suc_ile_eq)
    qed
  qed
qed

lemma chain_cpo_chain: ‹transp R ⟹ chain R lxs ⟹ Complete_Partial_Order.chain (reflclp R) (lset lxs)›
  unfolding Complete_Partial_Order.chain_def in_lset_conv_lnth
  by (metis (full_types) chain_transD in_lset_conv_lnth linorder_cases sup2CI)

lemma reflclp_subset: ‹reflclp (⊂) = (⊆)›
  by auto

lemma sum_strict_mono2_enat:
  fixes f :: ‹'a ⇒ enat›
  assumes ‹finite B› ‹A ⊆ B› ‹b ∈ B-A› ‹f b > 0› ‹∞ ∉ f ` B›
  shows ‹sum f A < sum f B›
proof -
  have ‹B - A ≠ {}›
    using assms(3) by blast
  have ‹sum f (B-A) > 0›
    by (rule sum_pos2) (use assms in auto)
  moreover have ‹sum f B = sum f (B-A) + sum f A›
    by (rule sum.subset_diff) (use assms in auto)
  ultimately show ?thesis
    by (metis add.commute add_diff_cancel_enat assms(1,5) enat_le_plus_same(2) idiff_self image_iff nless_le sum_eq_inf)
qed

lemma infinite_lset_chain:
  assumes ‹linfinite lxs› ‹chain R lxs› ‹irreflp R› ‹transp R›
  shows ‹infinite (lset lxs)›
proof -
  have inj: ‹inj_on (lnth lxs) UNIV›
  proof (rule inj_onI)
    fix m n :: nat assume eq: ‹lnth lxs m = lnth lxs n›
    show ‹m = n›
    proof (rule antisym)
      show ‹m ≤ n›
      proof (rule ccontr)
        assume ‹¬ m ≤ n›
        then have ‹n < m› by simp
        with assms have ‹R (lnth lxs n) (lnth lxs m)›
          using chain_transD[OF assms(4) assms(2)] linfinite_eq_llength
          by (metis enat_ord_code(4) assms(1))
        with assms(3) eq show False by (metis irreflpD)
      qed
    next
      show ‹n ≤ m›
      proof (rule ccontr)
        assume ‹¬ n ≤ m›
        then have ‹m < n› by simp
        with assms have ‹R (lnth lxs m) (lnth lxs n)›
          using chain_transD[OF assms(4) assms(2)] linfinite_eq_llength
          by (metis enat_ord_code(4) assms(1))
        with assms(3) eq show False by (metis irreflpD)
      qed
    qed
  qed
  have ‹infinite (lnth lxs ` UNIV)›
    using finite_image_iff[OF inj] by simp
  with assms(1) show ?thesis
    by (auto simp: lset_conv_lnth linfinite_eq_llength full_SetCompr_eq)
qed

lemma isum_eq_inf: ‹isum f A = ∞ ⟷ infinite {a ∈ A. f a ≠ 0} ∨ (∃a ∈ A. f a = ∞)›
proof (rule iffI)
  assume h: ‹isum f A = ∞›
  then have h2: ‹∞ ∈ sum f ` {B |B. B ⊆ A ∧ finite B} ∨ infinite (sum f ` {B |B. B ⊆ A ∧ finite B})›
    unfolding isum_def Sup_enat_eq_inf by simp
  show ‹infinite {a ∈ A. f a ≠ 0} ∨ (∃a ∈ A. f a = ∞)›
  proof (rule ccontr)
    assume hc: ‹¬ (infinite {a ∈ A. f a ≠ 0} ∨ (∃a ∈ A. f a = ∞))›
    then have hfin: ‹finite {a ∈ A. f a ≠ 0}› and hno_inf: ‹∀a ∈ A. f a ≠ ∞› by auto
    have surj: ‹sum f ` {B |B. B ⊆ A ∧ finite B} ⊆ sum f ` Pow {a ∈ A. f a ≠ 0}›
    proof
      fix s assume ‹s ∈ sum f ` {B |B. B ⊆ A ∧ finite B}›
      then obtain B where hB: ‹B ⊆ A› ‹finite B› and seq: ‹s = sum f B› by auto
      have eq: ‹sum f B = sum f {a ∈ B. f a ≠ 0}›
        by (rule sum.mono_neutral_right) (use hB in auto)
      show ‹s ∈ sum f ` Pow {a ∈ A. f a ≠ 0}›
        using hB eq seq by (auto simp: Pow_def)
    qed
    have ‹finite (sum f ` {B |B. B ⊆ A ∧ finite B})›
      by (rule finite_subset[OF surj]) (rule finite_imageI, rule finite_Pow_iff[THEN iffD2, OF hfin])
    moreover have ‹∞ ∉ sum f ` {B |B. B ⊆ A ∧ finite B}›
    proof
      assume ‹∞ ∈ sum f ` {B |B. B ⊆ A ∧ finite B}›
      then obtain B where hB: ‹B ⊆ A› ‹finite B› and seq: ‹sum f B = ∞› by auto
      then obtain a where ha: ‹a ∈ B› and hfa: ‹f a = ∞›
        using inf_eq_sum[of B f] by auto
      have ‹a ∈ A› using ha hB(1) by auto
      with hfa hno_inf show False by auto
    qed
    ultimately show False using h2 by simp
  qed
next
  assume h: ‹infinite {a ∈ A. f a ≠ 0} ∨ (∃a ∈ A. f a = ∞)›
  show ‹isum f A = ∞›
  proof (cases ‹∃a ∈ A. f a = ∞›)
    case True
    then obtain a where ha: ‹a ∈ A› and hfa: ‹f a = ∞› by auto
    have ‹∞ ∈ sum f ` {B |B. B ⊆ A ∧ finite B}›
      by (rule image_eqI[where x=‹{a}›]) (simp_all add: ha hfa)
    then show ?thesis unfolding isum_def Sup_enat_eq_inf by simp
  next
    case False
    with h have hinf: ‹infinite {a ∈ A. f a ≠ 0}› and hno_inf: ‹∞ ∉ f ` A› by auto
    show ?thesis
    proof -
      let ?Q = ‹{a ∈ A. f a ≠ 0}›
      let ?𝔄 = ‹lset (mk_chain ?Q {})›
      have h_chain_strict: ‹chain (⊂) (mk_chain ?Q {})›
        by (rule chain_mk_chain) (use hinf in simp_all)
      have h_chain: ‹Complete_Partial_Order.chain (⊆) ?𝔄›
        by (rule chain_cpo_chain[of ‹(⊂)›, unfolded reflclp_subset])
           (simp, rule h_chain_strict)
      have h_inf_𝔄: ‹infinite ?𝔄›
        by (rule infinite_lset_chain[where R=‹(⊂)›])
           (rule linfinite_mk_chain, rule h_chain_strict, simp_all)
      have h_sub_𝔄: ‹∀C ∈ ?𝔄. C ⊆ ?Q›
        by (auto dest!: in_lset_mk_chainD[OF _ hinf])
      have h_mem_𝔄: ‹∀C ∈ ?𝔄. C ∈ {B |B. B ⊆ A ∧ finite B}›
        by (auto dest!: in_lset_mk_chainD[OF _ hinf])
      have h_inj: ‹inj_on (sum f) ?𝔄›
      proof (rule inj_onI)
        fix B C assume hB: ‹B ∈ ?𝔄› and hC: ‹C ∈ ?𝔄› and heq: ‹sum f B = sum f C›
        from h_chain have chain_rel: ‹∀B ∈ ?𝔄. ∀C ∈ ?𝔄. B ⊆ C ∨ C ⊆ B›
          unfolding Complete_Partial_Order.chain_def by auto
        from chain_rel[rule_format, OF hB hC] have ‹B ⊆ C ∨ C ⊆ B› .
        moreover {
          assume hBC: ‹B ⊂ C›
          from h_mem_𝔄[rule_format, OF hC] have hCA: ‹C ⊆ A› and hfinC: ‹finite C› by simp+
          from h_mem_𝔄[rule_format, OF hB] have hfinB: ‹finite B› by simp+
          obtain c where hcC: ‹c ∈ C - B› using hBC by auto
          have hfcpos: ‹0 < f c›
            using hcC h_sub_𝔄[rule_format, OF hC] by (auto simp: zero_less_iff_neq_zero)
          have hno_infC: ‹∞ ∉ f ` C› using hCA hno_inf by auto
          have ‹sum f B < sum f C›
            using sum_strict_mono2_enat[where B=C and A=B and b=c and f=f,
                    OF hfinC _ hcC hfcpos hno_infC]
            using hBC by auto
          with heq have False by simp
        }
        moreover {
          assume hCB: ‹C ⊂ B›
          from h_mem_𝔄[rule_format, OF hB] have hBA: ‹B ⊆ A› and hfinB: ‹finite B› by simp+
          from h_mem_𝔄[rule_format, OF hC] have hCA: ‹C ⊆ A› and hfinC: ‹finite C› by simp+
          obtain c where hcB: ‹c ∈ B - C› using hCB by auto
          have hfcpos: ‹0 < f c›
            using hcB h_sub_𝔄[rule_format, OF hB] by (auto simp: zero_less_iff_neq_zero)
          have hno_infB: ‹∞ ∉ f ` B› using hBA hno_inf by auto
          have ‹sum f C < sum f B›
            using sum_strict_mono2_enat[where B=B and A=C and b=c and f=f,
                    OF hfinB _ hcB hfcpos hno_infB]
            using hCB by auto
          with heq have False by simp
        }
        ultimately show ‹B = C› by (cases ‹B = C›) auto
      qed
      have h_inf_image: ‹infinite (sum f ` ?𝔄)›
        by (metis finite_imageD h_inj h_inf_𝔄)
      have ‹sum f ` ?𝔄 ⊆ sum f ` {B |B. B ⊆ A ∧ finite B}›
        using h_mem_𝔄 by auto
      from infinite_super[OF this h_inf_image]
      show ?thesis unfolding isum_def Sup_enat_eq_inf by simp
    qed
  qed
qed

lemma cminfinite_alt: ‹cminfinite M = ((∃x. cmcount M x = ∞) ∨ infinite {x. cmcount M x ≠ 0})›
proof (transfer)
  fix M :: ‹'a llist›
  show ‹linfinite M = ((∃x. count_llist M x = ∞) ∨ infinite {x. count_llist M x ≠ 0})›
  proof (cases ‹lfinite M›)
    case True
    then have ‹¬ linfinite M› by (simp add: linfinite_eq_not_lfinite)
    moreover have ‹∀x. count_llist M x ≠ ∞›
      using True
    proof (induct M rule: lfinite.induct)
      case lfinite_LNil
      then show ?case by simp
    next
      case (lfinite_LConsI a M')
      then show ?case
        by (auto simp: eSuc_eq_infinity_iff eSuc_enat dest!: spec[of _ M'] split: if_splits)
    qed
    moreover have ‹finite {x. count_llist M x ≠ 0}›
      using True
    proof (induct M rule: lfinite.induct)
      case lfinite_LNil
      then show ?case by simp
    next
      case (lfinite_LConsI a M')
      then have ‹{x. count_llist (LCons M' a) x ≠ 0} ⊆ insert M' {x. count_llist a x ≠ 0}›
        by auto
      with lfinite_LConsI(2) show ?case
        by (meson finite_insert rev_finite_subset)
    qed
    ultimately show ?thesis by simp
  next
    case False
    then have linf: ‹linfinite M› by (simp add: linfinite_eq_not_lfinite)
    have count_inf: ‹count_llist (lmap (λ_. undefined) M) undefined = ∞›
      using False by (simp add: count_llist_lmap_const llength_eq_infty_conv_lfinite)
    then have ‹(∃x. count_llist M x = ∞) ∨ infinite {a ∈ UNIV. count_llist M a ≠ 0}›
      unfolding count_llist_lmap isum_eq_inf by fastforce
    with linf show ?thesis by simp
  qed
qed

lemma cmset_alt: ‹cmset M = {a. cmcount M a ≠ 0}›
proof (transfer)
  fix M :: ‹'a llist›
  show ‹(⋂(mx :: (unit + 'a) llist)∈Collect (eq_cmset (lmap Inr M)). ⋃ (Basic_BNFs.setr ` lset mx)) = {a. count_llist M a ≠ 0}›
  proof -
    { fix x
      assume ‹∀xa. (∀x. count_llist (lmap Inr M) x = count_llist xa x) ⟶ (∃xa∈lset xa. x ∈ Basic_BNFs.setr xa)›
      then have ‹x ∈ lset M› by force
    }
    moreover
    { fix x :: 'a and lxs :: ‹(unit + 'a) llist›
      assume ‹x ∈ lset M› and ‹∀x. count_llist (lmap Inr M) x = count_llist lxs x›
      then have ‹∃z∈lset lxs. x ∈ Basic_BNFs.setr z›
        by (metis count_llist_zero_iff imageI lset_lmap setr.intros)
    }
    ultimately show ?thesis
      by (fastforce simp: count_llist_zero_iff eq_cmset_def)
  qed
qed

lift_definition cmconst :: ‹'a ⇒ 'a cmset› is ‹repeat› .

lemma cminfinite_cmconst[simp]: ‹cminfinite (cmconst a)›
  by transfer (auto simp: linfinite_eq_not_lfinite)

lemma cminfinite_cmimage: ‹cminfinite (cmimage f M) ⟷ cminfinite M›
  by transfer (auto simp: linfinite_eq_not_lfinite)


locale cmset_as_Quotient
begin

setup_lifting Quotient_cmset

declare cmempty.transfer[transfer_rule]
declare cmadd.transfer[transfer_rule]
declare cmset.map_transfer[transfer_rule]
declare cmset.set_transfer[transfer_rule]
declare cminfinite.transfer[transfer_rule]

end

locale cmset_as_typedef
begin

setup_lifting type_definition_cmset

lemma cmempty_transfer[transfer_rule]: ‹pcr_cmset R (λ_. 0) cmempty›
  by (auto simp: pcr_cmset_def cr_cmset_def rel_fun_def relcompp_apply)

lemma cmadd_transfer[transfer_rule]: ‹rel_fun (pcr_cmset R) (rel_fun (pcr_cmset R) (pcr_cmset R)) (λM N x. M x + N x) cmadd›
  by (auto simp: pcr_cmset_def cr_cmset_def rel_fun_def relcompp_apply)

lemma cmimage_transfer[transfer_rule]: ‹rel_fun (=) (rel_fun (pcr_cmset (=)) (pcr_cmset (=))) (λf M b. isum M {a. f a = b}) cmimage›
  by (auto simp: pcr_cmset_def cr_cmset_def rel_fun_def relcompp_apply intro: isum_cong)

lemma cmset_transfer[transfer_rule]: ‹rel_fun (pcr_cmset (=)) (=) (λM. {a. M a ≠ 0}) cmset›
  by (auto simp: pcr_cmset_def cr_cmset_def rel_fun_def cmset_alt)

lemma cminfinite_transfer[transfer_rule]: ‹rel_fun (pcr_cmset (=)) (=) (λM. (∃x. M x = ∞) ∨ infinite {x. M x ≠ 0}) cminfinite›
  by (auto simp: pcr_cmset_def cr_cmset_def rel_fun_def cminfinite_alt)

lift_definition cmreplace :: ‹'a cmset ⇒ 'a ⇒ 'a ⇒ 'a cmset› is
  ‹λf a b. f(a := epred (f a), b := eSuc (f b))›
  by (erule countable_subset[rotated, OF countable_insert]) auto

lemma cminfinite_cmreplace: ‹cminfinite M ⟹ cminfinite (cmreplace M a b)›
proof (transfer fixing: a b)
  fix M :: ‹'a ⇒ enat›
  assume M: ‹countable {x. M x ≠ 0}› ‹(∃x. M x = ∞) ∨ infinite {x. M x ≠ 0}›
  show ‹(∃x. (M(a := epred (M a), b := eSuc (M b))) x = ∞) ∨ infinite {x. (M(a := epred (M a), b := eSuc (M b))) x ≠ 0}›
  proof (cases ‹∃x. M x = ∞›)
    case True
    then obtain x where ‹M x = ∞› ..
    show ?thesis
      by (metis ‹M x = ∞› eSuc_infinity epred_Infty fun_upd_other fun_upd_same)
  next
    case False
    with M have ‹infinite {x. M x ≠ 0}› by blast
    then have ‹infinite {x. (M(a := epred (M a), b := eSuc (M b))) x ≠ 0}›
      by (rule contrapos_nn, elim finite_subset[rotated, OF finite_insert[THEN iffD2, of _ a]]) auto
    then show ?thesis
      by blast
  qed
qed
end

lifting_update cmset.lifting
lifting_forget cmset.lifting

end