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'


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


/-
  Currently using this file as a playground to learn about meta programming in
  LEAN but eventally I will implement a tactic that normalises simple ring expressions.

  Monads in LEAN :

  consider a function summing the 2/5/7 elements of a list, returning the value
  rapped in some if there are enough elements in the list and none otherwise.
  A naive implementation is the following,

-/

def sum₂₅₇1 (l: list ℕ) : option ℕ :=
match list.nth l 1 with
| option.none    := option.none
| option.some n₂ := match list.nth l 4 with
                    | option.none    := option.none
                    | option.some n₅ := match list.nth l 6 with
                                        | option.none    := option.none
                                        | option.some n₇ := option.some (n₂ + n₅ + n₇)
                                        end
                    end
end

/-
  If we had a function that allow us to update the internal value of a option α via
  a fn on the left we could rewrite this in a more imperative manner.
-/

def connect {α β : Type} : option α → (α → option β) → option β
| option.none _    := option.none
| (option.some a) f := f a

def sum₂₅₇2 (l: list ℕ) : option ℕ := connect (list.nth l 1)
                                      (λ n₂, connect (list.nth l 4)
                                      (λ n₅, connect (list.nth l 6)
                                      (λ n₇, option.some (n₂ + n₅ +n₇))))

/-
  connect is rewritten as >>= and pronounced "bind".
  the function n ↦ some n is rewritten as "pure"
-/

def sum₂₅₇3 (l: list ℕ) : option ℕ :=
  (list.nth l 1) >>= (λ n₂,
  (list.nth l 4) >>= (λ n₅,
  (list.nth l 6) >>= (λ n₇,
  pure (n₂ + n₅ + n₇))))

/-
  this looks a lot like the imperative program
  let n₂ = l[1];
  let n₅ = l[4];
  let n₆ = l[5];
  return n₂ + n₅ + n₇

  Functional programming languages the following notation
  do x ← ma, t    is equiv to    ma >>= (λ x, t)
-/

def sum₂₅₇4 (l: list ℕ) : option ℕ := do n₂ ← list.nth l 1,
                                      (do n₅ ← list.nth l 4,
                                      (do n₇ ← list.nth l 6,
                                          pure (n₂ + n₅ + n₇)))

/-
  This look even more like an imperative program.

  we can check that the following laws hold for option:
  (*)
  pure a >>= f = f a
  m >>= pure = m
  (m >>= f) >>= g = m >>= (λ x, (f x) >>= g)

  so do x ← (pure a), pure (f x) = pure a >>= (λ x, pure (f x)) = pure (f a)
  so we can think of the last term as the return value. (m >>= f) >>= g = m >>= (λ x, (f x) >>= g)
  means we don't really care how the do's are bracketed in sum₂₅₇ so we can just drop them.
-/

def sum₂₅₇5 (l: list ℕ) : option ℕ :=
  do n₂ ← list.nth l 1,
     n₅ ← list.nth l 5,
     n₇ ← list.nth l 7,
     pure (n₂ + n₅ + n₇)

/-
  any fn m : Type u → Type u with similar operations >>= and pure satifying (*)
  is called a monad. Using >>= and pure we can defn m₁ >> m₂ = m₁ >>= (λ a, m₂).
  do s, t is sugar for s >> t. <|> : m a → m a → m a trys the 1st arg then tries the
  2nd.
-/

/-
  The following stuff is from a meta programming paper.

  Framework :

  Add metaconstants -- to the axiomatic foundation are just opaque constants but when the
  bytecode is evaluates them they are assoicted with internally defn gadgets.

  An example is tactic_state which represents the internal elaborator state in the contex where
  the tatic is invoked.

  The metaprogramming API provides access to fns that operate on these.

  the keyword meta gives access to these extensions.

  Using these primatives a tactics monad is defined. This is also an instance of
  the alternative type class so <|> can be used.

  (a bit about names that I don't really understand)

  Expressions in LEAN are represented using the following data types.

  inductive level
  | zero  : level
  | succ  : level → level
  | max   : level → level → level
  | imax  : level → level → level
  | param : name → level
  | mvar  : name → level

  inductive expr
  | var    : nat → expr
  | lconst : name → name → expr
  | mvar   : name → expr → expr
  | sort   : level → expr
  | const  : name → list level → expr
  | app    : expr → expr → expr
  | lam    : name → binfo → expr → expr → expr
  | pi     : name → binfo → expr → expr → expr
  | elet   : name → expr → expr → expr → expr

  the nats are de brujin indies, lconst/mvar should never be in any proof terms.

-/