Theory Main_Result_DCR_N1

(*     License:    LGPL  *)

subsection ‹DCR implies LD Property›

theory Main_Result_DCR_N1
  imports 
    DCR3_Method
    "Decreasing-Diagrams.Decreasing_Diagrams"
begin

(* ----------------------------------------------------------------------- *)

subsubsection ‹Auxiliary definitions›

(* ----------------------------------------------------------------------- *)

definition map_seq_labels :: "('b  'c)  ('a,'b) seq  ('a,'c) seq"
where
  "map_seq_labels f σ = (fst σ, map (λ(α,a). (f α, a)) (snd σ))"

fun map_diag_labels :: "('b  'c)  
   ('a,'b) seq × ('a,'b) seq × ('a,'b) seq × ('a,'b) seq  
   ('a,'c) seq × ('a,'c) seq × ('a,'c) seq × ('a,'c) seq"
where
  "map_diag_labels f (τ,σ,σ',τ') = ((map_seq_labels f τ), (map_seq_labels f σ), (map_seq_labels f σ'), (map_seq_labels f τ'))"
  
fun f_to_ls :: "(nat  'a)  nat  'a list"
where
  "f_to_ls f 0 = []"
| "f_to_ls f (Suc n) = (f_to_ls f n) @ [(f n)]"

(* ---------------------------------------------------------------------------------------------------- *)

subsubsection ‹Auxiliary lemmas›

lemma lem_ftofs_len: "length (f_to_ls f n) = n" by (induct n, simp+)

lemma lem_irr_inj_im_irr:
fixes r::"'a rel" and r'::"'b rel" and f::"'a  'b"
assumes "irrefl r" and "inj_on f (Field r)"
    and "r' = {(a',b').  a b. a' = f a  b' = f b  (a,b)  r}"
shows "irrefl r'"
  using assms unfolding inj_on_def Field_def irrefl_def by blast

lemma lem_tr_inj_im_tr:
fixes r::"'a rel" and r'::"'b rel" and f::"'a  'b"
assumes "trans r" and "inj_on f (Field r)"
    and "r' = {(a',b').  a b. a' = f a  b' = f b  (a,b)  r}"
shows "trans r'"
  using assms unfolding inj_on_def Field_def trans_def by blast

lemma lem_lpeak_expr: "local_peak lrs (τ, σ) = ( a b c α β. (a,α,b)  lrs  (a,β,c)  lrs  τ = (a,[(α,b)])  σ = (a,[(β,c)]))"
proof
  assume "local_peak lrs (τ, σ)"
  then show " a b c α β. (a,α,b)  lrs  (a,β,c)  lrs  τ = (a,[(α,b)])  σ = (a,[(β,c)])"
    unfolding Decreasing_Diagrams.local_peak_def Decreasing_Diagrams.peak_def
    apply(cases τ, cases σ, simp) 
    using Decreasing_Diagrams.seq_tail1(2)
    by (metis (no_types, lifting) Suc_length_conv length_0_conv prod.collapse)
next
  assume " a b c α β. (a,α,b)  lrs  (a,β,c)  lrs  τ = (a,[(α,b)])  σ = (a,[(β,c)])"
  then obtain a b c α β where "(a,α,b)  lrs  (a,β,c)  lrs  τ = (a,[(α,b)])  σ = (a,[(β,c)])" by blast
  then show "local_peak lrs (τ, σ)"
    unfolding Decreasing_Diagrams.local_peak_def Decreasing_Diagrams.peak_def
    by (simp add: Decreasing_Diagrams.seq.intros)
qed

lemma lem_map_seq:
fixes lrs::"('a,'b) lars" and f::"'b  'c" and lrs'::"('a,'c) lars" and σ::"('a,'b) seq"
assumes a1: "lrs' = {(a,l',b). l. l' = f l  (a,l,b)  lrs }" 
    and a2: "σ  Decreasing_Diagrams.seq lrs"
shows "(map_seq_labels f σ)  Decreasing_Diagrams.seq lrs'"
proof -
  have " s a. (a,s)  Decreasing_Diagrams.seq lrs  (map_seq_labels f (a,s))  Decreasing_Diagrams.seq lrs'"
  proof
    fix s
    show " a. (a,s)  Decreasing_Diagrams.seq lrs  (map_seq_labels f (a,s))  Decreasing_Diagrams.seq lrs'"
    proof (induct s)
      show "a. (a, [])  Decreasing_Diagrams.seq lrs  map_seq_labels f (a, [])  Decreasing_Diagrams.seq lrs'"
        unfolding map_seq_labels_def by (simp add: seq.intros(1))
    next
      fix p s1
      assume d1: "b. (b, s1)  Decreasing_Diagrams.seq lrs  map_seq_labels f (b, s1)  Decreasing_Diagrams.seq lrs'"
      show "b. (b, p # s1)  Decreasing_Diagrams.seq lrs  map_seq_labels f (b, p # s1)  Decreasing_Diagrams.seq lrs'"
      proof (intro allI impI)
        fix b
        assume e1: "(b, p # s1)  Decreasing_Diagrams.seq lrs"
        moreover obtain l b' where e2: "p = (l, b')" by force
        ultimately have e3: "(b,l,b')  lrs  (b',s1)  Decreasing_Diagrams.seq lrs"
          by (metis Decreasing_Diagrams.seq_tail1(1) Decreasing_Diagrams.seq_tail1(2) prod.collapse snd_conv)
        then have "(b,f l,b')  lrs'" using a1 by blast
        moreover have "map_seq_labels f (b', s1)  Decreasing_Diagrams.seq lrs'" using d1 e3 by blast
        ultimately show "map_seq_labels f (b, p # s1)  Decreasing_Diagrams.seq lrs'"
          using e2 unfolding map_seq_labels_def by (simp add: seq.intros(2))
      qed
    qed
  qed
  moreover obtain a s where "σ = (a,s)" by force
  ultimately show "(map_seq_labels f σ)  Decreasing_Diagrams.seq lrs'" using a2 by blast
