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')  (xset 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 : 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 (AsS. {(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: xlset 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 xY. ¬ 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 = (lxsY. 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) = ((lxsY. 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  (lxsY. count_llist lxs x)  0 
      (Z. epred (count_llist (lSup Y) x) = count_llist (lSup Z) x 
            epred (lxsY. count_llist lxs x) = (lxsZ. count_llist lxs x) 
            Complete_Partial_Order.chain lprefix Z  Z  {}) 
      epred (count_llist (lSup Y) x) = epred (lxsY. count_llist lxs x)
    proof (intro impI disjI1)
      assume h1: count_llist (lSup Y) x  0 and h2: (lxsY. 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: {lxsY. xlset 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 (lxsY. count_llist lxs x) = (lxsZ. count_llist lxs x)
      proof -
        have aux: (lxsY. epred (count_llist lxs x)) = (lxs{lxsY. xlset lxs}. count_llist (ltl (ldropWhile ((≠) x) lxs)) x)
        proof (rule antisym)
          show (lxsY. epred (count_llist lxs x))  (lxs{lxsY. xlset 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) ` {lxsY. xlset lxs})
              by (auto simp: bdd_above_def)
            fix lxs assume lxs_Y: lxs  Y
            show ya  {lxsY. xlset 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{lxsY. xlset lxs}. count_llist (ltl (ldropWhile ((≠) x) lxs)) x)  (lxsY. 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  {lxsY. xlset 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 (lxsY. count_llist lxs x) = (lxsZ. 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: zset 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: (zys. 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)) =
          (zys. 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: zset 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)  (xalset 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 zlset 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