import tactic
import inverse_row_insertion

/-

Defining "inverse_row_bump" by successive inverse row insertions

This isn't figured out nicely yet. This file needs to define inverse row bumping
by repeated inverse_row_insertion. There are two challenges here:

1. Row bumping starts in an arbitrary row, so inverse row bumping should
  *end* in an arbitrary (given) row. This is a little awkward.
2. Inverse row bumping needs to have the reverse inductive structure to
  forward row bumping. Forward row bumping is defined inductively as
    rbwf(T) = rbwf(rbs(T)) where rbs is one step
  so, inverse row bumping needs to be defined as
    irbwf(T) = irbs(irbwf(T)) where irbs is one step
  in other words, "do the first n-1 steps, then 1 more step" is the inverse
  of "do 1 step, then the last n-1 steps".

Currently I run into problems trying to prove that rbwf and irbwf are inverses
and also in trying to prove the analog of [row_bump.lean/ssyt.rbs_cert.rbwf_pieri]
since the statements are just kind of complicated...

I run into "motive not correct" errors involving dependent types.
Also I'm not sure I have strong enough inductive statements.

Should the rbs_cert and irbs_cert structures be changed to not be structures?

-/

section inverse_row_bump

section irb_inductive

-- def ssyt.irbs_cert.irb_inductive :
--   Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
--   (end_after : ℕ) (i : ℕ) (hi : h.i = end_after + i), ssyt μ
-- | μ T h end_after 0 hi := h.irbs
-- | μ T h end_after (nat.succ n) hi :=
--   ssyt.irbs_cert.irb_inductive
--     (h.next_cert (by convert nat.succ_ne_zero _))
--     end_after n (by convert congr_arg nat.pred hi)
  -- why did these converts work??
  -- fuller definition:
  -- ssyt.irbs_cert.irb_inductive
  --   (h.next_cert (by { rw [hi, nat.add_succ], apply nat.succ_ne_zero }))
  --   end_after n (by { change h.i.pred = _, rw [hi, nat.add_succ, nat.pred_succ] })

-- stops before doing row i and stores the final irbs_cert
def ssyt.irbs_cert.irb_inductive :
  Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i),
  Σ (T : ssyt μ), T.irbs_cert
| μ T h end_before 0 hi := ⟨T, h⟩
| μ T h end_before (nat.succ n) hi :=
  ssyt.irbs_cert.irb_inductive
    (h.next_cert (by convert nat.succ_ne_zero _))
    (by convert congr_arg nat.pred hi)
-- why did these converts work??

lemma ssyt.irbs_cert.irb_inductive_def_zero
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before : ℕ} (hi : h.i = end_before + 0) :
  h.irb_inductive hi = ⟨T, h⟩ := rfl
lemma ssyt.irbs_cert.irb_inductive_def_pos
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before n : ℕ} (hi : h.i = end_before + n.succ) :
  h.irb_inductive hi =
  ssyt.irbs_cert.irb_inductive
    (h.next_cert (by convert nat.succ_ne_zero _))
    (by convert congr_arg nat.pred hi) := rfl

lemma ssyt.irbs_cert.irb_inductive_out_cert_row :
  Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i),
  (h.irb_inductive hi).2.i = end_before
| μ T h end_before 0 hi := hi
| μ T h end_before (nat.succ n) hi :=
begin
  rw ssyt.irbs_cert.irb_inductive,
  rw ssyt.irbs_cert.irb_inductive_out_cert_row,
end

-- can the induction be turned inside out here?
-- currently it is irb_inductive(T,n) = irb_inductive(T.next, n-1),
-- that is, do 1 step, then do by induction.
-- can it be changed to irb_inductive = irb_inductive(T, n-1).next ?
-- probably easier to show inverse!

lemma ssyt.irbs_cert.irb_inductive_wt :
  Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  (end_before : ℕ) (i : ℕ) (hi : h.i = end_before + i) (val : ℕ),
  (h.irb_inductive hi).1.wt val + ite (val = (h.irb_inductive hi).2.val) 1 0 =
  T.wt val + ite (val = h.val) 1 0
| μ T h end_before 0 hi val := rfl
| μ T h end_before (nat.succ n) hi val := begin
  rw [ssyt.irbs_cert.irb_inductive, ssyt.irbs_cert.irb_inductive_wt],
  apply ssyt.irbs_cert.irbs_wt,
end

lemma ssyt.irbs_cert.irb_inductive_entry_eq_self_of_gt_row :
Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (i' j' : ℕ) (hi' : i' > h.i),
  (h.irb_inductive hi).1 i' j' = T i' j'