qed

lemma lem_map_diag:
fixes lrs::"('a,'b) lars" and f::"'b  'c" and lrs'::"('a,'c) lars" 
    and d::"('a,'b) seq × ('a,'b) seq × ('a,'b) seq × ('a,'b) seq"
assumes a1: "lrs' = {(a,l',b). l. l' = f l  (a,l,b)  lrs }" 
    and a2: "diagram lrs d"
shows "diagram lrs' (map_diag_labels f d)"
proof -
  obtain τ σ σ' τ' where b1: "d = (τ, σ, σ', τ')" using prod_cases4 by blast
  moreover obtain τ1 σ1 σ1' τ1' where b2: "τ1 = (map_seq_labels f τ)  σ1 = (map_seq_labels f σ) 
                           (σ1' = map_seq_labels f σ')  (τ1' = map_seq_labels f τ')" by blast
  ultimately have b3: "(map_diag_labels f d) = (τ1, σ1, σ1', τ1')" by simp
  have b4: "fst σ = fst τ  lst σ = fst τ'  lst τ = fst σ'  lst σ' = lst τ'" 
    using b1 a2 unfolding Decreasing_Diagrams.diagram_def by simp
  have b5: "σ1  Decreasing_Diagrams.seq lrs'  τ1  Decreasing_Diagrams.seq lrs' 
          σ1'  Decreasing_Diagrams.seq lrs'  τ1'  Decreasing_Diagrams.seq lrs'" 
      using a1 a2 b1 b2 lem_map_seq[of lrs' f] by (simp add: Decreasing_Diagrams.diagram_def)
  moreover have "fst σ1 = fst τ1" using b2 b4 unfolding map_seq_labels_def by simp
  moreover have "lst σ1 = fst τ1'  lst τ1 = fst σ1'" using b4 
    by (simp add: b2 map_seq_labels_def lst_def, metis (no_types, lifting) case_prod_beta last_map snd_conv)
  moreover have "lst σ1' = lst τ1'" using b4 
    by (simp add: b2 map_seq_labels_def lst_def, metis (no_types, lifting) case_prod_beta last_map snd_conv)
  ultimately show "diagram lrs' (map_diag_labels f d)" using b3 b5 unfolding Decreasing_Diagrams.diagram_def by simp
qed

lemma lem_map_D_loc:
fixes cmp cmp' s1 s2 s3 s4 f
assumes a1: "Decreasing_Diagrams.D cmp s1 s2 s3 s4" 
    and a2: "trans cmp" and a3: "irrefl cmp" and a4: "inj_on f (Field cmp)"
    and a5: "cmp' = {(a',b').  a b. a' = f a  b' = f b  (a,b)  cmp}"
    and a6: "length s1 = 1" and a7: "length s2 = 1"
shows "Decreasing_Diagrams.D cmp' (map f s1) (map f s2) (map f s3) (map f s4)"
proof -
  obtain α where b1: "s2 = [α]" using a7 by (metis One_nat_def Suc_length_conv length_0_conv)
  moreover obtain β where b2: "s1 = [β]" using a6 by (metis One_nat_def Suc_length_conv length_0_conv)
  ultimately have b3: "Decreasing_Diagrams.D cmp [β] [α] s3 s4" using a1 by blast
  then obtain σ1 σ2 σ3 τ1 τ2 τ3 where b4: "s3 = σ1@σ2@σ3" and b5: "s4 = τ1@τ2@τ3" and b6: "LD' cmp β α σ1 σ2 σ3 τ1 τ2 τ3"
    using Decreasing_Diagrams.proposition3_4_inv[of cmp β α s3 s4] a2 a3 by blast
  obtain σ1' σ2' σ3' where b7: "σ1' = map f σ1  σ2' = map f σ2  σ3' = map f σ3" by blast
  obtain τ1' τ2' τ3' where b8: "τ1' = map f τ1  τ2' = map f τ2  τ3' = map f τ3" by blast
  obtain s3' s4' where b9: "s3' = map f s3" and b10: "s4' = map f s4" by blast
  have "trans cmp'" using a2 a4 a5 lem_tr_inj_im_tr by blast
  moreover have "irrefl cmp'" using a3 a4 a5 lem_irr_inj_im_irr by blast
  moreover have "s3' = σ1'@σ2'@σ3'" using b4 b7 b9 by simp
  moreover have "s4' = τ1'@τ2'@τ3'" using b5 b8 b10 by simp
  moreover have "LD' cmp' (f β) (f α) σ1' σ2' σ3' τ1' τ2' τ3'"
  proof -
     have c1: "LD_1' cmp β α σ1 σ2 σ3" and c2: "LD_1' cmp α β τ1 τ2 τ3" 
      using b6 unfolding Decreasing_Diagrams.LD'_def by blast+
     have "LD_1' cmp' (f β) (f α) σ1' σ2' σ3'"
      using c1 unfolding Decreasing_Diagrams.LD_1'_def Decreasing_Diagrams.ds_def by (simp add: a5 b7, blast)
     moreover have "LD_1' cmp' (f α) (f β) τ1' τ2' τ3'"
      using c2 unfolding Decreasing_Diagrams.LD_1'_def Decreasing_Diagrams.ds_def by (simp add: a5 b8, blast)
     ultimately show "LD' cmp' (f β) (f α) σ1' σ2' σ3' τ1' τ2' τ3'" unfolding Decreasing_Diagrams.LD'_def by blast
  qed
  ultimately have "Decreasing_Diagrams.D cmp' [f β] [f α] s3' s4'" using Decreasing_Diagrams.proposition3_4[of cmp'] by blast
  moreover have "(map f s1) = [f β]  (map f s2) = [f α]" using b1 b2 by simp
  ultimately show "Decreasing_Diagrams.D cmp' (map f s1) (map f s2) (map f s3) (map f s4)" using b9 b10 by simp
qed

lemma lem_map_DD_loc:
fixes lrs::"('a,'b) lars" and cmp::"'b rel" and lrs'::"('a,'c) lars" and cmp'::"'c rel" and f::"'b  'c"
assumes a1: "trans cmp" and a2: "irrefl cmp" and a3: "inj_on f (Field cmp)"
    and a4: "cmp' = {(a',b').  a b. a' = f a  b' = f b  (a,b)  cmp}"
    and a5: "lrs' = {(a,l',b). l. l' = f l  (a,l,b)  lrs }"
    and a6: "length (snd (fst d)) = 1" and a7: "length (snd (fst (snd d))) = 1"
    and a8: "DD lrs cmp d"
shows "DD lrs' cmp' (map_diag_labels f d)"
proof -
  have "diagram lrs' (map_diag_labels f d)" using a4 a5 a8 lem_map_diag unfolding Decreasing_Diagrams.DD_def by blast
  moreover have "D2 cmp' (map_diag_labels f d)"
  proof -
    obtain τ σ σ' τ' where c1: "d = (τ,σ,σ',τ')" by (metis prod_cases3)
    obtain s1 s2 s3 s4 where c2: "s1 = labels τ  s2 = labels σ  s3 = labels σ'  s4 = labels τ'" by blast
    have "Decreasing_Diagrams.D cmp s1 s2 s3 s4" 
      using a8 c1 c2 unfolding Decreasing_Diagrams.DD_def Decreasing_Diagrams.D2_def by simp
    moreover have "length s1 = 1  length s2 = 1" using a6 a7 c1 c2 unfolding labels_def by simp
    ultimately have "Decreasing_Diagrams.D cmp' (map f s1) (map f s2) (map f s3) (map f s4)"
      using a1 a2 a3 a4 lem_map_D_loc by blast
    moreover have "labels (map_seq_labels f τ) = (map f s1)" 
              and "labels (map_seq_labels f σ) = (map f s2)"
              and "labels (map_seq_labels f σ') = (map f s3)"
              and "labels (map_seq_labels f τ') = (map f s4)"
      using c2 unfolding map_seq_labels_def Decreasing_Diagrams.labels_def by force+
    ultimately have "D2 cmp' ((map_seq_labels f τ), (map_seq_labels f σ), (map_seq_labels f σ'), (map_seq_labels f τ'))"
      unfolding Decreasing_Diagrams.D2_def by simp
    then show "D2 cmp' (map_diag_labels f d)" using c1 unfolding Decreasing_Diagrams.D2_def by simp
  qed
  ultimately show "DD lrs' cmp' (map_diag_labels f d)" unfolding Decreasing_Diagrams.DD_def by blast
qed

lemma lem_ddseq_mon: "lrs1  lrs2  Decreasing_Diagrams.seq lrs1  Decreasing_Diagrams.seq lrs2"
proof -
  assume a1: "lrs1  lrs2"
  show "Decreasing_Diagrams.seq lrs1  Decreasing_Diagrams.seq lrs2"
  proof
    fix a s
    assume b1: "(a,s)  Decreasing_Diagrams.seq lrs1"
    show "(a,s)  Decreasing_Diagrams.seq lrs2"
      by (rule Decreasing_Diagrams.seq.induct[of _ _ lrs1], 
          simp only: b1, simp only: seq.intros(1), meson a1 contra_subsetD seq.intros(2))
  qed
qed

lemma lem_dd_D_mon:
fixes cmp1 cmp2 α β s1 s2
assumes a1: "trans cmp1  irrefl cmp1" and a2: "trans cmp2  irrefl cmp2" and a3: "cmp1  cmp2"
    and a4: "Decreasing_Diagrams.D cmp1 [α] [β] s1 s2"
shows "Decreasing_Diagrams.D cmp2 [α] [β] s1 s2"
proof -
  obtain σ1 σ2 σ3 τ1 τ2 τ3 
    where b1: "s1 = σ1@σ2@σ3  s2 = τ1@τ2@τ3" and b2: "LD' cmp1 α β σ1 σ2 σ3 τ1 τ2 τ3" 
    using a1 a4 Decreasing_Diagrams.proposition3_4_inv[of "cmp1" α β s1 s2] by blast
  then have b3: "LD_1' cmp1 α β σ1 σ2 σ3" and b4: "LD_1' cmp1 β α τ1 τ2 τ3" 
    unfolding Decreasing_Diagrams.LD'_def by blast+
  have "LD_1' cmp2 α β σ1 σ2 σ3" 
    using a3 b3 unfolding Decreasing_Diagrams.LD_1'_def Decreasing_Diagrams.ds_def by blast
  moreover have "LD_1' cmp2 β α τ1 τ2 τ3"
    using a3 b4 unfolding Decreasing_Diagrams.LD_1'_def Decreasing_Diagrams.ds_def by blast
  ultimately show "Decreasing_Diagrams.D cmp2 [α] [β] s1 s2"
    using Decreasing_Diagrams.proposition3_4[of cmp2 α β] by (simp add: a2 b1 LD'_def)
qed

(* ----------------------------------------------------------------------- *)

subsubsection ‹Result›

(* ----------------------------------------------------------------------- *)

text ‹The next lemma has the following meaning: every ARS in the finite DCR hierarchy has the LD property.›

lemma lem_dcr_to_ld:
fixes n::nat and r::"'U rel"
assumes "DCR n r"
shows "LD (UNIV::nat set) r"
proof -
  obtain g::"nat  'U rel" where
    b1: "DCR_generating g" and b3: "r =  { r'.  α'. α' < n  r' = g α' }"
    using assms unfolding DCR_def by blast
  obtain lrs::"('U, nat) lars" where b4: "lrs = {(a,α',b). α' < n  (a,b)  g α'}" by blast
  obtain cmp::"nat rel" where b5: "cmp = {(α, β). α < β }" by blast
  have "r = unlabel lrs" using b3 b4 unfolding unlabel_def by blast
  moreover have b6: "trans cmp" using b5 unfolding trans_def by force
  moreover have b7: "wf cmp"
  proof -
    have "cmp = ({(x::nat, y::nat). x < y})"
      unfolding b5 lex_prod_def by fastforce
    moreover have "wf {(x::nat, y::nat). x < y}" using wf_less by blast
    ultimately show ?thesis using wf_lex_prod by blast
  qed
  moreover have "P. local_peak lrs P  ( σ' τ'. DD lrs cmp (fst P,snd P,σ',τ'))"
  proof (intro allI impI)
    fix P
    assume c1: "local_peak lrs P"
    moreover obtain τ σ where c2: "P = (τ, σ)" using surjective_pairing by blast
    ultimately obtain a b c α β 
        where c3: "(a,α,b)  lrs  (a,β,c)  lrs" 
          and c4: "σ = (a,[(α,b)])  τ = (a,[(β,c)])" using lem_lpeak_expr[of lrs] by blast
    then have c5: "α < n  β < n" and c6: "(a,b)  (g α)  (a,c)  (g β)" using b4 by blast+
    obtain b' b'' c' c'' d where 
                 c7: "(b,b')  (𝔏1 g α)^*  (b',b'')  (g β)^=  (b'',d)  (𝔏v g α β)^*"
             and c8: "(c,c')  (𝔏1 g β)^*  (c',c'')  (g α)^=  (c'',d)  (𝔏v g β α)^*" 
             using b1 c6 unfolding DCR_generating_def 𝔇_def by (metis (no_types, lifting) mem_Collect_eq old.prod.case)
    obtain pn1 where "(b,b')  (𝔏1 g α)^^pn1" using c7 by fastforce
    then obtain ph1 where pc9: "ph1 0 = b  ph1 pn1 = b'" and " i::nat. i < pn1  (ph1 i, ph1 (Suc i))  (𝔏1 g α)"
      using relpow_fun_conv by metis
    then have " i::nat. i<pn1  ( α'. α' < α  (ph1 i, ph1 (Suc i))  g α')" unfolding 𝔏1_def by blast
    then obtain pαi1::"nat  nat" 
      where pc10: " i::nat. i<pn1  (pαi1 i) < α  (ph1 i, ph1 (Suc i))  g (pαi1 i)" by metis
    let ?pf1 = "λi. ( pαi1 i, ph1 (Suc i) )"
    obtain pls1 where pc11: "pls1 = (f_to_ls ?pf1 pn1)" by blast
    obtain n1 where "(b'',d)  (𝔏v g α β)^^n1" using c7 by fastforce
    then obtain h1 where c9: "h1 0 = b''  h1 n1 = d" and " i::nat. i < n1  (h1 i, h1 (Suc i))  (𝔏v g α β)"
      using relpow_fun_conv by metis
    then have " i::nat. i < n1  ( α'. (α' < α  α' < β)  (h1 i, h1 (Suc i))  g α')" unfolding 𝔏v_def by blast
    then obtain αi1::"nat  nat" 
      where c10: " i::nat. i<n1  ((αi1 i) < α  (αi1 i) < β)  (h1 i, h1 (Suc i))  g (αi1 i)" by metis
    let ?f1 = "λi. ( αi1 i, h1 (Suc i) )"
    obtain ls1 where c11: "ls1 = (f_to_ls ?f1 n1)" by blast
    obtain τ'' where qc12: "τ'' = (if b' = b'' then (b'', ls1) else (b', (β, b'') # ls1))" by blast
    obtain τ' where c12: "τ' = (b, pls1 @ (snd τ''))" by blast
    obtain pn2 where "(c,c')  (𝔏1 g β)^^pn2" using c8 by fastforce
    then obtain ph2 where pc13: "ph2 0 = c  ph2 pn2 = c'" and " i::nat. i < pn2  (ph2 i, ph2 (Suc i))  (𝔏1 g β)"
      using relpow_fun_conv by metis
    then have " i::nat. i<pn2  ( α'. α' < β  (ph2 i, ph2 (Suc i))  g α')" unfolding 𝔏1_def by blast
    then obtain pαi2::"nat  nat" 
      where pc14: " i::nat. i<pn2  (pαi2 i) < β  (ph2 i, ph2 (Suc i))  g (pαi2 i)" by metis
    let ?pf2 = "λi. ( pαi2 i, ph2 (Suc i) )"
    obtain pls2 where pc15: "pls2 = (f_to_ls ?pf2 pn2)" by blast
    have "𝔏v g β α = 𝔏v g α β" unfolding 𝔏v_def by blast
    then have "(c'',d)  (𝔏v g α β)^*" using c8 by simp
    then obtain n2 where "(c'',d)  (𝔏v g α β)^^n2" using c8 by fastforce
    then obtain h2 where c13: "h2 0 = c''  h2 n2 = d" and " i::nat. i < n2  (h2 i, h2 (Suc i))  (𝔏v g α β)"
      using relpow_fun_conv by metis
    then have " i::nat. i<n2  ( α'. (α' < α  α' < β)  (h2 i, h2 (Suc i))  g α')" unfolding 𝔏v_def by blast
    then obtain αi2::"nat  nat" 
      where c14: " i::nat. i<n2  ((αi2 i) < α  (αi2 i) < β)  (h2 i, h2 (Suc i))  g (αi2 i)" by metis
    let ?f2 = "λi. ( αi2 i, h2 (Suc i) )"
    obtain ls2 where c15: "ls2 = (f_to_ls ?f2 n2)" by blast
    obtain σ'' where qc16: "σ'' = (if c' = c'' then (c'', ls2) else (c', (α, c'') # ls2))" by blast
    obtain σ' where c16: "σ' = (c, pls2 @ (snd σ''))" by blast
    have "DD lrs cmp (τ, σ, σ', τ')"
    proof -
      have d1': " k. k < pn1  (ph1 k, pαi1 k, ph1 (Suc k))  lrs"
      proof (intro allI impI)
        fix k
        assume "k < pn1"
        moreover then have "(ph1 k, ph1 (Suc k))  g (pαi1 k)  (pαi1 k <  n)" 
          using c5 pc10 by force
        ultimately show "(ph1 k, pαi1 k, ph1 (Suc k))  lrs" using b4 by blast
      qed
      have d1: " k. k < n1  (h1 k, αi1 k, h1 (Suc k))  lrs"
      proof (intro allI impI)
        fix k
        assume "k < n1"
        moreover then have "(h1 k, h1 (Suc k))  g (αi1 k)  αi1 k < n" 
          using c5 c10 by force
        ultimately show "(h1 k, αi1 k, h1 (Suc k))  lrs" using b4 by blast
      qed
      have d2': " k. k < pn2  (ph2 k, pαi2 k, ph2 (Suc k))  lrs"
      proof (intro allI impI)
        fix k
        assume "k < pn2"
        moreover then have "(ph2 k, ph2 (Suc k))  g (pαi2 k)  pαi2 k < n" 
          using c5 pc14 by force
        ultimately show "(ph2 k, pαi2 k, ph2 (Suc k))  lrs" using b4 by blast
      qed
      have d2: " k. k < n2  (h2 k, αi2 k, h2 (Suc k))  lrs"
      proof (intro allI impI)
        fix k
        assume "k < n2"
        moreover then have "(h2 k, h2 (Suc k))  g (αi2 k)  αi2 k < n" 
          using c5 c14 by force
        ultimately show "(h2 k, αi2 k, h2 (Suc k))  lrs" using b4 by blast
      qed
      have d3: "τ''  Decreasing_Diagrams.seq lrs"
      proof -
        have " k. k  n1  (b'', (f_to_ls ?f1 k))  Decreasing_Diagrams.seq lrs"
        proof
          fix k0
          show "k0  n1  (b'', (f_to_ls ?f1 k0))  Decreasing_Diagrams.seq lrs"
          proof (induct k0)
            show "0  n1  (b'', f_to_ls ?f1 0)  Decreasing_Diagrams.seq lrs"
              using Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
          next
            fix k
            assume g1: "k  n1  (b'', f_to_ls ?f1 k)  Decreasing_Diagrams.seq lrs"
            show "Suc k  n1  (b'', f_to_ls ?f1 (Suc k))  Decreasing_Diagrams.seq lrs"
            proof
              assume h1: "Suc k  n1"
              then have h2: "(b'', f_to_ls ?f1 k)  Decreasing_Diagrams.seq lrs" using g1 by simp
              obtain s where h3: "s = (h1 k, [(αi1 k, h1 (Suc k))])" by blast
              then have "s  Decreasing_Diagrams.seq lrs"
                using h1 d1 Decreasing_Diagrams.seq.intros(2)[of "h1 k" "αi1 k"] Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
              moreover have "lst (b'', f_to_ls ?f1 k) = fst s" 
                using c9 h3 unfolding lst_def by (cases k, simp+)
              ultimately show "(b'', f_to_ls ?f1 (Suc k))  Decreasing_Diagrams.seq lrs" 
                using h2 h3 Decreasing_Diagrams.seq_concat_helper[of b'' "f_to_ls ?f1 k" lrs s] by simp
            qed
          qed
        qed
        then have "(b'', ls1)  Decreasing_Diagrams.seq lrs" using c11 by blast
        moreover then have "b'  b''  (b', (β, b'') # ls1)  Decreasing_Diagrams.seq lrs"
          using b4 c5 c7 Decreasing_Diagrams.seq.intros(2)[of b' β b''] by fastforce
        ultimately show "τ''  Decreasing_Diagrams.seq lrs" using qc12 by simp
      qed
      have d4: "σ''  Decreasing_Diagrams.seq lrs"
      proof -
        have " k. k  n2  (c'', (f_to_ls ?f2 k))  Decreasing_Diagrams.seq lrs"
        proof
          fix k0
          show "k0  n2  (c'', (f_to_ls ?f2 k0))  Decreasing_Diagrams.seq lrs"
          proof (induct k0)
            show "0  n2  (c'', f_to_ls ?f2 0)  Decreasing_Diagrams.seq lrs"
              using Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
          next
            fix k
            assume g1: "k  n2  (c'', f_to_ls ?f2 k)  Decreasing_Diagrams.seq lrs"
            show "Suc k  n2  (c'', f_to_ls ?f2 (Suc k))  Decreasing_Diagrams.seq lrs"
            proof
              assume h1: "Suc k  n2"
              then have h2: "(c'', f_to_ls ?f2 k)  Decreasing_Diagrams.seq lrs" using g1 by simp
              obtain s where h3: "s = (h2 k, [(αi2 k, h2 (Suc k))])" by blast
              then have "s  Decreasing_Diagrams.seq lrs"
                using h1 d2 Decreasing_Diagrams.seq.intros(2)[of "h2 k" "αi2 k"] Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
              moreover have "lst (c'', f_to_ls ?f2 k) = fst s" 
                using c13 h3 unfolding lst_def  by (cases k, simp+)
              ultimately show "(c'', f_to_ls ?f2 (Suc k))  Decreasing_Diagrams.seq lrs" 
                using h2 h3 Decreasing_Diagrams.seq_concat_helper[of c'' "f_to_ls ?f2 k" lrs s] by simp
            qed
          qed
        qed
        then have "(c'', ls2)  Decreasing_Diagrams.seq lrs" using c15 by blast
        moreover then have "c'  c''  (c', (α, c'') # ls2)  Decreasing_Diagrams.seq lrs"
          using b4 c5 c8 Decreasing_Diagrams.seq.intros(2)[of c' α c''] by fastforce
        ultimately show "σ''  Decreasing_Diagrams.seq lrs" using qc16 by simp
      qed
      have "σ  Decreasing_Diagrams.seq lrs" by (simp add: c3 c4 seq.intros(1) seq.intros(2))
      moreover have "τ  Decreasing_Diagrams.seq lrs" by (simp add: c3 c4 seq.intros(1) seq.intros(2))
      moreover have d5: "σ'  Decreasing_Diagrams.seq lrs  lst σ' = lst σ''"
      proof -
        have "(c, pls2)  Decreasing_Diagrams.seq lrs"
        proof -
          have " k. k  pn2  (c, (f_to_ls ?pf2 k))  Decreasing_Diagrams.seq lrs"
          proof
            fix k0
            show "k0  pn2  (c, (f_to_ls ?pf2 k0))  Decreasing_Diagrams.seq lrs"
            proof (induct k0)
              show "0  pn2  (c, f_to_ls ?pf2 0)  Decreasing_Diagrams.seq lrs"
                using Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
            next
              fix k
              assume g1: "k  pn2  (c, f_to_ls ?pf2 k)  Decreasing_Diagrams.seq lrs"
              show "Suc k  pn2  (c, f_to_ls ?pf2 (Suc k))  Decreasing_Diagrams.seq lrs"
              proof
                assume h1: "Suc k  pn2"
                then have h2: "(c, f_to_ls ?pf2 k)  Decreasing_Diagrams.seq lrs" using g1 by simp
                obtain s where h3: "s = (ph2 k, [(pαi2 k, ph2 (Suc k))])" by blast
                then have "s  Decreasing_Diagrams.seq lrs"
                  using h1 d2' Decreasing_Diagrams.seq.intros(2)[of "ph2 k" "pαi2 k"] Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
                moreover have "lst (c, f_to_ls ?pf2 k) = fst s" 
                  using pc13 h3 unfolding lst_def by (cases k, simp+)
                ultimately show "(c, f_to_ls ?pf2 (Suc k))  Decreasing_Diagrams.seq lrs" 
                  using h2 h3 Decreasing_Diagrams.seq_concat_helper[of c "f_to_ls ?pf2 k" lrs s] by simp
              qed
            qed
          qed
          then show ?thesis using pc15 by blast
        qed
        moreover have "lst (c, pls2) = fst σ''"
        proof -
          have "lst (c, pls2) = c'" using pc13 pc15 unfolding lst_def by (cases pn2, simp+)
          then show ?thesis unfolding qc16 by simp
        qed
        ultimately show ?thesis using d4
          unfolding c16 using Decreasing_Diagrams.seq_concat_helper[of c pls2 lrs σ'' ] by blast
      qed
      moreover have d6: "τ'  Decreasing_Diagrams.seq lrs  lst τ' = lst τ''"
      proof -
        have "(b, pls1)  Decreasing_Diagrams.seq lrs"
        proof -
          have " k. k  pn1  (b, (f_to_ls ?pf1 k))  Decreasing_Diagrams.seq lrs"
          proof
            fix k0
            show "k0  pn1  (b, (f_to_ls ?pf1 k0))  Decreasing_Diagrams.seq lrs"
            proof (induct k0)
              show "0  pn1  (b, f_to_ls ?pf1 0)  Decreasing_Diagrams.seq lrs"
                using Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
            next
              fix k
              assume g1: "k  pn1  (b, f_to_ls ?pf1 k)  Decreasing_Diagrams.seq lrs"
              show "Suc k  pn1  (b, f_to_ls ?pf1 (Suc k))  Decreasing_Diagrams.seq lrs"
              proof
                assume h1: "Suc k  pn1"
                then have h2: "(b, f_to_ls ?pf1 k)  Decreasing_Diagrams.seq lrs" using g1 by simp
                obtain s where h3: "s = (ph1 k, [(pαi1 k, ph1 (Suc k))])" by blast
                then have "s  Decreasing_Diagrams.seq lrs"
                  using h1 d1' Decreasing_Diagrams.seq.intros(2)[of "ph1 k" "pαi1 k"] Decreasing_Diagrams.seq.intros(1)[of _ lrs] by simp
                moreover have "lst (b, f_to_ls ?pf1 k) = fst s" 
                  using pc9 h3 unfolding lst_def by (cases k, simp+)
                ultimately show "(b, f_to_ls ?pf1 (Suc k))  Decreasing_Diagrams.seq lrs" 
                  using h2 h3 Decreasing_Diagrams.seq_concat_helper[of b "f_to_ls ?pf1 k" lrs s] by simp
              qed
            qed
          qed
          then show ?thesis using pc11 by blast
        qed
        moreover have "lst (b, pls1) = fst τ''"
        proof -
          have "lst (b, pls1) = b'" using pc9 pc11 unfolding lst_def by (cases pn1, simp+)
          then show ?thesis unfolding qc12 by simp
        qed
        ultimately show ?thesis using d3
          unfolding c12 using Decreasing_Diagrams.seq_concat_helper[of b pls1 lrs τ'' ] by blast
      qed
      moreover have "fst σ = fst τ" using c4 by simp
      moreover have "lst σ = fst τ'" using c4 c12 unfolding lst_def by simp
      moreover have "lst τ = fst σ'" using c4 c16 unfolding lst_def by simp
      moreover have "lst σ' = lst τ'"
      proof -
        have "lst τ'' = d"
        proof (cases "n1 = 0")
          assume "n1 = 0"
          then show "lst τ'' = d" using c9 c11 qc12 unfolding lst_def by force
        next
          assume "n1  0"
          moreover then have "last ls1 = ( αi1 (n1-1), h1 n1 )" using c11 by (cases n1, simp+)
          ultimately show "lst τ'' = d" using c9 c11 qc12 lem_ftofs_len unfolding lst_def
            by (smt last_ConsR list.distinct(1) list.size(3) snd_conv)
        qed
        moreover have "lst σ'' = d"
        proof (cases "n2 = 0")
          assume "n2 = 0"
          then show "lst σ'' = d" using c13 c15 qc16 unfolding lst_def by force
        next
          assume "n2  0"
          moreover then have "last ls2 = ( αi2 (n2-1), h2 n2 )" using c15 by (cases n2, simp+)
          ultimately show "lst σ'' = d" using c13 c15 qc16 lem_ftofs_len unfolding lst_def
            by (smt last_ConsR list.distinct(1) list.size(3) snd_conv)
        qed
        moreover have "lst τ' = lst τ''  lst σ' = lst σ''" using d5 d6 by blast
        ultimately show ?thesis by metis
      qed
      moreover have "Decreasing_Diagrams.D cmp (labels τ) (labels σ) (labels σ') (labels τ')"
      proof -
        obtain σ1 where e01: "σ1 = (f_to_ls pαi2 pn2)" by blast
        obtain σ2 where e1: "σ2 = (if c' = c'' then [] else [α])" by blast
        obtain σ3 where e2: "σ3 = (f_to_ls αi2 n2)" by blast
        obtain τ1 where e02: "τ1 = (f_to_ls pαi1 pn1)" by blast
        obtain τ2 where e3: "τ2 = (if b' = b'' then [] else [β])" by blast
        obtain τ3 where e4: "τ3 = (f_to_ls αi1 n1)" by blast
        have "labels τ = [β]  labels σ = [α]" using c4 unfolding labels_def by simp
        moreover have "labels σ' = σ1 @ σ2 @ σ3"
        proof -
          have "labels σ'' = σ2 @ σ3"
          proof -
            have " k. k  n2  map fst (f_to_ls ?f2 k) = f_to_ls αi2 k"
            proof
              fix k
              show "k  n2  map fst (f_to_ls ?f2 k) = f_to_ls αi2 k" by (induct k, simp+)
            qed
            then show ?thesis using c15 qc16 e1 e2 unfolding labels_def by simp
          qed
          moreover have "labels σ' = σ1 @ labels σ''"
          proof -
            have " k. k  pn2  map fst (f_to_ls ?pf2 k) = f_to_ls pαi2 k"
            proof
              fix k
              show "k  pn2  map fst (f_to_ls ?pf2 k) = f_to_ls pαi2 k" by (induct k, simp+)
            qed
            then have "map fst pls2 = σ1" unfolding pc15 e01 by blast
            then show ?thesis unfolding c16 labels_def by simp
          qed
          ultimately show ?thesis by simp
        qed
        moreover have "labels τ' = τ1 @ τ2 @ τ3"
        proof -
          have "labels τ'' = τ2 @ τ3"
          proof -
            have " k. k  n1  map fst (f_to_ls ?f1 k) = f_to_ls αi1 k"
            proof
              fix k
              show "k  n1  map fst (f_to_ls ?f1 k) = f_to_ls αi1 k" by (induct k, simp+)
            qed
            then show ?thesis using c11 qc12 e3 e4 unfolding labels_def by simp
          qed
          moreover have "labels τ' = τ1 @ labels τ''"
          proof -
            have " k. k  pn1  map fst (f_to_ls ?pf1 k) = f_to_ls pαi1 k"
            proof
              fix k
              show "k  pn1  map fst (f_to_ls ?pf1 k) = f_to_ls pαi1 k" by (induct k, simp+)
            qed
            then have "map fst pls1 = τ1" unfolding pc11 e02 by blast
            then show ?thesis unfolding c12 labels_def by simp
          qed
          ultimately show ?thesis by simp
        qed
        moreover have "LD' cmp β α σ1 σ2 σ3 τ1 τ2 τ3"
        proof -
          let ?dn = "{α' . (α',α)  cmp  (α',β)  cmp}"
          have pf1: "set σ1  {y. (y, β)  cmp}"
          proof -
            have " k. k  pn2  set (f_to_ls pαi2 k)  {y. (y, β)  cmp}"
            proof
              fix k
              show "k  pn2  set (f_to_ls pαi2 k)  {y. (y, β)  cmp}" using b5 pc14 by (induct k, simp+)
            qed
            then show ?thesis using e01 by blast
          qed
          have pf2: "set τ1  {y. (y, α)  cmp}"
          proof -
            have " k. k  pn1  set (f_to_ls pαi1 k)  {y. (y, α)  cmp}"
            proof
              fix k
              show "k  pn1  set (f_to_ls pαi1 k)  {y. (y, α)  cmp}" using b5 pc10 by (induct k, simp+)
            qed
            then show ?thesis using e02 by blast
          qed
          have f1: "set σ3  ?dn"
          proof -
            have " k. k  n2  set (f_to_ls αi2 k)  ?dn"
            proof
              fix k
              show "k  n2  set (f_to_ls αi2 k)  ?dn" using b5 c14 by (induct k, simp+)
            qed
            then show ?thesis using e2 by blast
          qed
          have f2: "set τ3  ?dn"
          proof -
            have " k. k  n1  set (f_to_ls αi1 k)  ?dn"
            proof
              fix k
              show "k  n1  set (f_to_ls αi1 k)  ?dn" using b5 c10 by (induct k, simp+)
            qed
            then show ?thesis using e4 by blast
          qed
          have "LD_1' cmp β α σ1 σ2 σ3" using pf1 f1 e1 e2 unfolding LD_1'_def Decreasing_Diagrams.ds_def by simp
          moreover have "LD_1' cmp α β τ1 τ2 τ3" using pf2 f2 e3 e4 unfolding LD_1'_def Decreasing_Diagrams.ds_def by force
          ultimately show ?thesis unfolding LD'_def by blast
        qed
        moreover have "trans cmp  wf cmp" using b6 b7 by blast
        moreover then have "irrefl cmp" using irrefl_def by fastforce
        ultimately show ?thesis using proposition3_4[of cmp β α σ1 σ2 σ3 τ1 τ2 τ3] by simp
      qed
      ultimately show ?thesis unfolding DD_def diagram_def D2_def by simp
    qed
    then show " σ' τ'. DD lrs cmp (fst P,snd P,σ',τ')" using c2 by fastforce
  qed
  ultimately show ?thesis unfolding LD_def by blast
qed


(* ----------------------------------------------------------------------- *)

section ‹Main theorem›

(* ----------------------------------------------------------------------- *)

text ‹The next theorem has the following meaning:
  if the cardinality of a binary relation $r$ does not exceed the first uncountable cardinal (cardSuc |UNIV::nat set|›), then the following two conditions are equivalent:›
text ‹1. $r$ is confluent (Abstract_Rewriting.CR r›)›
text ‹2. $r$ can be proven confluent using the decreasing diagrams method with natural numbers as labels (Decreasing_Diagrams.LD (UNIV::nat set) r›).›

theorem N1_completeness:
fixes r::"'a rel"
assumes "|r| ≤o cardSuc |UNIV::nat set|"
shows "Abstract_Rewriting.CR r = Decreasing_Diagrams.LD (UNIV::nat set) r"
proof
  assume b0: "CR r"
  have b1: "|r| ≤o cardSuc |UNIV::nat set|" using assms by simp
  obtain κ where b2: "κ = cardSuc |UNIV::nat set|" by blast
  have "|Field r| ≤o cardSuc |UNIV::nat set|"
  proof (cases "finite r")
    assume "finite r"
    then show ?thesis using b2 lem_fin_fl_rel by (metis Field_card_of Field_natLeq cardSuc_ordLeq_ordLess 
      card_of_card_order_on card_of_mono2 finite_iff_ordLess_natLeq ordLess_imp_ordLeq)
  next
    assume "¬ finite r"
    then show ?thesis using b1 b2 lem_rel_inf_fld_card using ordIso_ordLeq_trans by blast
  qed
  moreover have "confl_rel r" using b0 unfolding confl_rel_def Abstract_Rewriting.CR_on_def by blast
  ultimately show "LD (UNIV::nat set) r" using lem_dc3_confl_lewsuc[of r] lem_dcr_to_ld by blast
next
  assume "LD (UNIV::nat set) r"
  then show "CR r" using Decreasing_Diagrams.sound by blast
qed

end