import data.fintype data.equiv.basic group_theory.subgroup

namespace list

@[simp] lemma length_attach {α} (L : list α) :
  L.attach.length = L.length :=
length_pmap

@[simp] lemma nth_le_attach {α} (L : list α) (i) (H : i < L.attach.length) :
  (L.attach.nth_le i H).1 = L.nth_le i (length_attach L ▸ H) :=
calc  (L.attach.nth_le i H).1
    = (L.attach.map subtype.val).nth_le i (by simpa using H) : by rw nth_le_map'
... = L.nth_le i _ : by congr; apply attach_map_val

@[simp] lemma nth_le_range {n} (i) (H : i < (range n).length) :
  nth_le (range n) i H = i :=
option.some.inj $ by rw [← nth_le_nth _, nth_range (by simpa using H)]

attribute [simp] length_of_fn
attribute [simp] nth_le_of_fn

-- Congratulations, I proved that two things which have
-- equally few lemmas are equal.
theorem of_fn_eq_pmap {α n} {f : fin n → α} :
  of_fn f = pmap (λ i hi, f ⟨i, hi⟩) (range n) (λ _, mem_range.1) :=
by rw [pmap_eq_map_attach]; from ext_le (by simp)
  (λ i hi1 hi2, by simp at hi1; simp [nth_le_of_fn f ⟨i, hi1⟩])

theorem nodup_of_fn {α n} {f : fin n → α} (hf : function.injective f) :
  nodup (of_fn f) :=
by rw of_fn_eq_pmap; from nodup_pmap
  (λ _ _ _ _ H, fin.veq_of_eq $ hf H) (nodup_range n)

end list

section fin

variables {m n : ℕ}

def fin_zero_elim {C : Sort*} : fin 0 → C :=
λ x, false.elim $ nat.not_lt_zero x.1 x.2

def fin_sum : (fin m ⊕ fin n) ≃ fin (m + n) :=
{ to_fun := λ x, sum.rec_on x
    (λ y, ⟨y.1, nat.lt_of_lt_of_le y.2 $ nat.le_add_right m n⟩)
    (λ y, ⟨m + y.1, nat.add_lt_add_left y.2 m⟩),
  inv_fun := λ x, if H : x.1 < m
    then sum.inl ⟨x.1, H⟩
    else sum.inr ⟨x.1 - m, nat.lt_of_add_lt_add_left $
      show m + (x.1 - m) < m + n,
      from (nat.add_sub_of_le $ le_of_not_gt H).symm ▸ x.2⟩,
  left_inv := λ x, sum.cases_on x
    (λ y, by simp [y.2]; from fin.eq_of_veq rfl)
    (λ y, have H : ¬m + y.val < m, by simp [nat.zero_le],
       by simp [H, nat.add_sub_cancel_left];
       from fin.eq_of_veq rfl),
  right_inv := λ x, begin
    by_cases H : x.1 < m,
    { dsimp; rw [dif_pos H]; simp,
      exact fin.eq_of_veq rfl },
    { dsimp; rw [dif_neg H]; simp,
      apply fin.eq_of_veq; simp,
      rw [nat.add_sub_of_le (le_of_not_gt H)] }
  end }

def fin_prod : (fin m × fin n) ≃ fin (m * n) :=
{ to_fun := λ x, ⟨x.2.1 + n * x.1.1, calc
          x.2.1 + n * x.1.1 + 1
        = x.1.1 * n + x.2.1 + 1 : by ac_refl
    ... ≤ x.1.1 * n + n : nat.add_le_add_left x.2.2 _
    ... = (x.1.1 + 1) * n : eq.symm $ nat.succ_mul _ _
    ... ≤ m * n : nat.mul_le_mul_right _ x.1.2⟩,
  inv_fun := λ x, have H : n > 0,
      from nat.pos_of_ne_zero $ λ H,
        nat.not_lt_zero x.1 $ by subst H; from x.2,
    (⟨x.1 / n, (nat.div_lt_iff_lt_mul _ _ H).2 x.2⟩,
     ⟨x.1 % n, nat.mod_lt _ H⟩),
  left_inv := λ ⟨x, y⟩, have H : n > 0,
      from nat.pos_of_ne_zero $ λ H,
        nat.not_lt_zero y.1 $ H ▸ y.2,
    prod.ext
    (fin.eq_of_veq $ calc
            (y.1 + n * x.1) / n
          = y.1 / n + x.1 : nat.add_mul_div_left _ _ H
      ... = 0 + x.1 : by rw nat.div_eq_of_lt y.2
      ... = x.1 : nat.zero_add x.1)
    (fin.eq_of_veq $ calc
            (y.1 + n * x.1) % n
          = y.1 % n : nat.add_mul_mod_self_left _ _ _
      ... = y.1 : nat.mod_eq_of_lt y.2),
    right_inv := λ x, fin.eq_of_veq $ nat.mod_add_div _ _ }

@[simp] lemma fin.raise_val (k : fin n) :
  k.raise.val = k.val :=
rfl

def fin.fall : Π i : fin (n+1), i.1 < n → fin n :=
λ i h, ⟨i.1, h⟩

@[simp] lemma fin.fall_val (k : fin (n+1)) (H : k.1 < n) :
  (k.fall H).val = k.val :=
rfl

def fin.descend (pivot : fin (n+1)) : Π i : fin (n+1), i ≠ pivot → fin n :=
λ i H, if h : i.1 < pivot.1
  then i.fall (lt_of_lt_of_le h $ nat.le_of_lt_succ pivot.2)
  else i.pred (λ H1, H $ by subst H1;
    replace h := nat.eq_zero_of_le_zero (le_of_not_gt h);
    from fin.eq_of_veq h.symm)

def fin.ascend (pivot : fin (n+1)) : Π i : fin n, fin (n+1) :=
λ i, if i.1 < pivot.1 then i.raise else i.succ

theorem fin.ascend_ne (pivot : fin (n+1)) (i : fin n) :
  pivot.ascend i ≠ pivot :=
λ H, begin
  unfold fin.ascend at H,
  split_ifs at H;
  rw ← H at h;
  simp [lt_irrefl, nat.lt_succ_self] at h;
  cc
end

@[simp] lemma fin.ascend_descend (pivot i : fin (n+1))
  (H : i ≠ pivot) : pivot.ascend (pivot.descend i H) = i :=
begin
  unfold fin.descend fin.ascend,
  split_ifs with H1 H2 H3; apply fin.eq_of_veq; simp at *,
  { cases pivot with p hp,
    cases i with i hi,
    cases i with i, { simp at * },
    exfalso, apply H, apply fin.eq_of_veq,
    apply le_antisymm, { apply nat.succ_le_of_lt H2 },
    simpa using H1 },
  { cases pivot with p hp,
    cases i with i hi,
    cases i with i,
    { exfalso, apply H, apply fin.eq_of_veq, symmetry,
      apply nat.eq_zero_of_le_zero H2 },
    refl }
end

@[simp] lemma fin.descend_ascend (pivot : fin (n+1))
  (i : fin n) (H : pivot.ascend i ≠ pivot) :
  pivot.descend (pivot.ascend i) H = i :=
begin
  unfold fin.descend fin.ascend,
  apply fin.eq_of_veq,
  by_cases h : i.val < pivot.val,
  { simp [h] },
  { unfold ite dite,
    cases nat.decidable_lt ((ite (i.val < pivot.val) (fin.raise i) (fin.succ i)).val) (pivot.val) with h1 h1,
    { simp,
      cases nat.decidable_lt (i.val) (pivot.val),
      { simp },
      { cc } },
    { simp,
      cases nat.decidable_lt (i.val) (pivot.val) with h2 h2,
      { simp [h2] at h1,
        simp at *,
        exfalso, apply lt_asymm (nat.lt_succ_self i.1),
        apply lt_of_lt_of_le h1 h },
      { simp } } }
end

@[simp] lemma fin.succ_pred (i : fin (n+1)) (H : i ≠ 0) :
  (i.pred H).succ = i :=
begin
  apply fin.eq_of_veq,
  cases i with i hi,
  cases i,
  { exfalso, apply H, apply fin.eq_of_veq, refl },
  refl
end

@[simp] lemma fin.pred_succ (i : fin n) (H : i.succ ≠ 0) :
  i.succ.pred H = i :=
by cases i; refl

instance : decidable_linear_order (fin n) :=
{ lt_iff_le_not_le := λ i j, nat.lt_iff_le_not_le,
  le_refl := λ ⟨i, hi⟩, nat.le_refl i,
  le_trans := λ ⟨i, hi⟩ ⟨j, hj⟩ ⟨k, hk⟩ hij hjk, nat.le_trans hij hjk,
  le_antisymm := λ ⟨i, hi⟩ ⟨j, hj⟩ hij hji, fin.eq_of_veq $ nat.le_antisymm hij hji,
  le_total := λ ⟨i, hi⟩ ⟨j, hj⟩, or.cases_on (@nat.le_total i j) or.inl or.inr,
  decidable_le := fin.decidable_le,
  .. fin.has_le, .. fin.has_lt }

instance : preorder (fin n) :=
by apply_instance

end fin

section miscellaneous

theorem nat.pred_eq_of_eq_succ {m n : ℕ}
  (H : m = n.succ) : m.pred = n :=
by simp [H]

@[simp] lemma equiv.symm_apply_eq {α β} {e : α ≃ β} {x y} :
  e.symm x = y ↔ x = e y :=
⟨λ H, by simp [H.symm], λ H, by simp [H]⟩

theorem finset.lt_wf {α} [decidable_eq α] :
  well_founded (@has_lt.lt (finset α) _) :=
have H : subrelation (@has_lt.lt (finset α) _)
    (inv_image (<) finset.card),
  from λ x y hxy, finset.card_lt_card hxy,
subrelation.wf H $ inv_image.wf _ $ nat.lt_wf

def finset.min' {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅) : α :=
@option.get _ S.min $
  let ⟨k, hk⟩ := finset.exists_mem_of_ne_empty H in
  let ⟨b, hb⟩ := finset.min_of_mem hk in by simp at hb; simp [hb]