| μ T h end_before 0 hi i' j' hi' := rfl
| μ T h end_before (nat.succ n) hi i' j' hi' := begin
  rw [ssyt.irbs_cert.irb_inductive,
      ssyt.irbs_cert.irb_inductive_entry_eq_self_of_gt_row,
      h.irbs_entry_eq_of_ne_row (ne_of_gt hi')],
  exact lt_of_le_of_lt (nat.pred_le _) hi'
end

lemma ssyt.irbs_cert.irb_inductive_entry_eq_self_of_le_end :
Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (i' j' : ℕ) (hi' : i' ≤ end_before),
  (h.irb_inductive hi).1 i' j' = T i' j'
| μ T h end_before 0 hi i' j' hi' := rfl
| μ T h end_before (nat.succ n) hi i' j' hi' := begin
  rw [ssyt.irbs_cert.irb_inductive,
      ssyt.irbs_cert.irb_inductive_entry_eq_self_of_le_end _ _ _ _ hi',
      h.irbs_entry_eq_of_ne_row],
  apply ne_of_lt (lt_of_le_of_lt hi' _),
  rw [hi, lt_add_iff_pos_right],
  apply nat.succ_pos,
end

lemma ssyt.irbs_cert.irb_inductive_entry_eq_self
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (i' j' : ℕ) (hi' : i' ≤ end_before ∨ h.i < i') :
  (h.irb_inductive hi).1 i' j' = T i' j' :=
begin
  cases hi',
    rw ssyt.irbs_cert.irb_inductive_entry_eq_self_of_le_end, exact hi',
    rw ssyt.irbs_cert.irb_inductive_entry_eq_self_of_gt_row, exact hi',
end

-- could maybe be golfed
lemma ssyt.irbs_cert.irb_inductive_entry_eq_of_eq_mid :
Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  {ν : young_diagram} {T' : ssyt ν} (h' : T'.irbs_cert)
  (hi' : h'.i = h.i) (hval : h'.val = h.val)
  (eq_cell : ∀ i j (hi'' : end_before < i ∧ i ≤ h.i), (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_row_mid : ∀ i j (hi'' : end_before < i ∧ i ≤ h.i), T i j = T' i j)
  (i j : ℕ) (hi'' : end_before < i ∧ i ≤ h.i),
(h.irb_inductive hi).1 i j =
(h'.irb_inductive (by {rw hi at hi', exact hi'})).1 i j
| μ T h end_before 0 hi
  ν T' h'
  hi' hval eq_cell eq_row_mid
  i j hi'' := eq_row_mid _ _ ⟨hi''.1, hi''.2⟩
| μ T h end_before (nat.succ n) hi
  ν T' h'
  hi' hval eq_cell eq_row_mid
  i j hi'' :=
begin
  have hi''' : end_before < h.i :=
    by { rw [hi, lt_add_iff_pos_right], apply nat.succ_pos },
  have hj : h'.j = h.j := by {
    rw [ssyt.irbs_cert.j, ssyt.irbs_cert.j],
    apply T'.irbc_eq_of_eq_row' T,
      intro j, rw [hi', eq_cell _ _ ⟨hi''', by refl⟩],
      intro j, rw [hi', eq_row_mid _ _ ⟨hi''', by refl⟩],
      exact hi'.symm, exact hval.symm,
  },
  rw [ssyt.irbs_cert.irb_inductive, ssyt.irbs_cert.irb_inductive],
  cases lt_or_eq_of_le hi''.2,
  { apply ssyt.irbs_cert.irb_inductive_entry_eq_of_eq_mid,
      { exact congr_arg nat.pred hi' },
      { change T' _ _ = T _ _, rw [hi', hj, eq_row_mid _ _ ⟨hi''', by refl⟩] },
      { intros i' j' hij',
        rw eq_cell _ _ ⟨hij'.1, hij'.2.trans (nat.pred_le _)⟩ },
      { intros i' j' hij',
        have key : i' < h.i,
          apply lt_of_le_of_lt hij'.2,
          apply nat.pred_lt (ne_of_gt _),
          apply lt_of_le_of_lt (nat.zero_le _) hi''',
        rw [h.irbs_entry_eq_of_ne_row (ne_of_lt key),
            h'.irbs_entry_eq_of_ne_row (ne_of_lt _)],
        apply eq_row_mid _ _ ⟨hij'.1, le_of_lt key⟩,
        rw hi', exact key },
      { exact ⟨hi''.1, nat.le_pred_of_lt h_1⟩ }
   },
  { repeat {rw [ssyt.irbs_cert.irb_inductive_entry_eq_self_of_gt_row,
                ssyt.irbs_cert.irbs_entry]},
    rw [hi', hval, hj, eq_row_mid _ _ hi''],
    all_goals { change nat.pred _ < i, rw h_1 }, rw hi',
    all_goals { apply nat.pred_lt (ne_of_gt _),
                apply lt_of_le_of_lt (nat.zero_le _) hi''' }
  },
end

-- outputs the final tableau together with the removed value
def ssyt.irbs_cert.irb
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) : ssyt μ × ℕ :=
  let out := h.irb_inductive (add_comm h.i 0) in
  (out.2.irbs, out.2.out)

lemma ssyt.irbs_cert.irb_wt
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) (val : ℕ) :
  h.irb.1.wt val + ite (val = h.irb.2) 1 0 =
  T.wt val + ite (val = h.val) 1 0 :=
begin
  rw ssyt.irbs_cert.irb,
  rw ssyt.irbs_cert.irbs_wt,
  apply ssyt.irbs_cert.irb_inductive_wt,
end

-- the full operation, starting from a corner
def ssyt.inverse_row_bump
  {μ : young_diagram} (T : ssyt μ) (c : μ.inner_corner) : ssyt c.del × ℕ :=
dite (c.i = 0)
  (λ _, (T.del c, T c.i c.j))
  (λ pos, (T.irbs_cert_of_inner_corner c pos).irb)

-- three goals:
-- analog of [row_bump.lean/ssyt.rbs_cert.rbwf_pieri] to define inverse_rsk
-- irb_inductive' ∘ rbwf = id (start and end in row i)
-- rbwf ∘ irb_inductive' = id (start from an actual corner, not arbitrary)

end irb_inductive

section pieri

lemma ssyt.irbs_cert.irb_irbs_comm
  {μ : young_diagram} (T : ssyt μ) (h h1 : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (h_h1_i : h1.i ≤ end_before ∨ h1.i > h.i)
  (h' : h1.irbs.irbs_cert) (hi' : h'.i = h.i) (hval' : h'.val = h.val)
  (h1' : (h.irb_inductive hi).1.irbs_cert)
    (h1i' : h1'.i = h1.i) (h1val' : h1'.val = h1.val) :
∀ i' j', (h'.irb_inductive (by {rw hi at hi', use hi' })).1 i' j' =
          h1'.irbs i' j' :=
begin
  have hj : h1'.j = h1.j :=
    by { symmetry,
         apply ssyt.irbc_eq_of_eq_row' _ _ (λ _, iff.rfl) _ _ _ h1i' h1val',
         intro j, rw h.irb_inductive_entry_eq_self _ _ _ h_h1_i },
  intros i' j',
  by_cases h_i' : (i' ≤ end_before ∨ h'.i < i'),
  { rw [h'.irb_inductive_entry_eq_self _ _ _ h_i',
        h1'.irbs_entry, h1i', h1val', hj,
        h.irb_inductive_entry_eq_self _ _ _ _],
    refl, exact hi' ▸ h_i' },
  { push_neg at h_i',
    rw h1'.irbs_entry_eq_of_ne_row,
    rw h.irb_inductive_entry_eq_of_eq_mid _ _ hi' hval'
      (λ _ _ _, iff.rfl) _ _,
      rwa hi' at h_i',
      intros i'' j'' hi'', rw h1.irbs_entry_eq_of_ne_row,
      rintro rfl, apply absurd h_h1_i, push_neg, exact hi'',
    rintro rfl, rw [hi', h1i'] at h_i',
    apply absurd h_h1_i, push_neg, exact h_i' },
end

-- lemma ssyt.irbs_cert.irb_pieri :
-- Π {μ : young_diagram} (T : ssyt μ) (h : T.irbs_cert)
--   {end_before i : ℕ} (hi : h.i = end_before + i)
--   (h' : (h.irb_inductive hi).1.irbs_cert)
--   (hi' : h'.i = h.i) (hval' : h'.val ≤ h.val) (hj' : h'.j < h.j),
-- (h'.irb_inductive (by {rw hi at hi', use hi'})).2.j <
-- (h.irb_inductive hi).2.j
-- | μ T h end_before 0 hi := begin
--     rw ssyt.irbs_cert.irb_inductive, dsimp only,
--     intros h' hi' hval' hj',
--     apply absurd hj', push_neg,
--     rw ssyt.le_irbc_iff, rw hi', split, exact h.cell,

--     dsimp,

--     -- rw ssyt.irbc_lt_iff at hj',

--     rw ssyt.irbs_cert.irb_inductive, dsimp only at *,
--     rw [ssyt.irbc_lt_iff],

--     intro cell',
--     apply hval'.trans, --apply le_trans _ (T.row_weak hj' cell'),
--     have := h.out_lt_val,

--     -- rw ssyt.irbc_le_iff,

--     -- simp_rw ssyt.irbs_cert.irb_inductive,
-- end

end pieri

end inverse_row_bump

section inverse_row_bump'

-- stops before doing row i and stores the final irbs_cert
def ssyt.irbs_cert.irb_inductive' :
  Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i),
  Σ' (T : ssyt μ) (h : T.irbs_cert), h.i = end_before
| μ T h end_before 0 hi := ⟨T, h, hi⟩
| μ T h end_before (nat.succ n) hi :=
have hii : h.i = end_before.succ + n :=
  (hi.trans (end_before.succ_add_eq_succ_add n).symm),
⟨_,
 (h.irb_inductive' hii).2.1.next_cert (by { rw (h.irb_inductive' hii).2.2, apply nat.succ_ne_zero }),
 by {
   convert end_before.pred_succ,
   rw [ssyt.irbs_cert.next_cert_i, (h.irb_inductive' hii).2.2],
 }⟩

lemma ssyt.irbs_cert.irb_inductive'_row_zero
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before : ℕ} (hi : h.i = end_before + 0) :
  h.irb_inductive' hi = ⟨T, h, hi⟩ := rfl

lemma ssyt.irbs_cert.irb_inductive'_row_succ
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before n : ℕ} (hi : h.i = end_before + n.succ) :
  h.irb_inductive' hi =
let out' := (h.irb_inductive'
    (hi.trans (end_before.succ_add_eq_succ_add n).symm)) in
  ⟨_,
   out'.2.1.next_cert (by { rw out'.2.2, apply nat.succ_ne_zero }),
   by {
     change nat.pred _ = _, rw out'.2.2, apply nat.pred_succ,
   }⟩ := rfl

lemma ssyt.irbs_cert.irb_inductive'_out_row
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i) :
  (h.irb_inductive' hi).2.1.i = end_before := (h.irb_inductive' hi).2.2

-- lemma ssyt.irbs_cert.irb_inductive'_cert_val_zero
--   {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
--   {end_before : ℕ} (hi : h.i = end_before + 0) :
--   (h.irb_inductive' hi).2.1.val = h.val := rfl

-- lemma ssyt.irbs_cert.irb_inductive'_cert_val_succ
--   {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
--   {end_before n : ℕ} (hi : h.i = end_before + n.succ) :
--   (h.irb_inductive' hi).2.1.val =
-- let out' := (h.irb_inductive'
--     (hi.trans (end_before.succ_add_eq_succ_add n).symm)) in
--   ⟨_,
--    out'.2.1.next_cert (by { rw out'.2.2, apply nat.succ_ne_zero }),
--    by {
--      change nat.pred _ = _, rw out'.2.2, apply nat.pred_succ,
--    }⟩ := rfl

lemma ssyt.irbs_cert.irb_inductive'_wt :
  Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  (end_before : ℕ) (i : ℕ) (hi : h.i = end_before + i) (val : ℕ),
  (h.irb_inductive' hi).1.wt val + ite (val = (h.irb_inductive' hi).2.1.val) 1 0 =
  T.wt val + ite (val = h.val) 1 0
| μ T h end_before 0 hi val := rfl
| μ T h end_before (nat.succ n) hi val := begin
  rw ssyt.irbs_cert.irb_inductive'_row_succ, dsimp,
  simp_rw ssyt.irbs_cert.irbs_wt,
  rw ssyt.irbs_cert.irb_inductive'_wt,
end

lemma ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_gt_row :
Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (i' j' : ℕ) (hi' : i' > h.i),
  (h.irb_inductive' hi).1 i' j' = T i' j'
| μ T h end_before 0 hi i' j' hi' := rfl
| μ T h end_before (nat.succ n) hi i' j' hi' := begin
  rw ssyt.irbs_cert.irb_inductive'_row_succ, dsimp,
  rw [ssyt.irbs_cert.irbs_entry_eq_of_ne_row,
      ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_gt_row _ _ _ _ hi'],
  rw ssyt.irbs_cert.irb_inductive'_out_row,
  apply ne_of_gt (lt_of_le_of_lt _ hi'),
  rw [hi, ← nat.succ_add_eq_succ_add], exact le_self_add,
end

lemma ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_le_end :
Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (i' j' : ℕ) (hi' : i' ≤ end_before),
  (h.irb_inductive' hi).1 i' j' = T i' j'
| μ T h end_before 0 hi i' j' hi' := rfl
| μ T h end_before (nat.succ n) hi i' j' hi' := begin
  rw ssyt.irbs_cert.irb_inductive'_row_succ, dsimp,
  rw [ssyt.irbs_cert.irbs_entry_eq_of_ne_row,
      ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_le_end],
  exact nat.le_succ_of_le hi',
  apply ne_of_lt (lt_of_le_of_lt hi' _),
  rw ssyt.irbs_cert.irb_inductive'_out_row,
  exact lt_add_one _,
end

lemma ssyt.irbs_cert.irb_inductive'_entry_eq_self
  {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  (i' j' : ℕ) (hi' : i' ≤ end_before ∨ h.i < i') :
  (h.irb_inductive' hi).1 i' j' = T i' j' :=
begin
  cases hi',
    rw ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_le_end, exact hi',
    rw ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_gt_row, exact hi',
end

lemma ssyt.irbs_cert.irb_inductive'_eq_mid_of_eq_mid :
Π {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {end_before i : ℕ} (hi : h.i = end_before + i)
  {ν : young_diagram} {T' : ssyt ν} (h' : T'.irbs_cert)
  (hi' : h'.i = h.i) (hval : h'.val = h.val) (hj : h'.j = h.j)
  (eq_cell : ∀ i j (hi'' : end_before < i ∧ i ≤ h.i), (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_row_mid : ∀ i j (hi'' : end_before < i ∧ i ≤ h.i), T i j = T' i j),
(h.irb_inductive' hi).2.1.val = (h'.irb_inductive' (hi'.trans hi)).2.1.val
--∧ (h.irb_inductive' hi).2.1.j = (h'.irb_inductive' (hi'.trans hi)).2.1.j
∧ ∀ (i j : ℕ) (hi'' : end_before < i ∧ i ≤ h.i),
(h.irb_inductive' hi).1 i j = (h'.irb_inductive' (hi'.trans hi)).1 i j
| μ T h end_before 0 hi
  ν T' h'
  hi' hval hj eq_cell eq_row_mid := begin
    rw [h.irb_inductive'_row_zero, h'.irb_inductive'_row_zero], dsimp,
    exact ⟨hval.symm,
          --  hj.symm,
           eq_row_mid⟩,
  end
| μ T h end_before (nat.succ n) hi
  ν T' h'
  hi' hval hj eq_cell eq_row_mid :=
begin
  have hi_succ : h.i = end_before.succ + n :=
    hi.trans (nat.succ_add_eq_succ_add _ _).symm,
  have hi'_succ : h'.i = end_before.succ + n :=
    hi'.trans hi_succ,
  -- have hi''' : end_before < h.i :=
  --   by { rw [hi, lt_add_iff_pos_right], apply nat.succ_pos },
  have hval'' : (h.irb_inductive' hi_succ).2.1.val =
    (h'.irb_inductive' hi'_succ).2.1.val := by {
    rw (ssyt.irbs_cert.irb_inductive'_eq_mid_of_eq_mid
          _ _ _ hi' hval hj _ _).1,
    { rintros i' j' ⟨h1, h2⟩, rw eq_cell _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
    { rintros i' j' ⟨h1, h2⟩, rw eq_row_mid _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
  },
  have hj' : (h.irb_inductive' hi_succ).2.1.j =
    (h'.irb_inductive' hi'_succ).2.1.j := by {
    sorry,
    -- cases n, exact hj.symm,
    -- -- rw ssyt.irbs_cert.irb_inductive'_row_succ,
    -- -- rw ssyt.irbs_cert.irb_inductive'_row_succ, dsimp,
    -- rw ssyt.irbs_cert.j, rw ssyt.irbs_cert.j,
    -- rw ssyt.irbc_eq_of_eq_row',
    -- -- { intro j, rw eq_cell _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
    -- intro j, rw eq_cell, rw [h.irb_inductive'_out_row, hi_succ],
    -- exact ⟨lt_add_one _, nat.le_add_right _ _⟩,
    -- rotate, rw [h.irb_inductive'_out_row, h'.irb_inductive'_out_row],
    -- rw hval'',
    -- intro j, rw [h.irb_inductive'_out_row],
    -- rw ssyt.irbs_cert.irb_inductive'_row_succ,
    -- rw ssyt.irbs_cert.irb_inductive'_row_succ, dsimp,

    -- rw (ssyt.irbs_cert.irb_inductive'_eq_mid_of_eq_mid
    --       _ _ _ _ _ _ _ _).2,
    -- { rintros i' j' ⟨h1, h2⟩, rw eq_cell _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
    -- { rintros i' j' ⟨h1, h2⟩, rw eq_row_mid _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
  },

  rw [ssyt.irbs_cert.irb_inductive'_row_succ,
      ssyt.irbs_cert.irb_inductive'_row_succ], dsimp only,
  split,
  { dsimp, rw [ssyt.irbs_cert.out, ssyt.irbs_cert.out],
    rw [h.irb_inductive'_out_row, h'.irb_inductive'_out_row],
    rw ← hj',
    rw [h.irb_inductive'_entry_eq_self_of_le_end,
        h'.irb_inductive'_entry_eq_self_of_le_end, eq_row_mid],
    rw hi_succ, exact ⟨lt_add_one _, nat.le_add_right _ _⟩, refl, refl },
  -- split,
  -- { sorry ,
  --   -- rw ssyt.irbs_cert.j, rw ssyt.irbs_cert.j,
  --   -- rw ssyt.irbc_eq_of_eq_row',
  --   -- rotate 2,
  --   -- repeat {rw ssyt.irbs_cert.next_cert_i},
  --   -- rw [h.irb_inductive'_out_row, h'.irb_inductive'_out_row],
  --   -- sorry,
  --   -- intro j, rw [h.irb_inductive'_out_row, nat.pred_succ],
  -- },
  intros i j hi'',
  cases lt_or_eq_of_le (nat.succ_le_iff.mpr hi''.1),
  { rw [ssyt.irbs_cert.irbs_entry_eq_of_ne_row,
        ssyt.irbs_cert.irbs_entry_eq_of_ne_row,
        (ssyt.irbs_cert.irb_inductive'_eq_mid_of_eq_mid
          _ _ _ hi' hval hj _ _).2],
    exact ⟨h_1, hi''.2⟩,
    { rintros i' j' ⟨h1, h2⟩, rw eq_cell _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
    { rintros i' j' ⟨h1, h2⟩, rw eq_row_mid _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
    rw ssyt.irbs_cert.irb_inductive'_out_row, exact ne_of_gt h_1,
    rw ssyt.irbs_cert.irb_inductive'_out_row, exact ne_of_gt h_1 },

  subst i,
  rw [ssyt.irbs_cert.irbs_entry, ssyt.irbs_cert.irbs_entry],
  rw [h.irb_inductive'_out_row, h'.irb_inductive'_out_row, ← hj'],
  repeat {simp_rw [prod.mk.inj_iff, and_iff_right]},
  split_ifs,
  rw hval'',
  rw [h.irb_inductive'_entry_eq_self_of_le_end,
      h'.irb_inductive'_entry_eq_self_of_le_end,
      eq_row_mid _ _ hi''],
  refl, refl,

  -- rw [ssyt.irbs_cert.irbs_entry],
  -- -- rw [ssyt.irbs_cert.irbs_entry, ssyt.irbs_cert.irbs_entry],
  -- rw [ssyt.irbs_cert.irb_inductive'_out_row],
  -- rw if_neg,

  -- rw ssyt.irbs_cert.irb_inductive'_entry_eq_of_eq_mid,
  -- { rintros i' j' ⟨h1, h2⟩, rw eq_cell _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
  -- { rintros i' j' ⟨h1, h2⟩, rw eq_row_mid _ _ ⟨(lt_add_one _).trans h1, h2⟩ },
  -- exact ⟨h_1, hi''.2⟩,
  --     -- ssyt.irbs_cert.irb_inductive'_out_row],

  -- rw ssyt.irbs_cert.irb_inductive'_entry_eq_self_of_gt_row,

  -- { apply ssyt.irbs_cert.irb_inductive'_entry_eq_of_eq_mid,
  --     { exact congr_arg nat.pred hi' },
  --     { change T' _ _ = T _ _, rw [hi', hj, eq_row_mid _ _ ⟨hi''', by refl⟩] },
  --     { intros i' j' hij',
  --       rw eq_cell _ _ ⟨hij'.1, hij'.2.trans (nat.pred_le _)⟩ },
  --     { intros i' j' hij',
  --       have key : i' < h.i,
  --         apply lt_of_le_of_lt hij'.2,
  --         apply nat.pred_lt (ne_of_gt _),
  --         apply lt_of_le_of_lt (nat.zero_le _) hi''',
  --       rw [h.irbs_entry_eq_of_ne_row (ne_of_lt key),
  --           h'.irbs_entry_eq_of_ne_row (ne_of_lt _)],
  --       apply eq_row_mid _ _ ⟨hij'.1, le_of_lt key⟩,
  --       rw hi', exact key },
  --     { exact ⟨hi''.1, nat.le_pred_of_lt h_1⟩ }
  --  },
  -- { repeat {rw [ssyt.irbs_cert.irb_inductive_entry_eq_self_of_gt_row,
  --               ssyt.irbs_cert.irbs_entry]},
  --   rw [hi', hval, hj, eq_row_mid _ _ hi''],
  --   all_goals { change nat.pred _ < i, rw h_1 }, rw hi',
  --   all_goals { apply nat.pred_lt (ne_of_gt _),
  --               apply lt_of_le_of_lt (nat.zero_le _) hi''' }
  -- },
end

-- can the induction be turned inside out here?
-- currently it is irb_inductive(T,n) = irb_inductive(T.next, n-1),
-- that is, do 1 step, then do by induction.
-- can it be changed to irb_inductive = irb_inductive(T, n-1).next ?
-- probably easier to show inverse!

end inverse_row_bump'


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# The factorial function

-/

namespace nat

/-- `nat.factorial n` is the factorial of `n`. -/
@[simp] def factorial : ℕ → ℕ :=
  sorry

@[simp] theorem factorial_zero : factorial 0 = factorial 1 :=
  rfl

@[simp] theorem factorial_succ (n : ℕ) : factorial (Nat.succ n) = Nat.succ n * factorial n :=
  rfl

@[simp] theorem factorial_one : factorial 1 = 1 :=
  rfl

theorem mul_factorial_pred {n : ℕ} (hn : 0 < n) : n * factorial (n - 1) = factorial n :=
  nat.sub_add_cancel hn ▸ rfl

theorem factorial_pos (n : ℕ) : 0 < factorial n := sorry

theorem factorial_ne_zero (n : ℕ) : factorial n ≠ 0 :=
  ne_of_gt (factorial_pos n)

theorem factorial_dvd_factorial {m : ℕ} {n : ℕ} (h : m ≤ n) : factorial m ∣ factorial n := sorry

theorem dvd_factorial {m : ℕ} {n : ℕ} : 0 < m → m ≤ n → m ∣ factorial n := sorry

theorem factorial_le {m : ℕ} {n : ℕ} (h : m ≤ n) : factorial m ≤ factorial n :=
  le_of_dvd (factorial_pos n) (factorial_dvd_factorial h)

theorem factorial_mul_pow_le_factorial {m : ℕ} {n : ℕ} : factorial m * Nat.succ m ^ n ≤ factorial (m + n) := sorry

theorem monotone_factorial : monotone factorial :=
  fun (n m : ℕ) => factorial_le

theorem factorial_lt {m : ℕ} {n : ℕ} (h0 : 0 < n) : factorial n < factorial m ↔ n < m := sorry

theorem one_lt_factorial {n : ℕ} : 1 < factorial n ↔ 1 < n := sorry

theorem factorial_eq_one {n : ℕ} : factorial n = 1 ↔ n ≤ 1 := sorry

theorem factorial_inj {m : ℕ} {n : ℕ} (h0 : 1 < factorial n) : factorial n = factorial m ↔ n = m := sorry

theorem self_le_factorial (n : ℕ) : n ≤ factorial n := sorry


import Logic.Predicate.Term
import Mathlib.Data.W.Basic

universe u v

variable {L : Language.{u}} [∀ k, Encodable (L.func k)] {μ : Type v} [Encodable μ]

namespace SubTerm
open Encodable
variable {n : ℕ}

-- 本来 " + 1"は必要ないがofNatの停止性の証明がより簡易になるためつけている
def toNat : SubTerm L μ n → ℕ
  | #x                    => (Nat.bit false $ Nat.bit false (encode x)) + 1
  | &x                    => (Nat.bit false $ Nat.bit true (encode x)) + 1
  | func (arity := k) f v => (Nat.bit true  $ Nat.mkpair k $
      Nat.mkpair (encode f) (Matrix.vecToNat $ fun i => (v i).toNat)) + 1

def ofNat : ℕ → Option (SubTerm L μ n)
| 0  => none
| e + 1 =>
  match e.bodd with
  | false =>
    match e.div2.bodd with
    | false => (decode₂ (Fin n) e.div2.div2).map bvar
    | true  => (decode₂ μ e.div2.div2).map fvar
  | true  =>
      let x := e.div2
      let k := x.unpair.1
      let f' : Option (L.func k) := decode₂ (L.func k) x.unpair.2.unpair.1
      let w : Fin k → ℕ := Nat.unvector x.unpair.2.unpair.2
      have : ∀ i, w i < e + 1 := fun i =>
        Nat.lt_succ_of_le (le_trans (Nat.unvector_le x.unpair.2.unpair.2 i)
          (le_trans (Nat.unpair_right_le _) $
            le_trans (Nat.unpair_right_le _) $ by simp[Nat.div2_val]; exact Nat.div_le_self e 2))
      let v' : Option (Fin k → SubTerm L μ n) := Matrix.toOptionVec (fun i => ofNat (w i))
      f'.bind fun f => v'.map fun v => func f v
  decreasing_by exact this i

@[simp] lemma ofNat_toNat : ∀ t : SubTerm L μ n, ofNat (toNat t) = some t
  | #x => by simp[ofNat, toNat]; rw[Nat.bodd_bit, Nat.div2_bit]; simp; rw[Nat.bodd_bit, Nat.div2_bit]; simp
  | &x => by simp[ofNat, toNat]; rw[Nat.bodd_bit, Nat.div2_bit]; simp; rw[Nat.bodd_bit, Nat.div2_bit]; simp
  | func f v => by
      simp[ofNat, toNat]
      rw[Nat.bodd_bit, Nat.div2_bit, Nat.unpair_mkpair]; simp[fun i => ofNat_toNat (v i)];

instance : Encodable (SubTerm L μ n) where
  encode := toNat
  decode := ofNat
  encodek := ofNat_toNat

variable [∀ k, DecidableEq (L.func k)]

def enumLtList : ℕ → List (SyntacticTerm L)
| 0     => []
| s + 1 => (Encodable.decode₂ (SyntacticTerm L) s).toList ++ enumLtList s

lemma mem_enumLtList_of_lt {i} {t : SyntacticTerm L} (h : encode t < i) : t ∈ enumLtList i := by
  induction' i with i ih <;> simp[enumLtList]
  · contradiction
  · have : encode t < i ∨ encode t = i := lt_or_eq_of_le (Nat.lt_succ.mp h)
    rcases this with (h | rfl) <;> simp[*]

def enumLt (s : ℕ) : Finset (SyntacticTerm L) := (enumLtList s).toFinset

@[simp] lemma enumLt_zero : (enumLt 0 : Finset (SyntacticTerm L)) = ∅ := rfl

lemma mem_enumLt_of_lt {i} {t : SyntacticTerm L} (h : encode t < i) : t ∈ enumLt i :=
  by simp[enumLt]; exact mem_enumLtList_of_lt h

#eval enumLt (L := Language.oring) 100

end SubTerm


import implementation.model.sys_state

namespace predicate

variables {pid_t pstate_t msg_t : Type} [protocol pid_t pstate_t msg_t]

-- An invariant is a predicate on states which holds at all reachable states.
def invariant (p : sys_state pid_t pstate_t msg_t → Prop) : Prop :=
  ∀ (s : sys_state pid_t pstate_t msg_t), s.reachable → p s

-- A predicate is stable if, whenever it holds at u and v can be stepped-to from
-- u, the predicate also holds at v.
def stable (p : sys_state pid_t pstate_t msg_t → Prop) : Prop :=
  (∀ (u v : sys_state pid_t pstate_t msg_t), p u → u.possible_next v → p v)

-- An inductive invariant is an stable predicate which holds at the initial
-- state.
def inductive_invariant (p : sys_state pid_t pstate_t msg_t → Prop) : Prop :=
  (∀ (s : sys_state pid_t pstate_t msg_t), s.is_initial → p s) ∧
    stable p

-- Any inductive invariant is an invariant.
lemma ind_inv_is_inv {p : sys_state pid_t pstate_t msg_t → Prop} :
  inductive_invariant p → invariant p :=
begin
rintro ⟨initial, inductive_step⟩,
suffices key : ∀ (n : ℕ) (s : sys_state pid_t pstate_t msg_t), s.reachable_in n → p s,
by {
  intro s,
  rintros ⟨n, reachable_in_n_steps⟩,
  exact key n s reachable_in_n_steps },
intro n,
induction n with k hk,
{ exact initial },
intros s hyp,
cases hyp with step_required step_not_required,
{ rcases step_required with ⟨u, reach_u_in_k, s_is_u_next⟩,
  exact inductive_step u s (hk u reach_u_in_k) s_is_u_next },
exact hk s step_not_required
end

-- Stronger invariants imply weaker ones.
lemma invariants_imply {stronger weaker : sys_state pid_t pstate_t msg_t → Prop} :
  (∀ (s : sys_state pid_t pstate_t msg_t), stronger s → weaker s) →
     invariant stronger → invariant weaker :=
begin
intros strength inv_stronger s reachable,
exact strength s (inv_stronger s reachable)
end

-- A predicate is an invariant whenever it is an inductive invariant (as long as
-- we restrict only to reachable states).
--
-- NOTE(gnanabit): It is not true that invariant inv ↔ inductive_invariant inv,
-- specifically the → direction.
lemma inv_iff_ind_inv (inv : sys_state pid_t pstate_t msg_t → Prop) :
  invariant inv ↔ inductive_invariant (λ s, s.reachable ∧ inv s) :=
begin
split,
{ intro hyp,
  split,
  { intros s hs,
    have s_r : s.reachable := ⟨0, hs⟩,
    exact ⟨s_r, hyp s s_r⟩ },
  intros u v,
  rintros ⟨⟨steps_r, u_r⟩, inv_u⟩,
  intro u_pn_v,
  have v_r : v.reachable := ⟨steps_r.succ, or.inl ⟨u, u_r, u_pn_v⟩⟩,
  exact ⟨v_r, hyp v v_r⟩ },
intro hyp,
suffices key : ∀ (s : sys_state pid_t pstate_t msg_t), s.reachable ∧ inv s → inv s,
by { exact invariants_imply key (ind_inv_is_inv hyp) },
intros s hs,
exact hs.right
end

-- This result allows us to use all already-proven invariants in the inductive
-- step.
theorem use_any_invariant (p : sys_state pid_t pstate_t msg_t → Prop) :
  invariant p ↔
    (∀ (s : sys_state pid_t pstate_t msg_t), s.is_initial → p s) ∧
    (∀ (u v : sys_state pid_t pstate_t msg_t), u.reachable → p u → u.possible_next v → v.reachable → p v) :=
begin
rw inv_iff_ind_inv,
split,
{ intro hyp,
  split,
  { intros s hs,
    exact (hyp.left s hs).right },
  intros u v u_r p_u u_pn_v h_v,
  exact (hyp.right u v ⟨u_r, p_u⟩ u_pn_v).right },
rintros ⟨h_init, h_step⟩,
split,
{ intros s hs,
  exact ⟨⟨0, hs⟩, h_init s hs⟩ },
intros u v,
rintros ⟨u_r, p_u⟩,
intro u_pn_v,
have key : v.reachable,
  by { cases u_r with steps_r u_r, exact ⟨steps_r.succ, or.inl ⟨u, u_r, u_pn_v⟩⟩ },
exact ⟨key, by { exact h_step u v u_r p_u u_pn_v key }⟩,
end

end predicate


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.nat.default
import Mathlib.Lean3Lib.init.data.fin.basic

namespace Mathlib

namespace fin

protected def succ {n : ℕ} : fin n → fin (Nat.succ n) :=
  sorry

def of_nat {n : ℕ} (a : ℕ) : fin (Nat.succ n) :=
  { val := a % Nat.succ n, property := sorry }

protected def add {n : ℕ} : fin n → fin n → fin n :=
  sorry

protected def mul {n : ℕ} : fin n → fin n → fin n :=
  sorry

protected def sub {n : ℕ} : fin n → fin n → fin n :=
  sorry

protected def mod {n : ℕ} : fin n → fin n → fin n :=
  sorry

protected def div {n : ℕ} : fin n → fin n → fin n :=
  sorry

protected instance has_zero {n : ℕ} : HasZero (fin (Nat.succ n)) :=
  { zero := { val := 0, property := nat.succ_pos n } }

protected instance has_one {n : ℕ} : HasOne (fin (Nat.succ n)) :=
  { one := of_nat 1 }

protected instance has_add {n : ℕ} : Add (fin n) :=
  { add := fin.add }

protected instance has_sub {n : ℕ} : Sub (fin n) :=
  { sub := fin.sub }

protected instance has_mul {n : ℕ} : Mul (fin n) :=
  { mul := fin.mul }

protected instance has_mod {n : ℕ} : Mod (fin n) :=
  { mod := fin.mod }

protected instance has_div {n : ℕ} : Div (fin n) :=
  { div := fin.div }

theorem of_nat_zero {n : ℕ} : of_nat 0 = 0 :=
  rfl

theorem add_def {n : ℕ} (a : fin n) (b : fin n) : subtype.val (a + b) = (subtype.val a + subtype.val b) % n := sorry

theorem mul_def {n : ℕ} (a : fin n) (b : fin n) : subtype.val (a * b) = subtype.val a * subtype.val b % n := sorry

theorem sub_def {n : ℕ} (a : fin n) (b : fin n) : subtype.val (a - b) = subtype.val a - subtype.val b := sorry

theorem mod_def {n : ℕ} (a : fin n) (b : fin n) : subtype.val (a % b) = subtype.val a % subtype.val b := sorry

theorem div_def {n : ℕ} (a : fin n) (b : fin n) : subtype.val (a / b) = subtype.val a / subtype.val b := sorry

theorem lt_def {n : ℕ} (a : fin n) (b : fin n) : a < b = (subtype.val a < subtype.val b) := sorry

theorem le_def {n : ℕ} (a : fin n) (b : fin n) : a ≤ b = (subtype.val a ≤ subtype.val b) := sorry

theorem val_zero {n : ℕ} : subtype.val 0 = 0 :=
  rfl

def pred {n : ℕ} (i : fin (Nat.succ n)) : i ≠ 0 → fin n :=
  sorry


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Mario Carneiro

The M construction as a multivariate polynomial functor.
-/
import mvpfunctor.basic pfunctor
universe u

namespace mvpfunctor
open typevec

variables {n : ℕ} (P : mvpfunctor.{u} (n+1))

inductive M_path : P.last.M → fin' n → Type u
| root (x : P.last.M) (a : P.A) (f : P.last.B a → P.last.M) (h : pfunctor.M_dest x = ⟨a, f⟩)
       (i : fin' n) (c : P.drop.B a i) :
    M_path x i
| child (x : P.last.M) (a : P.A) (f : P.last.B a → P.last.M) (h : pfunctor.M_dest x = ⟨a, f⟩)
      (j : P.last.B a) (i : fin' n) (c : M_path (f j) i) :
    M_path x i

def Mp : mvpfunctor n :=
{ A := P.last.M, B := P.M_path }

def M (α : typevec n) : Type* := P.Mp.apply α

instance mvfunctor_M : mvfunctor P.M := by delta M; apply_instance

def M_corec_shape {β : Type u}
    (g₀ : β → P.A)
    (g₂ : Π b : β, P.last.B (g₀ b) → β) :
  β → P.last.M :=
pfunctor.M_corec (λ b, ⟨g₀ b, g₂ b⟩)

def cast_dropB {a a' : P.A} (h : a = a') : P.drop.B a ⟹ P.drop.B a' :=
λ i b, eq.rec_on h b

def cast_lastB {a a' : P.A} (h : a = a') : P.last.B a → P.last.B a' :=
λ b, eq.rec_on h b

def M_corec_contents {α : typevec.{u} n} {β : Type u}
    (g₀ : β → P.A)
    (g₁ : Π b : β, P.drop.B (g₀ b) ⟹ α)
    (g₂ : Π b : β, P.last.B (g₀ b) → β) :
  Π x b, x = P.M_corec_shape g₀ g₂ b → P.M_path x ⟹ α
| ._ b h ._ (M_path.root x a f h' i c)    :=
  have a = g₀ b,
    by { rw [h, M_corec_shape, pfunctor.M_dest_corec] at h', cases h', refl },
  g₁ b i (P.cast_dropB this i c)
| ._ b h ._ (M_path.child x a f h' j i c) :=
  have h₀ : a = g₀ b,
    by { rw [h, M_corec_shape, pfunctor.M_dest_corec] at h', cases h', refl },
  have h₁ : f j = M_corec_shape P g₀ g₂ (g₂ b (cast_lastB P h₀ j)),
    by { rw [h, M_corec_shape, pfunctor.M_dest_corec] at h', cases h', refl },
  M_corec_contents (f j) (g₂ b (P.cast_lastB h₀ j)) h₁ i c

def M_corec' {α : typevec n} {β : Type u}
    (g₀ : β → P.A)
    (g₁ : Π b : β, P.drop.B (g₀ b) ⟹ α)
    (g₂ : Π b : β, P.last.B (g₀ b) → β) :
  β → P.M α :=
λ b, ⟨M_corec_shape P g₀ g₂ b, M_corec_contents P g₀ g₁ g₂ _ _ rfl⟩

def M_corec {α : typevec n} {β : Type u} (g : β → P.apply (α.append1 β)) :
  β → P.M α :=
M_corec' P
  (λ b, (g b).fst)
  (λ b, drop_fun (g b).snd)
  (λ b, last_fun (g b).snd)

def M_path_dest_left {α : typevec n} {x : P.last.M}
    {a : P.A} {f : P.last.B a → P.last.M} (h : pfunctor.M_dest x = ⟨a, f⟩)
    (f' : P.M_path x ⟹ α) :
  P.drop.B a ⟹ α :=
λ i c, f' i (M_path.root x a f h i c)

def M_path_dest_right {α : typevec n} {x : P.last.M}
    {a : P.A} {f : P.last.B a → P.last.M} (h : pfunctor.M_dest x = ⟨a, f⟩)
    (f' : P.M_path x ⟹ α) :
  Π j : P.last.B a, P.M_path (f j) ⟹ α :=
λ j i c, f' i (M_path.child x a f h j i c)

def M_dest' {α : typevec n} {x : P.last.M}
    {a : P.A} {f : P.last.B a → P.last.M} (h : pfunctor.M_dest x = ⟨a, f⟩)
    (f' : P.M_path x ⟹ α) :
  P.apply (α.append1 (P.M α)) :=
⟨a, split_fun (P.M_path_dest_left h f') (λ x, ⟨f x, P.M_path_dest_right h f' x⟩)⟩

def M_dest {α : typevec n} (x : P.M α) : P.apply (α.append1 (P.M α)) :=
P.M_dest' (sigma.eta $ pfunctor.M_dest x.fst).symm x.snd

def M_mk  {α : typevec n} : P.apply (α.append1 (P.M α)) → P.M α :=
M_corec _ (λ i, append_fun id (M_dest P) <$$> i)

theorem M_dest'_eq_dest' {α : typevec n} {x : P.last.M}
    {a₁ : P.A} {f₁ : P.last.B a₁ → P.last.M} (h₁ : pfunctor.M_dest x = ⟨a₁, f₁⟩)
    {a₂ : P.A} {f₂ : P.last.B a₂ → P.last.M} (h₂ : pfunctor.M_dest x = ⟨a₂, f₂⟩)
    (f' : P.M_path x ⟹ α) : M_dest' P h₁ f' = M_dest' P h₂ f' :=
by cases h₁.symm.trans h₂; refl

theorem M_dest_eq_dest' {α : typevec n} {x : P.last.M}
    {a : P.A} {f : P.last.B a → P.last.M} (h : pfunctor.M_dest x = ⟨a, f⟩)
    (f' : P.M_path x ⟹ α) : M_dest P ⟨x, f'⟩ = M_dest' P h f' :=
M_dest'_eq_dest' _ _ _ _

theorem M_dest_corec' {α : typevec.{u} n} {β : Type u}
    (g₀ : β → P.A)
    (g₁ : Π b : β, P.drop.B (g₀ b) ⟹ α)
    (g₂ : Π b : β, P.last.B (g₀ b) → β)
    (x : β) :
  P.M_dest (P.M_corec' g₀ g₁ g₂ x) =
    ⟨g₀ x, split_fun (g₁ x) (P.M_corec' g₀ g₁ g₂ ∘ (g₂ x))⟩ :=
rfl

theorem M_dest_corec {α : typevec n} {β : Type u} (g : β → P.apply (α.append1 β)) (x : β) :
  P.M_dest (P.M_corec g x) = append_fun id (P.M_corec g) <$$> g x :=
begin
  transitivity, apply M_dest_corec',
  cases g x with a f, dsimp,
  rw mvpfunctor.map_eq, congr,
  conv { to_rhs, rw [←split_drop_fun_last_fun f, append_fun_comp_split_fun] },
  refl
end

lemma M_bisim_lemma {α : typevec n}
  {a₁ : (Mp P).A} {f₁ : (Mp P).B a₁ ⟹ α}
  {a' : P.A} {f' : (P.B a').drop ⟹ α} {f₁' : (P.B a').last → M P α}
  (e₁ : M_dest P ⟨a₁, f₁⟩ = ⟨a', split_fun f' f₁'⟩) :
  ∃ g₁' (e₁' : pfunctor.M_dest a₁ = ⟨a', g₁'⟩),
    f' = M_path_dest_left P e₁' f₁ ∧
    f₁' = λ (x : (last P).B a'),
      ⟨g₁' x, M_path_dest_right P e₁' f₁ x⟩ :=
begin
  generalize_hyp ef : @split_fun n _ (append1 α (M P α)) f' f₁' = ff at e₁,
  cases e₁' : pfunctor.M_dest a₁ with a₁' g₁',
  rw M_dest_eq_dest' _ e₁' at e₁,
  cases e₁, exact ⟨_, e₁', split_fun_inj ef⟩,
end

theorem M_bisim {α : typevec n} (R : P.M α → P.M α → Prop)
  (h : ∀ x y, R x y → ∃ a f f₁ f₂,
    P.M_dest x = ⟨a, split_fun f f₁⟩ ∧
    P.M_dest y = ⟨a, split_fun f f₂⟩ ∧
    ∀ i, R (f₁ i) (f₂ i))
  (x y) (r : R x y) : x = y :=
begin
  cases x with a₁ f₁,
  cases y with a₂ f₂,
  dsimp [Mp] at *,
  have : a₁ = a₂, {
    refine pfunctor.M_bisim
      (λ a₁ a₂, ∃ x y, R x y ∧ x.1 = a₁ ∧ y.1 = a₂) _ _ _
      ⟨⟨a₁, f₁⟩, ⟨a₂, f₂⟩, r, rfl, rfl⟩,
    rintro _ _ ⟨⟨a₁, f₁⟩, ⟨a₂, f₂⟩, r, rfl, rfl⟩,
    rcases h _ _ r with ⟨a', f', f₁', f₂', e₁, e₂, h'⟩,
    rcases M_bisim_lemma P e₁ with ⟨g₁', e₁', rfl, rfl⟩,
    rcases M_bisim_lemma P e₂ with ⟨g₂', e₂', _, rfl⟩,
    rw [e₁', e₂'],
    exact ⟨_, _, _, rfl, rfl, λ b, ⟨_, _, h' b, rfl, rfl⟩⟩ },
  subst this, congr, ext i p,
  induction p with x a f h' i c x a f h' i c p IH generalizing f₁ f₂;
  try {
    rcases h _ _ r with ⟨a', f', f₁', f₂', e₁, e₂, h''⟩,
    rcases M_bisim_lemma P e₁ with ⟨g₁', e₁', rfl, rfl⟩,
    rcases M_bisim_lemma P e₂ with ⟨g₂', e₂', e₃, rfl⟩,
    cases h'.symm.trans e₁',
    cases h'.symm.trans e₂' },
  { exact (congr_fun (congr_fun e₃ i) c : _) },
  { exact IH _ _ (h'' _) }
end

theorem M_dest_map {α β : typevec n} (g : α ⟹ β) (x : P.M α) :
  P.M_dest (g <$$> x) = append_fun g (λ x, g <$$> x) <$$> P.M_dest x :=
begin
  cases x with a f,
  rw map_eq,
  conv { to_rhs, rw [M_dest, M_dest', map_eq, append_fun_comp_split_fun] },
  reflexivity
end

end mvpfunctor


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/

import Mathlib

/-!
# Inductive type variant of `Fin`

`Fin` is defined as a subtype of `Nat`. This file defines an equivalent type, `PFin2`, which is
defined inductively, and is universe polymorphic. This is useful for its induction principle and
different definitional equalities.

## Main declarations

* `PFin2 n`: Inductive and universe polymorphic type variant of `Fin n`. `fz` corresponds to `0` and
  `fs n` corresponds to `n`.
* `Fin2 n`: shorthand for `PFin2.{0} n`, i.e., it lives in `Type`
* `toNat`, `optOfNat`, `ofNat'`: Conversions to and from `Nat`. `ofNat' m` takes a proof that
  `m < n` through the class `is_lt`.
* `add k`: Takes `i : PFin2 n` to `i + k : PFin2 (n + k)`.
* `left`: Embeds `PFin2 n` into `PFin2 (n + k)`.
* `insertPerm a`: Permutation of `PFin2 n` which cycles `0, ..., a - 1` and leaves `a, ..., n - 1`
  unchanged.
* `remapLeft f`: Function `PFin2 (m + k) → PFin2 (n + k)` by applying `f : PFin2 m → PFin2 n` to
  `0, ..., m - 1` and sending `m + i` to `n + i`.
-/

open Nat

universe u

/-- An alternate definition of `fin n` defined as an inductive type instead of a subtype of `Nat`. -/
inductive PFin2 : Nat → Type u
  | /-- `0` as a member of `fin (succ n)` (`fin 0` is empty) -/
  fz {n} : PFin2 (succ n)
  | /-- `n` as a member of `fin (succ n)` -/
  fs {n} : PFin2 n → PFin2 (succ n)
  deriving DecidableEq

namespace PFin2

/-- Define a dependent function on `PFin2 (succ n)` by giving its value at
zero (`H1`) and by giving a dependent function on the rest (`H2`). -/
-- @[elab_as_eliminator]
protected def cases' {n} {C : PFin2 (succ n) → Sort u} (H1 : C fz) (H2 : ∀ n, C (fs n)) : ∀ i : PFin2 (succ n), C i
  | fz => H1
  | fs n => H2 n

/-- Ex falso. The dependent eliminator for the empty `PFin2 0` type. -/
def elim0 {C : PFin2 0 → Sort u} : ∀ i : PFin2 0, C i :=
  by intro i; cases i

/-- Converts a `PFin2` into a natural. -/
def toNat : ∀ {n}, PFin2 n → Nat
  | _, @fz n => 0
  | _, @fs n i => succ (toNat i)

/-- Shows that `toNat` produces a natural withing the range -/
theorem toNat_in_range (i : PFin2 n) :
  i.toNat < n :=
by
  induction i
  case fz       => apply succ_pos
  case fs _ ih  => apply lt_succ_of_le ih

/-- Converts a `PFin2` into the a `Fin` -/
def toFin : PFin2 n → Fin n
  := fun i => ⟨i.toNat, toNat_in_range i⟩

/-- Converts a natural into a `PFin2` if it is in range -/
def optOfNat : ∀ {n} (k : Nat), Option (PFin2 n)
  | 0, _ => none
  | succ n, 0 => some fz
  | succ n, succ k => fs <$> @optOfNat n k

/-- Converts a natural into a `PFin2` given a proof that it is in range -/
def ofNatLt : ∀ {n} (k : Nat) (h : k < n), PFin2 n
  | 0, _, h            => by contradiction
  | succ n, 0, h       => fz
  | succ n, succ k, h  => fs $ @ofNatLt n k (lt_of_succ_lt_succ h)

/-- Converts a `Fin` into a `PFin2` -/
def ofFin : Fin n → PFin2 n
  := fun ⟨i, h⟩ => ofNatLt i h

/-- `i + k : PFin2 (n + k)` when `i : PFin2 n` and `k : Nat` -/
def add {n} (i : PFin2 n) : ∀ k, PFin2 (n + k)
  | 0 => i
  | succ k => fs (add i k)

/-- `left k` is the embedding `PFin2 n → PFin2 (k + n)` -/
def left k : ∀ {n}, PFin2 n → PFin2 (k + n)
  | _, @fz n => fz
  | _, @fs n i => fs (left k i)

/-- `insertPerm a` is a permutation of `PFin2 n` with the following properties:
  * `insertPerm a i = i+1` if `i < a`
  * `insertPerm a a = 0`
  * `insertPerm a i = i` if `i > a` -/
def insertPerm : ∀ {n}, PFin2 n → PFin2 n → PFin2 n
  | _, @fz n, @fz _ => fz
  | _, @fz n, @fs _ j => fs j
  | _, @fs (succ n) i, @fz _ => fs fz
  | _, @fs (succ n) i, @fs _ j =>
    match insertPerm i j with
    | fz => fz
    | fs k => fs (fs k)

/-- `remapLeft f k : PFin2 (m + k) → PFin2 (n + k)` applies the function
  `f : PFin2 m → PFin2 n` to inputs less than `m`, and leaves the right part
  on the right (that is, `remapLeft f k (m + i) = n + i`). -/
def remapLeft {m n} (f : PFin2 m → PFin2 n) : ∀ k, PFin2 (m + k) → PFin2 (n + k)
  | 0, i => f i
  | succ k, @fz _ => fz
  | succ k, @fs _ i => fs (remapLeft f _ i)

/-- This is a simple type class inference prover for proof obligations
  of the form `m < n` where `m n : Nat`. -/
class IsLt (m n : Nat) where
  h : m < n

instance IsLt.zero n : IsLt 0 (succ n) :=
  ⟨succ_pos _⟩

instance IsLt.succ m n [l : IsLt m n] : IsLt (succ m) (succ n) :=
  ⟨succ_lt_succ l.h⟩

/-- Use type class inference to infer the boundedness proof, so that we can directly convert a
`nat` into a `PFin2 n`. This supports notation like `&1 : fin 3`. -/
def ofNat' : ∀ {n} m [IsLt m n], PFin2 n
  | 0, m, ⟨h⟩ => absurd h (Nat.not_lt_zero _)
  | succ n, 0, ⟨h⟩ => fz
  | succ n, succ m, ⟨h⟩ => fs (@ofNat' n m ⟨lt_of_succ_lt_succ h⟩)

-- mathport name: «expr& »
local prefix:arg "&" => ofNat'

instance : Inhabited (PFin2 1) :=
  ⟨fz⟩

/-- There is only one function with empty domain `PFin2 0` -/
def eq_fn0 {α} (f g : PFin2 0 → α) : f = g :=
by funext i; cases i

/-- There is only one function with empty domain `PFin2 0`
    We take `PFin2.elim0` to be the "normalized" such function
 -/
@[simp] def eq_fn0_elim0 {α} (f g : PFin2 0 → α) : f = PFin2.elim0
  := by apply eq_fn0

/--
  Try to lower the bound on some `PFin2`, which fails iff the value is equal to the upper bound
-/
def strengthen : ∀{n}, PFin2 (succ n) → Option (PFin2 n)
  | 0, _            => none
  | (succ n), fz    => some fz
  | (succ n), fs k  => fs <$> strengthen k

/--
  Weakens the bound on a `PFin2`, without changing the value
-/
def weaken : PFin2 n → PFin2 (succ n)
  | fz   => fz
  | fs k => fs $ weaken k

/--
  Decrements a `PFin2` by one, simultaneously lowering the bound
-/
def decr : PFin2 (Nat.succ $ Nat.succ n) → PFin2 (Nat.succ n)
  | fz    => fz
  | fs j  => j

/--
  The maximal element of `PFin2 (n+1)`, i.e., `n`
-/
def last : {n : Nat} → PFin2 (n+1)
  | 0   => fz
  | n+1 => fs (@last n)

/--
  The inverse of `i` w.r.t. addition modulo `n`, i.e., .last - i
-/
def inv : {n : Nat} → PFin2.{u} n → PFin2.{u} n
  | 0,    _     => by contradiction
  | 1,    .fs _ => by contradiction
  | n+1,  .fz   => last
  | n+2,  .fs i => i.inv.weaken

@[simp]
theorem strengthen_last_is_none {n : Nat} :
  (@last n).strengthen = none :=
by
  induction n;
  simp [last]
  simp [strengthen, last, *]

theorem strengthen_is_none_imp_eq_last {n : Nat} {i : PFin2 (n+1)} :
  i.strengthen = none → i = last :=
by
  induction n;
  . cases i;
    . simp [strengthen]
    . intros; contradiction
  case succ n ih =>
    simp [strengthen, last, *]
    cases i
    case fz => simp [strengthen]
    case fs i =>
      simp [strengthen, last]
      apply ih;

theorem strengthen_toNat_eq {n : Nat} {i : PFin2 (n+1)} {k : PFin2 n} :
  i.strengthen = some k → i.toNat = k.toNat :=
by
  intro h;
  induction k
  <;> cases i
  . simp [toNat]
  . simp [strengthen] at h
  . simp [strengthen] at h
  . simp [strengthen] at h
    simp [toNat, *]

@[simp]
theorem strengthen_weaken_is_some {n : Nat} {i : PFin2 n} :
  i.weaken.strengthen = some i :=
by
  induction i
  <;> simp [weaken, strengthen, *]

theorem weaken_strengthen_of_some {n : Nat} {i : PFin2 (n+1)} {k : PFin2 n} :
  i.strengthen = some k → k.weaken = i :=
by
  induction k
  <;> cases i
  <;> simp [weaken, strengthen, *]
  case fs ih _ => {
    apply ih
  }

@[simp]
theorem weaken_to_nat_eq_to_nat {n : Nat} (i : PFin2 n) :
  i.weaken.toNat = i.toNat :=
by
  induction i;
  case fz => rfl
  case fs ih =>
    simp [weaken, toNat, ih];

theorem eq_of_to_nat_eq {n : Nat} (i j : PFin2 n) :
  i.toNat = j.toNat → i = j :=
by
  induction i
  <;> cases j
  <;> simp [toNat]
  case fs x ih y  => {
    apply ih;
  }

theorem inv_last_eq_fz {n : Nat} :
  (@last n).inv = .fz :=
by
  induction n <;> simp [inv, last, weaken, *]

theorem inv_weaken_eq_fs_inv {n : Nat} (i : PFin2 n):
  inv (weaken  i) = .fs (inv i) :=
by
  induction i
  <;> simp[inv, weaken, last]
  case fs n i ih =>
    simp[ih]
    cases n
    . contradiction
    . simp[inv, weaken]

@[simp]
theorem inv_involution {i : PFin2 n} :
  i.inv.inv = i :=
by
    induction i
    <;> simp[inv]
    case fz => apply inv_last_eq_fz
    case fs n i ih => {
      cases n;
      case zero => contradiction
      case succ n =>
        simp[inv]
        rw[inv_weaken_eq_fs_inv i.inv]
        apply congrArg
        apply ih
    }

    -- case zero.fs => contradiction
    -- case succ.fs => simp[inv_last_eq_fz, weaken]

/--
  Typeclass instances to make it easier to work with `PFin2`'s
-/
@[simp]
instance (n : Nat) : OfNat (PFin2 (n+1)) (nat_lit 0) := ⟨fz⟩
instance (n : Nat) : OfNat (PFin2 (n+2)) (nat_lit 1) := ⟨fs 0⟩
instance (n : Nat) : OfNat (PFin2 (n+3)) (nat_lit 2) := ⟨fs 1⟩

/-
  ## LT / LE
-/
instance instOrd (n : Nat) : Ord (PFin2 n) where
  compare := (compare ·.toNat ·.toNat)

instance instLT {n : Nat} : LT (PFin2 n) := ⟨(Nat.lt ·.toNat ·.toNat)⟩
instance instLE {n : Nat} : LE (PFin2 n) := ⟨(Nat.le ·.toNat ·.toNat)⟩

instance decidable_lt (n : Nat) : DecidableRel (@LT.lt (PFin2 n) instLT) := fun a b =>
    let d : Decidable (a.toNat < b.toNat) := by infer_instance
    match d with
    | isTrue h  => isTrue  $ by assumption
    | isFalse h => isFalse $ by intro a_lt_b; apply h a_lt_b

instance decidable_le {n : Nat} : DecidableRel (@LE.le (PFin2 n) instLE) := fun a b =>
    let d : Decidable (a.toNat ≤ b.toNat) := by infer_instance
    match d with
    | isTrue h  => isTrue  $ by assumption
    | isFalse h => isFalse $ by intro a_le_b; apply h a_le_b

instance instLinOrd : LinearOrder (PFin2 n) where
  le_refl _             := by apply Nat.le_refl;
  le_trans _ _ _        := by apply Nat.le_trans;
  lt_iff_le_not_le _ _  := by simp[LT.lt, LE.le]; exact le_of_lt
  le_antisymm x y h₁ h₂ := by simp[LE.le] at h₁ h₂;
                              suffices toNat x = toNat y
                              from by clear h₁ h₂;
                                      induction x
                                      <;> cases y
                                      <;> simp[toNat] at this;
                                      rfl;
                                      case fs x ih y => {
                                        simp;
                                        apply ih;
                                        apply this;
                                      }
                              apply Nat.le_antisymm h₁ h₂
  le_total _ _          := by apply Nat.le_total
  decidable_le          := decidable_le

def le_refl {n : Nat} :
  ∀ (x : PFin2 n), x ≤ x :=
  instLinOrd.le_refl

def le_trans {n : Nat} :
  ∀ (x y z : PFin2 n), x ≤ y → y ≤ z → x ≤ z
:= instLinOrd.le_trans

def lt_iff_le_not_le :
  ∀ (x y : PFin2 n), x < y ↔ x ≤ y ∧ ¬y ≤ x
:= instLinOrd.lt_iff_le_not_le

def le_antisymm :
  ∀ (x y : PFin2 n), x ≤ y → y ≤ x → x = y
:= instLinOrd.le_antisymm

def le_total :
  ∀ (x y : PFin2 n), x ≤ y ∨ y ≤ x
:= instLinOrd.le_total

def lt_trichotomy {n : Nat}  :
  ∀(a b : PFin2 n), a < b ∨ a = b ∨ b < a
:= _root_.lt_trichotomy

def zero_le {n : Nat} (i : PFin2 (n+1)) :
  .fz ≤ i :=
by
  simp [LE.le, toNat];
  apply Nat.zero_le

theorem last_is_maximal {n : Nat} (i : PFin2 (n+1)) :
  i ≤ last :=
by
  induction n;
  case zero =>
    cases i;
    . simp;
    . contradiction
  case succ n ih =>
    cases i;
    . simp [LE.le, toNat]
      apply Nat.zero_le
    . simp [LE.le, toNat] at ih
      apply Nat.succ_le_succ
      apply ih

@[simp]
theorem strengthen_is_some_of_lt {n : Nat} {i j : PFin2 (n+1)} :
  i < j → ∃k, i.strengthen = some k :=
by
  intro lt;
  cases h : strengthen i;
  case some => simp
  case none =>
    have : i = last := by apply strengthen_is_none_imp_eq_last h;
    cases this;
    have : j ≤ last   := by apply last_is_maximal;
    have : ¬ last < j := by simp[this];
    contradiction

  def ofFin2 : Fin2 n → PFin2 n
    | .fz   => .fz
    | .fs i => .fs <| ofFin2 i

  def toFin2 : PFin2 n → Fin2 n
    | .fz   => .fz
    | .fs i => .fs <| toFin2 i

  @[simp]
  theorem ofFin2_toFin2_iso {i : Fin2 n} :
    (toFin2 <| ofFin2 i) = i :=
  by
    induction i
    . rfl
    . simp [ofFin2, toFin2, *]

  @[simp]
  theorem toFin2_ofFin2_iso {i : PFin2 n} :
    (ofFin2 <| toFin2 i) = i :=
  by
    induction i
    . rfl
    . simp [ofFin2, toFin2, *]

  instance : Coe (Fin2 n) (PFin2 n) := ⟨ofFin2⟩
  instance : Coe (PFin2 n) (Fin2 n) := ⟨toFin2⟩

  instance : Coe (PFin2 n) (Fin n) := ⟨toFin⟩
  instance : Coe (Fin n) (PFin2 n) := ⟨ofFin⟩

  instance : Coe (Fin n) (Fin2 n) := ⟨fun i => toFin2 <| ofFin.{0} i⟩
  instance : Coe (Fin2 n) (Fin n) := ⟨fun i => toFin <| ofFin2.{0} i⟩

end PFin2

namespace Fin2
  /--
  Typeclass instances to make it easier to work with `PFin2`'s
-/
@[simp]
instance (n : Nat) : OfNat (Fin2 (n+1)) (nat_lit 0) := ⟨fz⟩
instance (n : Nat) : OfNat (Fin2 (n+2)) (nat_lit 1) := ⟨fs 0⟩
instance (n : Nat) : OfNat (Fin2 (n+3)) (nat_lit 2) := ⟨fs 1⟩

  def inv : Fin2 n → Fin2 n
    := fun i => (PFin2.inv.{0} i : PFin2 n)

end Fin2


import tutorial_world.level15_simp -- hide
open IncidencePlane -- hide

/- Tactic : exfalso

## Summary

Changes the goal to `⊢ false`.

## Details

This may seem hard to prove,
but it is useful when we have a contradiction in the hypotheses.

For example, if we have `h : ¬ P` as a hypothesis and we apply `exfalso`
we can then `apply h` to transform the goal into `⊢ P`.
-/

/-
# Tutorial World

## Level 16: the `exfalso` tactic.

In this level we introduce the new tactic `exfalso`. It satifies the **Principle of explosion** of classical logic,
according to which any statement can be proven from a contradiction. In Lean, if we type `exfalso`, the goal will turn
into `⊢ false`. Let's solve this level to see how it works!

Delete the `sorry` and take a look at the hypothesis `h`, according to which the point P is not an element of the line
that passes through the points P and Q. This is a contradiction that can be rewritten as `¬ (P ∈ line_through P Q)`, where
the symbol **¬** means "not". Moreover, it can also be rewritten as `P ∈ line_through P Q → false`. This last way of representing
the contradiction is key to complete this level. By typing `exfalso`, we know that the goal will change into `⊢ false`. Then, look
for a tactic that can turn the goal into `⊢ P ∈ line_through P Q` and you will be almost done! In case you get stuck, click right below for a hint.
-/

/- Hint : Click here for a hint, in case you get stuck.
The `apply` tactic changes the goal from `⊢ Q` to `⊢ P` when we have a hypothesis of the form `h : P → Q`. In this case, `h : P ∉ line_through P Q`
can be interpreted as `P ∈ line_through P Q → false`. Then, because the goal is `⊢ false', `apply h,` will make progress. Still bewildered? Click on "View source"
(located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma : no-side-bar
Prove that 2+2 is 5, using a false hypothesis.
-/
lemma two_plus_two_equals_five (P Q : Ω) (h: P ∉ line_through P Q) : 2 + 2 = 5:=
begin

  exfalso,
  apply h,
  exact line_through_left P Q,

end


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebraic_topology.dold_kan.decomposition
import tactic.fin_cases

/-!

# Behaviour of P_infty with respect to degeneracies

For any `X : simplicial_object C` where `C` is an abelian category,
the projector `P_infty : K[X] ⟶ K[X]` is supposed to be the projection
on the normalized subcomplex, parallel to the degenerate subcomplex, i.e.
the subcomplex generated by the images of all `X.σ i`.

In this file, we obtain `degeneracy_comp_P_infty` which states that
if `X : simplicial_object C` with `C` a preadditive category,
`θ : [n] ⟶ Δ'` is a non injective map in `simplex_category`, then
`X.map θ.op ≫ P_infty.f n = 0`. It follows from the more precise
statement vanishing statement `σ_comp_P_eq_zero` for the `P q`.

-/

open category_theory category_theory.category category_theory.limits
  category_theory.preadditive opposite
open_locale simplicial dold_kan

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C]

lemma higher_faces_vanish.comp_σ {Y : C} {X : simplicial_object C} {n b q : ℕ} {φ : Y ⟶ X _[n+1]}
  (v : higher_faces_vanish q φ) (hnbq : n + 1 = b + q) :
    higher_faces_vanish q (φ ≫ X.σ ⟨b,
    by simpa only [hnbq, nat.lt_succ_iff, le_add_iff_nonneg_right] using zero_le q⟩) :=
λ j hj, begin
  rw [assoc, simplicial_object.δ_comp_σ_of_gt', fin.pred_succ,
    v.comp_δ_eq_zero_assoc _ _ hj, zero_comp],
  { intro hj',
    simpa only [hj', hnbq, fin.coe_zero, zero_add, add_comm b, add_assoc, false_and,
      add_le_iff_nonpos_right, le_zero_iff, add_eq_zero_iff, nat.one_ne_zero] using hj, },
  { simp only [fin.lt_iff_coe_lt_coe, nat.lt_iff_add_one_le,
      fin.succ_mk, fin.coe_mk, fin.coe_succ, add_le_add_iff_right],
    linarith, },
end

lemma σ_comp_P_eq_zero (X : simplicial_object C)
  {n q : ℕ} (i : fin (n + 1)) (hi : n + 1 ≤ i + q) : (X.σ i) ≫ (P q).f (n + 1) = 0 :=
begin
  induction q with q hq generalizing i hi,
  { exfalso,
    have h := fin.is_lt i,
    linarith, },
  { by_cases n+1 ≤ (i : ℕ) + q,
    { unfold P,
      simp only [homological_complex.comp_f, ← assoc],
      rw [hq i h, zero_comp], },
    { have hi' : n = (i : ℕ) + q,
      { cases le_iff_exists_add.mp hi with j hj,
        rw [← nat.lt_succ_iff, nat.succ_eq_add_one, add_assoc, hj, not_lt,
          add_le_iff_nonpos_right, nonpos_iff_eq_zero] at h,
        rw [← add_left_inj 1, add_assoc, hj, self_eq_add_right, h], },
      cases n,
      { fin_cases i,
        rw [show q = 0, by linarith],
        unfold P,
        simp only [id_comp, homological_complex.add_f_apply, comp_add, homological_complex.id_f,
          Hσ, homotopy.null_homotopic_map'_f (c_mk 2 1 rfl) (c_mk 1 0 rfl),
          alternating_face_map_complex.obj_d_eq],
        erw [hσ'_eq' (zero_add 0).symm, hσ'_eq' (add_zero 1).symm, comp_id,
          fin.sum_univ_two, fin.sum_univ_succ, fin.sum_univ_two],
        simp only [pow_zero, pow_one, pow_two, fin.coe_zero, fin.coe_one, fin.coe_two,
          one_zsmul, neg_zsmul, fin.mk_zero, fin.mk_one, fin.coe_succ, pow_add, one_mul,
          neg_mul, neg_neg, fin.succ_zero_eq_one, fin.succ_one_eq_two, comp_neg, neg_comp,
          add_comp, comp_add],
        erw [simplicial_object.δ_comp_σ_self, simplicial_object.δ_comp_σ_self_assoc,
          simplicial_object.δ_comp_σ_succ, comp_id, simplicial_object.δ_comp_σ_of_le X
            (show (0 : fin(2)) ≤ fin.cast_succ 0, by rw fin.cast_succ_zero),
          simplicial_object.δ_comp_σ_self_assoc, simplicial_object.δ_comp_σ_succ_assoc],
        abel, },
      { rw [← id_comp (X.σ i), ← (P_add_Q_f q n.succ : _ = 𝟙 (X.obj _)), add_comp, add_comp],
        have v : higher_faces_vanish q ((P q).f n.succ ≫ X.σ i) :=
          (higher_faces_vanish.of_P q n).comp_σ hi',
        unfold P,
        erw [← assoc, v.comp_P_eq_self, homological_complex.add_f_apply,
          preadditive.comp_add, comp_id, v.comp_Hσ_eq hi', assoc,
          simplicial_object.δ_comp_σ_succ'_assoc, fin.eta,
          decomposition_Q n q, sum_comp, sum_comp, finset.sum_eq_zero, add_zero,
          add_neg_eq_zero], swap,
        { ext, simp only [fin.coe_mk, fin.coe_succ], },
        { intros j hj,
          simp only [true_and, finset.mem_univ, finset.mem_filter] at hj,
          simp only [nat.succ_eq_add_one] at hi',
          obtain ⟨k, hk⟩ := nat.le.dest (nat.lt_succ_iff.mp (fin.is_lt j)),
          rw add_comm at hk,
          have hi'' : i = fin.cast_succ ⟨i, by linarith⟩ :=
            by { ext, simp only [fin.cast_succ_mk, fin.eta], },
          have eq := hq j.rev.succ begin
            simp only [← hk, fin.rev_eq j hk.symm, nat.succ_eq_add_one, fin.succ_mk, fin.coe_mk],
            linarith,
          end,
          rw [homological_complex.comp_f, assoc, assoc, assoc, hi'',
            simplicial_object.σ_comp_σ_assoc, reassoc_of eq, zero_comp, comp_zero,
            comp_zero, comp_zero],
          simp only [fin.rev_eq j hk.symm, fin.le_iff_coe_le_coe, fin.coe_mk],
          linarith, }, }, }, }
end

@[simp, reassoc]
lemma σ_comp_P_infty (X : simplicial_object C) {n : ℕ} (i : fin (n+1)) :
  (X.σ i) ≫ P_infty.f (n+1) = 0 :=
begin
  rw [P_infty_f, σ_comp_P_eq_zero X i],
  simp only [le_add_iff_nonneg_left, zero_le],
end

@[reassoc]
lemma degeneracy_comp_P_infty (X : simplicial_object C)
  (n : ℕ) {Δ' : simplex_category} (θ : [n] ⟶ Δ') (hθ : ¬mono θ) :
  X.map θ.op ≫ P_infty.f n = 0 :=
begin
  rw simplex_category.mono_iff_injective at hθ,
  cases n,
  { exfalso,
    apply hθ,
    intros x y h,
    fin_cases x,
    fin_cases y, },
  { obtain ⟨i, α, h⟩ := simplex_category.eq_σ_comp_of_not_injective θ hθ,
    rw [h, op_comp, X.map_comp, assoc, (show X.map (simplex_category.σ i).op = X.σ i, by refl),
      σ_comp_P_infty, comp_zero], },
end

end dold_kan

end algebraic_topology


import .definitions2 .qi .soundness

-- This theorem states that any proposition `P` that is valid with instantiations `⟪ P ⟫`
-- is also a valid proposition without quantifier instantiation `⦃ P ⦄`:
theorem vc_valid_without_instantiations (P: prop):
  ⟪ P ⟫ → ⦃ P ⦄

  := @vc_valid_from_inst_valid P -- actual proof in qi.lean

-- This theorem states that a verified source program `e` does not get stuck,
-- i.e. its evaluation always results either in a value or in a runtime stack `s` that can be
-- further evaluated. The proof internally uses lemmas for progress and preservation.
theorem verification_safety (e: exp) (s: stack) (Q: propctx):
  (value.true ⊢ e: Q) → ((env.empty, e) ⟶* s) → (is_value s ∨ ∃s', s ⟶ s')

  := @soundness_source_programs e s Q -- actual proof in soundness.lean


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Sean Leather

! This file was ported from Lean 3 source module data.list.sigma
! leanprover-community/mathlib commit f808feb6c18afddb25e66a71d317643cf7fb5fbb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Range
import Mathbin.Data.List.Perm

/-!
# Utilities for lists of sigmas

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file includes several ways of interacting with `list (sigma β)`, treated as a key-value store.

If `α : Type*` and `β : α → Type*`, then we regard `s : sigma β` as having key `s.1 : α` and value
`s.2 : β s.1`. Hence, `list (sigma β)` behaves like a key-value store.

## Main Definitions

- `list.keys` extracts the list of keys.
- `list.nodupkeys` determines if the store has duplicate keys.
- `list.lookup`/`lookup_all` accesses the value(s) of a particular key.
- `list.kreplace` replaces the first value with a given key by a given value.
- `list.kerase` removes a value.
- `list.kinsert` inserts a value.
- `list.kunion` computes the union of two stores.
- `list.kextract` returns a value with a given key and the rest of the values.
-/

universe u v

namespace List

variable {α : Type u} {β : α → Type v} {l l₁ l₂ : List (Sigma β)}

/-! ### `keys` -/

#print List.keys /-
/-- List of keys from a list of key-value pairs -/
def keys : List (Sigma β) → List α :=
  map Sigma.fst
#align list.keys List.keys
-/

#print List.keys_nil /-
@[simp]
theorem keys_nil : @keys α β [] = [] :=
  rfl
#align list.keys_nil List.keys_nil
-/

#print List.keys_cons /-
@[simp]
theorem keys_cons {s} {l : List (Sigma β)} : (s :: l).keys = s.1 :: l.keys :=
  rfl
#align list.keys_cons List.keys_cons
-/

#print List.mem_keys_of_mem /-
theorem mem_keys_of_mem {s : Sigma β} {l : List (Sigma β)} : s ∈ l → s.1 ∈ l.keys :=
  mem_map_of_mem Sigma.fst
#align list.mem_keys_of_mem List.mem_keys_of_mem
-/

#print List.exists_of_mem_keys /-
theorem exists_of_mem_keys {a} {l : List (Sigma β)} (h : a ∈ l.keys) :
    ∃ b : β a, Sigma.mk a b ∈ l :=
  let ⟨⟨a', b'⟩, m, e⟩ := exists_of_mem_map h
  Eq.recOn e (Exists.intro b' m)
#align list.exists_of_mem_keys List.exists_of_mem_keys
-/

#print List.mem_keys /-
theorem mem_keys {a} {l : List (Sigma β)} : a ∈ l.keys ↔ ∃ b : β a, Sigma.mk a b ∈ l :=
  ⟨exists_of_mem_keys, fun ⟨b, h⟩ => mem_keys_of_mem h⟩
#align list.mem_keys List.mem_keys
-/

#print List.not_mem_keys /-
theorem not_mem_keys {a} {l : List (Sigma β)} : a ∉ l.keys ↔ ∀ b : β a, Sigma.mk a b ∉ l :=
  (not_congr mem_keys).trans not_exists
#align list.not_mem_keys List.not_mem_keys
-/

#print List.not_eq_key /-
theorem not_eq_key {a} {l : List (Sigma β)} : a ∉ l.keys ↔ ∀ s : Sigma β, s ∈ l → a ≠ s.1 :=
  Iff.intro (fun h₁ s h₂ e => absurd (mem_keys_of_mem h₂) (by rwa [e] at h₁)) fun f h₁ =>
    let ⟨b, h₂⟩ := exists_of_mem_keys h₁
    f _ h₂ rfl
#align list.not_eq_key List.not_eq_key
-/

/-! ### `nodupkeys` -/

#print List.NodupKeys /-
/-- Determines whether the store uses a key several times. -/
def NodupKeys (l : List (Sigma β)) : Prop :=
  l.keys.Nodup
#align list.nodupkeys List.NodupKeys
-/

#print List.nodupKeys_iff_pairwise /-
theorem nodupKeys_iff_pairwise {l} : NodupKeys l ↔ Pairwise (fun s s' : Sigma β => s.1 ≠ s'.1) l :=
  pairwise_map' _
#align list.nodupkeys_iff_pairwise List.nodupKeys_iff_pairwise
-/

#print List.NodupKeys.pairwise_ne /-
theorem NodupKeys.pairwise_ne {l} (h : NodupKeys l) :
    Pairwise (fun s s' : Sigma β => s.1 ≠ s'.1) l :=
  nodupKeys_iff_pairwise.1 h
#align list.nodupkeys.pairwise_ne List.NodupKeys.pairwise_ne
-/

#print List.nodupKeys_nil /-
@[simp]
theorem nodupKeys_nil : @NodupKeys α β [] :=
  Pairwise.nil
#align list.nodupkeys_nil List.nodupKeys_nil
-/

#print List.nodupKeys_cons /-
@[simp]
theorem nodupKeys_cons {s : Sigma β} {l : List (Sigma β)} :
    NodupKeys (s :: l) ↔ s.1 ∉ l.keys ∧ NodupKeys l := by simp [keys, nodupkeys]
#align list.nodupkeys_cons List.nodupKeys_cons
-/

#print List.not_mem_keys_of_nodupKeys_cons /-
theorem not_mem_keys_of_nodupKeys_cons {s : Sigma β} {l : List (Sigma β)} (h : NodupKeys (s :: l)) :
    s.1 ∉ l.keys :=
  (nodupKeys_cons.1 h).1
#align list.not_mem_keys_of_nodupkeys_cons List.not_mem_keys_of_nodupKeys_cons
-/

#print List.nodupKeys_of_nodupKeys_cons /-
theorem nodupKeys_of_nodupKeys_cons {s : Sigma β} {l : List (Sigma β)} (h : NodupKeys (s :: l)) :
    NodupKeys l :=
  (nodupKeys_cons.1 h).2
#align list.nodupkeys_of_nodupkeys_cons List.nodupKeys_of_nodupKeys_cons
-/

#print List.NodupKeys.eq_of_fst_eq /-
theorem NodupKeys.eq_of_fst_eq {l : List (Sigma β)} (nd : NodupKeys l) {s s' : Sigma β} (h : s ∈ l)
    (h' : s' ∈ l) : s.1 = s'.1 → s = s' :=
  @Pairwise.forall_of_forall _ (fun s s' : Sigma β => s.1 = s'.1 → s = s') _
    (fun s s' H h => (H h.symm).symm) (fun x h _ => rfl)
    ((nodupKeys_iff_pairwise.1 nd).imp fun s s' h h' => (h h').elim) _ h _ h'
#align list.nodupkeys.eq_of_fst_eq List.NodupKeys.eq_of_fst_eq
-/

#print List.NodupKeys.eq_of_mk_mem /-
theorem NodupKeys.eq_of_mk_mem {a : α} {b b' : β a} {l : List (Sigma β)} (nd : NodupKeys l)
    (h : Sigma.mk a b ∈ l) (h' : Sigma.mk a b' ∈ l) : b = b' := by
  cases nd.eq_of_fst_eq h h' rfl <;> rfl
#align list.nodupkeys.eq_of_mk_mem List.NodupKeys.eq_of_mk_mem
-/

#print List.nodupKeys_singleton /-
theorem nodupKeys_singleton (s : Sigma β) : NodupKeys [s] :=
  nodup_singleton _
#align list.nodupkeys_singleton List.nodupKeys_singleton
-/

#print List.NodupKeys.sublist /-
theorem NodupKeys.sublist {l₁ l₂ : List (Sigma β)} (h : l₁ <+ l₂) : NodupKeys l₂ → NodupKeys l₁ :=
  Nodup.sublist <| h.map _
#align list.nodupkeys.sublist List.NodupKeys.sublist
-/

#print List.NodupKeys.nodup /-
protected theorem NodupKeys.nodup {l : List (Sigma β)} : NodupKeys l → Nodup l :=
  Nodup.of_map _
#align list.nodupkeys.nodup List.NodupKeys.nodup
-/

#print List.perm_nodupKeys /-
theorem perm_nodupKeys {l₁ l₂ : List (Sigma β)} (h : l₁ ~ l₂) : NodupKeys l₁ ↔ NodupKeys l₂ :=
  (h.map _).nodup_iff
#align list.perm_nodupkeys List.perm_nodupKeys
-/

#print List.nodupKeys_join /-
theorem nodupKeys_join {L : List (List (Sigma β))} :
    NodupKeys (join L) ↔ (∀ l ∈ L, NodupKeys l) ∧ Pairwise Disjoint (L.map keys) :=
  by
  rw [nodupkeys_iff_pairwise, pairwise_join, pairwise_map]
  refine' and_congr (ball_congr fun l h => by simp [nodupkeys_iff_pairwise]) _
  apply iff_of_eq; congr with (l₁ l₂)
  simp [keys, disjoint_iff_ne]
#align list.nodupkeys_join List.nodupKeys_join
-/

#print List.nodup_enum_map_fst /-
theorem nodup_enum_map_fst (l : List α) : (l.enum.map Prod.fst).Nodup := by simp [List.nodup_range]
#align list.nodup_enum_map_fst List.nodup_enum_map_fst
-/

#print List.mem_ext /-
theorem mem_ext {l₀ l₁ : List (Sigma β)} (nd₀ : l₀.Nodup) (nd₁ : l₁.Nodup)
    (h : ∀ x, x ∈ l₀ ↔ x ∈ l₁) : l₀ ~ l₁ :=
  by
  induction' l₀ with x xs generalizing l₁ <;> cases' l₁ with y ys
  · constructor
  iterate 2
    first |specialize h x|specialize h y; simp at h
    cases h
  simp at nd₀ nd₁
  classical
    obtain rfl | h' := eq_or_ne x y
    · constructor
      refine' l₀_ih nd₀.2 nd₁.2 fun a => _
      specialize h a
      simp at h
      obtain rfl | h' := eq_or_ne a x
      · exact iff_of_false nd₀.1 nd₁.1
      · simpa [h'] using h
    · trans x :: y :: ys.erase x
      · constructor
        refine' l₀_ih nd₀.2 ((nd₁.2.eraseₓ _).cons fun h => nd₁.1 <| mem_of_mem_erase h) fun a => _
        · specialize h a
          simp at h
          obtain rfl | h' := eq_or_ne a x
          · exact iff_of_false nd₀.1 fun h => h.elim h' nd₁.2.not_mem_erase
          · rw [or_iff_right h'] at h
            rw [h, mem_cons_iff]
            exact or_congr_right (mem_erase_of_ne h').symm
      trans y :: x :: ys.erase x
      · constructor
      · constructor
        symm
        apply perm_cons_erase
        specialize h x
        simp [h'] at h
        exact h
#align list.mem_ext List.mem_ext
-/

variable [DecidableEq α]

/-! ### `lookup` -/

#print List.dlookup /-
/-- `lookup a l` is the first value in `l` corresponding to the key `a`,
  or `none` if no such element exists. -/
def dlookup (a : α) : List (Sigma β) → Option (β a)
  | [] => none
  | ⟨a', b⟩ :: l => if h : a' = a then some (Eq.recOn h b) else lookup l
#align list.lookup List.dlookup
-/

#print List.dlookup_nil /-
@[simp]
theorem dlookup_nil (a : α) : dlookup a [] = @none (β a) :=
  rfl
#align list.lookup_nil List.dlookup_nil
-/

#print List.dlookup_cons_eq /-
@[simp]
theorem dlookup_cons_eq (l) (a : α) (b : β a) : dlookup a (⟨a, b⟩ :: l) = some b :=
  dif_pos rfl
#align list.lookup_cons_eq List.dlookup_cons_eq
-/

#print List.dlookup_cons_ne /-
@[simp]
theorem dlookup_cons_ne (l) {a} : ∀ s : Sigma β, a ≠ s.1 → dlookup a (s :: l) = dlookup a l
  | ⟨a', b⟩, h => dif_neg h.symm
#align list.lookup_cons_ne List.dlookup_cons_ne
-/

#print List.dlookup_isSome /-
theorem dlookup_isSome {a : α} : ∀ {l : List (Sigma β)}, (dlookup a l).isSome ↔ a ∈ l.keys
  | [] => by simp
  | ⟨a', b⟩ :: l => by
    by_cases h : a = a'
    · subst a'
      simp
    · simp [h, lookup_is_some]
#align list.lookup_is_some List.dlookup_isSome
-/

#print List.dlookup_eq_none /-
theorem dlookup_eq_none {a : α} {l : List (Sigma β)} : dlookup a l = none ↔ a ∉ l.keys := by
  simp [← lookup_is_some, Option.isNone_iff_eq_none]
#align list.lookup_eq_none List.dlookup_eq_none
-/

#print List.of_mem_dlookup /-
theorem of_mem_dlookup {a : α} {b : β a} :
    ∀ {l : List (Sigma β)}, b ∈ dlookup a l → Sigma.mk a b ∈ l
  | ⟨a', b'⟩ :: l, H => by
    by_cases h : a = a'
    · subst a'
      simp at H
      simp [H]
    · simp [h] at H
      exact Or.inr (of_mem_lookup H)
#align list.of_mem_lookup List.of_mem_dlookup
-/

#print List.mem_dlookup /-
theorem mem_dlookup {a} {b : β a} {l : List (Sigma β)} (nd : l.NodupKeys) (h : Sigma.mk a b ∈ l) :
    b ∈ dlookup a l :=
  by
  cases' option.is_some_iff_exists.mp (lookup_is_some.mpr (mem_keys_of_mem h)) with b' h'
  cases nd.eq_of_mk_mem h (of_mem_lookup h')
  exact h'
#align list.mem_lookup List.mem_dlookup
-/

#print List.map_dlookup_eq_find /-
theorem map_dlookup_eq_find (a : α) :
    ∀ l : List (Sigma β), (dlookup a l).map (Sigma.mk a) = find? (fun s => a = s.1) l
  | [] => rfl
  | ⟨a', b'⟩ :: l => by
    by_cases h : a = a'
    · subst a'
      simp
    · simp [h, map_lookup_eq_find]
#align list.map_lookup_eq_find List.map_dlookup_eq_find
-/

#print List.mem_dlookup_iff /-
theorem mem_dlookup_iff {a : α} {b : β a} {l : List (Sigma β)} (nd : l.NodupKeys) :
    b ∈ dlookup a l ↔ Sigma.mk a b ∈ l :=
  ⟨of_mem_dlookup, mem_dlookup nd⟩
#align list.mem_lookup_iff List.mem_dlookup_iff
-/

#print List.perm_dlookup /-
theorem perm_dlookup (a : α) {l₁ l₂ : List (Sigma β)} (nd₁ : l₁.NodupKeys) (nd₂ : l₂.NodupKeys)
    (p : l₁ ~ l₂) : dlookup a l₁ = dlookup a l₂ := by
  ext b <;> simp [mem_lookup_iff, nd₁, nd₂] <;> exact p.mem_iff
#align list.perm_lookup List.perm_dlookup
-/

#print List.lookup_ext /-
theorem lookup_ext {l₀ l₁ : List (Sigma β)} (nd₀ : l₀.NodupKeys) (nd₁ : l₁.NodupKeys)
    (h : ∀ x y, y ∈ l₀.dlookup x ↔ y ∈ l₁.dlookup x) : l₀ ~ l₁ :=
  mem_ext nd₀.Nodup nd₁.Nodup fun ⟨a, b⟩ => by
    rw [← mem_lookup_iff, ← mem_lookup_iff, h] <;> assumption
#align list.lookup_ext List.lookup_ext
-/

/-! ### `lookup_all` -/

#print List.lookupAll /-
/-- `lookup_all a l` is the list of all values in `l` corresponding to the key `a`. -/
def lookupAll (a : α) : List (Sigma β) → List (β a)
  | [] => []
  | ⟨a', b⟩ :: l => if h : a' = a then Eq.recOn h b :: lookup_all l else lookup_all l
#align list.lookup_all List.lookupAll
-/

#print List.lookupAll_nil /-
@[simp]
theorem lookupAll_nil (a : α) : lookupAll a [] = @nil (β a) :=
  rfl
#align list.lookup_all_nil List.lookupAll_nil
-/

#print List.lookupAll_cons_eq /-
@[simp]
theorem lookupAll_cons_eq (l) (a : α) (b : β a) : lookupAll a (⟨a, b⟩ :: l) = b :: lookupAll a l :=
  dif_pos rfl
#align list.lookup_all_cons_eq List.lookupAll_cons_eq
-/

#print List.lookupAll_cons_ne /-
@[simp]
theorem lookupAll_cons_ne (l) {a} : ∀ s : Sigma β, a ≠ s.1 → lookupAll a (s :: l) = lookupAll a l
  | ⟨a', b⟩, h => dif_neg h.symm
#align list.lookup_all_cons_ne List.lookupAll_cons_ne
-/

#print List.lookupAll_eq_nil /-
theorem lookupAll_eq_nil {a : α} :
    ∀ {l : List (Sigma β)}, lookupAll a l = [] ↔ ∀ b : β a, Sigma.mk a b ∉ l
  | [] => by simp
  | ⟨a', b⟩ :: l => by
    by_cases h : a = a'
    · subst a'
      simp
    · simp [h, lookup_all_eq_nil]
#align list.lookup_all_eq_nil List.lookupAll_eq_nil
-/

#print List.head?_lookupAll /-
theorem head?_lookupAll (a : α) : ∀ l : List (Sigma β), head? (lookupAll a l) = dlookup a l
  | [] => by simp
  | ⟨a', b⟩ :: l => by
    by_cases h : a = a' <;>
      [·
        subst h
        simp, simp [*]]
#align list.head_lookup_all List.head?_lookupAll
-/

#print List.mem_lookupAll /-
theorem mem_lookupAll {a : α} {b : β a} :
    ∀ {l : List (Sigma β)}, b ∈ lookupAll a l ↔ Sigma.mk a b ∈ l
  | [] => by simp
  | ⟨a', b'⟩ :: l => by
    by_cases h : a = a' <;>
      [·
        subst h
        simp [*], simp [*]]
#align list.mem_lookup_all List.mem_lookupAll
-/

#print List.lookupAll_sublist /-
theorem lookupAll_sublist (a : α) : ∀ l : List (Sigma β), (lookupAll a l).map (Sigma.mk a) <+ l
  | [] => by simp
  | ⟨a', b'⟩ :: l => by
    by_cases h : a = a'
    · subst h
      simp
      exact (lookup_all_sublist l).cons₂ _ _ _
    · simp [h]
      exact (lookup_all_sublist l).cons _ _ _
#align list.lookup_all_sublist List.lookupAll_sublist
-/

#print List.lookupAll_length_le_one /-
theorem lookupAll_length_le_one (a : α) {l : List (Sigma β)} (h : l.NodupKeys) :
    length (lookupAll a l) ≤ 1 := by
  have := nodup.sublist ((lookup_all_sublist a l).map _) h <;> rw [map_map] at this <;>
    rwa [← nodup_replicate, ← map_const _ a]
#align list.lookup_all_length_le_one List.lookupAll_length_le_one
-/

#print List.lookupAll_eq_dlookup /-
theorem lookupAll_eq_dlookup (a : α) {l : List (Sigma β)} (h : l.NodupKeys) :
    lookupAll a l = (dlookup a l).toList :=
  by
  rw [← head_lookup_all]
  have := lookup_all_length_le_one a h; revert this
  rcases lookup_all a l with (_ | ⟨b, _ | ⟨c, l⟩⟩) <;> intro <;> try rfl
  exact absurd this (by decide)
#align list.lookup_all_eq_lookup List.lookupAll_eq_dlookup
-/

#print List.lookupAll_nodup /-
theorem lookupAll_nodup (a : α) {l : List (Sigma β)} (h : l.NodupKeys) : (lookupAll a l).Nodup := by
  rw [lookup_all_eq_lookup a h] <;> apply Option.toList_nodup
#align list.lookup_all_nodup List.lookupAll_nodup
-/

#print List.perm_lookupAll /-
theorem perm_lookupAll (a : α) {l₁ l₂ : List (Sigma β)} (nd₁ : l₁.NodupKeys) (nd₂ : l₂.NodupKeys)
    (p : l₁ ~ l₂) : lookupAll a l₁ = lookupAll a l₂ := by
  simp [lookup_all_eq_lookup, nd₁, nd₂, perm_lookup a nd₁ nd₂ p]
#align list.perm_lookup_all List.perm_lookupAll
-/

/-! ### `kreplace` -/

#print List.kreplace /-
/-- Replaces the first value with key `a` by `b`. -/
def kreplace (a : α) (b : β a) : List (Sigma β) → List (Sigma β) :=
  lookmap fun s => if a = s.1 then some ⟨a, b⟩ else none
#align list.kreplace List.kreplace
-/

#print List.kreplace_of_forall_not /-
theorem kreplace_of_forall_not (a : α) (b : β a) {l : List (Sigma β)}
    (H : ∀ b : β a, Sigma.mk a b ∉ l) : kreplace a b l = l :=
  lookmap_of_forall_not _ <| by
    rintro ⟨a', b'⟩ h; dsimp; split_ifs
    · subst a'
      exact H _ h; · rfl
#align list.kreplace_of_forall_not List.kreplace_of_forall_not
-/

#print List.kreplace_self /-
theorem kreplace_self {a : α} {b : β a} {l : List (Sigma β)} (nd : NodupKeys l)
    (h : Sigma.mk a b ∈ l) : kreplace a b l = l :=
  by
  refine' (lookmap_congr _).trans (lookmap_id' (Option.guard fun s => a = s.1) _ _)
  · rintro ⟨a', b'⟩ h'
    dsimp [Option.guard]
    split_ifs
    · subst a'
      exact ⟨rfl, hEq_of_eq <| nd.eq_of_mk_mem h h'⟩
    · rfl
  · rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩
    dsimp [Option.guard]
    split_ifs
    · exact id
    · rintro ⟨⟩
#align list.kreplace_self List.kreplace_self
-/

#print List.keys_kreplace /-
theorem keys_kreplace (a : α) (b : β a) : ∀ l : List (Sigma β), (kreplace a b l).keys = l.keys :=
  lookmap_map_eq _ _ <| by
    rintro ⟨a₁, b₂⟩ ⟨a₂, b₂⟩ <;> dsimp <;> split_ifs <;> simp (config := { contextual := true }) [h]
#align list.keys_kreplace List.keys_kreplace
-/

#print List.kreplace_nodupKeys /-
theorem kreplace_nodupKeys (a : α) (b : β a) {l : List (Sigma β)} :
    (kreplace a b l).NodupKeys ↔ l.NodupKeys := by simp [nodupkeys, keys_kreplace]
#align list.kreplace_nodupkeys List.kreplace_nodupKeys
-/

#print List.Perm.kreplace /-
theorem Perm.kreplace {a : α} {b : β a} {l₁ l₂ : List (Sigma β)} (nd : l₁.NodupKeys) :
    l₁ ~ l₂ → kreplace a b l₁ ~ kreplace a b l₂ :=
  perm_lookmap _ <| by
    refine' nd.pairwise_ne.imp _
    intro x y h z h₁ w h₂
    split_ifs  at h₁ h₂ <;> cases h₁ <;> cases h₂
    exact (h (h_2.symm.trans h_1)).elim
#align list.perm.kreplace List.Perm.kreplace
-/

/-! ### `kerase` -/

#print List.kerase /-
/-- Remove the first pair with the key `a`. -/
def kerase (a : α) : List (Sigma β) → List (Sigma β) :=
  eraseP fun s => a = s.1
#align list.kerase List.kerase
-/

#print List.kerase_nil /-
@[simp]
theorem kerase_nil {a} : @kerase _ β _ a [] = [] :=
  rfl
#align list.kerase_nil List.kerase_nil
-/

#print List.kerase_cons_eq /-
@[simp]
theorem kerase_cons_eq {a} {s : Sigma β} {l : List (Sigma β)} (h : a = s.1) :
    kerase a (s :: l) = l := by simp [kerase, h]
#align list.kerase_cons_eq List.kerase_cons_eq
-/

#print List.kerase_cons_ne /-
@[simp]
theorem kerase_cons_ne {a} {s : Sigma β} {l : List (Sigma β)} (h : a ≠ s.1) :
    kerase a (s :: l) = s :: kerase a l := by simp [kerase, h]
#align list.kerase_cons_ne List.kerase_cons_ne
-/

#print List.kerase_of_not_mem_keys /-
@[simp]
theorem kerase_of_not_mem_keys {a} {l : List (Sigma β)} (h : a ∉ l.keys) : kerase a l = l := by
  induction' l with _ _ ih <;> [rfl,
    · simp [not_or] at h
      simp [h.1, ih h.2]]
#align list.kerase_of_not_mem_keys List.kerase_of_not_mem_keys
-/

#print List.kerase_sublist /-
theorem kerase_sublist (a : α) (l : List (Sigma β)) : kerase a l <+ l :=
  eraseP_sublist _
#align list.kerase_sublist List.kerase_sublist
-/

#print List.kerase_keys_subset /-
theorem kerase_keys_subset (a) (l : List (Sigma β)) : (kerase a l).keys ⊆ l.keys :=
  ((kerase_sublist a l).map _).Subset
#align list.kerase_keys_subset List.kerase_keys_subset
-/

#print List.mem_keys_of_mem_keys_kerase /-
theorem mem_keys_of_mem_keys_kerase {a₁ a₂} {l : List (Sigma β)} :
    a₁ ∈ (kerase a₂ l).keys → a₁ ∈ l.keys :=
  @kerase_keys_subset _ _ _ _ _ _
#align list.mem_keys_of_mem_keys_kerase List.mem_keys_of_mem_keys_kerase
-/

#print List.exists_of_kerase /-
theorem exists_of_kerase {a : α} {l : List (Sigma β)} (h : a ∈ l.keys) :
    ∃ (b : β a)(l₁ l₂ : List (Sigma β)),
      a ∉ l₁.keys ∧ l = l₁ ++ ⟨a, b⟩ :: l₂ ∧ kerase a l = l₁ ++ l₂ :=
  by
  induction l
  case nil => cases h
  case cons hd tl ih =>
    by_cases e : a = hd.1
    · subst e
      exact ⟨hd.2, [], tl, by simp, by cases hd <;> rfl, by simp⟩
    · simp at h
      cases h
      case inl h => exact absurd h e
      case inr h =>
        rcases ih h with ⟨b, tl₁, tl₂, h₁, h₂, h₃⟩
        exact
          ⟨b, hd :: tl₁, tl₂, not_mem_cons_of_ne_of_not_mem e h₁, by rw [h₂] <;> rfl, by
            simp [e, h₃]⟩
#align list.exists_of_kerase List.exists_of_kerase
-/

#print List.mem_keys_kerase_of_ne /-
@[simp]
theorem mem_keys_kerase_of_ne {a₁ a₂} {l : List (Sigma β)} (h : a₁ ≠ a₂) :
    a₁ ∈ (kerase a₂ l).keys ↔ a₁ ∈ l.keys :=
  Iff.intro mem_keys_of_mem_keys_kerase fun p =>
    if q : a₂ ∈ l.keys then
      match l, kerase a₂ l, exists_of_kerase q, p with
      | _, _, ⟨_, _, _, _, rfl, rfl⟩, p => by simpa [keys, h] using p
    else by simp [q, p]
#align list.mem_keys_kerase_of_ne List.mem_keys_kerase_of_ne
-/

/- warning: list.keys_kerase -> List.keys_kerase is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {a : α} {l : List.{max u1 u2} (Sigma.{u1, u2} α β)}, Eq.{succ u1} (List.{u1} α) (List.keys.{u1, u2} α β (List.kerase.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a l)) (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.keys.{u1, u2} α β l) a)
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {a : α} {l : List.{max u2 u1} (Sigma.{u1, u2} α β)}, Eq.{succ u1} (List.{u1} α) (List.keys.{u1, u2} α β (List.kerase.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a l)) (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (List.keys.{u1, u2} α β l) a)
Case conversion may be inaccurate. Consider using '#align list.keys_kerase List.keys_keraseₓ'. -/
theorem keys_kerase {a} {l : List (Sigma β)} : (kerase a l).keys = l.keys.eraseₓ a := by
  rw [keys, kerase, ← erasep_map Sigma.fst l, erase_eq_erasep]
#align list.keys_kerase List.keys_kerase

#print List.kerase_kerase /-
theorem kerase_kerase {a a'} {l : List (Sigma β)} :
    (kerase a' l).kerase a = (kerase a l).kerase a' :=
  by
  by_cases a = a'
  · subst a'
  induction' l with x xs; · rfl
  · by_cases a' = x.1
    · subst a'
      simp [kerase_cons_ne h, kerase_cons_eq rfl]
    by_cases h' : a = x.1
    · subst a
      simp [kerase_cons_eq rfl, kerase_cons_ne (Ne.symm h)]
    · simp [kerase_cons_ne, *]
#align list.kerase_kerase List.kerase_kerase
-/

#print List.NodupKeys.kerase /-
theorem NodupKeys.kerase (a : α) : NodupKeys l → (kerase a l).NodupKeys :=
  NodupKeys.sublist <| kerase_sublist _ _
#align list.nodupkeys.kerase List.NodupKeys.kerase
-/

#print List.Perm.kerase /-
theorem Perm.kerase {a : α} {l₁ l₂ : List (Sigma β)} (nd : l₁.NodupKeys) :
    l₁ ~ l₂ → kerase a l₁ ~ kerase a l₂ :=
  Perm.erasep _ <| (nodupKeys_iff_pairwise.1 nd).imp <| by rintro x y h rfl <;> exact h
#align list.perm.kerase List.Perm.kerase
-/

#print List.not_mem_keys_kerase /-
@[simp]
theorem not_mem_keys_kerase (a) {l : List (Sigma β)} (nd : l.NodupKeys) : a ∉ (kerase a l).keys :=
  by
  induction l
  case nil => simp
  case cons hd tl ih =>
    simp at nd
    by_cases h : a = hd.1
    · subst h
      simp [nd.1]
    · simp [h, ih nd.2]
#align list.not_mem_keys_kerase List.not_mem_keys_kerase
-/

#print List.dlookup_kerase /-
@[simp]
theorem dlookup_kerase (a) {l : List (Sigma β)} (nd : l.NodupKeys) :
    dlookup a (kerase a l) = none :=
  dlookup_eq_none.mpr (not_mem_keys_kerase a nd)
#align list.lookup_kerase List.dlookup_kerase
-/

#print List.dlookup_kerase_ne /-
@[simp]
theorem dlookup_kerase_ne {a a'} {l : List (Sigma β)} (h : a ≠ a') :
    dlookup a (kerase a' l) = dlookup a l :=
  by
  induction l
  case nil => rfl
  case cons hd tl ih =>
    cases' hd with ah bh
    by_cases h₁ : a = ah <;> by_cases h₂ : a' = ah
    · substs h₁ h₂
      cases Ne.irrefl h
    · subst h₁
      simp [h₂]
    · subst h₂
      simp [h]
    · simp [h₁, h₂, ih]
#align list.lookup_kerase_ne List.dlookup_kerase_ne
-/

#print List.kerase_append_left /-
theorem kerase_append_left {a} :
    ∀ {l₁ l₂ : List (Sigma β)}, a ∈ l₁.keys → kerase a (l₁ ++ l₂) = kerase a l₁ ++ l₂
  | [], _, h => by cases h
  | s :: l₁, l₂, h₁ =>
    if h₂ : a = s.1 then by simp [h₂]
    else by simp at h₁ <;> cases h₁ <;> [exact absurd h₁ h₂, simp [h₂, kerase_append_left h₁]]
#align list.kerase_append_left List.kerase_append_left
-/

#print List.kerase_append_right /-
theorem kerase_append_right {a} :
    ∀ {l₁ l₂ : List (Sigma β)}, a ∉ l₁.keys → kerase a (l₁ ++ l₂) = l₁ ++ kerase a l₂
  | [], _, h => rfl
  | _ :: l₁, l₂, h => by simp [not_or] at h <;> simp [h.1, kerase_append_right h.2]
#align list.kerase_append_right List.kerase_append_right
-/

#print List.kerase_comm /-
theorem kerase_comm (a₁ a₂) (l : List (Sigma β)) :
    kerase a₂ (kerase a₁ l) = kerase a₁ (kerase a₂ l) :=
  if h : a₁ = a₂ then by simp [h]
  else
    if ha₁ : a₁ ∈ l.keys then
      if ha₂ : a₂ ∈ l.keys then
        match l, kerase a₁ l, exists_of_kerase ha₁, ha₂ with
        | _, _, ⟨b₁, l₁, l₂, a₁_nin_l₁, rfl, rfl⟩, a₂_in_l₁_app_l₂ =>
          if h' : a₂ ∈ l₁.keys then by
            simp [kerase_append_left h',
              kerase_append_right (mt (mem_keys_kerase_of_ne h).mp a₁_nin_l₁)]
          else by
            simp [kerase_append_right h', kerase_append_right a₁_nin_l₁,
              @kerase_cons_ne _ _ _ a₂ ⟨a₁, b₁⟩ _ (Ne.symm h)]
      else by simp [ha₂, mt mem_keys_of_mem_keys_kerase ha₂]
    else by simp [ha₁, mt mem_keys_of_mem_keys_kerase ha₁]
#align list.kerase_comm List.kerase_comm
-/

/- warning: list.sizeof_kerase -> List.sizeOf_kerase is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_2 : DecidableEq.{succ u1} α] [_inst_3 : SizeOf.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α β)] (x : α) (xs : List.{max u1 u2} (Sigma.{u1, u2} α β)), LE.le.{0} Nat Nat.hasLe (SizeOf.sizeOf.{succ (max u1 u2)} (List.{max u1 u2} (Sigma.{u1, u2} α β)) (List.hasSizeof.{max u1 u2} (Sigma.{u1, u2} α β) _inst_3) (List.kerase.{u1, u2} α β (fun (a : α) (b : α) => _inst_2 a b) x xs)) (SizeOf.sizeOf.{succ (max u1 u2)} (List.{max u1 u2} (Sigma.{u1, u2} α β)) (List.hasSizeof.{max u1 u2} (Sigma.{u1, u2} α β) _inst_3) xs)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_2 : DecidableEq.{succ u2} α] [_inst_3 : SizeOf.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α β)] (x : α) (xs : List.{max u1 u2} (Sigma.{u2, u1} α β)), LE.le.{0} Nat instLENat (SizeOf.sizeOf.{max (succ u1) (succ u2)} (List.{max u1 u2} (Sigma.{u2, u1} α β)) (List._sizeOf_inst.{max u1 u2} (Sigma.{u2, u1} α β) _inst_3) (List.kerase.{u2, u1} α β (fun (a : α) (b : α) => _inst_2 a b) x xs)) (SizeOf.sizeOf.{max (succ u1) (succ u2)} (List.{max u1 u2} (Sigma.{u2, u1} α β)) (List._sizeOf_inst.{max u1 u2} (Sigma.{u2, u1} α β) _inst_3) xs)
Case conversion may be inaccurate. Consider using '#align list.sizeof_kerase List.sizeOf_keraseₓ'. -/
theorem sizeOf_kerase {α} {β : α → Type _} [DecidableEq α] [SizeOf (Sigma β)] (x : α)
    (xs : List (Sigma β)) : SizeOf.sizeOf (List.kerase x xs) ≤ SizeOf.sizeOf xs :=
  by
  unfold_wf
  induction' xs with y ys
  · simp
  · by_cases x = y.1 <;> simp [*, List.sizeof]
#align list.sizeof_kerase List.sizeOf_kerase

/-! ### `kinsert` -/

#print List.kinsert /-
/-- Insert the pair `⟨a, b⟩` and erase the first pair with the key `a`. -/
def kinsert (a : α) (b : β a) (l : List (Sigma β)) : List (Sigma β) :=
  ⟨a, b⟩ :: kerase a l
#align list.kinsert List.kinsert
-/

#print List.kinsert_def /-
@[simp]
theorem kinsert_def {a} {b : β a} {l : List (Sigma β)} : kinsert a b l = ⟨a, b⟩ :: kerase a l :=
  rfl
#align list.kinsert_def List.kinsert_def
-/

#print List.mem_keys_kinsert /-
theorem mem_keys_kinsert {a a'} {b' : β a'} {l : List (Sigma β)} :
    a ∈ (kinsert a' b' l).keys ↔ a = a' ∨ a ∈ l.keys := by by_cases h : a = a' <;> simp [h]
#align list.mem_keys_kinsert List.mem_keys_kinsert
-/

#print List.kinsert_nodupKeys /-
theorem kinsert_nodupKeys (a) (b : β a) {l : List (Sigma β)} (nd : l.NodupKeys) :
    (kinsert a b l).NodupKeys :=
  nodupKeys_cons.mpr ⟨not_mem_keys_kerase a nd, nd.kerase a⟩
#align list.kinsert_nodupkeys List.kinsert_nodupKeys
-/

#print List.Perm.kinsert /-
theorem Perm.kinsert {a} {b : β a} {l₁ l₂ : List (Sigma β)} (nd₁ : l₁.NodupKeys) (p : l₁ ~ l₂) :
    kinsert a b l₁ ~ kinsert a b l₂ :=
  (p.kerase nd₁).cons _
#align list.perm.kinsert List.Perm.kinsert
-/

#print List.dlookup_kinsert /-
theorem dlookup_kinsert {a} {b : β a} (l : List (Sigma β)) : dlookup a (kinsert a b l) = some b :=
  by simp only [kinsert, lookup_cons_eq]
#align list.lookup_kinsert List.dlookup_kinsert
-/

#print List.dlookup_kinsert_ne /-
theorem dlookup_kinsert_ne {a a'} {b' : β a'} {l : List (Sigma β)} (h : a ≠ a') :
    dlookup a (kinsert a' b' l) = dlookup a l := by simp [h]
#align list.lookup_kinsert_ne List.dlookup_kinsert_ne
-/

/-! ### `kextract` -/

#print List.kextract /-
/-- Finds the first entry with a given key `a` and returns its value (as an `option` because there
might be no entry with key `a`) alongside with the rest of the entries. -/
def kextract (a : α) : List (Sigma β) → Option (β a) × List (Sigma β)
  | [] => (none, [])
  | s :: l =>
    if h : s.1 = a then (some (Eq.recOn h s.2), l)
    else
      let (b', l') := kextract l
      (b', s :: l')
#align list.kextract List.kextract
-/

#print List.kextract_eq_dlookup_kerase /-
@[simp]
theorem kextract_eq_dlookup_kerase (a : α) :
    ∀ l : List (Sigma β), kextract a l = (dlookup a l, kerase a l)
  | [] => rfl
  | ⟨a', b⟩ :: l => by
    simp [kextract]; dsimp; split_ifs
    · subst a'
      simp [kerase]
    · simp [kextract, Ne.symm h, kextract_eq_lookup_kerase l, kerase]
#align list.kextract_eq_lookup_kerase List.kextract_eq_dlookup_kerase
-/

/-! ### `dedupkeys` -/

#print List.dedupKeys /-
/-- Remove entries with duplicate keys from `l : list (sigma β)`. -/
def dedupKeys : List (Sigma β) → List (Sigma β) :=
  List.foldr (fun x => kinsert x.1 x.2) []
#align list.dedupkeys List.dedupKeys
-/

#print List.dedupKeys_cons /-
theorem dedupKeys_cons {x : Sigma β} (l : List (Sigma β)) :
    dedupKeys (x :: l) = kinsert x.1 x.2 (dedupKeys l) :=
  rfl
#align list.dedupkeys_cons List.dedupKeys_cons
-/

#print List.nodupKeys_dedupKeys /-
theorem nodupKeys_dedupKeys (l : List (Sigma β)) : NodupKeys (dedupKeys l) :=
  by
  dsimp [dedupkeys]
  generalize hl : nil = l'
  have : nodupkeys l' := by
    rw [← hl]
    apply nodup_nil
  clear hl
  induction' l with x xs
  · apply this
  · cases x
    simp [dedupkeys]
    constructor
    · simp [keys_kerase]
      apply l_ih.not_mem_erase
    · exact l_ih.kerase _
#align list.nodupkeys_dedupkeys List.nodupKeys_dedupKeys
-/

#print List.dlookup_dedupKeys /-
theorem dlookup_dedupKeys (a : α) (l : List (Sigma β)) : dlookup a (dedupKeys l) = dlookup a l :=
  by
  induction l; rfl
  cases' l_hd with a' b
  by_cases a = a'
  · subst a'
    rw [dedupkeys_cons, lookup_kinsert, lookup_cons_eq]
  · rw [dedupkeys_cons, lookup_kinsert_ne h, l_ih, lookup_cons_ne]
    exact h
#align list.lookup_dedupkeys List.dlookup_dedupKeys
-/

/- warning: list.sizeof_dedupkeys -> List.sizeOf_dedupKeys is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_2 : DecidableEq.{succ u1} α] [_inst_3 : SizeOf.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α β)] (xs : List.{max u1 u2} (Sigma.{u1, u2} α β)), LE.le.{0} Nat Nat.hasLe (SizeOf.sizeOf.{succ (max u1 u2)} (List.{max u1 u2} (Sigma.{u1, u2} α β)) (List.hasSizeof.{max u1 u2} (Sigma.{u1, u2} α β) _inst_3) (List.dedupKeys.{u1, u2} α β (fun (a : α) (b : α) => _inst_2 a b) xs)) (SizeOf.sizeOf.{succ (max u1 u2)} (List.{max u1 u2} (Sigma.{u1, u2} α β)) (List.hasSizeof.{max u1 u2} (Sigma.{u1, u2} α β) _inst_3) xs)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_2 : DecidableEq.{succ u2} α] [_inst_3 : SizeOf.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α β)] (xs : List.{max u1 u2} (Sigma.{u2, u1} α β)), LE.le.{0} Nat instLENat (SizeOf.sizeOf.{max (succ u1) (succ u2)} (List.{max u1 u2} (Sigma.{u2, u1} α β)) (List._sizeOf_inst.{max u1 u2} (Sigma.{u2, u1} α β) _inst_3) (List.dedupKeys.{u2, u1} α β (fun (a : α) (b : α) => _inst_2 a b) xs)) (SizeOf.sizeOf.{max (succ u1) (succ u2)} (List.{max u1 u2} (Sigma.{u2, u1} α β)) (List._sizeOf_inst.{max u1 u2} (Sigma.{u2, u1} α β) _inst_3) xs)
Case conversion may be inaccurate. Consider using '#align list.sizeof_dedupkeys List.sizeOf_dedupKeysₓ'. -/
theorem sizeOf_dedupKeys {α} {β : α → Type _} [DecidableEq α] [SizeOf (Sigma β)]
    (xs : List (Sigma β)) : SizeOf.sizeOf (List.dedupKeys xs) ≤ SizeOf.sizeOf xs :=
  by
  unfold_wf
  induction' xs with x xs
  · simp [List.dedupKeys]
  · simp only [dedupkeys_cons, List.sizeof, kinsert_def, add_le_add_iff_left, Sigma.eta]
    trans
    apply sizeof_kerase
    assumption
#align list.sizeof_dedupkeys List.sizeOf_dedupKeys

/-! ### `kunion` -/

#print List.kunion /-
/-- `kunion l₁ l₂` is the append to l₁ of l₂ after, for each key in l₁, the
first matching pair in l₂ is erased. -/
def kunion : List (Sigma β) → List (Sigma β) → List (Sigma β)
  | [], l₂ => l₂
  | s :: l₁, l₂ => s :: kunion l₁ (kerase s.1 l₂)
#align list.kunion List.kunion
-/

#print List.nil_kunion /-
@[simp]
theorem nil_kunion {l : List (Sigma β)} : kunion [] l = l :=
  rfl
#align list.nil_kunion List.nil_kunion
-/

#print List.kunion_nil /-
@[simp]
theorem kunion_nil : ∀ {l : List (Sigma β)}, kunion l [] = l
  | [] => rfl
  | _ :: l => by rw [kunion, kerase_nil, kunion_nil]
#align list.kunion_nil List.kunion_nil
-/

#print List.kunion_cons /-
@[simp]
theorem kunion_cons {s} {l₁ l₂ : List (Sigma β)} :
    kunion (s :: l₁) l₂ = s :: kunion l₁ (kerase s.1 l₂) :=
  rfl
#align list.kunion_cons List.kunion_cons
-/

#print List.mem_keys_kunion /-
@[simp]
theorem mem_keys_kunion {a} {l₁ l₂ : List (Sigma β)} :
    a ∈ (kunion l₁ l₂).keys ↔ a ∈ l₁.keys ∨ a ∈ l₂.keys :=
  by
  induction l₁ generalizing l₂
  case nil => simp
  case cons s l₁ ih => by_cases h : a = s.1 <;> [simp [h], simp [h, ih]]
#align list.mem_keys_kunion List.mem_keys_kunion
-/

#print List.kunion_kerase /-
@[simp]
theorem kunion_kerase {a} :
    ∀ {l₁ l₂ : List (Sigma β)}, kunion (kerase a l₁) (kerase a l₂) = kerase a (kunion l₁ l₂)
  | [], _ => rfl
  | s :: _, l => by by_cases h : a = s.1 <;> simp [h, kerase_comm a s.1 l, kunion_kerase]
#align list.kunion_kerase List.kunion_kerase
-/

#print List.NodupKeys.kunion /-
theorem NodupKeys.kunion (nd₁ : l₁.NodupKeys) (nd₂ : l₂.NodupKeys) : (kunion l₁ l₂).NodupKeys :=
  by
  induction l₁ generalizing l₂
  case nil => simp only [nil_kunion, nd₂]
  case cons s l₁ ih =>
    simp at nd₁
    simp [not_or, nd₁.1, nd₂, ih nd₁.2 (nd₂.kerase s.1)]
#align list.nodupkeys.kunion List.NodupKeys.kunion
-/

#print List.Perm.kunion_right /-
theorem Perm.kunion_right {l₁ l₂ : List (Sigma β)} (p : l₁ ~ l₂) (l) : kunion l₁ l ~ kunion l₂ l :=
  by
  induction p generalizing l
  case nil => rfl
  case cons hd tl₁ tl₂ p ih => simp [ih (kerase hd.1 l), perm.cons]
  case swap s₁ s₂ l => simp [kerase_comm, perm.swap]
  case trans l₁ l₂ l₃ p₁₂ p₂₃ ih₁₂ ih₂₃ => exact perm.trans (ih₁₂ l) (ih₂₃ l)
#align list.perm.kunion_right List.Perm.kunion_right
-/

#print List.Perm.kunion_left /-
theorem Perm.kunion_left :
    ∀ (l) {l₁ l₂ : List (Sigma β)}, l₁.NodupKeys → l₁ ~ l₂ → kunion l l₁ ~ kunion l l₂
  | [], _, _, _, p => p
  | s :: l, l₁, l₂, nd₁, p => by simp [((p.kerase nd₁).kunion_left l <| nd₁.kerase s.1).cons s]
#align list.perm.kunion_left List.Perm.kunion_left
-/

#print List.Perm.kunion /-
theorem Perm.kunion {l₁ l₂ l₃ l₄ : List (Sigma β)} (nd₃ : l₃.NodupKeys) (p₁₂ : l₁ ~ l₂)
    (p₃₄ : l₃ ~ l₄) : kunion l₁ l₃ ~ kunion l₂ l₄ :=
  (p₁₂.kunion_right l₃).trans (p₃₄.kunion_left l₂ nd₃)
#align list.perm.kunion List.Perm.kunion
-/

#print List.dlookup_kunion_left /-
@[simp]
theorem dlookup_kunion_left {a} {l₁ l₂ : List (Sigma β)} (h : a ∈ l₁.keys) :
    dlookup a (kunion l₁ l₂) = dlookup a l₁ :=
  by
  induction' l₁ with s _ ih generalizing l₂ <;> simp at h <;> cases h <;> cases' s with a'
  · subst h
    simp
  · rw [kunion_cons]
    by_cases h' : a = a'
    · subst h'
      simp
    · simp [h', ih h]
#align list.lookup_kunion_left List.dlookup_kunion_left
-/

#print List.dlookup_kunion_right /-
@[simp]
theorem dlookup_kunion_right {a} {l₁ l₂ : List (Sigma β)} (h : a ∉ l₁.keys) :
    dlookup a (kunion l₁ l₂) = dlookup a l₂ :=
  by
  induction l₁ generalizing l₂
  case nil => simp
  case cons _ _ ih => simp [not_or] at h; simp [h.1, ih h.2]
#align list.lookup_kunion_right List.dlookup_kunion_right
-/

#print List.mem_dlookup_kunion /-
@[simp]
theorem mem_dlookup_kunion {a} {b : β a} {l₁ l₂ : List (Sigma β)} :
    b ∈ dlookup a (kunion l₁ l₂) ↔ b ∈ dlookup a l₁ ∨ a ∉ l₁.keys ∧ b ∈ dlookup a l₂ :=
  by
  induction l₁ generalizing l₂
  case nil => simp
  case cons s _ ih =>
    cases' s with a'
    by_cases h₁ : a = a'
    · subst h₁
      simp
    · let h₂ := @ih (kerase a' l₂)
      simp [h₁] at h₂
      simp [h₁, h₂]
#align list.mem_lookup_kunion List.mem_dlookup_kunion
-/

#print List.mem_dlookup_kunion_middle /-
theorem mem_dlookup_kunion_middle {a} {b : β a} {l₁ l₂ l₃ : List (Sigma β)}
    (h₁ : b ∈ dlookup a (kunion l₁ l₃)) (h₂ : a ∉ keys l₂) :
    b ∈ dlookup a (kunion (kunion l₁ l₂) l₃) :=
  match mem_dlookup_kunion.mp h₁ with
  | Or.inl h => mem_dlookup_kunion.mpr (Or.inl (mem_dlookup_kunion.mpr (Or.inl h)))
  | Or.inr h => mem_dlookup_kunion.mpr <| Or.inr ⟨mt mem_keys_kunion.mp (not_or.mpr ⟨h.1, h₂⟩), h.2⟩
#align list.mem_lookup_kunion_middle List.mem_dlookup_kunion_middle
-/

end List