theorem finset.min'_mem {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅) : S.min' H ∈ S :=
finset.mem_of_min $ by simp [finset.min']

theorem finset.min'_le {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅)
  (x) (H2 : x ∈ S) : S.min' H ≤ x :=
finset.le_min_of_mem H2 $ option.get_mem _

theorem finset.le_min' {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅)
  (x) (H2 : ∀ y ∈ S, x ≤ y) : x ≤ S.min' H :=
H2 _ $ finset.min'_mem _ _

def finset.max' {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅) : α :=
@option.get _ S.max $
  let ⟨k, hk⟩ := finset.exists_mem_of_ne_empty H in
  let ⟨b, hb⟩ := finset.max_of_mem hk in by simp at hb; simp [hb]

theorem finset.max'_mem {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅) : S.max' H ∈ S :=
finset.mem_of_max $ by simp [finset.max']

theorem finset.le_max' {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅)
  (x) (H2 : x ∈ S) : x ≤ S.max' H :=
finset.le_max_of_mem H2 $ option.get_mem _

theorem finset.max'_le {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅)
  (x) (H2 : ∀ y ∈ S, y ≤ x) : S.max' H ≤ x :=
H2 _ $ finset.max'_mem _ _

theorem finset.min'_lt_max' {α} [decidable_linear_order α]
  (S : finset α) (H : S ≠ ∅) {i j}
  (H1 : i ∈ S) (H2 : j ∈ S) (H3 : i ≠ j) :
  S.min' H < S.max' H :=
begin
  rcases lt_trichotomy i j with H4 | H4 | H4,
  { have H5 := finset.min'_le S H i H1,
    have H6 := finset.le_max' S H j H2,
    apply lt_of_le_of_lt H5,
    apply lt_of_lt_of_le H4 H6 },
  { cc },
  { have H5 := finset.min'_le S H j H2,
    have H6 := finset.le_max' S H i H1,
    apply lt_of_le_of_lt H5,
    apply lt_of_lt_of_le H4 H6 }
end

end miscellaneous

variable (n : ℕ)

def Sym : Type :=
equiv.perm (fin n)

instance : has_coe_to_fun (Sym n) :=
equiv.has_coe_to_fun

@[extensionality] theorem Sym.ext (σ τ : Sym n)
  (H : ∀ i, σ i = τ i) : σ = τ :=
equiv.ext _ _ H

theorem Sym.ext_iff (σ τ : Sym n) :
  σ = τ ↔ ∀ i, σ i = τ i :=
⟨λ H i, H ▸ rfl, Sym.ext _ _ _⟩

instance : decidable_eq (Sym n) :=
λ σ τ, decidable_of_iff' _ (Sym.ext_iff _ _ _)

instance : group (Sym n) :=
equiv.perm_group

variable {n}

section perm

def Sym.to_list (σ : Sym n) : list (fin n) :=
list.of_fn σ

theorem Sym.to_list_perm (σ : Sym n) :
  σ.to_list ~ list.of_fn (1 : Sym n) :=
(list.perm_ext
  (list.nodup_of_fn $ σ.bijective.1)
  (list.nodup_of_fn $ (1 : Sym n).bijective.1)).2 $ λ f,
by rw [list.of_fn_eq_pmap, list.of_fn_eq_pmap, list.mem_pmap, list.mem_pmap]; from
⟨λ _, ⟨f.1, by simp [f.2], fin.eq_of_veq rfl⟩,
λ _, ⟨(σ⁻¹ f).1, by simp [(σ⁻¹ f).2], by convert equiv.apply_inverse_apply σ f;
  from congr_arg _ (fin.eq_of_veq rfl)⟩⟩

def list.to_sym (L : list (fin n))
  (HL : L ~ list.of_fn (1 : Sym n)) : Sym n :=
{ to_fun := λ f, list.nth_le L f.1 $
    by rw [list.perm_length HL, list.length_of_fn]; from f.2,
  inv_fun := λ f, ⟨list.index_of f L,
    begin
      convert list.index_of_lt_length.2 _,
      { rw [list.perm_length HL, list.length_of_fn] },
      { rw [list.mem_of_perm HL, list.mem_iff_nth_le],
        refine ⟨f.1, _, _⟩,
        { rw list.length_of_fn,
          exact f.2 },
        { apply list.nth_le_of_fn } }
    end⟩,
  left_inv := λ f, fin.eq_of_veq $ list.nth_le_index_of
    ((list.perm_nodup HL).2 $ list.nodup_of_fn $ λ _ _, id) _ _,
  right_inv := λ f, list.index_of_nth_le $ list.index_of_lt_length.2 $
    (list.mem_of_perm HL).2 $ list.mem_iff_nth_le.2 $
    ⟨f.1, by rw list.length_of_fn; from f.2,
      list.nth_le_of_fn _ _⟩ }

@[simp] lemma list.to_sym_apply (L : list (fin n))
  (HL : L ~ list.of_fn (1 : Sym n)) (i) :
  (L.to_sym HL) i = L.nth_le i.1 (by simp [list.perm_length HL, i.2]) :=
rfl

@[simp] lemma Sym.to_list_to_sym (σ : Sym n) :
  σ.to_list.to_sym σ.to_list_perm = σ :=
Sym.ext _ _ _ $ λ i, fin.eq_of_veq $ by simp [Sym.to_list]

end perm

namespace Sym

def equiv_0 : Sym 0 ≃ fin (0:ℕ).fact :=
{ to_fun    := λ _, ⟨0, dec_trivial⟩,
  inv_fun   := λ _, 1,
  left_inv  := λ _, ext _ _ _ $ λ ⟨n, H⟩, by cases H,
  right_inv := λ ⟨n, H⟩, fin.eq_of_veq $
    by cases H with H1 H1; [refl, cases H1] }

def descend (σ : Sym (n+1)) : Sym n :=
{ to_fun    := λ i, (σ 0).descend (σ i.succ)
    (λ H, by cases i; from nat.no_confusion
      (fin.veq_of_eq (σ.bijective.1 H))),
  inv_fun   := λ i, (σ.symm ((σ 0).ascend i)).pred $ λ H,
    fin.ascend_ne (σ 0) i $ by simpa using H,
  left_inv  := λ i, fin.eq_of_veq $ by dsimp; rw [fin.pred_val];
    apply nat.pred_eq_of_eq_succ; rw [← fin.succ_val];
    apply fin.veq_of_eq; simp,
  right_inv := λ i, fin.eq_of_veq $ by simp }

def ascend (σ : Sym n) (k : fin (n+1)) : Sym (n+1) :=
{ to_fun    := λ i, if H : i = 0 then k
    else k.ascend $ σ $ i.pred H,
  inv_fun   := λ i, if H : i = k then 0
    else (σ.symm $ k.descend i H).succ,
  left_inv  := λ i, fin.eq_of_veq $ begin
      dsimp,
      by_cases h1 : i = 0,
      { simp [h1] },
      { rw [dif_neg h1],
        rw [dif_neg (fin.ascend_ne k (σ (i.pred h1)))],
        simp }
    end,
  right_inv := λ i, fin.eq_of_veq $ begin
      dsimp,
      by_cases h1 : i = k,
      { simp [h1] },
      { rw [dif_neg h1, dif_neg], { simp },
        intro H,
        replace H := fin.veq_of_eq H,
        simp at H,
        exact nat.no_confusion H }
    end }

@[simp] lemma descend_ascend (σ : Sym n) (k : fin (n+1)) :
  descend (ascend σ k) = σ :=
begin
  ext i,
  dsimp [ascend, descend],
  have H : i.succ ≠ 0,
  { intro H,
    replace H := fin.veq_of_eq H,
    simp at H, injections },
  simp [H]
end

def equiv_succ (ih : Sym n ≃ fin n.fact) :
  Sym (n+1) ≃ (fin (n+1) × fin n.fact) :=
{ to_fun    := λ σ, (σ 0, ih $ descend σ),
  inv_fun   := λ F, ascend (ih.symm F.2) F.1,
  left_inv  := λ σ, ext _ _ _ $ λ i, begin
    dsimp, rw [equiv.inverse_apply_apply ih],
    dsimp [descend, ascend],
    split_ifs, {subst h},
    simp
  end,
  right_inv := λ F, prod.ext
      (fin.eq_of_veq $ by dsimp [ascend]; simp) $
    fin.eq_of_veq $ by simp }

protected def equiv : Sym n ≃ fin n.fact :=
nat.rec_on n equiv_0 $ λ n ih,
calc  Sym (n+1)
    ≃ (fin (n+1) × fin n.fact) : equiv_succ ih
... ≃ fin (n+1).fact : fin_prod

instance : fintype (Sym n) :=
fintype.of_equiv _ Sym.equiv.symm

theorem card : fintype.card (Sym n) = nat.fact n :=
(fintype.of_equiv_card Sym.equiv.symm).trans $
fintype.card_fin _

theorem Cayley (α : Type*) [group α] [fintype α] :
  ∃ f : α → Sym (fintype.card α), function.injective f ∧ is_group_hom f :=
nonempty.rec_on (fintype.card_eq.1 $ fintype.card_fin $ fintype.card α) $ λ φ,
⟨λ x, ⟨λ i, φ.symm (x * φ i), λ i, φ.symm (x⁻¹ * φ i),
  λ i, by simp, λ i, by simp⟩,
λ x y H, have H1 : _ := congr_fun (equiv.mk.inj H).1 (φ.symm 1), by simpa using H1,
⟨λ x y, ext _ _ _ $ λ i, by simp [mul_assoc]⟩⟩

@[simp] lemma mul_apply (σ τ : Sym n) (i : fin n) :
  (σ * τ) i = σ (τ i) :=
rfl

@[simp] lemma one_apply (i : fin n) :
  (1 : Sym n) i = i :=
rfl

@[simp] lemma inv_apply (σ : Sym n) (i : fin n) :
  σ⁻¹ i = σ.symm i :=
rfl

def swap (i j : fin n) : Sym n :=
{ to_fun    := λ k, if k = i then j
    else if k = j then i else k,
  inv_fun   := λ k, if k = i then j
    else if k = j then i else k,
  left_inv  := λ k, by dsimp; split_ifs; cc,
  right_inv := λ k, by dsimp; split_ifs; cc }

@[simp] lemma swap_left (i j : fin n) :
  swap i j i = j :=
by dsimp [swap]; cc

@[simp] lemma swap_right (i j : fin n) :
  swap i j j = i :=
by dsimp [swap]; split_ifs; cc

@[simp] lemma swap_mul_self (i j : fin n) :
  swap i j * swap i j = 1 :=
ext _ _ _ $ λ k, by dsimp [swap]; split_ifs; cc

theorem swap_comm (i j : fin n) :
  swap i j = swap j i :=
ext _ _ _ $ λ k, by dsimp [swap]; split_ifs; cc

theorem swap_canonical (i j : fin n)
  (H1 H2 : ({i, j} : finset (fin n)) ≠ ∅) :
  swap (finset.min' _ H1) (finset.max' _ H2) = swap i j :=
begin
  have H3 := finset.min'_mem _ H1,
  have H4 : finset.min' _ H1 = j ∨ finset.min' _ H1 = i,
  { simpa using H3 },
  have H5 := finset.max'_mem _ H2,
  have H6 : finset.max' _ H2 = j ∨ finset.max' _ H2 = i,
  { simpa using H5 },
  cases H4; cases H6,
  { rw [H4, H6],
    have H7 := finset.min'_le _ H1 i (by simp),
    have H8 := finset.le_max' _ H2 i (by simp),
    rw H4 at H7, rw H6 at H8,
    have H9 := le_antisymm H7 H8,
    subst H9 },
  { rw [H4, H6, swap_comm] },
  { rw [H4, H6] },
  { rw [H4, H6],
    have H7 := finset.min'_le _ H1 j (by simp),
    have H8 := finset.le_max' _ H2 j (by simp),
    rw H4 at H7, rw H6 at H8,
    have H9 := le_antisymm H7 H8,
    subst H9 }
end

@[simp] theorem swap_self (i : fin n) :
  swap i i = 1 :=
ext _ _ _ $ λ k, by dsimp [swap]; split_ifs; cc

def support (σ : Sym n) : finset (fin n) :=
finset.filter (λ i, σ i ≠ i) finset.univ

theorem support_def {σ : Sym n} {i : fin n} :
  i ∈ σ.support ↔ σ i ≠ i :=
⟨λ H, (finset.mem_filter.1 H).2, λ H, finset.mem_filter.2 ⟨finset.mem_univ _, H⟩⟩

def support_choice (σ : Sym n) (H : σ.support ≠ ∅) :
  { i // i ∈ σ.support } :=
⟨σ.support.min' H, finset.min'_mem _ _⟩

theorem support_swap {i j : fin n} (H : i ≠ j) :
  (swap i j).support = {i, j} :=
begin
  ext k, split,
  { intro H1,
    simp [support_def, swap] at H1,
    split_ifs at H1 with h1 h2 h3 h4,
    { subst h1, simp },
    { subst h2, simp },
    cc },
  { intro H1,
    simp at H1,
    cases H1 with H1 H1;
    subst H1;
    simp [support_def, swap, H.symm, H] }
end

theorem support_swap_mul {σ : Sym n} {i : fin n}
  (H : i ∈ σ.support) : (swap (σ i) i * σ).support < σ.support :=
begin
  split,
  { intros j h1,
    simp [support_def, swap] at *,
    split_ifs at h1,
    { intro h2, rw ← h2 at h, subst h, cc },
    { cc },
    { cc } },
  intro H1,
  specialize H1 H,
  simp [support_def, swap] at H1,
  apply H1
end

@[simp] lemma support_one : support (1 : Sym n) = ∅ :=
finset.eq_empty_of_forall_not_mem $ λ i H,
support_def.1 H rfl

variable (n)
@[derive decidable_eq]
structure step : Type :=
(fst : fin n)
(snd : fin n)
(lt  : fst < snd)
variable {n}

instance step.fintype : fintype (step n) :=
@fintype.of_surjective { i : fin n × fin n // i.1 < i.2 } _ _ _
  (λ i, (⟨i.1.1, i.1.2, i.2⟩ : step n)) $ λ s,
⟨⟨(s.1, s.2), s.3⟩, by cases s; refl⟩

instance : has_mem (fin n) (step n) :=
⟨λ i s, i = s.1 ∨ i = s.2⟩

@[extensionality] theorem step.ext (s t : step n)
  (H1 : s.1 = t.1) (H2 : s.2 = t.2) : s = t :=
by cases s; cases t; congr; assumption

def step.mk' (i j : fin n) (H : i ≠ j) : step n :=
if h : i < j then ⟨i, j, h⟩ else
⟨j, i, (eq_or_lt_of_not_lt h).resolve_left H⟩

def step.eval (s : step n) : Sym n :=
swap s.1 s.2

@[simp] lemma step.eval_mul_self (s : step n) :
  s.eval * s.eval = 1 :=
by simp [step.eval]

@[simp] lemma step.eval_mk' (i j : fin n) (H : i ≠ j) :
  (step.mk' i j H).eval = swap i j :=
by unfold step.mk'; split_ifs; simp [step.eval, swap_comm]

theorem choice.aux (σ : Sym n)
  (H : ∃ i j, i ≠ j ∧ σ = swap i j) :
  σ.support ≠ ∅ :=
let ⟨i, j, h1, h2⟩ := H in by
  refine finset.ne_empty_of_mem (_ : j ∈ σ.support);
  rw [h2, support_swap h1];
  apply finset.mem_insert_self

def choice (σ : Sym n)
  (H : ∃ i j, i ≠ j ∧ σ = swap i j) : step n :=
{ fst := σ.support.min' $ choice.aux _ H,
  snd := σ.support.max' $ choice.aux _ H,
  lt  := by rcases H with ⟨i, j, h1, h2⟩; subst h2; dsimp;
    refine finset.min'_lt_max' _ _ _ _ h1;
    simp [support_swap h1] }

theorem eval_choice (σ : Sym n)
  (H : ∃ i j, i ≠ j ∧ σ = swap i j) :
  (σ.choice H).eval = σ :=
begin
  rcases H with ⟨i, j, h1, h2⟩,
  subst h2, unfold step.eval choice, dsimp,
  convert swap_canonical i j _ _;
  simp [support_swap h1]
end

theorem choice_eval (s : step n)
  (H : ∃ i j, i ≠ j ∧ s.eval = swap i j) :
  s.eval.choice H = s :=
begin
  ext; dsimp [step.eval, choice],
  { apply le_antisymm,
    { apply finset.min'_le,
      simp [support_swap (ne_of_lt s.3)] },
    { apply finset.le_min',
      intros y h1,
      simp [support_swap (ne_of_lt s.3)] at h1,
      cases h1; subst h1,
      apply le_of_lt s.3 } },
  { apply le_antisymm,
    { apply finset.max'_le,
      intros y h1,
      simp [support_swap (ne_of_lt s.3)] at h1,
      cases h1; subst h1,
      apply le_of_lt s.3 },
    { apply finset.le_max',
      simp [support_swap (ne_of_lt s.3)] } }
end

def list_step.aux : has_well_founded (Sym n) :=
{ r := inv_image (<) support,
  wf := inv_image.wf _ finset.lt_wf }

local attribute [instance] list_step.aux
attribute [elab_as_eliminator] well_founded.fix
attribute [elab_as_eliminator] well_founded.induction

def list_step (σ : Sym n) : list (step n) :=
by refine well_founded.fix list_step.aux.wf _ σ; from
λ σ ih, if H : σ.support = ∅ then []
  else let ⟨i, hi⟩ := σ.support_choice H in
    step.mk' (σ i) i (support_def.1 hi)
    :: ih (swap (σ i) i * σ) (support_swap_mul hi)

@[simp] lemma list_step_prod (σ : Sym n) :
  (σ.list_step.map step.eval).prod = σ :=
well_founded.induction list_step.aux.wf σ $ λ σ ih,
begin
  dsimp [list_step],
  rw [well_founded.fix_eq],
  split_ifs,
  { ext, by_contra H,
    suffices : i ∈ (∅ : finset (fin n)),
    { simp at this, cc },
    rw [← h, support_def],
    exact mt eq.symm H },
  cases support_choice σ h with i hi,
  unfold list_step._match_1,
  specialize ih _ (support_swap_mul hi),
  dsimp [list_step] at ih,
  rw [list.map_cons, list.prod_cons, ih, ← mul_assoc],
  rw [step.eval_mk', swap_mul_self, one_mul]
end

theorem mem_step_iff_mem_support (s : step n) (i : fin n) :
  i ∈ s ↔ i ∈ s.eval.support :=
begin
  unfold step.eval,
  simp [support_swap (ne_of_lt s.3)],
  rw [or_comm], refl
end

theorem support_eq_of_mul_eq_one {σ τ : Sym n} (H : σ * τ = 1) :
  σ.support = τ.support :=
begin
  ext i, simp [support_def, not_iff_not],
  rw [eq_comm, iff.comm],
  convert equiv.symm_apply_eq,
  symmetry,
  rw [equiv.symm_apply_eq, ← mul_apply, H, one_apply],
end

theorem of_mem_mul_support {σ τ : Sym n} {i}
  (H : i ∈ (σ * τ).support) :
  i ∈ σ.support ∨ i ∈ τ.support :=
by_contradiction $ λ H2,
by simp [support_def, not_or_distrib] at H H2;
simp [H2] at H; cc

theorem of_not_mem_mul_support {σ τ : Sym n} {i}
  (H : i ∉ (σ * τ).support) :
  i ∈ σ.support ↔ i ∈ τ.support :=
begin
  simp [support_def] at H ⊢,
  split,
  { intros H2 H3, rw H3 at H, cc },
  { intros H2 H3, rw ← H3 at H,
    replace H := σ.bijective.1 H,
    rw H3 at H, cc }
end

theorem not_mem_mul_support {σ τ : Sym n} {i}
  (H1 : i ∉ σ.support) (H2 : i ∉ τ.support) :
  i ∉ (σ * τ).support :=
begin
  simp [support_def] at H1 H2 ⊢,
  rw [H2, H1]
end

@[simp] lemma mem_mk' {i j k : fin n} (H : i ≠ j) :
  k ∈ step.mk' i j H ↔ k = i ∨ k = j :=
begin
  unfold step.mk',
  split_ifs,
  { refl },
  { apply or_comm }
end

-- (ab)(cd) = (cd)(ab)
theorem sgn_aux5 (s t : step n)
  (H1 : s.1 ≠ t.1) (H2 : s.1 ≠ t.2)
  (H3 : s.2 ≠ t.1) (H4 : s.2 ≠ t.2) :
  s.eval * t.eval = t.eval * s.eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  dsimp [step.eval, swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(ac) = (bc)(ab)
theorem sgn_aux4a (s t : step n)
  (H1 : s.1 = t.1) (H4 : s.2 ≠ t.2) :
  s.eval * t.eval = (step.mk' s.2 t.2 H4).eval * s.eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  unfold step.eval step.mk',
  simp [swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(ca) = (cb)(ab)
theorem sgn_aux4b (s t : step n) (H1 : s.1 = t.2)
  (H2 : t.1 < s.2) :
  s.eval * t.eval = (⟨t.1, s.2, H2⟩ : step n).eval * s.eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  have := ne_of_lt H2,
  dsimp [step.eval, swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(ac) = (ac)(bc)
theorem sgn_aux4c (s t : step n)
  (H1 : s.1 = t.1) (H4 : s.2 ≠ t.2) :
  s.eval * t.eval = t.eval * (step.mk' s.2 t.2 H4).eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  unfold step.eval step.mk',
  simp [swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(ca) = (ca)(cb)
theorem sgn_aux4d (s t : step n)
  (H1 : s.1 = t.2) (H4 : t.1 < s.2) :
  s.eval * t.eval = t.eval * (⟨t.1, s.2, H4⟩ : step n).eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  have := ne_of_lt H4,
  simp [step.eval, swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(bc) = (bc)(ac)
theorem sgn_aux3a (s t : step n) (H1 : s.2 = t.1)
  (H2 : s.1 < t.2) :
  s.eval * t.eval = t.eval * (⟨s.1, t.2, H2⟩ : step n).eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  have := ne_of_lt H2,
  dsimp [step.eval, swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(cb) = (cb)(ac)
theorem sgn_aux3b (s t : step n) (H1 : s.2 = t.2)
  (H2 : s.1 ≠ t.1) :
  s.eval * t.eval = t.eval * (step.mk' s.1 t.1 H2).eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  unfold step.eval step.mk',
  simp [swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(bc) = (ac)(ab)
theorem sgn_aux3c (s t : step n) (H1 : s.2 = t.1)
  (H2 : s.1 < t.2) :
  s.eval * t.eval = (⟨s.1, t.2, H2⟩ : step n).eval * s.eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  have := ne_of_lt H2,
  dsimp [step.eval, swap], ext k,
  dsimp at *,
  split_ifs; cc
end

-- (ab)(cb) = (ac)(ab)
theorem sgn_aux3d (s t : step n) (H1 : s.2 = t.2)
  (H2 : s.1 ≠ t.1) :
  s.eval * t.eval = (step.mk' s.1 t.1 H2).eval * s.eval :=
begin
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  unfold step.eval step.mk',
  simp [swap], ext k,
  dsimp at *,
  split_ifs; cc
end

theorem sgn_aux2 (s t : step n) (i) (H : i ∈ s) :
  s = t ∨ ∃ s' t' : step n, s.eval * t.eval = s'.eval * t'.eval
    ∧ i ∉ s' ∧ i ∈ t' :=
begin
  cases H with H H; subst H,
  { by_cases H2 : s.1 = t.1,
    { by_cases H3 : s.2 = t.2,
      { left, ext; assumption },
      right, -- (ab)(ac) = (bc)(ab)
      refine ⟨step.mk' s.2 t.2 H3, s, _, _⟩,
      { exact sgn_aux4a _ _ H2 _ },
      rw [mem_mk'],
      exact ⟨λ H, or.cases_on H
        (ne_of_lt s.3) (H2.symm ▸ (ne_of_lt t.3)),
      or.inl rfl⟩ },
    right,
    by_cases H3 : s.1 = t.2,
    { -- (ab)(ca) = (cb)(ab)
      have H4 : t.1 < s.2 := lt_trans t.3 (H3 ▸ s.3),
      refine ⟨⟨t.1, s.2, H4⟩, s, _, _⟩,
      { exact sgn_aux4b _ _ H3 _ },
      exact ⟨λ H, or.cases_on H
        H2 (ne_of_lt s.3),
      or.inl rfl⟩ },
    by_cases H4 : s.2 = t.1,
    { -- (ab)(bc) = (bc)(ac)
      have H5 : s.1 < t.2 := lt_trans s.3 (H4.symm ▸ t.3),
      refine ⟨t, ⟨s.1, t.2, H5⟩, _, _⟩,
      { exact sgn_aux3a _ _ H4 _ },
      exact ⟨λ H, or.cases_on H
        H2 (ne_of_lt H5),
      or.inl rfl⟩ },
    by_cases H5 : s.2 = t.2,
    { -- (ab)(cb) = (cb)(ac)
      refine ⟨t, step.mk' s.1 t.1 H2, _, _⟩,
      { exact sgn_aux3b _ _ H5 _ },
      exact ⟨λ H, or.cases_on H
        H2 H3,
      by simp⟩ },
    -- (ab)(cd) = (cd)(ab)
    refine ⟨t, s, _, _⟩,
    { exact sgn_aux5 _ _ H2 H3 H4 H5 },
    exact ⟨λ H, or.cases_on H
      H2 H3,
    or.inl rfl⟩ },
  by_cases H2 : s.1 = t.1,
  { by_cases H3 : s.2 = t.2,
    { left, ext; assumption },
    right, -- (ab)(ac) = (ac)(bc)
    refine ⟨t, step.mk' s.2 t.2 H3, _, _⟩,
    { exact sgn_aux4c _ _ H2 _ },
    rw [mem_mk'],
    exact ⟨λ H, or.cases_on H
      (H2 ▸ ne_of_gt s.3) H3,
    or.inl rfl⟩ },
  right,
  by_cases H3 : s.1 = t.2,
  { -- (ab)(ca) = (ca)(cb)
    have H4 : t.1 < s.2 := lt_trans t.3 (H3 ▸ s.3),
    refine ⟨t, ⟨t.1, s.2, H4⟩, _, _⟩,
    { exact sgn_aux4d _ _ H3 _ },
    exact ⟨λ H, or.cases_on H
      (ne_of_gt H4) (H3 ▸ ne_of_gt s.3),
    or.inr rfl⟩ },
  by_cases H4 : s.2 = t.1,
  { -- (ab)(bc) = (ac)(ab)
    have H5 : s.1 < t.2 := lt_trans s.3 (H4.symm ▸ t.3),
    refine ⟨⟨s.1, t.2, H5⟩, s, _, _⟩,
    { exact sgn_aux3c _ _ H4 _ },
    exact ⟨λ H, or.cases_on H
      (ne_of_gt s.3) (H4.symm ▸ ne_of_lt t.3),
    or.inr rfl⟩ },
  by_cases H5 : s.2 = t.2,
  { -- (ab)(cb) = (ac)(ab)
    refine ⟨step.mk' s.1 t.1 H2, s, _, _⟩,
    { exact sgn_aux3d _ _ H5 _ },
    rw [mem_mk'],
    exact ⟨λ H, or.cases_on H
      (ne_of_gt s.3) (H5.symm ▸ ne_of_gt t.3),
    or.inr rfl⟩ },
  refine ⟨t, s, _, _⟩,
  { exact sgn_aux5 _ _ H2 H3 H4 H5 },
  exact ⟨λ H, or.cases_on H
    H4 H5,
  or.inr rfl⟩
end

theorem sgn_aux (L1 : list (step n)) (s : step n) (L2 : list (step n)) (i : fin n)
  (H1 : (L1.map step.eval).prod * s.eval * (L2.map step.eval).prod = 1)
  (H2 : i ∈ s) (H3 : i ∉ (L1.map step.eval).prod.support) :
  ∃ (L : list (step n)),
    (L.map step.eval).prod = 1
    ∧ L.length + 2 = L1.length + 1 + L2.length :=
begin
  induction L2 with hd tl ih generalizing L1 s,
  { simp at H1,
    simp [mem_step_iff_mem_support] at H2,
    rw support_eq_of_mul_eq_one H1 at H3,
    cc },
  simp [mul_assoc] at H1,
  simp [mem_step_iff_mem_support] at H2,
  have H4 := H3,
  rw [support_eq_of_mul_eq_one H1] at H4,
  replace H4 := of_not_mem_mul_support H4,
  replace H4 := H4.1 H2,
  rw [← mem_step_iff_mem_support] at H2,
  rcases sgn_aux2 s hd i H2 with H5 | ⟨s', t', H5, H6, H7⟩,
  { subst H5,
    rw [← mul_assoc s.eval, step.eval_mul_self, one_mul] at H1,
    rw [← list.prod_append, ← list.map_append] at H1,
    refine ⟨_, H1, _⟩,
    simp, unfold bit0, ac_refl },
  specialize ih (L1 ++ [s']) t' _ H7 _,
  rcases ih with ⟨L, H8, H9⟩,
  refine ⟨L, H8, _⟩,
  { simp [H9] },
  { simp at H5 ⊢,
    rw [mul_assoc (L1.map step.eval).prod, ← H5],
    simpa [mul_assoc] using H1 },
  simpa using not_mem_mul_support H3 _,
  simpa [mem_step_iff_mem_support] using H6
end

theorem length_even_of_prod_one (L : list (step n))
  (H : (L.map step.eval).prod = 1) :
  L.length % 2 = 0 :=
begin
  generalize H1 : L.length = k,
  revert L,
  apply nat.strong_induction_on k,
  intros k ih L H H1,
  cases k with k, { refl },
  cases k with k,
  { exfalso,
    rw list.length_eq_one at H1,
    cases H1 with s H2,
    subst H2,
    replace H := congr_arg support H,
    simp [step.eval, support_swap (ne_of_lt s.3)] at H,
    exact H },
  cases L with hd tl, { simp at H1, injections },
  rcases sgn_aux [] hd tl hd.1 _ (or.inl rfl) _ with ⟨L, H2, H3⟩,
  specialize ih k _ L H2 _,
  change (k + 2) % 2 = 0,
  { rw [nat.add_mod_right, ih] },
  { constructor, constructor },
  { simp at H1 H3,
    rw ← H3 at H1,
    exact nat.succ_inj (nat.succ_inj H1) },
  { simpa using H },
  simp
end

theorem length_mod_two_eq (L1 L2 : list (step n))
  (H : (L1.map step.eval).prod = (L2.map step.eval).prod) :
  L1.length % 2 = L2.length % 2 :=
have H1 : (L2.map step.eval).reverse.prod = (L2.map step.eval).prod⁻¹,
  from list.rec_on L2 (by simp) $ λ hd tl ih,
    by simp [ih, eq_inv_iff_mul_eq_one],
have H2 : _,
  from length_even_of_prod_one (L1 ++ L2.reverse) $
    by simp [H1, H],
have H3 : 2 ∣ L1.length + L2.length,
  by simpa [nat.dvd_iff_mod_eq_zero] using H2,
calc  L1.length % 2
    = (L1.length + L2.length + L2.length) % 2 :
  by rw [add_assoc, ← mul_two, nat.add_mul_mod_self_right]
... = L2.length % 2 :
  by cases H3 with k H4; rw [H4, add_comm, nat.add_mul_mod_self_left]

end Sym

@[derive decidable_eq]
inductive mu2 : Type
| plus_one : mu2
| minus_one : mu2

namespace mu2

definition neg : mu2 → mu2
| plus_one := minus_one
| minus_one := plus_one

instance : has_one mu2 := ⟨plus_one⟩
instance : has_neg mu2 := ⟨neg⟩

instance : comm_group mu2 :=
{ mul := λ x y, mu2.rec_on x (mu2.rec_on y 1 (-1)) (mu2.rec_on y (-1) 1),
  mul_assoc := λ x y z, by cases x; cases y; cases z; refl,
  mul_one := λ x, by cases x; refl,
  one_mul := λ x, by cases x; refl,
  inv := id,
  mul_left_inv := λ x, by cases x; refl,
  mul_comm := λ x y, by cases x; cases y; refl,
  .. mu2.has_one }

instance : fintype mu2 :=
{ elems := {1, -1},
  complete := λ x, mu2.cases_on x (or.inr $ or.inl rfl) (or.inl rfl) }

theorem card : fintype.card mu2 = 2 :=
rfl

theorem neg_one_pow {n} : (-1 : mu2) ^ n = (-1 : mu2) ^ (n%2) :=
have H : (-1 : mu2) ^ 2 = 1, from rfl,
by rw [← nat.mod_add_div n 2, pow_add, pow_mul, H, one_pow, mul_one, nat.mod_add_div n 2]

@[simp] lemma mul_self_eq_one (x : mu2) : x * x = 1 :=
by cases x; refl

@[simp] lemma inv_eq_self (x : mu2) : x⁻¹ = x :=
rfl

@[simp] protected lemma mul_neg_one (x : mu2) : x * -1 = -x :=
by cases x; refl

@[simp] protected lemma neg_one_mul (x : mu2) : -1 * x = -x :=
by cases x; refl

@[simp] lemma neg_mul_self (x : mu2) : -x * x = -1 :=
by cases x; refl

@[simp] lemma mul_neg (x y : mu2) : x * -y = -x * y :=
by cases x; cases y; refl

end mu2

namespace Sym

def sgn (σ : Sym n) : mu2 :=
(-1) ^ σ.list_step.length

instance sgn.is_group_hom : is_group_hom (@sgn n) :=
begin
  constructor,
  intros σ τ,
  unfold sgn,
  rw [← pow_add, ← list.length_append],
  rw [mu2.neg_one_pow, eq_comm, mu2.neg_one_pow],
  refine congr_arg _ _,
  apply length_mod_two_eq,
  simp
end

@[simp] lemma sgn_step (s : step n) :
  sgn s.eval = -1 :=
suffices s.eval.list_step.length % 2 = [s].length % 2,
  by unfold sgn; rw [mu2.neg_one_pow, this]; refl,
length_mod_two_eq _ _ $ by simp

@[simp] lemma sgn_mul (σ τ : Sym n) :
  sgn (σ * τ) = sgn σ * sgn τ :=
is_group_hom.mul sgn _ _

@[simp] lemma sgn_one :
  sgn (1 : Sym n) = 1 :=
is_group_hom.one sgn

@[simp] lemma sgn_inv (σ : Sym n) :
  sgn σ⁻¹ = sgn σ :=
is_group_hom.inv sgn _

def eq_sgn_aux4 (s t : step n) : Sym n :=
swap (swap s.1 t.1 s.2) t.2 * swap s.1 t.1

theorem eq_sgn_aux3 (s t : step n) :
  eq_sgn_aux4 s t s.1 = t.1 :=
begin
  dsimp [eq_sgn_aux4, swap],
  have := ne_of_lt s.3,
  have := ne_of_lt t.3,
  simp, split_ifs; cc
end

theorem eq_sgn_aux2 (s t : step n) :
  eq_sgn_aux4 s t s.2 = t.2 :=
begin
  dsimp [eq_sgn_aux4, swap],
  simp
end

theorem eq_sgn_aux (s t : step n) :
  eq_sgn_aux4 s t * s.eval * (eq_sgn_aux4 s t)⁻¹ = t.eval :=
begin
  ext k,
  by_cases H1 : k = t.1,
  { subst H1,
    dsimp [step.eval],
    simp [equiv.symm_apply_eq.2 (eq_sgn_aux3 s t).symm, eq_sgn_aux2] },
  by_cases H2 : k = t.2,
  { subst H2,
    dsimp [step.eval],
    simp [equiv.symm_apply_eq.2 (eq_sgn_aux2 s t).symm, eq_sgn_aux3] },
  dsimp [step.eval, swap],
  simp [H1, H2, eq_sgn_aux2, eq_sgn_aux3]
end

theorem eq_sgn (f : Sym n → mu2) [is_group_hom f]
  (s : step n) (H1 : f s.eval = -1) (σ : Sym n) :
  f σ = sgn σ :=
begin
  have H2 : ∀ t : step n, f t.eval = -1,
  { intro t,
    rw [← eq_sgn_aux s t],
    simp [is_group_hom.mul f, is_group_hom.inv f, H1] },
  have H3 := list_step_prod σ,
  revert H3, generalize : list_step σ = L, intro H3, subst H3,
  induction L with hd tl ih, { simp [is_group_hom.one f] },
  simp [is_group_hom.mul f, ih, H2]
end

section inversions

def step.map (s : step n) (σ : Sym n) : step n :=
step.mk' (σ s.1) (σ s.2) $ λ H, ne_of_lt s.3 $
σ.bijective.1 H

@[simp] lemma step.map_map_inv (s : step n) (σ : Sym n) :
  (s.map σ).map σ⁻¹ = s :=
begin
  unfold step.map step.mk',
  by_cases H1 : σ s.1 < σ s.2,
  { rw [dif_pos H1], dsimp,
    rw dif_pos, ext; simp,
    simp [s.3] },
  rw [dif_neg H1], dsimp,
  rw dif_neg, ext; simp,
  simp [le_of_lt s.3]
end

@[simp] lemma step.map_inv_map (s : step n) (σ : Sym n) :
  (s.map σ⁻¹).map σ = s :=
by simpa using step.map_map_inv s σ⁻¹

def inversion (σ : Sym n) (s : step n) : mu2 :=
if σ s.1 > σ s.2 then -1 else 1

def inversions (σ : Sym n) : mu2 :=
finset.prod finset.univ $ inversion σ

theorem inversion_mul (σ τ : Sym n) (s : step n) :
  inversion (σ * τ) s = inversion σ (s.map τ) * inversion τ s :=
begin
  unfold inversion step.map step.mk',
  split_ifs with h1 h2 h3 h3 h4 h4 h2 h3 h3 h4 h4; try { refl },
  { exfalso, apply lt_asymm h2 h3 },
  { exfalso, apply lt_asymm h1 h3 },
  { simp at *, exfalso,
    exact ne_of_lt s.3 (τ.bijective.1 $ le_antisymm h4 h2) },
  { exfalso, apply lt_asymm h2 h3 },
  { simp at *, exfalso,
    exact ne_of_lt s.3 (τ.bijective.1 $ le_antisymm h4 h2) },
  { simp at *, exfalso,
    exact ne_of_lt s.3 (τ.bijective.1 $ σ.bijective.1 $ le_antisymm h1 h3) }
end

instance : is_group_hom (@inversions n) :=
⟨λ σ τ, calc
      inversions (σ * τ)
    = finset.prod finset.univ (inversion (σ * τ)) : rfl
... = finset.prod finset.univ (λ s : step n,
        inversion σ (s.map τ) * inversion τ s) :
  congr_arg _ $ funext $ inversion_mul σ τ
... = finset.prod finset.univ (λ s : step n,
        inversion σ (s.map τ)) * inversions τ :
  finset.prod_mul_distrib
... = finset.prod finset.univ (inversion σ) * inversions τ :
  congr_arg (λ z, z * inversions τ) $ finset.prod_bij
    (λ s _, step.map s τ) (λ _ _, finset.mem_univ _) (λ _ _, rfl)
    (λ s t _ _ H, by simpa using congr_arg (λ z, step.map z τ⁻¹) H)
    (λ s _, ⟨s.map τ⁻¹, finset.mem_univ _, by simp⟩)⟩

variable (n)
def step01 : step (n+2) :=
⟨⟨0, nat.zero_lt_succ _⟩, ⟨1, nat.succ_lt_succ $ nat.zero_lt_succ _⟩, dec_trivial⟩
variable {n}

theorem inversions_step01 : inversions (step01 n).eval = -1 :=
show _ = finset.prod {step01 n} (inversion (step01 n).eval), from
eq.symm $ finset.prod_subset (finset.subset_univ _) $ λ s _ H1, begin
  unfold inversion step.eval swap step01; dsimp at *, rw if_neg,
  by_cases H2 : s.1.1 = 0,
  { rw [if_pos, if_neg, if_neg],
    { intro H3,
      replace H3 := nat.le_of_lt_succ H3,
      replace H3 := nat.eq_zero_of_le_zero H3,
      exact ne_of_lt s.3 (fin.eq_of_veq $ H2.trans H3.symm) },
    { intro H3, apply H1, simp, ext, exact fin.eq_of_veq H2, exact H3 },
    { exact ne_of_gt (H2 ▸ s.3 : s.2.1 > 0), },
    { exact fin.eq_of_veq H2 } },
  by_cases H3 : s.1.1 = 1,
  { rw [if_neg, if_pos], exact nat.not_lt_zero _,
    exact fin.eq_of_veq H3, exact mt fin.veq_of_eq H2 },
  rw [if_neg, if_neg, if_neg, if_neg],
  { exact lt_asymm s.3 },
  { intro H4, have H5 := s.3, rw H4 at H5,
    replace H5 := nat.le_of_lt_succ H5,
    replace H5 := nat.eq_zero_of_le_zero H5,
    cc },
  { intro H4, have H5 := s.3, rw H4 at H5,
    cases H5 },
  { exact mt fin.veq_of_eq H3 },
  { exact mt fin.veq_of_eq H2 }
end

theorem inversions_eq_sgn : ∀ σ : Sym n, inversions σ = sgn σ :=
nat.cases_on n dec_trivial $ λ n,
nat.cases_on n dec_trivial $ λ n σ,
eq_sgn inversions (step01 n) inversions_step01 σ

end inversions

end Sym

variable (n)
def Alt : Type :=
is_group_hom.ker (@Sym.sgn n)

instance : group (Alt n) :=
by unfold Alt; apply_instance


import data.sigma.basic
import tactic.ext

namespace sigma
universes u v

section
variables {α : Type u} {β β' : α → Type v}

theorem eq_fst {s₁ s₂ : sigma β} : s₁ = s₂ → s₁.1 = s₂.1 :=
by cases s₁; cases s₂; cc

theorem eq_snd {s₁ s₂ : sigma β} : s₁ = s₂ → s₁.2 == s₂.2 :=
by cases s₁; cases s₂; cc

end

section
variables {α₁ α₂ : Type u} {β₁ : α₁ → Type v} {β₂ : α₂ → Type v}

/-- A function on `sigma`s that is functional on `fst`s (preserves equality from
argument to result). -/
def fst_functional (f : sigma β₁ → sigma β₂) : Prop :=
∀ ⦃s t : sigma β₁⦄, s.1 = t.1 → (f s).1 = (f t).1

/-- A function on `sigma`s that is injective on `fst`s (preserves equality from
result to argument). -/
def fst_injective (f : sigma β₁ → sigma β₂) : Prop :=
∀ ⦃s t : sigma β₁⦄, (f s).1 = (f t).1 → s.1 = t.1

end

/-- A function on `sigma`s bundled with its `fst`-injectivity property. -/
structure embedding {α₁ α₂ : Type u} (β₁ : α₁ → Type v) (β₂ : α₂ → Type v) :=
(to_fun  : sigma β₁ → sigma β₂)
(fst_inj : fst_injective to_fun)

infixr ` s↪ `:25 := embedding

namespace embedding
variables {α₁ α₂ : Type u} {β₁ : α₁ → Type v} {β₂ : α₂ → Type v}

instance : has_coe_to_fun (β₁ s↪ β₂) :=
⟨_, embedding.to_fun⟩

@[simp] theorem to_fun_eq_coe (f : β₁ s↪ β₂) : f.to_fun = f :=
rfl

@[simp] theorem coe_fn_mk (f : sigma β₁ → sigma β₂) (i : fst_injective f) :
  (mk f i : sigma β₁ → sigma β₂) = f :=
rfl

theorem fst_inj' : ∀ (f : β₁ s↪ β₂), fst_injective f
| ⟨_, h⟩ := h

end embedding

section map_id
variables {α : Type u} {β₁ β₂ : α → Type v}

@[simp] theorem map_id_eq_fst {s : sigma β₁} (f : ∀ a, β₁ a → β₂ a) :
  (s.map id f).1 = s.1 :=
by cases s; refl

theorem map_id_fst_functional (f : ∀ a, β₁ a → β₂ a) :
  fst_functional (map id f) :=
λ _ _, by simp only [map_id_eq_fst]; exact id

theorem map_id_fst_injective (f : ∀ a, β₁ a → β₂ a) :
  fst_injective (map id f) :=
λ _ _, by simp only [map_id_eq_fst]; exact id

/-- Construct an `embedding` with `id` on `fst`. -/
def embedding.mk₂ (f : ∀ a, β₁ a → β₂ a) : embedding β₁ β₂ :=
⟨_, map_id_fst_injective f⟩

end map_id

section
variables {α : Type u} {β : α → Type v} {R : α → α → Prop}

/-- A relation `R` on `fst` values lifted to the `sigma`. This is useful where
you might otherwise use the term `λ s₁ s₂, R s₁.1 s₂.1`. -/
def fst_rel (R : α → α → Prop) (s₁ s₂ : sigma β) : Prop :=
R s₁.1 s₂.1

@[simp] theorem fst_rel_def {s₁ s₂ : sigma β} : fst_rel R s₁ s₂ = R s₁.1 s₂.1 :=
rfl

instance fst_rel_decidable [d : decidable_rel R] : decidable_rel (@fst_rel _ β R)
| s₁ s₂ := @d s₁.1 s₂.1

theorem fst_rel.refl (h : reflexive R) : reflexive (@fst_rel _ β R) :=
λ s, h s.1

theorem fst_rel.symm (h : symmetric R) : symmetric (@fst_rel _ β R) :=
λ s₁ s₂ (p : R s₁.1 s₂.1), h p

theorem fst_rel.trans (h : transitive R) : transitive (@fst_rel _ β R) :=
λ s₁ s₂ s₃ (p : R s₁.1 s₂.1) (q : R s₂.1 s₃.1), h p q

end

section
variables {α : Type u} {β : α → Type v}

theorem fst_functional_id : fst_functional (@id (sigma β)) :=
λ s t h, h

theorem fst_injective_id : fst_injective (@id (sigma β)) :=
λ s t h, h

@[refl] protected def embedding.refl (β : α → Type v) : β s↪ β :=
⟨_, fst_injective_id⟩

@[simp] theorem embedding.refl_apply (s : sigma β) : embedding.refl β s = s :=
rfl

end

section
variables {α₁ α₂ α₃ : Type u}
variables {β₁ : α₁ → Type v} {β₂ : α₂ → Type v} {β₃ : α₃ → Type v}
variables {g : sigma β₂ → sigma β₃} {f : sigma β₁ → sigma β₂}

theorem fst_functional_comp (gf : fst_functional g) (ff : fst_functional f) :
  fst_functional (g ∘ f) :=
λ s t h, gf (ff h)

theorem fst_injective_comp (gi : fst_injective g) (fi : fst_injective f) :
  fst_injective (g ∘ f) :=
λ s t h, fi (gi h)

@[trans] protected def embedding.trans (f : β₁ s↪ β₂) (g : β₂ s↪ β₃) : β₁ s↪ β₃ :=
⟨_, fst_injective_comp g.fst_inj f.fst_inj⟩

@[simp] theorem embedding.trans_apply (f : β₁ s↪ β₂) (g : β₂ s↪ β₃) (s : sigma β₁) :
  (f.trans g) s = g (f s) :=
rfl

@[extensionality]
lemma ext {x₀ x₁ : sigma β₁}
  (h₀ : x₀.1 = x₁.1)
  (h₁ : x₀.1 = x₁.1 → x₀.2 == x₁.2) :
  x₀ = x₁ :=
by casesm* sigma _; cases h₀; cases h₁ h₀; refl

lemma eta (x : sigma β₁) : sigma.mk x.1 x.2 = x :=
by cases x; refl

end

end sigma


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Mon.basic
import Mathlib.category_theory.endomorphism
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Category instances for group, add_group, comm_group, and add_comm_group.

We introduce the bundled categories:
* `Group`
* `AddGroup`
* `CommGroup`
* `AddCommGroup`
along with the relevant forgetful functors between them, and to the bundled monoid categories.
-/

/-- The category of groups and group morphisms. -/
def AddGroup := category_theory.bundled add_group

/-- The category of additive groups and group morphisms -/
namespace Group

protected instance Mathlib.AddGroup.group.to_monoid.category_theory.bundled_hom.parent_projection :
    category_theory.bundled_hom.parent_projection add_group.to_add_monoid :=
  category_theory.bundled_hom.parent_projection.mk

protected instance has_coe_to_sort : has_coe_to_sort Group :=
  category_theory.bundled.has_coe_to_sort

/-- Construct a bundled `Group` from the underlying type and typeclass. -/
def of (X : Type u) [group X] : Group := category_theory.bundled.of X

/-- Construct a bundled `AddGroup` from the underlying type and typeclass. -/
protected instance group (G : Group) : group ↥G := category_theory.bundled.str G

@[simp] theorem coe_of (R : Type u) [group R] : ↥(of R) = R := rfl

protected instance Mathlib.AddGroup.has_zero : HasZero AddGroup := { zero := AddGroup.of PUnit }

protected instance inhabited : Inhabited Group := { default := 1 }

protected instance one.unique : unique ↥1 := unique.mk { default := 1 } sorry

@[simp] theorem one_apply (G : Group) (H : Group) (g : ↥G) : coe_fn 1 g = 1 := rfl

theorem ext (G : Group) (H : Group) (f₁ : G ⟶ H) (f₂ : G ⟶ H)
    (w : ∀ (x : ↥G), coe_fn f₁ x = coe_fn f₂ x) : f₁ = f₂ :=
  monoid_hom.ext fun (x : ↥G) => w x

-- should to_additive do this automatically?

protected instance Mathlib.AddGroup.has_forget_to_AddMon :
    category_theory.has_forget₂ AddGroup AddMon :=
  category_theory.bundled_hom.forget₂ add_monoid_hom add_group.to_add_monoid

end Group

/-- The category of commutative groups and group morphisms. -/
def AddCommGroup := category_theory.bundled add_comm_group

/-- The category of additive commutative groups and group morphisms. -/
/-- `Ab` is an abbreviation for `AddCommGroup`, for the sake of mathematicians' sanity. -/
def Ab := AddCommGroup

namespace CommGroup

protected instance comm_group.to_group.category_theory.bundled_hom.parent_projection :
    category_theory.bundled_hom.parent_projection comm_group.to_group :=
  category_theory.bundled_hom.parent_projection.mk

protected instance large_category : category_theory.large_category CommGroup :=
  category_theory.bundled_hom.category
    (category_theory.bundled_hom.map_hom
      (category_theory.bundled_hom.map_hom monoid_hom group.to_monoid) comm_group.to_group)

/-- Construct a bundled `CommGroup` from the underlying type and typeclass. -/
def of (G : Type u) [comm_group G] : CommGroup := category_theory.bundled.of G

/-- Construct a bundled `AddCommGroup` from the underlying type and typeclass. -/
protected instance Mathlib.AddCommGroup.add_comm_group_instance (G : AddCommGroup) :
    add_comm_group ↥G :=
  category_theory.bundled.str G

@[simp] theorem coe_of (R : Type u) [comm_group R] : ↥(of R) = R := rfl

protected instance Mathlib.AddCommGroup.has_zero : HasZero AddCommGroup :=
  { zero := AddCommGroup.of PUnit }

protected instance inhabited : Inhabited CommGroup := { default := 1 }

protected instance one.unique : unique ↥1 := unique.mk { default := 1 } sorry

@[simp] theorem one_apply (G : CommGroup) (H : CommGroup) (g : ↥G) : coe_fn 1 g = 1 := rfl

theorem ext (G : CommGroup) (H : CommGroup) (f₁ : G ⟶ H) (f₂ : G ⟶ H)
    (w : ∀ (x : ↥G), coe_fn f₁ x = coe_fn f₂ x) : f₁ = f₂ :=
  monoid_hom.ext fun (x : ↥G) => w x

protected instance Mathlib.AddCommGroup.has_forget_to_AddGroup :
    category_theory.has_forget₂ AddCommGroup AddGroup :=
  category_theory.bundled_hom.forget₂
    (category_theory.bundled_hom.map_hom add_monoid_hom add_group.to_add_monoid)
    add_comm_group.to_add_group

protected instance Mathlib.AddCommGroup.has_forget_to_AddCommMon :
    category_theory.has_forget₂ AddCommGroup AddCommMon :=
  category_theory.induced_category.has_forget₂ fun (G : AddCommGroup) => AddCommMon.of ↥G

end CommGroup

-- This example verifies an improvement possible in Lean 3.8.

-- Before that, to have `monoid_hom.map_map` usable by `simp` here,

-- we had to mark all the concrete category `has_coe_to_sort` instances reducible.

-- Now, it just works.

namespace AddCommGroup

/-- Any element of an abelian group gives a unique morphism from `ℤ` sending
`1` to that element. -/
-- Note that because `ℤ : Type 0`, this forces `G : AddCommGroup.{0}`,

-- so we write this explicitly to be clear.

-- TODO generalize this, requiring a `ulift_instances.lean` file

def as_hom {G : AddCommGroup} (g : ↥G) : of ℤ ⟶ G := coe_fn (gmultiples_hom ↥G) g

@[simp] theorem as_hom_apply {G : AddCommGroup} (g : ↥G) (i : ℤ) : coe_fn (as_hom g) i = i • g :=
  rfl

theorem as_hom_injective {G : AddCommGroup} : function.injective as_hom := sorry

theorem int_hom_ext {G : AddCommGroup} (f : of ℤ ⟶ G) (g : of ℤ ⟶ G) (w : coe_fn f 1 = coe_fn g 1) :
    f = g :=
  add_monoid_hom.ext_int w

-- TODO: this argument should be generalised to the situation where

-- the forgetful functor is representable.

theorem injective_of_mono {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H)
    [category_theory.mono f] : function.injective ⇑f :=
  sorry

end AddCommGroup

/-- Build an isomorphism in the category `Group` from a `mul_equiv` between `group`s. -/
def mul_equiv.to_Group_iso {X : Type u} {Y : Type u} [group X] [group Y] (e : X ≃* Y) :
    Group.of X ≅ Group.of Y :=
  category_theory.iso.mk (mul_equiv.to_monoid_hom e) (mul_equiv.to_monoid_hom (mul_equiv.symm e))

/-- Build an isomorphism in the category `AddGroup` from an `add_equiv` between `add_group`s. -/
/-- Build an isomorphism in the category `CommGroup` from a `mul_equiv` between `comm_group`s. -/
def add_equiv.to_AddCommGroup_iso {X : Type u} {Y : Type u} [add_comm_group X] [add_comm_group Y]
    (e : X ≃+ Y) : AddCommGroup.of X ≅ AddCommGroup.of Y :=
  category_theory.iso.mk (add_equiv.to_add_monoid_hom e)
    (add_equiv.to_add_monoid_hom (add_equiv.symm e))

/-- Build an isomorphism in the category `AddCommGroup` from a `add_equiv` between
`add_comm_group`s. -/
namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Group`. -/
@[simp] theorem Group_iso_to_add_equiv_apply {X : AddGroup} {Y : AddGroup} (i : X ≅ Y) :
    ∀ (ᾰ : ↥X), coe_fn (AddGroup_iso_to_add_equiv i) ᾰ = coe_fn (hom i) ᾰ :=
  fun (ᾰ : ↥X) => Eq.refl (coe_fn (hom i) ᾰ)

/-- Build a `mul_equiv` from an isomorphism in the category `CommGroup`. -/
@[simp] theorem CommGroup_iso_to_add_equiv_apply {X : AddCommGroup} {Y : AddCommGroup} (i : X ≅ Y) :
    ∀ (ᾰ : ↥X), coe_fn (AddCommGroup_iso_to_add_equiv i) ᾰ = coe_fn (hom i) ᾰ :=
  fun (ᾰ : ↥X) => Eq.refl (coe_fn (hom i) ᾰ)

end category_theory.iso

/-- multiplicative equivalences between `group`s are the same as (isomorphic to) isomorphisms
in `Group` -/
def add_equiv_iso_AddGroup_iso {X : Type u} {Y : Type u} [add_group X] [add_group Y] :
    X ≃+ Y ≅ AddGroup.of X ≅ AddGroup.of Y :=
  category_theory.iso.mk (fun (e : X ≃+ Y) => add_equiv.to_AddGroup_iso e)
    fun (i : AddGroup.of X ≅ AddGroup.of Y) => category_theory.iso.AddGroup_iso_to_add_equiv i

/-- multiplicative equivalences between `comm_group`s are the same as (isomorphic to) isomorphisms
in `CommGroup` -/
def mul_equiv_iso_CommGroup_iso {X : Type u} {Y : Type u} [comm_group X] [comm_group Y] :
    X ≃* Y ≅ CommGroup.of X ≅ CommGroup.of Y :=
  category_theory.iso.mk (fun (e : X ≃* Y) => mul_equiv.to_CommGroup_iso e)
    fun (i : CommGroup.of X ≅ CommGroup.of Y) => category_theory.iso.CommGroup_iso_to_mul_equiv i

namespace category_theory.Aut

/-- The (bundled) group of automorphisms of a type is isomorphic to the (bundled) group
of permutations. -/
def iso_perm {α : Type u} : Group.of (Aut α) ≅ Group.of (equiv.perm α) :=
  iso.mk (monoid_hom.mk (fun (g : ↥(Group.of (Aut α))) => iso.to_equiv g) sorry sorry)
    (monoid_hom.mk (fun (g : ↥(Group.of (equiv.perm α))) => equiv.to_iso g) sorry sorry)

/-- The (unbundled) group of automorphisms of a type is `mul_equiv` to the (unbundled) group
of permutations. -/
def mul_equiv_perm {α : Type u} : Aut α ≃* equiv.perm α := iso.Group_iso_to_mul_equiv iso_perm

end category_theory.Aut

protected instance Group.forget_reflects_isos :
    category_theory.reflects_isomorphisms (category_theory.forget Group) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : Group) (f : X ⟶ Y)
      (_x :
      category_theory.is_iso (category_theory.functor.map (category_theory.forget Group) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget Group) X ≅
          category_theory.functor.obj (category_theory.forget Group) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget Group) f);
      let e : ↥X ≃* ↥Y :=
        mul_equiv.mk (monoid_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry
          sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (mul_equiv.to_Group_iso e))

protected instance CommGroup.forget_reflects_isos :
    category_theory.reflects_isomorphisms (category_theory.forget CommGroup) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : CommGroup) (f : X ⟶ Y)
      (_x :
      category_theory.is_iso (category_theory.functor.map (category_theory.forget CommGroup) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget CommGroup) X ≅
          category_theory.functor.obj (category_theory.forget CommGroup) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget CommGroup) f);
      let e : ↥X ≃* ↥Y :=
        mul_equiv.mk (monoid_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry
          sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (mul_equiv.to_CommGroup_iso e))

end Mathlib


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.basic
import Mathlib.data.set.finite
import Mathlib.group_theory.submonoid.basic
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Pointwise addition, multiplication, and scalar multiplication of sets.

This file defines pointwise algebraic operations on sets.
* For a type `α` with multiplication, multiplication is defined on `set α` by taking
  `s * t` to be the set of all `x * y` where `x ∈ s` and `y ∈ t`. Similarly for addition.
* For `α` a semigroup, `set α` is a semigroup.
* If `α` is a (commutative) monoid, we define an alias `set_semiring α` for `set α`, which then
  becomes a (commutative) semiring with union as addition and pointwise multiplication as
  multiplication.
* For a type `β` with scalar multiplication by another type `α`, this
  file defines a scalar multiplication of `set β` by `set α` and a separate scalar
  multiplication of `set β` by `α`.
* We also define pointwise multiplication on `finset`.

Appropriate definitions and results are also transported to the additive theory via `to_additive`.

## Implementation notes
* The following expressions are considered in simp-normal form in a group:
  `(λ h, h * g) ⁻¹' s`, `(λ h, g * h) ⁻¹' s`, `(λ h, h * g⁻¹) ⁻¹' s`, `(λ h, g⁻¹ * h) ⁻¹' s`,
  `s * t`, `s⁻¹`, `(1 : set _)` (and similarly for additive variants).
  Expressions equal to one of these will be simplified.

## Tags

set multiplication, set addition, pointwise addition, pointwise multiplication

-/

namespace set

/-! ### Properties about 1 -/

protected instance has_one {α : Type u_1} [HasOne α] : HasOne (set α) :=
  { one := singleton 1 }

theorem singleton_one {α : Type u_1} [HasOne α] : singleton 1 = 1 :=
  rfl

@[simp] theorem mem_zero {α : Type u_1} {a : α} [HasZero α] : a ∈ 0 ↔ a = 0 :=
  iff.rfl

theorem one_mem_one {α : Type u_1} [HasOne α] : 1 ∈ 1 :=
  Eq.refl 1

@[simp] theorem zero_subset {α : Type u_1} {s : set α} [HasZero α] : 0 ⊆ s ↔ 0 ∈ s :=
  singleton_subset_iff

theorem zero_nonempty {α : Type u_1} [HasZero α] : set.nonempty 0 :=
  Exists.intro 0 rfl

@[simp] theorem image_zero {α : Type u_1} {β : Type u_2} [HasZero α] {f : α → β} : f '' 0 = singleton (f 0) :=
  image_singleton

/-! ### Properties about multiplication -/

protected instance has_add {α : Type u_1} [Add α] : Add (set α) :=
  { add := image2 Add.add }

@[simp] theorem image2_mul {α : Type u_1} {s : set α} {t : set α} [Mul α] : image2 Mul.mul s t = s * t :=
  rfl

theorem mem_add {α : Type u_1} {s : set α} {t : set α} {a : α} [Add α] : a ∈ s + t ↔ ∃ (x : α), ∃ (y : α), x ∈ s ∧ y ∈ t ∧ x + y = a :=
  iff.rfl

theorem mul_mem_mul {α : Type u_1} {s : set α} {t : set α} {a : α} {b : α} [Mul α] (ha : a ∈ s) (hb : b ∈ t) : a * b ∈ s * t :=
  mem_image2_of_mem ha hb

theorem add_image_prod {α : Type u_1} {s : set α} {t : set α} [Add α] : (fun (x : α × α) => prod.fst x + prod.snd x) '' set.prod s t = s + t :=
  image_prod Add.add

@[simp] theorem image_mul_left {α : Type u_1} {t : set α} {a : α} [group α] : (fun (b : α) => a * b) '' t = (fun (b : α) => a⁻¹ * b) ⁻¹' t := sorry

@[simp] theorem image_add_right {α : Type u_1} {t : set α} {b : α} [add_group α] : (fun (a : α) => a + b) '' t = (fun (a : α) => a + -b) ⁻¹' t := sorry

theorem image_add_left' {α : Type u_1} {t : set α} {a : α} [add_group α] : (fun (b : α) => -a + b) '' t = (fun (b : α) => a + b) ⁻¹' t := sorry

theorem image_mul_right' {α : Type u_1} {t : set α} {b : α} [group α] : (fun (a : α) => a * (b⁻¹)) '' t = (fun (a : α) => a * b) ⁻¹' t := sorry

@[simp] theorem preimage_add_left_singleton {α : Type u_1} {a : α} {b : α} [add_group α] : Add.add a ⁻¹' singleton b = singleton (-a + b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Add.add a ⁻¹' singleton b = singleton (-a + b))) (Eq.symm image_add_left')))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((fun (b : α) => -a + b) '' singleton b = singleton (-a + b))) image_singleton))
      (Eq.refl (singleton (-a + b))))

@[simp] theorem preimage_mul_right_singleton {α : Type u_1} {a : α} {b : α} [group α] : (fun (_x : α) => _x * a) ⁻¹' singleton b = singleton (b * (a⁻¹)) := sorry

@[simp] theorem preimage_add_left_zero {α : Type u_1} {a : α} [add_group α] : (fun (b : α) => a + b) ⁻¹' 0 = singleton (-a) := sorry

@[simp] theorem preimage_mul_right_one {α : Type u_1} {b : α} [group α] : (fun (a : α) => a * b) ⁻¹' 1 = singleton (b⁻¹) := sorry

theorem preimage_add_left_zero' {α : Type u_1} {a : α} [add_group α] : (fun (b : α) => -a + b) ⁻¹' 0 = singleton a := sorry

theorem preimage_add_right_zero' {α : Type u_1} {b : α} [add_group α] : (fun (a : α) => a + -b) ⁻¹' 0 = singleton b := sorry

@[simp] theorem mul_singleton {α : Type u_1} {s : set α} {b : α} [Mul α] : s * singleton b = (fun (a : α) => a * b) '' s :=
  image2_singleton_right

@[simp] theorem singleton_add {α : Type u_1} {t : set α} {a : α} [Add α] : singleton a + t = (fun (b : α) => a + b) '' t :=
  image2_singleton_left

@[simp] theorem singleton_add_singleton {α : Type u_1} {a : α} {b : α} [Add α] : singleton a + singleton b = singleton (a + b) :=
  image2_singleton

protected instance semigroup {α : Type u_1} [semigroup α] : semigroup (set α) :=
  semigroup.mk Mul.mul sorry

protected instance monoid {α : Type u_1} [monoid α] : monoid (set α) :=
  monoid.mk semigroup.mul sorry 1 sorry sorry

protected theorem mul_comm {α : Type u_1} {s : set α} {t : set α} [comm_semigroup α] : s * t = t * s := sorry

protected instance add_comm_monoid {α : Type u_1} [add_comm_monoid α] : add_comm_monoid (set α) :=
  add_comm_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry sorry

theorem singleton.is_mul_hom {α : Type u_1} [Mul α] : is_mul_hom singleton :=
  is_mul_hom.mk fun (a b : α) => Eq.symm singleton_mul_singleton

@[simp] theorem empty_add {α : Type u_1} {s : set α} [Add α] : ∅ + s = ∅ :=
  image2_empty_left

@[simp] theorem mul_empty {α : Type u_1} {s : set α} [Mul α] : s * ∅ = ∅ :=
  image2_empty_right

theorem add_subset_add {α : Type u_1} {s₁ : set α} {s₂ : set α} {t₁ : set α} {t₂ : set α} [Add α] (h₁ : s₁ ⊆ t₁) (h₂ : s₂ ⊆ t₂) : s₁ + s₂ ⊆ t₁ + t₂ :=
  image2_subset h₁ h₂

theorem union_add {α : Type u_1} {s : set α} {t : set α} {u : set α} [Add α] : s ∪ t + u = s + u ∪ (t + u) :=
  image2_union_left

theorem mul_union {α : Type u_1} {s : set α} {t : set α} {u : set α} [Mul α] : s * (t ∪ u) = s * t ∪ s * u :=
  image2_union_right

theorem Union_mul_left_image {α : Type u_1} {s : set α} {t : set α} [Mul α] : (Union fun (a : α) => Union fun (H : a ∈ s) => (fun (x : α) => a * x) '' t) = s * t :=
  Union_image_left fun (a x : α) => a * x

theorem Union_mul_right_image {α : Type u_1} {s : set α} {t : set α} [Mul α] : (Union fun (a : α) => Union fun (H : a ∈ t) => (fun (x : α) => x * a) '' s) = s * t :=
  Union_image_right fun (x a : α) => x * a

@[simp] theorem univ_mul_univ {α : Type u_1} [monoid α] : univ * univ = univ := sorry

/-- `singleton` is a monoid hom. -/
def singleton_add_hom {α : Type u_1} [add_monoid α] : α →+ set α :=
  add_monoid_hom.mk singleton sorry sorry

theorem nonempty.add {α : Type u_1} {s : set α} {t : set α} [Add α] : set.nonempty s → set.nonempty t → set.nonempty (s + t) :=
  nonempty.image2

theorem finite.mul {α : Type u_1} {s : set α} {t : set α} [Mul α] (hs : finite s) (ht : finite t) : finite (s * t) :=
  finite.image2 (fun (a b : α) => a * b) hs ht

/-- multiplication preserves finiteness -/
def fintype_mul {α : Type u_1} [Mul α] [DecidableEq α] (s : set α) (t : set α) [hs : fintype ↥s] [ht : fintype ↥t] : fintype ↥(s * t) :=
  set.fintype_image2 (fun (a b : α) => a * b) s t

theorem bdd_above_add {α : Type u_1} [ordered_add_comm_monoid α] {A : set α} {B : set α} : bdd_above A → bdd_above B → bdd_above (A + B) := sorry

/-! ### Properties about inversion -/

protected instance has_inv {α : Type u_1} [has_inv α] : has_inv (set α) :=
  has_inv.mk (preimage has_inv.inv)

@[simp] theorem mem_inv {α : Type u_1} {s : set α} {a : α} [has_inv α] : a ∈ (s⁻¹) ↔ a⁻¹ ∈ s :=
  iff.rfl

theorem inv_mem_inv {α : Type u_1} {s : set α} {a : α} [group α] : a⁻¹ ∈ (s⁻¹) ↔ a ∈ s := sorry

@[simp] theorem inv_preimage {α : Type u_1} {s : set α} [has_inv α] : has_inv.inv ⁻¹' s = (s⁻¹) :=
  rfl

@[simp] theorem image_inv {α : Type u_1} {s : set α} [group α] : has_inv.inv '' s = (s⁻¹) := sorry

@[simp] theorem inter_neg {α : Type u_1} {s : set α} {t : set α} [Neg α] : -(s ∩ t) = -s ∩ -t :=
  preimage_inter

@[simp] theorem union_neg {α : Type u_1} {s : set α} {t : set α} [Neg α] : -(s ∪ t) = -s ∪ -t :=
  preimage_union

@[simp] theorem compl_inv {α : Type u_1} {s : set α} [has_inv α] : sᶜ⁻¹ = (s⁻¹ᶜ) :=
  preimage_compl

@[simp] protected theorem inv_inv {α : Type u_1} {s : set α} [group α] : s⁻¹⁻¹ = s := sorry

@[simp] protected theorem univ_inv {α : Type u_1} [group α] : univ⁻¹ = univ :=
  preimage_univ

@[simp] theorem neg_subset_neg {α : Type u_1} [add_group α] {s : set α} {t : set α} : -s ⊆ -t ↔ s ⊆ t :=
  function.surjective.preimage_subset_preimage_iff (equiv.surjective (equiv.neg α))

theorem neg_subset {α : Type u_1} [add_group α] {s : set α} {t : set α} : -s ⊆ t ↔ s ⊆ -t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-s ⊆ t ↔ s ⊆ -t)) (Eq.symm (propext neg_subset_neg))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ( --s ⊆ -t ↔ s ⊆ -t)) set.neg_neg)) (iff.refl (s ⊆ -t)))

/-! ### Properties about scalar multiplication -/

/-- Scaling a set: multiplying every element by a scalar. -/
protected instance has_scalar_set {α : Type u_1} {β : Type u_2} [has_scalar α β] : has_scalar α (set β) :=
  has_scalar.mk fun (a : α) => image (has_scalar.smul a)

@[simp] theorem image_smul {α : Type u_1} {β : Type u_2} {a : α} [has_scalar α β] {t : set β} : (fun (x : β) => a • x) '' t = a • t :=
  rfl

theorem mem_smul_set {α : Type u_1} {β : Type u_2} {a : α} {x : β} [has_scalar α β] {t : set β} : x ∈ a • t ↔ ∃ (y : β), y ∈ t ∧ a • y = x :=
  iff.rfl

theorem smul_mem_smul_set {α : Type u_1} {β : Type u_2} {a : α} {y : β} [has_scalar α β] {t : set β} (hy : y ∈ t) : a • y ∈ a • t :=
  Exists.intro y { left := hy, right := rfl }

theorem smul_set_union {α : Type u_1} {β : Type u_2} {a : α} [has_scalar α β] {s : set β} {t : set β} : a • (s ∪ t) = a • s ∪ a • t := sorry

@[simp] theorem smul_set_empty {α : Type u_1} {β : Type u_2} [has_scalar α β] (a : α) : a • ∅ = ∅ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a • ∅ = ∅)) (Eq.symm image_smul)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((fun (x : β) => a • x) '' ∅ = ∅)) (image_empty fun (x : β) => a • x))) (Eq.refl ∅))

theorem smul_set_mono {α : Type u_1} {β : Type u_2} {a : α} [has_scalar α β] {s : set β} {t : set β} (h : s ⊆ t) : a • s ⊆ a • t := sorry

/-- Pointwise scalar multiplication by a set of scalars. -/
protected instance has_scalar {α : Type u_1} {β : Type u_2} [has_scalar α β] : has_scalar (set α) (set β) :=
  has_scalar.mk (image2 has_scalar.smul)

@[simp] theorem image2_smul {α : Type u_1} {β : Type u_2} {s : set α} [has_scalar α β] {t : set β} : image2 has_scalar.smul s t = s • t :=
  rfl

theorem mem_smul {α : Type u_1} {β : Type u_2} {s : set α} {x : β} [has_scalar α β] {t : set β} : x ∈ s • t ↔ ∃ (a : α), ∃ (y : β), a ∈ s ∧ y ∈ t ∧ a • y = x :=
  iff.rfl

theorem image_smul_prod {α : Type u_1} {β : Type u_2} {s : set α} [has_scalar α β] {t : set β} : (fun (x : α × β) => prod.fst x • prod.snd x) '' set.prod s t = s • t :=
  image_prod has_scalar.smul

theorem range_smul_range {α : Type u_1} {β : Type u_2} [has_scalar α β] {ι : Type u_3} {κ : Type u_4} (b : ι → α) (c : κ → β) : range b • range c = range fun (p : ι × κ) => b (prod.fst p) • c (prod.snd p) := sorry

theorem singleton_smul {α : Type u_1} {β : Type u_2} {a : α} [has_scalar α β] {t : set β} : singleton a • t = a • t :=
  image2_singleton_left

/-! ### `set α` as a `(∪,*)`-semiring -/

/-- An alias for `set α`, which has a semiring structure given by `∪` as "addition" and pointwise
  multiplication `*` as "multiplication". -/
def set_semiring (α : Type u_1) :=
  set α

/-- The identitiy function `set α → set_semiring α`. -/
/-- The identitiy function `set_semiring α → set α`. -/
protected def up {α : Type u_1} (s : set α) : set_semiring α :=
  s

protected def set_semiring.down {α : Type u_1} (s : set_semiring α) : set α :=
  s

@[simp] protected theorem down_up {α : Type u_1} {s : set α} : set_semiring.down (set.up s) = s :=
  rfl

@[simp] protected theorem up_down {α : Type u_1} {s : set_semiring α} : set.up (set_semiring.down s) = s :=
  rfl

protected instance set_semiring.semiring {α : Type u_1} [monoid α] : semiring (set_semiring α) :=
  semiring.mk (fun (s t : set_semiring α) => s ∪ t) union_assoc ∅ empty_union union_empty union_comm monoid.mul sorry
    monoid.one sorry sorry sorry sorry sorry sorry

protected instance set_semiring.comm_semiring {α : Type u_1} [comm_monoid α] : comm_semiring (set_semiring α) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry comm_monoid.mul sorry comm_monoid.one sorry sorry
    sorry sorry sorry sorry sorry

/-- A multiplicative action of a monoid on a type β gives also a
 multiplicative action on the subsets of β. -/
protected instance mul_action_set {α : Type u_1} {β : Type u_2} [monoid α] [mul_action α β] : mul_action α (set β) :=
  mul_action.mk sorry sorry

theorem image_add {α : Type u_1} {β : Type u_2} {s : set α} {t : set α} [Add α] [Add β] (m : α → β) [is_add_hom m] : m '' (s + t) = m '' s + m '' t := sorry

theorem preimage_mul_preimage_subset {α : Type u_1} {β : Type u_2} [Mul α] [Mul β] (m : α → β) [is_mul_hom m] {s : set β} {t : set β} : m ⁻¹' s * m ⁻¹' t ⊆ m ⁻¹' (s * t) := sorry

/-- The image of a set under function is a ring homomorphism
with respect to the pointwise operations on sets. -/
def image_hom {α : Type u_1} {β : Type u_2} [monoid α] [monoid β] (f : α →* β) : set_semiring α →+* set_semiring β :=
  ring_hom.mk (image ⇑f) sorry sorry sorry sorry

end set

/-- A nonempty set in a semimodule is scaled by zero to the singleton
containing 0 in the semimodule. -/
theorem zero_smul_set {α : Type u_1} {β : Type u_2} [semiring α] [add_comm_monoid β] [semimodule α β] {s : set β} (h : set.nonempty s) : 0 • s = 0 := sorry

theorem mem_inv_smul_set_iff {α : Type u_1} {β : Type u_2} [field α] [mul_action α β] {a : α} (ha : a ≠ 0) (A : set β) (x : β) : x ∈ a⁻¹ • A ↔ a • x ∈ A := sorry

theorem mem_smul_set_iff_inv_smul_mem {α : Type u_1} {β : Type u_2} [field α] [mul_action α β] {a : α} (ha : a ≠ 0) (A : set β) (x : β) : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (x ∈ a • A ↔ a⁻¹ • x ∈ A)) (Eq.symm (propext (mem_inv_smul_set_iff (inv_ne_zero ha) A x)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ∈ a • A ↔ x ∈ a⁻¹⁻¹ • A)) (inv_inv' a))) (iff.refl (x ∈ a • A)))

namespace finset

/-- The pointwise product of two finite sets `s` and `t`:
  `st = s ⬝ t = s * t = { x * y | x ∈ s, y ∈ t }`. -/
protected instance has_add {α : Type u_1} [DecidableEq α] [Add α] : Add (finset α) :=
  { add := fun (s t : finset α) => image (fun (p : α × α) => prod.fst p + prod.snd p) (finset.product s t) }

theorem mul_def {α : Type u_1} [DecidableEq α] [Mul α] {s : finset α} {t : finset α} : s * t = image (fun (p : α × α) => prod.fst p * prod.snd p) (finset.product s t) :=
  rfl

theorem mem_add {α : Type u_1} [DecidableEq α] [Add α] {s : finset α} {t : finset α} {x : α} : x ∈ s + t ↔ ∃ (y : α), ∃ (z : α), y ∈ s ∧ z ∈ t ∧ y + z = x := sorry

@[simp] theorem coe_add {α : Type u_1} [DecidableEq α] [Add α] {s : finset α} {t : finset α} : ↑(s + t) = ↑s + ↑t := sorry

theorem mul_mem_mul {α : Type u_1} [DecidableEq α] [Mul α] {s : finset α} {t : finset α} {x : α} {y : α} (hx : x ∈ s) (hy : y ∈ t) : x * y ∈ s * t :=
  eq.mpr (id (propext mem_mul)) (Exists.intro x (Exists.intro y { left := hx, right := { left := hy, right := rfl } }))

theorem add_card_le {α : Type u_1} [DecidableEq α] [Add α] {s : finset α} {t : finset α} : card (s + t) ≤ card s * card t := sorry

theorem mul_card_le {α : Type u_1} [DecidableEq α] [Mul α] {s : finset α} {t : finset α} : card (s * t) ≤ card s * card t := sorry

/-- A finite set `U` contained in the product of two sets `S * S'` is also contained in the product
of two finite sets `T * T' ⊆ S * S'`. -/
theorem subset_add {M : Type u_1} [add_monoid M] {S : set M} {S' : set M} {U : finset M} (f : ↑U ⊆ S + S') : ∃ (T : finset M), ∃ (T' : finset M), ↑T ⊆ S ∧ ↑T' ⊆ S' ∧ U ⊆ T + T' := sorry

end finset

/-! Some lemmas about pointwise multiplication and submonoids. Ideally we put these in
  `group_theory.submonoid.basic`, but currently we cannot because that file is imported by this. -/

namespace submonoid

theorem mul_subset {M : Type u_1} [monoid M] {s : set M} {t : set M} {S : submonoid M} (hs : s ⊆ ↑S) (ht : t ⊆ ↑S) : s * t ⊆ ↑S := sorry

theorem mul_subset_closure {M : Type u_1} [monoid M] {s : set M} {t : set M} {u : set M} (hs : s ⊆ u) (ht : t ⊆ u) : s * t ⊆ ↑(closure u) :=
  mul_subset (set.subset.trans hs subset_closure) (set.subset.trans ht subset_closure)

theorem Mathlib.add_submonoid.coe_add_self_eq {M : Type u_1} [add_monoid M] (s : add_submonoid M) : ↑s + ↑s = ↑s := sorry


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.applicative
import control.traversable.basic

/-!
# Traversing collections

This file proves basic properties of traversable and applicative functors and defines
`pure_transformation F`, the natural applicative transformation from the identity functor to `F`.

## References

Inspired by [The Essence of the Iterator Pattern][gibbons2009].
-/

universes u

open is_lawful_traversable
open function (hiding comp)
open functor

attribute [functor_norm] is_lawful_traversable.naturality
attribute [simp] is_lawful_traversable.id_traverse

namespace traversable

variable {t : Type u → Type u}
variables [traversable t] [is_lawful_traversable t]
variables F G : Type u → Type u

variables [applicative F] [is_lawful_applicative F]
variables [applicative G] [is_lawful_applicative G]
variables {α β γ : Type u}
variables g : α → F β
variables h : β → G γ
variables f : β → γ

/-- The natural applicative transformation from the identity functor
to `F`, defined by `pure : Π {α}, α → F α`. -/
def pure_transformation : applicative_transformation id F :=
{ app := @pure F _,
  preserves_pure' := λ α x, rfl,
  preserves_seq' := λ α β f x, by { simp only [map_pure, seq_pure], refl } }

@[simp] theorem pure_transformation_apply {α} (x : id α) : pure_transformation F x = pure x := rfl

variables {F G} (x : t β)

lemma map_eq_traverse_id : map f = @traverse t _ _ _ _ _ (id.mk ∘ f) :=
funext $ λ y, (traverse_eq_map_id f y).symm

theorem map_traverse (x : t α) : map f <$> traverse g x = traverse (map f ∘ g) x :=
begin
  rw @map_eq_traverse_id t _ _ _ _ f,
  refine (comp_traverse (id.mk ∘ f) g x).symm.trans _,
  congr, apply comp.applicative_comp_id
end

theorem traverse_map (f : β → F γ) (g : α → β) (x : t α) :
  traverse f (g <$> x) = traverse (f ∘ g) x :=
begin
  rw @map_eq_traverse_id t _ _ _ _ g,
  refine (comp_traverse f (id.mk ∘ g) x).symm.trans _,
  congr, apply comp.applicative_id_comp
end

lemma pure_traverse (x : t α) : traverse pure x = (pure x : F (t α)) :=
by have : traverse pure x = pure (traverse id.mk x) :=
     (naturality (pure_transformation F) id.mk x).symm;
   rwa id_traverse at this

lemma id_sequence (x : t α) : sequence (id.mk <$> x) = id.mk x :=
by simp [sequence, traverse_map, id_traverse]; refl

lemma comp_sequence (x : t (F (G α))) :
  sequence (comp.mk <$> x) = comp.mk (sequence <$> sequence x) :=
by simp [sequence, traverse_map]; rw ← comp_traverse; simp [map_id]

lemma naturality' (η : applicative_transformation F G) (x : t (F α)) :
  η (sequence x) = sequence (@η _ <$> x) :=
by simp [sequence, naturality, traverse_map]

@[functor_norm]
lemma traverse_id : traverse id.mk = (id.mk : t α → id (t α)) :=
by { ext, exact id_traverse _ }

@[functor_norm]
lemma traverse_comp (g : α → F β) (h : β → G γ) :
  traverse (comp.mk ∘ map h ∘ g) =
  (comp.mk ∘ map (traverse h) ∘ traverse g : t α → comp F G (t γ)) :=
by { ext, exact comp_traverse _ _ _ }

lemma traverse_eq_map_id' (f : β → γ) : traverse (id.mk ∘ f) = id.mk ∘ (map f : t β → t γ) :=
by { ext, exact traverse_eq_map_id _ _ }

-- @[functor_norm]
lemma traverse_map' (g : α → β) (h : β → G γ) :
  traverse (h ∘ g) = (traverse h ∘ map g : t α → G (t γ)) :=
by { ext, rw [comp_app, traverse_map] }

lemma map_traverse' (g : α → G β) (h : β → γ) :
  traverse (map h ∘ g) = (map (map h) ∘ traverse g : t α → G (t γ)) :=
by { ext, rw [comp_app, map_traverse] }

lemma naturality_pf (η : applicative_transformation F G) (f : α → F β) :
  traverse (@η _ ∘ f) = @η _ ∘ (traverse f : t α → F (t β)) :=
by { ext, rw [comp_app, naturality] }

end traversable


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.preserves.finite

/-!
# Bundled exact functors

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

We say that a functor `F` is left exact if it preserves finite limits, it is right exact if it
preserves finite colimits, and it is exact if it is both left exact and right exact.

In this file, we define the categories of bundled left exact, right exact and exact functors.

-/

universes v₁ v₂ u₁ u₂

open category_theory.limits

namespace category_theory
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

section
variables (C) (D)

/-- Bundled left-exact functors. -/
@[derive category, nolint has_nonempty_instance]
def LeftExactFunctor :=
full_subcategory (λ F : C ⥤ D, nonempty (preserves_finite_limits F))

infixr ` ⥤ₗ `:26 := LeftExactFunctor

/-- A left exact functor is in particular a functor. -/
@[derive full, derive faithful]
def LeftExactFunctor.forget : (C ⥤ₗ D) ⥤ (C ⥤ D) :=
full_subcategory_inclusion _

/-- Bundled right-exact functors. -/
@[derive category, nolint has_nonempty_instance]
def RightExactFunctor :=
full_subcategory (λ F : C ⥤ D, nonempty (preserves_finite_colimits F))

infixr ` ⥤ᵣ `:26 := RightExactFunctor

/-- A right exact functor is in particular a functor. -/
@[derive full, derive faithful]
def RightExactFunctor.forget : (C ⥤ᵣ D) ⥤ (C ⥤ D) :=
full_subcategory_inclusion _

/-- Bundled exact functors. -/
@[derive category, nolint has_nonempty_instance]
def ExactFunctor := full_subcategory
  (λ F : C ⥤ D, nonempty (preserves_finite_limits F) ∧ nonempty (preserves_finite_colimits F))

infixr ` ⥤ₑ `:26 := ExactFunctor

/-- An exact functor is in particular a functor. -/
@[derive full, derive faithful]
def ExactFunctor.forget : (C ⥤ₑ D) ⥤ (C ⥤ D) :=
full_subcategory_inclusion _

/-- Turn an exact functor into a left exact functor. -/
@[derive full, derive faithful]
def LeftExactFunctor.of_exact : (C ⥤ₑ D) ⥤ (C ⥤ₗ D) :=
full_subcategory.map (λ X, and.left)

/-- Turn an exact functor into a left exact functor. -/
@[derive full, derive faithful]
def RightExactFunctor.of_exact : (C ⥤ₑ D) ⥤ (C ⥤ᵣ D) :=
full_subcategory.map (λ X, and.right)

variables {C D}

@[simp] lemma LeftExactFunctor.of_exact_obj (F : C ⥤ₑ D) :
  (LeftExactFunctor.of_exact C D).obj F = ⟨F.1, F.2.1⟩ := rfl
@[simp] lemma RightExactFunctor.of_exact_obj (F : C ⥤ₑ D) :
  (RightExactFunctor.of_exact C D).obj F = ⟨F.1, F.2.2⟩ := rfl

@[simp] lemma LeftExactFunctor.of_exact_map {F G : C ⥤ₑ D} (α : F ⟶ G) :
  (LeftExactFunctor.of_exact C D).map α = α := rfl
@[simp] lemma RightExactFunctor.of_exact_map {F G : C ⥤ₑ D} (α : F ⟶ G) :
  (RightExactFunctor.of_exact C D).map α = α := rfl

@[simp]

@[simp] lemma LeftExactFunctor.forget_map {F G : C ⥤ₗ D} (α : F ⟶ G) :
  (LeftExactFunctor.forget C D).map α = α := rfl
@[simp] lemma RightExactFunctor.forget_map {F G : C ⥤ᵣ D} (α : F ⟶ G) :
  (RightExactFunctor.forget C D).map α = α := rfl
@[simp] lemma ExactFunctor.forget_map {F G : C ⥤ₑ D} (α : F ⟶ G) :
  (ExactFunctor.forget C D).map α = α := rfl

/-- Turn a left exact functor into an object of the category `LeftExactFunctor C D`. -/
def LeftExactFunctor.of (F : C ⥤ D) [preserves_finite_limits F] : C ⥤ₗ D := ⟨F, ⟨infer_instance⟩⟩
/-- Turn a right exact functor into an object of the category `RightExactFunctor C D`. -/
def RightExactFunctor.of (F : C ⥤ D) [preserves_finite_colimits F] : C ⥤ᵣ D :=
⟨F, ⟨infer_instance⟩⟩
/-- Turn an exact functor into an object of the category `ExactFunctor C D`. -/
def ExactFunctor.of (F : C ⥤ D) [preserves_finite_limits F] [preserves_finite_colimits F] :
  C ⥤ₑ D := ⟨F, ⟨⟨infer_instance⟩, ⟨infer_instance⟩⟩⟩

@[simp] lemma LeftExactFunctor.of_fst (F : C ⥤ D) [preserves_finite_limits F] :
  (LeftExactFunctor.of F).obj = F := rfl
@[simp] lemma RightExactFunctor.of_fst (F : C ⥤ D) [preserves_finite_colimits F] :
  (RightExactFunctor.of F).obj = F := rfl
@[simp] lemma ExactFunctor.of_fst (F : C ⥤ D) [preserves_finite_limits F]
  [preserves_finite_colimits F] : (ExactFunctor.of F).obj = F := rfl

lemma LeftExactFunctor.forget_obj_of (F : C ⥤ D) [preserves_finite_limits F] :
  (LeftExactFunctor.forget C D).obj (LeftExactFunctor.of F) = F := rfl
lemma RightExactFunctor.forget_obj_of (F : C ⥤ D) [preserves_finite_colimits F] :
  (RightExactFunctor.forget C D).obj (RightExactFunctor.of F) = F := rfl
lemma ExactFunctor.forget_obj_of (F : C ⥤ D) [preserves_finite_limits F]
  [preserves_finite_colimits F] : (ExactFunctor.forget C D).obj (ExactFunctor.of F) = F := rfl

noncomputable instance (F : C ⥤ₗ D) : preserves_finite_limits F.obj := F.property.some
noncomputable instance (F : C ⥤ᵣ D) : preserves_finite_colimits F.obj := F.property.some
noncomputable instance (F : C ⥤ₑ D) : preserves_finite_limits F.obj := F.property.1.some
noncomputable instance (F : C ⥤ₑ D) : preserves_finite_colimits F.obj := F.property.2.some

end

end category_theory


def is_smooth {α β} (f : α → β) : Prop := sorry

class IsSmooth {α β} (f : α → β) : Prop where
  (proof : is_smooth f)

instance identity : IsSmooth fun a : α => a := sorry
instance const (b : β) : IsSmooth fun a : α => b := sorry
instance swap (f : α → β → γ) [∀ a, IsSmooth (f a)] : IsSmooth (λ b a => f a b) := sorry
instance parm (f : α → β → γ) [IsSmooth f] (b : β) : IsSmooth (λ a => f a b) := sorry
instance comp (f : β → γ) (g : α → β) [IsSmooth f] [IsSmooth g] : IsSmooth (fun a => f (g a)) := sorry
instance diag (f : β → δ → γ) (g : α → β) (h : α → δ) [IsSmooth f] [∀ b, IsSmooth (f b)] [IsSmooth g] [IsSmooth h] : IsSmooth (λ a => f (g a) (h a)) := sorry

example (f : β → δ → γ) [IsSmooth f] (g : α → β) [IsSmooth g] (d : δ) : IsSmooth (λ a => f (g a) d) := by infer_instance
example (f : β → δ → γ) [IsSmooth f] (g : α → β) [IsSmooth g] : IsSmooth (λ a d => f (g a) d) := by infer_instance
example (f : β → δ → γ) [IsSmooth f] (g : α → β) [IsSmooth g] (h : α → α) [IsSmooth h] (d : δ) : IsSmooth (λ a => f (g (h a)) d) := by infer_instance
example (f : α → β → γ) [∀ a, IsSmooth (f a)] : IsSmooth (λ b a => f a b) := by infer_instance
example (f : α → β → γ → δ) [∀ a b, IsSmooth (f a b)] : IsSmooth (λ c b a => f a b c) := by infer_instance
example (f : α → β → γ → δ) [∀ a b, IsSmooth (f a b)] : IsSmooth (λ c a b => f a b c) := by infer_instance
example (f : α → β → γ → δ → ε) [∀ a b c, IsSmooth (f a b c)] : IsSmooth (λ d a b c => f a b c d) := by infer_instance
example (f : α → β → γ) [IsSmooth f] (b : β) : IsSmooth (λ a => f a b) := by infer_instance
example (f : α → β → γ → δ) [IsSmooth f] (b : β) (c : γ) : IsSmooth (λ a => f a b c) := by infer_instance
example (f : α → β → γ → δ) [IsSmooth f] (b : β) : IsSmooth (λ a c => f a b c) := by infer_instance
example (f : α → β → γ → δ) [IsSmooth f] (c : γ) : IsSmooth (λ a b => f a b c) := by infer_instance
example (f : α → β → γ → δ) (b : β) [IsSmooth (λ a => f a b)] : IsSmooth (λ a c => f a b c) := by infer_instance
example (f : α → β → γ) (g : δ → ε → α) (h : δ → ε → β) [IsSmooth f] [∀ a, IsSmooth (f a)] [IsSmooth g] [IsSmooth h] : IsSmooth (λ x y => f (g x y) (h x y)) := by infer_instance
example (f : β → δ → γ) (g : α → β) [IsSmooth f] [∀ b, IsSmooth (f b)] [IsSmooth g] (a : α): IsSmooth (λ (h : α → δ) => f (g a) (h a)) := by infer_instance
example (f : β → δ → γ) (h : α → δ) [IsSmooth f] : IsSmooth (λ (g : α → β) a => f (g a) (h a)) := by infer_instance
example (f : β → δ → γ) [IsSmooth f] (d : δ) : IsSmooth (λ (g : α → β) a => f (g a) d) := by infer_instance
example (f : β → γ) (g : β → β) [IsSmooth f] [IsSmooth g] : IsSmooth (fun x => f (g (g x))) := by infer_instance
example (f : α → β → γ) [∀ a, IsSmooth (f a)] : IsSmooth (λ b a => f a b) := by infer_instance
example (f : α → β → γ → δ) [∀ a b, IsSmooth (f a b)] : IsSmooth (λ c a b => f a b c) := by infer_instance
example (f : α → β → γ → δ → ε) [∀ a b c, IsSmooth (f a b c)] : IsSmooth (λ d a b c => f a b c d) := by infer_instance
example (f : β → δ → γ) [IsSmooth f] (g : α → β) [IsSmooth g] (d : δ) : IsSmooth (λ a => f (g a) d) := by infer_instance
example (f : β → δ → γ) [IsSmooth f] (g : α → β) [IsSmooth g] : IsSmooth (λ a d => f (g a) d) := by infer_instance
example (f : δ → β → γ) [∀ d, IsSmooth (f d)] (g : α → β) [IsSmooth g] : IsSmooth (λ a d => (f d (g a))) := by infer_instance

-- Recall Function.comp is not reducible anymore
instance (f : β → γ) (g : α → β) [IsSmooth f] [IsSmooth g] : IsSmooth (f ∘ g) := by
  delta Function.comp
  infer_instance

example (f : β → γ) (g : α → β) [IsSmooth f] [IsSmooth g] : IsSmooth (f ∘ g) := by infer_instance

example (f : β → γ) [IsSmooth f] : IsSmooth λ (g : α → β) => (f ∘ g) := by
  delta Function.comp
  infer_instance


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis

! This file was ported from Lean 3 source module tactic.linarith.datatypes
! leanprover-community/mathlib commit 2558b3b31d33969bb3ef330982ff131533eebfdd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Linarith.Lemmas
import Mathbin.Tactic.Ring

/-!
# Datatypes for `linarith`

Some of the data structures here are used in multiple parts of the tactic.
We split them into their own file.

This file also contains a few convenient auxiliary functions.
-/

initialize
  registerTraceClass.1 `linarith

open Native

namespace Linarith

/-- A shorthand for tracing when the `trace.linarith` option is set to true. -/
unsafe def linarith_trace {α} [has_to_tactic_format α] (s : α) : tactic Unit :=
  tactic.when_tracing `linarith (tactic.trace s)
#align linarith.linarith_trace linarith.linarith_trace

/-- A shorthand for tracing the types of a list of proof terms
when the `trace.linarith` option is set to true.
-/
unsafe def linarith_trace_proofs (s : String := "") (l : List expr) : tactic Unit :=
  tactic.when_tracing `linarith do
    tactic.trace s
    l tactic.infer_type >>= tactic.trace
#align linarith.linarith_trace_proofs linarith.linarith_trace_proofs

/-! ### Linear expressions -/

#print Linarith.Linexp /-
/-- A linear expression is a list of pairs of variable indices and coefficients,
representing the sum of the products of each coefficient with its corresponding variable.

Some functions on `linexp` assume that `n : ℕ` occurs at most once as the first element of a pair,
and that the list is sorted in decreasing order of the first argument.
This is not enforced by the type but the operations here preserve it.
-/
@[reducible]
def Linexp : Type :=
  List (ℕ × ℤ)
#align linarith.linexp Linarith.Linexp
-/

namespace Linexp

/-- Add two `linexp`s together componentwise.
Preserves sorting and uniqueness of the first argument.
-/
unsafe def add : Linexp → Linexp → Linexp
  | [], a => a
  | a, [] => a
  | a@(n1, z1) :: t1, b@(n2, z2) :: t2 =>
    if n1 < n2 then b :: add (a :: t1) t2
    else
      if n2 < n1 then a :: add t1 (b :: t2)
      else
        let sum := z1 + z2
        if Sum = 0 then add t1 t2 else (n1, Sum) :: add t1 t2
#align linarith.linexp.add linarith.linexp.add

#print Linarith.Linexp.scale /-
/-- `l.scale c` scales the values in `l` by `c` without modifying the order or keys. -/
def scale (c : ℤ) (l : Linexp) : Linexp :=
  if c = 0 then [] else if c = 1 then l else l.map fun ⟨n, z⟩ => (n, z * c)
#align linarith.linexp.scale Linarith.Linexp.scale
-/

#print Linarith.Linexp.get /-
/-- `l.get n` returns the value in `l` associated with key `n`, if it exists, and `none` otherwise.
This function assumes that `l` is sorted in decreasing order of the first argument,
that is, it will return `none` as soon as it finds a key smaller than `n`.
-/
def get (n : ℕ) : Linexp → Option ℤ
  | [] => none
  | (a, b) :: t => if a < n then none else if a = n then some b else get t
#align linarith.linexp.get Linarith.Linexp.get
-/

#print Linarith.Linexp.contains /-
/-- `l.contains n` is true iff `n` is the first element of a pair in `l`.
-/
def contains (n : ℕ) : Linexp → Bool :=
  Option.isSome ∘ get n
#align linarith.linexp.contains Linarith.Linexp.contains
-/

#print Linarith.Linexp.zfind /-
/-- `l.zfind n` returns the value associated with key `n` if there is one, and 0 otherwise.
-/
def zfind (n : ℕ) (l : Linexp) : ℤ :=
  match l.get n with
  | none => 0
  | some v => v
#align linarith.linexp.zfind Linarith.Linexp.zfind
-/

#print Linarith.Linexp.vars /-
/-- `l.vars` returns the list of variables that occur in `l`. -/
def vars (l : Linexp) : List ℕ :=
  l.map Prod.fst
#align linarith.linexp.vars Linarith.Linexp.vars
-/

#print Linarith.Linexp.cmp /-
/-- Defines a lex ordering on `linexp`. This function is performance critical.
-/
def cmp : Linexp → Linexp → Ordering
  | [], [] => Ordering.eq
  | [], _ => Ordering.lt
  | _, [] => Ordering.gt
  | (n1, z1) :: t1, (n2, z2) :: t2 =>
    if n1 < n2 then Ordering.lt
    else
      if n2 < n1 then Ordering.gt
      else if z1 < z2 then Ordering.lt else if z2 < z1 then Ordering.gt else cmp t1 t2
#align linarith.linexp.cmp Linarith.Linexp.cmp
-/

end Linexp

/-! ### Inequalities -/

#print Linarith.Ineq /-
/-- The three-element type `ineq` is used to represent the strength of a comparison between
terms. -/
inductive Ineq : Type
  | Eq
  | le
  | lt
  deriving DecidableEq, Inhabited
#align linarith.ineq Linarith.Ineq
-/

namespace Ineq

#print Linarith.Ineq.max /-
/-- `max R1 R2` computes the strength of the sum of two inequalities. If `t1 R1 0` and `t2 R2 0`,
then `t1 + t2 (max R1 R2) 0`.
-/
def max : Ineq → Ineq → Ineq
  | lt, a => lt
  | a, lt => lt
  | le, a => le
  | a, le => le
  | Eq, Eq => eq
#align linarith.ineq.max Linarith.Ineq.max
-/

#print Linarith.Ineq.cmp /-
/-- `ineq` is ordered `eq < le < lt`. -/
def cmp : Ineq → Ineq → Ordering
  | Eq, Eq => Ordering.eq
  | Eq, _ => Ordering.lt
  | le, le => Ordering.eq
  | le, lt => Ordering.lt
  | lt, lt => Ordering.eq
  | _, _ => Ordering.gt
#align linarith.ineq.cmp Linarith.Ineq.cmp
-/

#print Linarith.Ineq.toString /-
/-- Prints an `ineq` as the corresponding infix symbol. -/
def toString : Ineq → String
  | Eq => "="
  | le => "≤"
  | lt => "<"
#align linarith.ineq.to_string Linarith.Ineq.toString
-/

/-- Finds the name of a multiplicative lemma corresponding to an inequality strength. -/
unsafe def to_const_mul_nm : Ineq → Name
  | lt => `` mul_neg
  | le => `` mul_nonpos
  | Eq => `` mul_eq
#align linarith.ineq.to_const_mul_nm linarith.ineq.to_const_mul_nm

instance : ToString Ineq :=
  ⟨Ineq.toString⟩

unsafe instance : has_to_format Ineq :=
  ⟨fun i => Ineq.toString i⟩

end Ineq

/-! ### Comparisons with 0 -/

#print Linarith.Comp /-
/-- The main datatype for FM elimination.
Variables are represented by natural numbers, each of which has an integer coefficient.
Index 0 is reserved for constants, i.e. `coeffs.find 0` is the coefficient of 1.
The represented term is `coeffs.sum (λ ⟨k, v⟩, v * Var[k])`.
str determines the strength of the comparison -- is it < 0, ≤ 0, or = 0?
-/
structure Comp : Type where
  str : Ineq
  coeffs : Linexp
  deriving Inhabited
#align linarith.comp Linarith.Comp
-/

#print Linarith.Comp.vars /-
/-- `c.vars` returns the list of variables that appear in the linear expression contained in `c`. -/
def Comp.vars : Comp → List ℕ :=
  Linexp.vars ∘ Comp.coeffs
#align linarith.comp.vars Linarith.Comp.vars
-/

#print Linarith.Comp.coeffOf /-
/-- `comp.coeff_of c a` projects the coefficient of variable `a` out of `c`. -/
def Comp.coeffOf (c : Comp) (a : ℕ) : ℤ :=
  c.coeffs.zfind a
#align linarith.comp.coeff_of Linarith.Comp.coeffOf
-/

#print Linarith.Comp.scale /-
/-- `comp.scale c n` scales the coefficients of `c` by `n`. -/
def Comp.scale (c : Comp) (n : ℕ) : Comp :=
  { c with coeffs := c.coeffs.scale n }
#align linarith.comp.scale Linarith.Comp.scale
-/

/-- `comp.add c1 c2` adds the expressions represented by `c1` and `c2`.
The coefficient of variable `a` in `c1.add c2`
is the sum of the coefficients of `a` in `c1` and `c2`.
 -/
unsafe def comp.add (c1 c2 : Comp) : Comp :=
  ⟨c1.str.max c2.str, c1.coeffs.add c2.coeffs⟩
#align linarith.comp.add linarith.comp.add

/-- `comp` has a lex order. First the `ineq`s are compared, then the `coeff`s. -/
unsafe def comp.cmp : Comp → Comp → Ordering
  | ⟨str1, coeffs1⟩, ⟨str2, coeffs2⟩ =>
    match str1.cmp str2 with
    | Ordering.lt => Ordering.lt
    | Ordering.gt => Ordering.gt
    | Ordering.eq => coeffs1.cmp coeffs2
#align linarith.comp.cmp linarith.comp.cmp

/-- A `comp` represents a contradiction if its expression has no coefficients and its strength is <,
that is, it represents the fact `0 < 0`.
 -/
unsafe def comp.is_contr (c : Comp) : Bool :=
  c.coeffs.Empty ∧ c.str = Ineq.lt
#align linarith.comp.is_contr linarith.comp.is_contr

unsafe instance comp.to_format : has_to_format Comp :=
  ⟨fun p => to_fmt p.coeffs ++ toString p.str ++ "0"⟩
#align linarith.comp.to_format linarith.comp.to_format

/-! ### Parsing into linear form -/

/-! ### Control -/

/-- A preprocessor transforms a proof of a proposition into a proof of a different propositon.
The return type is `list expr`, since some preprocessing steps may create multiple new hypotheses,
and some may remove a hypothesis from the list.
A "no-op" preprocessor should return its input as a singleton list.
-/
unsafe structure preprocessor : Type where
  Name : String
  transform : expr → tactic (List expr)
#align linarith.preprocessor linarith.preprocessor

/-- Some preprocessors need to examine the full list of hypotheses instead of working item by item.
As with `preprocessor`, the input to a `global_preprocessor` is replaced by, not added to, its
output.
-/
unsafe structure global_preprocessor : Type where
  Name : String
  transform : List expr → tactic (List expr)
#align linarith.global_preprocessor linarith.global_preprocessor

/-- Some preprocessors perform branching case splits. A `branch` is used to track one of these case
splits. The first component, an `expr`, is the goal corresponding to this branch of the split,
given as a metavariable. The `list expr` component is the list of hypotheses for `linarith`
in this branch. Every `expr` in this list should be type correct in the context of the associated
goal.
-/
unsafe def branch : Type :=
  expr × List expr
#align linarith.branch linarith.branch

/-- Some preprocessors perform branching case splits.
A `global_branching_preprocessor` produces a list of branches to run.
Each branch is independent, so hypotheses that appear in multiple branches should be duplicated.
The preprocessor is responsible for making sure that each branch contains the correct goal
metavariable.
-/
unsafe structure global_branching_preprocessor : Type where
  Name : String
  transform : List expr → tactic (List branch)
#align linarith.global_branching_preprocessor linarith.global_branching_preprocessor

/-- A `preprocessor` lifts to a `global_preprocessor` by folding it over the input list.
-/
unsafe def preprocessor.globalize (pp : preprocessor) : global_preprocessor
    where
  Name := pp.Name
  transform :=
    List.foldlM
      (fun ret e => do
        let l' ← pp.transform e
        return (l' ++ ret))
      []
#align linarith.preprocessor.globalize linarith.preprocessor.globalize

/-- A `global_preprocessor` lifts to a `global_branching_preprocessor` by producing only one branch.
-/
unsafe def global_preprocessor.branching (pp : global_preprocessor) : global_branching_preprocessor
    where
  Name := pp.Name
  transform l := do
    let g ← tactic.get_goal
    singleton <$> Prod.mk g <$> pp l
#align linarith.global_preprocessor.branching linarith.global_preprocessor.branching

/-- `process pp l` runs `pp.transform` on `l` and returns the result,
tracing the result if `trace.linarith` is on.
-/
unsafe def global_branching_preprocessor.process (pp : global_branching_preprocessor)
    (l : List expr) : tactic (List branch) := do
  let l ← pp.transform l
  when (l > 1) <| linarith_trace f! "Preprocessing: {pp} has branched, with branches:"
  l fun l => tactic.set_goals [l.1] >> linarith_trace_proofs (toString f! "Preprocessing: {pp}") l.2
  return l
#align linarith.global_branching_preprocessor.process linarith.global_branching_preprocessor.process

unsafe instance preprocessor_to_gb_preprocessor : Coe preprocessor global_branching_preprocessor :=
  ⟨global_preprocessor.branching ∘ preprocessor.globalize⟩
#align linarith.preprocessor_to_gb_preprocessor linarith.preprocessor_to_gb_preprocessor

unsafe instance global_preprocessor_to_gb_preprocessor :
    Coe global_preprocessor global_branching_preprocessor :=
  ⟨global_preprocessor.branching⟩
#align linarith.global_preprocessor_to_gb_preprocessor linarith.global_preprocessor_to_gb_preprocessor

/--
A `certificate_oracle` is a function `produce_certificate : list comp → ℕ → tactic (rb_map ℕ ℕ)`.
`produce_certificate hyps max_var` tries to derive a contradiction from the comparisons in `hyps`
by eliminating all variables ≤ `max_var`.
If successful, it returns a map `coeff : ℕ → ℕ` as a certificate.
This map represents that we can find a contradiction by taking the sum  `∑ (coeff i) * hyps[i]`.

The default `certificate_oracle` used by `linarith` is
`linarith.fourier_motzkin.produce_certificate`.
-/
unsafe def certificate_oracle : Type :=
  List Comp → ℕ → tactic (rb_map ℕ ℕ)
#align linarith.certificate_oracle linarith.certificate_oracle

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- A configuration object for `linarith`. -/
unsafe structure linarith_config : Type where
  discharger : tactic Unit := sorry
  restrict_type : Option Type := none
  restrict_type_reflect : reflected _ restrict_type := by infer_instance
  exfalso : Bool := true
  Transparency : Tactic.Transparency := reducible
  split_hypotheses : Bool := true
  split_ne : Bool := false
  preprocessors : Option (List global_branching_preprocessor) := none
  oracle : Option certificate_oracle := none
#align linarith.linarith_config linarith.linarith_config

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- `cfg.update_reducibility reduce_semi` will change the transparency setting of `cfg` to
`semireducible` if `reduce_semi` is true. In this case, it also sets the discharger to `ring!`,
since this is typically needed when using stronger unification.
-/
unsafe def linarith_config.update_reducibility (cfg : linarith_config) (reduce_semi : Bool) :
    linarith_config :=
  if reduce_semi then
    { cfg with
      Transparency := semireducible
      discharger := sorry }
  else cfg
#align linarith.linarith_config.update_reducibility linarith.linarith_config.update_reducibility

/-!
### Auxiliary functions

These functions are used by multiple modules, so we put them here for accessibility.
-/

open Tactic

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `get_rel_sides e` returns the left and right hand sides of `e` if `e` is a comparison,
      and fails otherwise.
      This function is more naturally in the `option` monad, but it is convenient to put in `tactic`
      for compositionality.
       -/
    unsafe
  def
    get_rel_sides
    : expr → tactic ( expr × expr )
    | q( $ ( a ) < $ ( b ) ) => return ( a , b )
      | q( $ ( a ) ≤ $ ( b ) ) => return ( a , b )
      | q( $ ( a ) = $ ( b ) ) => return ( a , b )
      | q( $ ( a ) ≥ $ ( b ) ) => return ( a , b )
      | q( $ ( a ) > $ ( b ) ) => return ( a , b )
      | _ => tactic.failed
#align linarith.get_rel_sides linarith.get_rel_sides

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `parse_into_comp_and_expr e` checks if `e` is of the form `t < 0`, `t ≤ 0`, or `t = 0`.
      If it is, it returns the comparison along with `t`.
       -/
    unsafe
  def
    parse_into_comp_and_expr
    : expr → Option ( Ineq × expr )
    | q( $ ( e ) < 0 ) => ( Ineq.lt , e )
      | q( $ ( e ) ≤ 0 ) => ( Ineq.le , e )
      | q( $ ( e ) = 0 ) => ( Ineq.eq , e )
      | _ => none
#align linarith.parse_into_comp_and_expr linarith.parse_into_comp_and_expr

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `mk_single_comp_zero_pf c h` assumes that `h` is a proof of `t R 0`.
      It produces a pair `(R', h')`, where `h'` is a proof of `c*t R' 0`.
      Typically `R` and `R'` will be the same, except when `c = 0`, in which case `R'` is `=`.
      If `c = 1`, `h'` is the same as `h` -- specifically, it does *not* change the type to `1*t R 0`.
      -/
    unsafe
  def
    mk_single_comp_zero_pf
    ( c : ℕ ) ( h : expr ) : tactic ( Ineq × expr )
    :=
      do
        let tp ← infer_type h
          let some ( iq , e ) ← return <| parse_into_comp_and_expr tp
          if
            c = 0
            then
            do let e' ← mk_app ` ` MulZeroClass.zero_mul [ e ] return ( ineq.eq , e' )
            else
            if
              c = 1
              then
              return ( iq , h )
              else
              do
                let tp ← Prod.snd <$> ( infer_type h >>= get_rel_sides ) >>= infer_type
                  let c ← tp c
                  let cpos ← to_expr ` `( $ ( c ) > 0 )
                  let ( _ , ex ) ← solve_aux cpos sorry
                  let e' ← mk_app iq [ h , ex ]
                  return ( iq , e' )
#align linarith.mk_single_comp_zero_pf linarith.mk_single_comp_zero_pf

end Linarith