/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import data.pnat.basic
import data.list.range
import data.array.lemmas
import algebra.group
import data.sigma.basic

/-!
# Hash maps

Defines a hash map data structure, representing a finite key-value map
with a value type that may depend on the key type.  The structure
requires a `nat`-valued hash function to associate keys to buckets.

## Main definitions

* `hash_map`: constructed with `mk_hash_map`.

## Implementation details

A hash map with key type `α` and (dependent) value type `β : α → Type*`
consists of an array of *buckets*, which are lists containing
key/value pairs for that bucket.  The hash function is taken modulo `n`
to assign keys to their respective bucket.  Because of this, some care
should be put into the hash function to ensure it evenly distributes
keys.

The bucket array is an `array`.  These have special VM support for
in-place modification if there is only ever one reference to them.  If
one takes special care to never keep references to old versions of a
hash map alive after updating it, then the hash map will be modified
in-place.  In this documentation, when we say a hash map is modified
in-place, we are assuming the API is being used in this manner.

When inserting (`hash_map.insert`), if the number of stored pairs (the
*size*) is going to exceed the number of buckets, then a new hash map
is first created with double the number of buckets and everything in
the old hash map is reinserted along with the new key/value pair.
Otherwise, the bucket array is modified in-place.  The amortized
running time of inserting $$n$$ elements into a hash map is $$O(n)$$.

When removing (`hash_map.erase`), the hash map is modified in-place.
The implementation does not reduce the number of buckets in the hash
map if the size gets too low.

## Tags

hash map

-/

universes u v w

/-- `bucket_array α β` is the underlying data type for `hash_map α β`,
  an array of linked lists of key-value pairs. -/
def bucket_array (α : Type u) (β : α → Type v) (n : ℕ+) :=
array n (list Σ a, β a)

/-- Make a hash_map index from a `nat` hash value and a (positive) buffer size -/
def hash_map.mk_idx (n : ℕ+) (i : nat) : fin n :=
⟨i % n, nat.mod_lt _ n.2⟩

namespace bucket_array
section
parameters {α : Type u} {β : α → Type v} (hash_fn : α → nat)
variables {n : ℕ+} (data : bucket_array α β n)

instance : inhabited (bucket_array α β n) :=
⟨mk_array _ []⟩

/-- Read the bucket corresponding to an element -/
def read (a : α) : list Σ a, β a :=
let bidx := hash_map.mk_idx n (hash_fn a) in
data.read bidx

/-- Write the bucket corresponding to an element -/
def write (a : α) (l : list Σ a, β a) : bucket_array α β n :=
let bidx := hash_map.mk_idx n (hash_fn a) in
data.write bidx l

/-- Modify (read, apply `f`, and write) the bucket corresponding to an element -/
def modify (a : α) (f : list (Σ a, β a) → list (Σ a, β a)) : bucket_array α β n :=
let bidx := hash_map.mk_idx n (hash_fn a) in
array.write data bidx (f (array.read data bidx))

/-- The list of all key-value pairs in the bucket list -/
def as_list : list Σ a, β a := data.to_list.join

theorem mem_as_list {a : Σ a, β a} : a ∈ data.as_list ↔ ∃i, a ∈ array.read data i :=
have (∃ (l : list (Σ (a : α), β a)) (i : fin (n.val)), a ∈ l ∧ array.read data i = l) ↔
  ∃ (i : fin (n.val)), a ∈ array.read data i,
by rw exists_swap; exact exists_congr (λ i, by simp),
by simp [as_list]; simpa [array.mem.def, and_comm]

/-- Fold a function `f` over the key-value pairs in the bucket list -/
def foldl {δ : Type w} (d : δ) (f : δ → Π a, β a → δ) : δ :=
data.foldl d (λ b d, b.foldl (λ r a, f r a.1 a.2) d)

theorem foldl_eq {δ : Type w} (d : δ) (f : δ → Π a, β a → δ) :
  data.foldl d f = data.as_list.foldl (λ r a, f r a.1 a.2) d :=
by rw [foldl, as_list, list.foldl_join, ← array.to_list_foldl]

end
end bucket_array

namespace hash_map
section
parameters {α : Type u} {β : α → Type v} (hash_fn : α → nat)

/-- Insert the pair `⟨a, b⟩` into the correct location in the bucket array
  (without checking for duplication) -/
def reinsert_aux {n} (data : bucket_array α β n) (a : α) (b : β a) : bucket_array α β n :=
data.modify hash_fn a (λl, ⟨a, b⟩ :: l)

theorem mk_as_list (n : ℕ+) : bucket_array.as_list (mk_array n [] : bucket_array α β n) = [] :=
list.eq_nil_iff_forall_not_mem.mpr $ λ x m,
let ⟨i, h⟩ := (bucket_array.mem_as_list _).1 m in h

parameter [decidable_eq α]

/-- Search a bucket for a key `a` and return the value -/
def find_aux (a : α) : list (Σ a, β a) → option (β a)
| []          := none
| (⟨a',b⟩::t) := if h : a' = a then some (eq.rec_on h b) else find_aux t

theorem find_aux_iff {a : α} {b : β a} :
  Π {l : list Σ a, β a}, (l.map sigma.fst).nodup → (find_aux a l = some b ↔ sigma.mk a b ∈ l)
| []          nd := ⟨λn, by injection n, false.elim⟩
| (⟨a',b'⟩::t) nd := begin
  by_cases a' = a,
  { clear find_aux_iff, subst h,
    suffices : b' = b ↔ b' = b ∨ sigma.mk a' b ∈ t, {simpa [find_aux, eq_comm]},
    refine (or_iff_left_of_imp (λ m, _)).symm,
    have : a' ∉ t.map sigma.fst, from list.not_mem_of_nodup_cons nd,
    exact this.elim (list.mem_map_of_mem sigma.fst m) },
  { have : sigma.mk a b ≠ ⟨a', b'⟩,
    { intro e, injection e with e, exact h e.symm },
    simp at nd, simp [find_aux, h, ne.symm h, find_aux_iff, nd] }
end

/-- Returns `tt` if the bucket `l` contains the key `a` -/
def contains_aux (a : α) (l : list Σ a, β a) : bool :=
(find_aux a l).is_some

theorem contains_aux_iff {a : α} {l : list Σ a, β a} (nd : (l.map sigma.fst).nodup) :
  contains_aux a l ↔ a ∈ l.map sigma.fst :=
begin
  unfold contains_aux,
  cases h : find_aux a l with b; simp,
  { assume (b : β a) (m : sigma.mk a b ∈ l),
    rw (find_aux_iff nd).2 m at h,
    contradiction },
  { show ∃ (b : β a), sigma.mk a b ∈ l,
    exact ⟨_, (find_aux_iff nd).1 h⟩ },
end

/-- Modify a bucket to replace a value in the list. Leaves the list
 unchanged if the key is not found. -/
def replace_aux (a : α) (b : β a) : list (Σ a, β a) → list (Σ a, β a)
| []            := []
| (⟨a', b'⟩::t) := if a' = a then ⟨a, b⟩::t else ⟨a', b'⟩ :: replace_aux t

/-- Modify a bucket to remove a key, if it exists. -/
def erase_aux (a : α) : list (Σ a, β a) → list (Σ a, β a)
| []            := []
| (⟨a', b'⟩::t) := if a' = a then t else ⟨a', b'⟩ :: erase_aux t

/-- The predicate `valid bkts sz` means that `bkts` satisfies the `hash_map`
  invariants: There are exactly `sz` elements in it, every pair is in the
  bucket determined by its key and the hash function, and no key appears
  multiple times in the list. -/
structure valid {n} (bkts : bucket_array α β n) (sz : nat) : Prop :=
(len : bkts.as_list.length = sz)
(idx : ∀ {i} {a : Σ a, β a}, a ∈ array.read bkts i →
  mk_idx n (hash_fn a.1) = i)
(nodup : ∀i, ((array.read bkts i).map sigma.fst).nodup)

theorem valid.idx_enum {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz)
  {i l} (he : (i, l) ∈ bkts.to_list.enum) {a} {b : β a} (hl : sigma.mk a b ∈ l) :
  ∃ h, mk_idx n (hash_fn a) = ⟨i, h⟩ :=
(array.mem_to_list_enum.mp he).imp (λ h e, by subst e; exact v.idx hl)

theorem valid.idx_enum_1 {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz)
  {i l} (he : (i, l) ∈ bkts.to_list.enum) {a} {b : β a} (hl : sigma.mk a b ∈ l) :
  (mk_idx n (hash_fn a)).1 = i :=
let ⟨h, e⟩ := v.idx_enum _ he hl in by rw e; refl

theorem valid.as_list_nodup {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz) :
  (bkts.as_list.map sigma.fst).nodup :=
begin
  suffices : (bkts.to_list.map (list.map sigma.fst)).pairwise list.disjoint,
  { suffices : ∀ l, array.mem l bkts → (l.map sigma.fst).nodup,
      by simpa [bucket_array.as_list, list.nodup_join, *],
    rintros l ⟨i, rfl⟩,
    apply v.nodup },
  rw [← list.enum_map_snd bkts.to_list, list.pairwise_map, list.pairwise_map],
  have : (bkts.to_list.enum.map prod.fst).nodup := by simp [list.nodup_range],
  refine list.pairwise.imp_of_mem _ ((list.pairwise_map _).1 this),
  rw prod.forall, intros i l₁,
  rw prod.forall, intros j l₂ me₁ me₂ ij,
  simp [list.disjoint], intros a b ml₁ b' ml₂,
  apply ij, rwa [← v.idx_enum_1 _ me₁ ml₁, ← v.idx_enum_1 _ me₂ ml₂]
end

theorem mk_valid (n : ℕ+) : @valid n (mk_array n []) 0 :=
⟨by simp [mk_as_list], λ i a h, by cases h, λ i, list.nodup_nil⟩

theorem valid.find_aux_iff {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz) {a : α}
  {b : β a} :
  find_aux a (bkts.read hash_fn a) = some b ↔ sigma.mk a b ∈ bkts.as_list :=
(find_aux_iff (v.nodup _)).trans $
by rw bkts.mem_as_list; exact ⟨λ h, ⟨_, h⟩, λ ⟨i, h⟩, (v.idx h).symm ▸ h⟩

theorem valid.contains_aux_iff {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz)
  (a : α) :
  contains_aux a (bkts.read hash_fn a) ↔ a ∈ bkts.as_list.map sigma.fst :=
by simp [contains_aux, option.is_some_iff_exists, v.find_aux_iff hash_fn]

section
  parameters {n : ℕ+} {bkts : bucket_array α β n}
             {bidx : fin n} {f : list (Σ a, β a) → list (Σ a, β a)}
             (u v1 v2 w : list Σ a, β a)

  local notation `L` := array.read bkts bidx
  private def bkts' : bucket_array α β n := array.write bkts bidx (f L)

  variables (hl : L = u ++ v1 ++ w)
            (hfl : f L = u ++ v2 ++ w)
  include hl hfl

  theorem append_of_modify :
  ∃ u' w', bkts.as_list = u' ++ v1 ++ w' ∧ bkts'.as_list = u' ++ v2 ++ w' :=
  begin
    unfold bucket_array.as_list,
    have h : (bidx : ℕ) < bkts.to_list.length, { simp only [bidx.is_lt, array.to_list_length] },
    refine ⟨(bkts.to_list.take bidx).join ++ u, w ++ (bkts.to_list.drop (bidx+1)).join, _, _⟩,
    { conv { to_lhs,
        rw [← list.take_append_drop bidx bkts.to_list, list.drop_eq_nth_le_cons h],
        simp [hl] }, simp },
    { conv { to_lhs,
        rw [bkts', array.write_to_list, list.update_nth_eq_take_cons_drop _ h],
        simp [hfl] }, simp }
  end

  variables (hvnd : (v2.map sigma.fst).nodup)
            (hal : ∀ (a : Σ a, β a), a ∈ v2 → mk_idx n (hash_fn a.1) = bidx)
            (djuv : (u.map sigma.fst).disjoint (v2.map sigma.fst))
            (djwv : (w.map sigma.fst).disjoint (v2.map sigma.fst))
  include hvnd hal djuv djwv

  theorem valid.modify {sz : ℕ} (v : valid bkts sz) :
    v1.length ≤ sz + v2.length ∧ valid bkts' (sz + v2.length - v1.length) :=
  begin
    rcases append_of_modify u v1 v2 w hl hfl with ⟨u', w', e₁, e₂⟩,
    rw [← v.len, e₁],
    suffices : valid bkts' (u' ++ v2 ++ w').length,
    { simpa [ge, add_comm, add_left_comm, nat.le_add_right, nat.add_sub_cancel_left] },
    refine ⟨congr_arg _ e₂, λ i a, _, λ i, _⟩,
    { by_cases bidx = i,
      { subst i, rw [bkts', array.read_write, hfl],
        have := @valid.idx _ _ _ v bidx a,
        simp only [hl, list.mem_append, or_imp_distrib, forall_and_distrib] at this ⊢,
        exact ⟨⟨this.1.1, hal _⟩, this.2⟩ },
      { rw [bkts', array.read_write_of_ne _ _ h], apply v.idx } },
    { by_cases bidx = i,
      { subst i, rw [bkts', array.read_write, hfl],
        have := @valid.nodup _ _ _ v bidx,
        simp [hl, list.nodup_append] at this,
        simp [list.nodup_append, this, hvnd, djuv, djwv.symm] },
      { rw [bkts', array.read_write_of_ne _ _ h], apply v.nodup } }
  end
end

theorem valid.replace_aux (a : α) (b : β a) : Π (l : list (Σ a, β a)), a ∈ l.map sigma.fst →
  ∃ (u w : list Σ a, β a) b', l = u ++ [⟨a, b'⟩] ++ w ∧ replace_aux a b l = u ++ [⟨a, b⟩] ++ w
| []            := false.elim
| (⟨a', b'⟩::t) := begin
  by_cases e : a' = a,
  { subst a',
    suffices : ∃ (u w : list Σ a, β a) (b'' : β a),
      (sigma.mk a b') :: t = u ++ ⟨a, b''⟩ :: w ∧
      replace_aux a b (⟨a, b'⟩ :: t) = u ++ ⟨a, b⟩ :: w, {simpa},
    refine ⟨[], t, b', _⟩, simp [replace_aux] },
  { suffices : ∀ (x : β a) (_ : sigma.mk a x ∈ t), ∃ u w (b'' : β a),
      (sigma.mk a' b') :: t = u ++ ⟨a, b''⟩ :: w ∧
      (sigma.mk a' b') :: (replace_aux a b t) = u ++ ⟨a, b⟩ :: w,
    { simpa [replace_aux, ne.symm e, e] },
    intros x m,
    have IH : ∀ (x : β a) (_ : sigma.mk a x ∈ t), ∃ u w (b'' : β a),
      t = u ++ ⟨a, b''⟩ :: w ∧ replace_aux a b t = u ++ ⟨a, b⟩ :: w,
    { simpa using valid.replace_aux t },
    rcases IH x m with ⟨u, w, b'', hl, hfl⟩,
    exact ⟨⟨a', b'⟩ :: u, w, b'', by simp [hl, hfl.symm, ne.symm e]⟩ }
end

theorem valid.replace {n : ℕ+}
  {bkts : bucket_array α β n} {sz : ℕ} (a : α) (b : β a)
  (Hc : contains_aux a (bkts.read hash_fn a))
  (v : valid bkts sz) : valid (bkts.modify hash_fn a (replace_aux a b)) sz :=
begin
  have nd := v.nodup (mk_idx n (hash_fn a)),
  rcases hash_map.valid.replace_aux a b (array.read bkts (mk_idx n (hash_fn a)))
    ((contains_aux_iff nd).1 Hc) with ⟨u, w, b', hl, hfl⟩,
  simp [hl, list.nodup_append] at nd,
  refine (v.modify hash_fn
    u [⟨a, b'⟩] [⟨a, b⟩] w hl hfl (list.nodup_singleton _)
    (λa' e, by simp at e; rw e)
    (λa' e1 e2, _)
    (λa' e1 e2, _)).2;
  { revert e1, simp [-sigma.exists] at e2, subst a', simp [nd] }
end

theorem valid.insert {n : ℕ+}
  {bkts : bucket_array α β n} {sz : ℕ} (a : α) (b : β a)
  (Hnc : ¬ contains_aux a (bkts.read hash_fn a))
  (v : valid bkts sz) : valid (reinsert_aux bkts a b) (sz+1) :=
begin
  have nd := v.nodup (mk_idx n (hash_fn a)),
  refine (v.modify hash_fn
    [] [] [⟨a, b⟩] (bkts.read hash_fn a) rfl rfl (list.nodup_singleton _)
    (λa' e, by simp at e; rw e)
    (λa', false.elim)
    (λa' e1 e2, _)).2,
  simp [-sigma.exists] at e2, subst a',
  exact Hnc ((contains_aux_iff nd).2 e1)
end

theorem valid.erase_aux (a : α) : Π (l : list (Σ a, β a)), a ∈ l.map sigma.fst →
  ∃ (u w : list Σ a, β a) b, l = u ++ [⟨a, b⟩] ++ w ∧ erase_aux a l = u ++ [] ++ w
| []            := false.elim
| (⟨a', b'⟩::t) := begin
  by_cases e : a' = a,
  { subst a',
    simpa [erase_aux, and_comm] using show ∃ u w (x : β a),
      t = u ++ w ∧ (sigma.mk a b') :: t = u ++ ⟨a, x⟩ :: w,
      from ⟨[], t, b', by simp⟩ },
  { simp [erase_aux, e, ne.symm e],
    suffices : ∀ (b : β a) (_ : sigma.mk a b ∈ t), ∃ u w (x : β a),
      (sigma.mk a' b') :: t = u ++ ⟨a, x⟩ :: w ∧
      (sigma.mk a' b') :: (erase_aux a t) = u ++ w,
    { simpa [replace_aux, ne.symm e, e] },
    intros b m,
    have IH : ∀ (x : β a) (_ : sigma.mk a x ∈ t), ∃ u w (x : β a),
      t = u ++ ⟨a, x⟩ :: w ∧ erase_aux a t = u ++ w,
    { simpa using valid.erase_aux t },
    rcases IH b m with ⟨u, w, b'', hl, hfl⟩,
    exact ⟨⟨a', b'⟩ :: u, w, b'', by simp [hl, hfl.symm]⟩ }
end

theorem valid.erase {n} {bkts : bucket_array α β n} {sz}
  (a : α) (Hc : contains_aux a (bkts.read hash_fn a))
  (v : valid bkts sz) : valid (bkts.modify hash_fn a (erase_aux a)) (sz-1) :=
begin
  have nd := v.nodup (mk_idx n (hash_fn a)),
  rcases hash_map.valid.erase_aux a (array.read bkts (mk_idx n (hash_fn a)))
    ((contains_aux_iff nd).1 Hc) with ⟨u, w, b, hl, hfl⟩,
  refine (v.modify hash_fn u [⟨a, b⟩] [] w hl hfl list.nodup_nil _ _ _).2;
  simp
end

end
end hash_map

/-- A hash map data structure, representing a finite key-value map
  with key type `α` and value type `β` (which may depend on `α`). -/
structure hash_map (α : Type u) [decidable_eq α] (β : α → Type v) :=
(hash_fn : α → nat)
(size : ℕ)
(nbuckets : ℕ+)
(buckets : bucket_array α β nbuckets)
(is_valid : hash_map.valid hash_fn buckets size)

/-- Construct an empty hash map with buffer size `nbuckets` (default 8). -/
def mk_hash_map {α : Type u} [decidable_eq α] {β : α → Type v} (hash_fn : α → nat) (nbuckets := 8) :
  hash_map α β :=
let n := if nbuckets = 0 then 8 else nbuckets in
let nz : n > 0 := by abstract { cases nbuckets; simp [if_pos, nat.succ_ne_zero] } in
{ hash_fn  := hash_fn,
  size     := 0,
  nbuckets := ⟨n, nz⟩,
  buckets  := mk_array n [],
  is_valid := hash_map.mk_valid _ _ }

namespace hash_map
variables {α : Type u} {β : α → Type v} [decidable_eq α]

/-- Return the value corresponding to a key, or `none` if not found -/
def find (m : hash_map α β) (a : α) : option (β a) :=
find_aux a (m.buckets.read m.hash_fn a)

/-- Return `tt` if the key exists in the map -/
def contains (m : hash_map α β) (a : α) : bool :=
(m.find a).is_some

instance : has_mem α (hash_map α β) := ⟨λa m, m.contains a⟩

/-- Fold a function over the key-value pairs in the map -/
def fold {δ : Type w} (m : hash_map α β) (d : δ) (f : δ → Π a, β a → δ) : δ :=
m.buckets.foldl d f

/-- The list of key-value pairs in the map -/
def entries (m : hash_map α β) : list Σ a, β a :=
m.buckets.as_list

/-- The list of keys in the map -/
def keys (m : hash_map α β) : list α :=
m.entries.map sigma.fst

theorem find_iff (m : hash_map α β) (a : α) (b : β a) :
  m.find a = some b ↔ sigma.mk a b ∈ m.entries :=
m.is_valid.find_aux_iff _

theorem contains_iff (m : hash_map α β) (a : α) :
  m.contains a ↔ a ∈ m.keys :=
m.is_valid.contains_aux_iff _ _

theorem entries_empty (hash_fn : α → nat) (n) :
  (@mk_hash_map α _ β hash_fn n).entries = [] :=
mk_as_list _

theorem find_empty (hash_fn : α → nat) (n a) :
  (@mk_hash_map α _ β hash_fn n).find a = none :=
by induction h : (@mk_hash_map α _ β hash_fn n).find a; [refl,
   { have := (find_iff _ _ _).1 h, rw entries_empty at this, contradiction }]

theorem not_contains_empty (hash_fn : α → nat) (n a) :
  ¬ (@mk_hash_map α _ β hash_fn n).contains a :=
by apply bool_iff_false.2; dsimp [contains]; rw [find_empty]; refl

theorem insert_lemma (hash_fn : α → nat) {n n'}
  {bkts : bucket_array α β n} {sz} (v : valid hash_fn bkts sz) :
  valid hash_fn (bkts.foldl (mk_array _ [] : bucket_array α β n') (reinsert_aux hash_fn)) sz :=
begin
  suffices : ∀ (l : list Σ a, β a) (t : bucket_array α β n') sz,
    valid hash_fn t sz → ((l ++ t.as_list).map sigma.fst).nodup →
    valid hash_fn (l.foldl (λr (a : Σ a, β a), reinsert_aux hash_fn r a.1 a.2) t) (sz + l.length),
  { have p := this bkts.as_list _ _ (mk_valid _ _),
    rw [mk_as_list, list.append_nil, zero_add, v.len] at p,
    rw bucket_array.foldl_eq,
    exact p (v.as_list_nodup _) },
  intro l, induction l with c l IH; intros t sz v nd, {exact v},
  rw show sz + (c :: l).length = sz + 1 + l.length, by simp [add_comm, add_assoc],
  rcases (show (l.map sigma.fst).nodup ∧
      ((bucket_array.as_list t).map sigma.fst).nodup ∧
      c.fst ∉ l.map sigma.fst ∧
      c.fst ∉ (bucket_array.as_list t).map sigma.fst ∧
      (l.map sigma.fst).disjoint ((bucket_array.as_list t).map sigma.fst),
    by simpa [list.nodup_append, not_or_distrib, and_comm, and.left_comm] using nd)
    with ⟨nd1, nd2, nm1, nm2, dj⟩,
  have v' := v.insert _ _ c.2 (λHc, nm2 $ (v.contains_aux_iff _ c.1).1 Hc),
  apply IH _ _ v',
  suffices : ∀ ⦃a : α⦄ (b : β a), sigma.mk a b ∈ l →
    ∀ (b' : β a), sigma.mk a b' ∈ (reinsert_aux hash_fn t c.1 c.2).as_list → false,
  { simpa [list.nodup_append, nd1, v'.as_list_nodup _, list.disjoint] },
  intros a b m1 b' m2,
  rcases (reinsert_aux hash_fn t c.1 c.2).mem_as_list.1 m2 with ⟨i, im⟩,
  have : sigma.mk a b' ∉ array.read t i,
  { intro m3,
    have : a ∈ list.map sigma.fst t.as_list :=
      list.mem_map_of_mem sigma.fst (t.mem_as_list.2 ⟨_, m3⟩),
    exact dj (list.mem_map_of_mem sigma.fst m1) this },
  by_cases h : mk_idx n' (hash_fn c.1) = i,
  { subst h,
    have e : sigma.mk a b' = ⟨c.1, c.2⟩,
    { simpa [reinsert_aux, bucket_array.modify, array.read_write, this] using im },
    injection e with e, subst a,
    exact nm1.elim (@list.mem_map_of_mem _ _ sigma.fst _ _ m1) },
  { apply this,
    simpa [reinsert_aux, bucket_array.modify, array.read_write_of_ne _ _ h] using im }
end

/-- Insert a key-value pair into the map. (Modifies `m` in-place when applicable) -/
def insert : Π (m : hash_map α β) (a : α) (b : β a), hash_map α β
| ⟨hash_fn, size, n, buckets, v⟩ a b :=
let bkt := buckets.read hash_fn a in
if hc : contains_aux a bkt then
{ hash_fn  := hash_fn,
  size     := size,
  nbuckets := n,
  buckets  := buckets.modify hash_fn a (replace_aux a b),
  is_valid := v.replace _ a b hc }
else
let size'    := size + 1,
    buckets' := buckets.modify hash_fn a (λl, ⟨a, b⟩::l),
    valid'   := v.insert _ a b hc in
if size' ≤ n then
{ hash_fn  := hash_fn,
  size     := size',
  nbuckets := n,
  buckets  := buckets',
  is_valid := valid' }
else
let n'        : ℕ+ := ⟨n * 2, mul_pos n.2 dec_trivial⟩,
    buckets'' : bucket_array α β n' :=
                buckets'.foldl (mk_array _ []) (reinsert_aux hash_fn) in
{ hash_fn  := hash_fn,
  size     := size',
  nbuckets := n',
  buckets  := buckets'',
  is_valid := insert_lemma _ valid' }

theorem mem_insert : Π (m : hash_map α β) (a b a' b'),
  (sigma.mk a' b' : sigma β) ∈ (m.insert a b).entries ↔
  if a = a' then b == b' else sigma.mk a' b' ∈ m.entries
| ⟨hash_fn, size, n, bkts, v⟩ a b a' b' := begin
  let bkt := bkts.read hash_fn a,
  have nd : (bkt.map sigma.fst).nodup := v.nodup (mk_idx n (hash_fn a)),
  have lem : Π (bkts' : bucket_array α β n) (v1 u w)
    (hl : bucket_array.as_list bkts = u ++ v1 ++ w)
    (hfl : bucket_array.as_list bkts' = u ++ [⟨a, b⟩] ++ w)
    (veq : (v1 = [] ∧ ¬ contains_aux a bkt) ∨ ∃b'', v1 = [⟨a, b''⟩]),
    sigma.mk a' b' ∈ bkts'.as_list ↔
    if a = a' then b == b' else sigma.mk a' b' ∈ bkts.as_list,
  { intros bkts' v1 u w hl hfl veq,
    rw [hl, hfl],
    by_cases h : a = a',
    { subst a',
      suffices : b = b' ∨ sigma.mk a b' ∈ u ∨ sigma.mk a b' ∈ w ↔ b = b',
      { simpa [eq_comm, or.left_comm] },
      refine or_iff_left_of_imp (not.elim $ not_or_distrib.2 _),
      rcases veq with ⟨rfl, Hnc⟩ | ⟨b'', rfl⟩,
      { have na := (not_iff_not_of_iff $ v.contains_aux_iff _ _).1 Hnc,
        simp [hl, not_or_distrib] at na, simp [na] },
      { have nd' := v.as_list_nodup _,
        simp [hl, list.nodup_append] at nd', simp [nd'] } },
    { suffices : sigma.mk a' b' ∉ v1, {simp [h, ne.symm h, this]},
      rcases veq with ⟨rfl, Hnc⟩ | ⟨b'', rfl⟩; simp [ne.symm h] } },
  by_cases Hc : (contains_aux a bkt : Prop),
  { rcases hash_map.valid.replace_aux a b (array.read bkts (mk_idx n (hash_fn a)))
      ((contains_aux_iff nd).1 Hc) with ⟨u', w', b'', hl', hfl'⟩,
    rcases (append_of_modify u' [⟨a, b''⟩] [⟨a, b⟩] w' hl' hfl') with ⟨u, w, hl, hfl⟩,
    simpa [insert, @dif_pos (contains_aux a bkt) _ Hc]
      using lem _ _ u w hl hfl (or.inr ⟨b'', rfl⟩) },
  { let size' := size + 1,
    let bkts' := bkts.modify hash_fn a (λl, ⟨a, b⟩::l),
    have mi : sigma.mk a' b' ∈ bkts'.as_list ↔
        if a = a' then b == b' else sigma.mk a' b' ∈ bkts.as_list :=
      let ⟨u, w, hl, hfl⟩ := append_of_modify [] [] [⟨a, b⟩] _ rfl rfl in
      lem bkts' _ u w hl hfl $ or.inl ⟨rfl, Hc⟩,
    simp [insert, @dif_neg (contains_aux a bkt) _ Hc],
    by_cases h : size' ≤ n,
    { simpa [show size' ≤ n, from h] using mi },
    { let n' : ℕ+ := ⟨n * 2, mul_pos n.2 dec_trivial⟩,
      let bkts'' : bucket_array α β n' := bkts'.foldl (mk_array _ []) (reinsert_aux hash_fn),
      suffices : sigma.mk a' b' ∈ bkts''.as_list ↔ sigma.mk a' b' ∈ bkts'.as_list.reverse,
      { simpa [show ¬ size' ≤ n, from h, mi] },
      rw [show bkts'' = bkts'.as_list.foldl _ _, from bkts'.foldl_eq _ _,
          ← list.foldr_reverse],
      induction bkts'.as_list.reverse with a l IH,
      { simp [mk_as_list] },
      { cases a with a'' b'',
        let B := l.foldr (λ (y : sigma β) (x : bucket_array α β n'),
          reinsert_aux hash_fn x y.1 y.2) (mk_array n' []),
        rcases append_of_modify [] [] [⟨a'', b''⟩] _ rfl rfl with ⟨u, w, hl, hfl⟩,
        simp [IH.symm, or.left_comm, show B.as_list = _, from hl,
              show (reinsert_aux hash_fn B a'' b'').as_list = _, from hfl] } } }
end

theorem find_insert_eq (m : hash_map α β) (a : α) (b : β a) : (m.insert a b).find a = some b :=
(find_iff (m.insert a b) a b).2 $ (mem_insert m a b a b).2 $ by rw if_pos rfl

theorem find_insert_ne (m : hash_map α β) (a a' : α) (b : β a) (h : a ≠ a') :
  (m.insert a b).find a' = m.find a' :=
option.eq_of_eq_some $ λb',
let t := mem_insert m a b a' b' in
(find_iff _ _ _).trans $ iff.trans (by rwa if_neg h at t) (find_iff _ _ _).symm

theorem find_insert (m : hash_map α β) (a' a : α) (b : β a) :
  (m.insert a b).find a' = if h : a = a' then some (eq.rec_on h b) else m.find a' :=
if h : a = a' then by rw dif_pos h; exact
  match a', h with ._, rfl := find_insert_eq m a b end
else by rw dif_neg h; exact find_insert_ne m a a' b h

/-- Insert a list of key-value pairs into the map. (Modifies `m` in-place when applicable) -/
def insert_all (l : list (Σ a, β a)) (m : hash_map α β) : hash_map α β :=
l.foldl (λ m ⟨a, b⟩, insert m a b) m

/-- Construct a hash map from a list of key-value pairs. -/
def of_list (l : list (Σ a, β a)) (hash_fn) : hash_map α β :=
insert_all l (mk_hash_map hash_fn (2 * l.length))

/-- Remove a key from the map. (Modifies `m` in-place when applicable) -/
def erase (m : hash_map α β) (a : α) : hash_map α β :=
match m with ⟨hash_fn, size, n, buckets, v⟩ :=
  if hc : contains_aux a (buckets.read hash_fn a) then
  { hash_fn  := hash_fn,
    size     := size - 1,
    nbuckets := n,
    buckets  := buckets.modify hash_fn a (erase_aux a),
    is_valid := v.erase _ a hc }
  else m
end

theorem mem_erase : Π (m : hash_map α β) (a a' b'),
  (sigma.mk a' b' : sigma β) ∈ (m.erase a).entries ↔
  a ≠ a' ∧ sigma.mk a' b' ∈ m.entries
| ⟨hash_fn, size, n, bkts, v⟩ a a' b' := begin
  let bkt := bkts.read hash_fn a,
  by_cases Hc : (contains_aux a bkt : Prop),
  { let bkts' := bkts.modify hash_fn a (erase_aux a),
    suffices : sigma.mk a' b' ∈ bkts'.as_list ↔ a ≠ a' ∧ sigma.mk a' b' ∈ bkts.as_list,
    { simpa [erase, @dif_pos (contains_aux a bkt) _ Hc] },
    have nd := v.nodup (mk_idx n (hash_fn a)),
    rcases valid.erase_aux a bkt ((contains_aux_iff nd).1 Hc) with ⟨u', w', b, hl', hfl'⟩,
    rcases append_of_modify u' [⟨a, b⟩] [] _ hl' hfl' with ⟨u, w, hl, hfl⟩,
    suffices : ∀_:sigma.mk a' b' ∈ u ∨ sigma.mk a' b' ∈ w, a ≠ a',
    { have : sigma.mk a' b' ∈ u ∨ sigma.mk a' b' ∈ w ↔ (¬a = a' ∧ a' = a) ∧ b' == b ∨
        ¬a = a' ∧ (sigma.mk a' b' ∈ u ∨ sigma.mk a' b' ∈ w),
      { simp [eq_comm, not_and_self_iff, and_iff_right_of_imp this] },
      simpa [hl, show bkts'.as_list = _, from hfl, and_or_distrib_left,
             and_comm, and.left_comm, or.left_comm] },
    intros m e, subst a', revert m, apply not_or_distrib.2,
    have nd' := v.as_list_nodup _,
    simp [hl, list.nodup_append] at nd', simp [nd'] },
  { suffices : ∀_:sigma.mk a' b' ∈ bucket_array.as_list bkts, a ≠ a',
    { simp [erase, @dif_neg (contains_aux a bkt) _ Hc, entries, and_iff_right_of_imp this] },
    intros m e, subst a',
    exact Hc ((v.contains_aux_iff _ _).2 (list.mem_map_of_mem sigma.fst m)) }
end

theorem find_erase_eq (m : hash_map α β) (a : α) : (m.erase a).find a = none :=
begin
  cases h : (m.erase a).find a with b, {refl},
  exact absurd rfl ((mem_erase m a a b).1 ((find_iff (m.erase a) a b).1 h)).left
end

theorem find_erase_ne (m : hash_map α β) (a a' : α) (h : a ≠ a') :
  (m.erase a).find a' = m.find a' :=
option.eq_of_eq_some $ λb',
(find_iff _ _ _).trans $ (mem_erase m a a' b').trans $
  (and_iff_right h).trans (find_iff _ _ _).symm

theorem find_erase (m : hash_map α β) (a' a : α) :
  (m.erase a).find a' = if a = a' then none else m.find a' :=
if h : a = a' then by subst a'; simp [find_erase_eq m a]
else by rw if_neg h; exact find_erase_ne m a a' h

section string
variables [has_to_string α] [∀ a, has_to_string (β a)]
open prod
private def key_data_to_string (a : α) (b : β a) (first : bool) : string :=
(if first then "" else ", ") ++ sformat!"{a} ← {b}"

private def to_string (m : hash_map α β) : string :=
"⟨" ++ (fst (fold m ("", tt) (λ p a b, (fst p ++ key_data_to_string a b (snd p), ff)))) ++ "⟩"

instance : has_to_string (hash_map α β) :=
⟨to_string⟩

end string

section format
open format prod
variables [has_to_format α] [∀ a, has_to_format (β a)]

private meta def format_key_data (a : α) (b : β a) (first : bool) : format :=
(if first then to_fmt "" else to_fmt "," ++ line) ++
  to_fmt a ++ space ++ to_fmt "←" ++ space ++ to_fmt b

private meta def to_format (m : hash_map α β) : format :=
group $ to_fmt "⟨" ++
  nest 1 (fst (fold m (to_fmt "", tt) (λ p a b, (fst p ++ format_key_data a b (snd p), ff)))) ++
  to_fmt "⟩"

meta instance : has_to_format (hash_map α β) :=
⟨to_format⟩
end format

/-- `hash_map` with key type `nat` and value type that may vary. -/
instance {β : ℕ → Type*} : inhabited (hash_map ℕ β) := ⟨mk_hash_map id⟩

end hash_map


-- import data.int.basic -- this doesnt work
-- import data.real.basic -- this doesnt work

open classical

variables (α : Type*) (p q : α → Prop)
variable r : Prop

example : (∃ x : α, r) → r :=
assume h,
  exists.elim h
    (assume w,
     assume hw,
            hw)
-- ⇯ I don't truly grokk what is going on here. Just following the syntax lol
-- Another way of doing that is using tactics that
-- I learnt in the number game

-- begin
-- cases h, exact h_h
-- end

example (a : α) : r → (∃ x : α, r) :=
assume h, ⟨a,h⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
  (assume hl,
  exists.elim hl
  (assume w,
  assume hw,
  ⟨⟨w, hw.left⟩,hw.right ⟩)) --
  (assume hr,
  exists.elim hr.left
    (assume w,
    assume hw,
  ⟨w, hw, hr.right⟩))  --

-- another way of solving
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
(assume hl,
  match hl with ⟨w, hw ⟩ :=
  ⟨⟨w, hw.left⟩, hw.right ⟩
  end)
(assume hr,
  match hr.left with ⟨w, hw⟩ :=
  ⟨w, hw, hr.right⟩
  end)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
iff.intro
(assume hl,
  exists.elim hl
  (assume w,
  assume hw,
  or.elim hw
  (assume hpw, (or.inl ⟨w, hpw⟩))
  (assume hqw,(or.inr ⟨w, hqw⟩))))
(assume hr, or.elim hr
  (assume hepx,
  exists.elim hepx
  (assume w,
  assume hw, ⟨w, (or.inl hw)⟩))
  (assume hepq,
  exists.elim hepq
  (assume w,
  assume hw, ⟨w, (or.inr hw)⟩)))

-- neater way

-- example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
-- iff.intro
-- (assume hl,
--  match hl with ⟨w, hw⟩ :=
--     or.elim hw
--     (assume hpw, (or.inl ⟨w, hpw⟩))
--     (assume hqw,(or.inr ⟨w, hqw⟩))
--     end)
-- (assume hr,
--   or.elim hr
--   (assume hepx,
--   match hepx with ⟨w,hw⟩ :=
--   ⟨w, (or.inl hw)⟩
--   end)
-- (assume hepw,
--   match hepw with ⟨w,hw⟩ := ⟨w, (or.inr hw)⟩ end ))

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := iff.intro
(assume hl,
  by_contradiction
  (assume h1,
  have h2 : (∃ (x : α), ¬p x),
  from dne h1,
  exists.elim h2
  (assume w,
  assume hw, absurd (hl w) hw)))
(assume hr,
 assume foo,
 by_contradiction
 (assume bar, hr ⟨foo,bar⟩))

 variables a : α

 example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
 iff.intro
 (assume hl,
 by_contradiction
  (assume f,
  have bar : ∀ (x : α), ¬p x, from dne f,
   exists.elim hl
    (assume w,
     assume hw,
     absurd hw (bar w))) )
 (assume hr,
 by_contradiction
 (assume h1,
  have h2 : ∀ x, ¬ p x, from
      assume x,
      assume h3 : p x,
      have h4 : ∃ x, p x, from  ⟨x, h3⟩,
      show false, from h1 h4,
    show false, from hr h2))
-- this one was true dark magic
-- I don't know what is happening
-- but I created h2,x,h3 out of nothing ness LOLL

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
iff.intro
(assume hl,
  assume h1,
  assume h2, hl ⟨h1, h2⟩)
(assume hr,
assume h1,
exists.elim h1
(assume w,
assume hw,
absurd hw (hr w)))

example: (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
iff.intro
(assume hl,
  by_contradiction
    (assume bar,_))      --
--  have h1 : ∀ (x : α), p x, from
(assume hr,
assume h1,
exists.elim hr
  (assume w,
  assume hw,
  absurd (h1 w) hw)) --

-- example: (∀ x, p x → r) ↔ (∃ x, p x) → r := sorry
-- example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := sorry
-- example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := sorry

-- -- *    Prove these equivalences:

-- example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := sorry

-- example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := sorry

-- example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := sorry

-- --  You should also try to understand why the reverse implication is not
-- --    derivable in the last example. It is often possible to bring a component
-- --    of a formula outside a universal quantifier, when it does not depend on
-- --    the quantified variable. Try proving these (one direction of the second of
-- --    these requires classical logic):

-- example : α → ((∀ x : α, r) ↔ r) := sorry
-- example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := sorry
-- example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := sorry

-- -- Consider the “barber paradox,” that is, the claim that in a certain town
-- -- there is a (male) barber that shaves all and only the men who do not
-- -- shave themselves. Prove that this is a contradiction:

-- variables (men : Type*) (barber : men)
-- variable  (shaves : men → men → Prop)

-- example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
-- false := sorry

-- --  Remember that, without any parameters, an expression of type Prop is just
-- --  an assertion. Fill in the definitions of prime and Fermat_prime below,
-- --  and construct each of the given assertions. For example, you can say that
-- --  there are infinitely many primes by asserting that for every natural
-- --  number n, there is a prime number greater than n. Goldbach’s weak
-- --  conjecture states that every odd number greater than 5 is the sum of
-- --  three primes. Look up the definition of a Fermat prime or any of the
-- --  other statements, if necessary.

-- #check even

-- def prime (n : ℕ) : Prop := sorry
-- def infinitely_many_primes : Prop := sorry
-- def Fermat_prime (n : ℕ) : Prop := sorry
-- def infinitely_many_Fermat_primes : Prop := sorry
-- def goldbach_conjecture : Prop := sorry
-- def Goldbach's_weak_conjecture : Prop := sorry
-- def Fermat's_last_theorem : Prop := sorry

-- --  Give a calculational proof of the theorem log_mul below.

-- variables log exp     : real → real
-- variable  log_exp_eq : ∀ x, log (exp x) = x
-- variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
-- variable  exp_pos    : ∀ x, exp x > 0
-- variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

--  -- this ensures the assumptions are available in tactic proofs
--  include log_exp_eq exp_log_eq exp_pos exp_add

-- example (x y z : real) :
--     exp (x + y + z) = exp x * exp y * exp z :=
--   by rw [exp_add, exp_add]
-- example (y : real) (h : y > 0)  : exp (log y) = y :=
--   exp_log_eq h
-- theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
--     log (x * y) = log x + log y :=
--   sorry

-- --  Prove the theorem below, using only the ring properties of ℤ enumerated in
-- --  Section 4.2 and the theorem sub_self.

-- #check sub_self
-- example (x : ℤ) : x * 0 = 0 :=
--  sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import category_theory.simple
import category_theory.linear
import category_theory.endomorphism
import field_theory.algebraic_closure

/-!
# Schur's lemma
We first prove the part of Schur's Lemma that holds in any preadditive category with kernels,
that any nonzero morphism between simple objects
is an isomorphism.

Second, we prove Schur's lemma for `𝕜`-linear categories with finite dimensional hom spaces,
over an algebraically closed field `𝕜`:
the hom space `X ⟶ Y` between simple objects `X` and `Y` is at most one dimensional,
and is 1-dimensional iff `X` and `Y` are isomorphic.

## Future work
It might be nice to provide a `division_ring` instance on `End X` when `X` is simple.
This is an easy consequence of the results here,
but may take some care setting up usable instances.
-/

namespace category_theory

open category_theory.limits

universes v u
variables {C : Type u} [category.{v} C]
variables [preadditive C]

/--
The part of Schur's lemma that holds in any preadditive category with kernels:
that a nonzero morphism between simple objects is an isomorphism.
-/
lemma is_iso_of_hom_simple [has_kernels C] {X Y : C} [simple X] [simple Y] {f : X ⟶ Y} (w : f ≠ 0) :
  is_iso f :=
begin
  haveI : mono f := preadditive.mono_of_kernel_zero (kernel_zero_of_nonzero_from_simple w),
  exact is_iso_of_mono_of_nonzero w
end

/--
As a corollary of Schur's lemma for preadditive categories,
any morphism between simple objects is (exclusively) either an isomorphism or zero.
-/
lemma is_iso_iff_nonzero [has_kernels C] {X Y : C} [simple.{v} X] [simple.{v} Y] (f : X ⟶ Y) :
  is_iso.{v} f ↔ f ≠ 0 :=
⟨λ I,
  begin
    introI h,
    apply id_nonzero X,
    simp only [←is_iso.hom_inv_id f, h, zero_comp],
  end,
  λ w, is_iso_of_hom_simple w⟩

open finite_dimensional

variables (𝕜 : Type*) [field 𝕜]

/--
Part of Schur's lemma for `𝕜`-linear categories:
the hom space between two non-isomorphic simple objects is 0-dimensional.
-/
lemma finrank_hom_simple_simple_eq_zero_of_not_iso
  [has_kernels C] [linear 𝕜 C] {X Y : C} [simple.{v} X] [simple.{v} Y]
  (h : (X ≅ Y) → false):
  finrank 𝕜 (X ⟶ Y) = 0 :=
begin
  haveI := subsingleton_of_forall_eq (0 : X ⟶ Y) (λ f, begin
    have p := not_congr (is_iso_iff_nonzero f),
    simp only [not_not, ne.def] at p,
    refine p.mp (λ _, by exactI h (as_iso f)),
  end),
  exact finrank_zero_of_subsingleton,
end

variables [is_alg_closed 𝕜] [linear 𝕜 C]

-- In the proof below we have some difficulty using `I : finite_dimensional 𝕜 (X ⟶ X)`
-- where we need a `finite_dimensional 𝕜 (End X)`.
-- These are definitionally equal, but without eta reduction Lean can't see this.
-- To get around this, we use `convert I`,
-- then check the various instances agree field-by-field,
-- using `ext` equipped with the following extra lemmas:
local attribute [ext] add_comm_group module distrib_mul_action mul_action has_scalar

/--
An auxiliary lemma for Schur's lemma.

If `X ⟶ X` is finite dimensional, and every nonzero endomorphism is invertible,
then `X ⟶ X` is 1-dimensional.
-/
-- We prove this with the explicit `is_iso_iff_nonzero` assumption,
-- rather than just `[simple X]`, as this form is useful for
-- Müger's formulation of semisimplicity.
lemma finrank_endomorphism_eq_one
  {X : C} (is_iso_iff_nonzero : ∀ f : X ⟶ X, is_iso f ↔ f ≠ 0)
  [I : finite_dimensional 𝕜 (X ⟶ X)] :
  finrank 𝕜 (X ⟶ X) = 1 :=
begin
  have id_nonzero := (is_iso_iff_nonzero (𝟙 X)).mp (by apply_instance),
  apply finrank_eq_one (𝟙 X),
  { exact id_nonzero, },
  { intro f,
    haveI : nontrivial (End X) := nontrivial_of_ne _ _ id_nonzero,
    obtain ⟨c, nu⟩ := @exists_spectrum_of_is_alg_closed_of_finite_dimensional 𝕜 _ _ (End X) _ _ _
      (by { convert I, ext; refl, ext; refl, }) (End.of f),
    use c,
    rw [is_unit_iff_is_iso, is_iso_iff_nonzero, ne.def, not_not, sub_eq_zero,
      algebra.algebra_map_eq_smul_one] at nu,
    exact nu.symm, },
end

variables [has_kernels C]

/--
Schur's lemma for endomorphisms in `𝕜`-linear categories.
-/
lemma finrank_endomorphism_simple_eq_one
  (X : C) [simple.{v} X] [I : finite_dimensional 𝕜 (X ⟶ X)] :
  finrank 𝕜 (X ⟶ X) = 1 :=
finrank_endomorphism_eq_one 𝕜 is_iso_iff_nonzero

lemma endomorphism_simple_eq_smul_id
  {X : C} [simple.{v} X] [I : finite_dimensional 𝕜 (X ⟶ X)] (f : X ⟶ X) :
  ∃ c : 𝕜, c • 𝟙 X = f :=
(finrank_eq_one_iff_of_nonzero' (𝟙 X) (id_nonzero X)).mp (finrank_endomorphism_simple_eq_one 𝕜 X) f

/--
Schur's lemma for `𝕜`-linear categories:
if hom spaces are finite dimensional, then the hom space between simples is at most 1-dimensional.

See `finrank_hom_simple_simple_eq_one_iff` and `finrank_hom_simple_simple_eq_zero_iff` below
for the refinements when we know whether or not the simples are isomorphic.
-/
-- We don't really need `[∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)]` here,
-- just at least one of `[finite_dimensional 𝕜 (X ⟶ X)]` or `[finite_dimensional 𝕜 (Y ⟶ Y)]`.
lemma finrank_hom_simple_simple_le_one
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) ≤ 1 :=
begin
  cases subsingleton_or_nontrivial (X ⟶ Y) with h,
  { resetI,
    convert zero_le_one,
    exact finrank_zero_of_subsingleton, },
  { obtain ⟨f, nz⟩ := (nontrivial_iff_exists_ne 0).mp h,
    haveI fi := (is_iso_iff_nonzero f).mpr nz,
    apply finrank_le_one f,
    intro g,
    obtain ⟨c, w⟩ := endomorphism_simple_eq_smul_id 𝕜 (g ≫ inv f),
    exact ⟨c, by simpa using w =≫ f⟩, },
end

lemma finrank_hom_simple_simple_eq_one_iff
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) = 1 ↔ nonempty (X ≅ Y) :=
begin
  fsplit,
  { intro h,
    rw finrank_eq_one_iff' at h,
    obtain ⟨f, nz, -⟩ := h,
    rw ←is_iso_iff_nonzero at nz,
    exactI ⟨as_iso f⟩, },
  { rintro ⟨f⟩,
    have le_one := finrank_hom_simple_simple_le_one 𝕜 X Y,
    have zero_lt : 0 < finrank 𝕜 (X ⟶ Y) :=
      finrank_pos_iff_exists_ne_zero.mpr ⟨f.hom, (is_iso_iff_nonzero f.hom).mp infer_instance⟩,
    linarith, }
end

lemma finrank_hom_simple_simple_eq_zero_iff
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) = 0 ↔ ¬ nonempty (X ≅ Y) :=
begin
  rw ←not_congr (finrank_hom_simple_simple_eq_one_iff 𝕜 X Y),
  refine ⟨λ h, by { rw h, simp, }, λ h, _⟩,
  have := finrank_hom_simple_simple_le_one 𝕜 X Y,
  interval_cases finrank 𝕜 (X ⟶ Y) with h',
  { exact h', },
  { exact false.elim (h h'), },
end

end category_theory


/-
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.traversable.lemmas
import data.equiv.basic

/-!
# Transferring `traversable` instances along isomorphisms

This file allows to transfer `traversable` instances along isomorphisms.

## Main declarations

* `equiv.map`: Turns functorially a function `α → β` into a function `t' α → t' β` using the functor
  `t` and the equivalence `Π α, t α ≃ t' α`.
* `equiv.functor`: `equiv.map` as a functor.
* `equiv.traverse`: Turns traversably a function `α → m β` into a function `t' α → m (t' β)` using
  the traversable functor `t` and the equivalence `Π α, t α ≃ t' α`.
* `equiv.traversable`: `equiv.traverse` as a traversable functor.
* `equiv.is_lawful_traversable`: `equiv.traverse` as a lawful traversable functor.
-/

universes u

namespace equiv

section functor
parameters {t t' : Type u → Type u}
parameters (eqv : Π α, t α ≃ t' α)
variables [functor t]

open functor

/-- Given a functor `t`, a function `t' : Type u → Type u`, and
equivalences `t α ≃ t' α` for all `α`, then every function `α → β` can
be mapped to a function `t' α → t' β` functorially (see
`equiv.functor`). -/
protected def map {α β : Type u} (f : α → β) (x : t' α) : t' β :=
eqv β $ map f ((eqv α).symm x)

/-- The function `equiv.map` transfers the functoriality of `t` to
`t'` using the equivalences `eqv`.  -/
protected def functor : functor t' :=
{ map := @equiv.map _ }

variables [is_lawful_functor t]

protected lemma id_map {α : Type u} (x : t' α) : equiv.map id x = x :=
by simp [equiv.map, id_map]

protected lemma comp_map {α β γ : Type u} (g : α → β) (h : β → γ) (x : t' α) :
  equiv.map (h ∘ g) x = equiv.map h (equiv.map g x) :=
by simp [equiv.map]; apply comp_map

protected lemma is_lawful_functor : @is_lawful_functor _ equiv.functor :=
{ id_map := @equiv.id_map _ _,
  comp_map := @equiv.comp_map _ _ }

protected lemma is_lawful_functor' [F : _root_.functor t']
  (h₀ : ∀ {α β} (f : α → β), _root_.functor.map f = equiv.map f)
  (h₁ : ∀ {α β} (f : β), _root_.functor.map_const f = (equiv.map ∘ function.const α) f) :
  _root_.is_lawful_functor t' :=
begin
  have : F = equiv.functor,
  { casesI F, dsimp [equiv.functor],
    congr; ext; [rw ← h₀, rw ← h₁] },
  substI this,
  exact equiv.is_lawful_functor
end

end functor

section traversable
parameters {t t' : Type u → Type u}
parameters (eqv : Π α, t α ≃ t' α)
variables [traversable t]
variables {m : Type u → Type u} [applicative m]
variables {α β : Type u}

/-- Like `equiv.map`, a function `t' : Type u → Type u` can be given
the structure of a traversable functor using a traversable functor
`t'` and equivalences `t α ≃ t' α` for all α.  See `equiv.traversable`. -/
protected def traverse (f : α → m β) (x : t' α) : m (t' β) :=
eqv β <$> traverse f ((eqv α).symm x)

/-- The function `equiv.traverse` transfers a traversable functor
instance across the equivalences `eqv`. -/
protected def traversable : traversable t' :=
{ to_functor := equiv.functor eqv,
  traverse := @equiv.traverse _ }

end traversable

section equiv
parameters {t t' : Type u → Type u}
parameters (eqv : Π α, t α ≃ t' α)
variables [traversable t] [is_lawful_traversable t]
variables {F G : Type u → Type u} [applicative F] [applicative G]
variables [is_lawful_applicative F] [is_lawful_applicative G]
variables (η : applicative_transformation F G)
variables {α β γ : Type u}

open is_lawful_traversable functor

protected lemma id_traverse (x : t' α) :
  equiv.traverse eqv id.mk x = x :=
by simp! [equiv.traverse,id_bind,id_traverse,functor.map] with functor_norm

protected lemma traverse_eq_map_id (f : α → β) (x : t' α) :
  equiv.traverse eqv (id.mk ∘ f) x = id.mk (equiv.map eqv f x) :=
by simp [equiv.traverse, traverse_eq_map_id] with functor_norm; refl

protected lemma comp_traverse (f : β → F γ) (g : α → G β) (x : t' α) :
  equiv.traverse eqv (comp.mk ∘ functor.map f ∘ g) x =
  comp.mk (equiv.traverse eqv f <$> equiv.traverse eqv g x) :=
by simp [equiv.traverse,comp_traverse] with functor_norm; congr; ext; simp

protected lemma naturality (f : α → F β) (x : t' α) :
  η (equiv.traverse eqv f x) = equiv.traverse eqv (@η _ ∘ f) x :=
by simp only [equiv.traverse] with functor_norm

/-- The fact that `t` is a lawful traversable functor carries over the
equivalences to `t'`, with the traversable functor structure given by
`equiv.traversable`. -/
protected def is_lawful_traversable : @is_lawful_traversable t' (equiv.traversable eqv) :=
{ to_is_lawful_functor := @equiv.is_lawful_functor _ _ eqv _ _,
  id_traverse := @equiv.id_traverse _ _,
  comp_traverse := @equiv.comp_traverse _ _,
  traverse_eq_map_id := @equiv.traverse_eq_map_id _ _,
  naturality := @equiv.naturality _ _ }

/-- If the `traversable t'` instance has the properties that `map`,
`map_const`, and `traverse` are equal to the ones that come from
carrying the traversable functor structure from `t` over the
equivalences, then the fact that `t` is a lawful traversable functor
carries over as well. -/
protected def is_lawful_traversable' [_i : traversable t']
  (h₀ : ∀ {α β} (f : α → β),
         map f = equiv.map eqv f)
  (h₁ : ∀ {α β} (f : β),
         map_const f = (equiv.map eqv ∘ function.const α) f)
  (h₂ : ∀ {F : Type u → Type u} [applicative F],
        by exactI ∀ [is_lawful_applicative F]
          {α β} (f : α → F β),
         traverse f = equiv.traverse eqv f) :
  _root_.is_lawful_traversable t' :=
begin
    -- we can't use the same approach as for `is_lawful_functor'` because
    -- h₂ needs a `is_lawful_applicative` assumption
  refine {to_is_lawful_functor :=
    equiv.is_lawful_functor' eqv @h₀ @h₁, ..}; introsI,
  { rw [h₂, equiv.id_traverse], apply_instance },
  { rw [h₂, equiv.comp_traverse f g x, h₂], congr,
    rw [h₂], all_goals { apply_instance } },
  { rw [h₂, equiv.traverse_eq_map_id, h₀]; apply_instance },
  { rw [h₂, equiv.naturality, h₂]; apply_instance }
end

end equiv
end equiv


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.basic
import Mathlib.PostPort

universes u_1 u_2 u_4 u_5 u_3

namespace Mathlib

/-!
# Renaming variables of polynomials

This file establishes the `rename` operation on multivariate polynomials,
which modifies the set of variables.

## Main declarations

* `mv_polynomial.rename`

## Notation

As in other polynomial files, we typically use the notation:

+ `σ τ α : Type*` (indexing the variables)

+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `r : R` elements of the coefficient ring

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ α`

-/

namespace mv_polynomial

/-- Rename all the variables in a multivariable polynomial. -/
def rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ) :
    alg_hom R (mv_polynomial σ R) (mv_polynomial τ R) :=
  aeval (X ∘ f)

@[simp] theorem rename_C {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (r : R) : coe_fn (rename f) (coe_fn C r) = coe_fn C r :=
  eval₂_C (algebra_map R (mv_polynomial τ R)) (fun (n : σ) => function.comp X f n) r

@[simp] theorem rename_X {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (i : σ) : coe_fn (rename f) (X i) = X (f i) :=
  eval₂_X (algebra_map R (mv_polynomial τ R)) (fun (n : σ) => function.comp X f n) i

theorem map_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (g : σ → τ) (p : mv_polynomial σ R) :
    coe_fn (map f) (coe_fn (rename g) p) = coe_fn (rename g) (coe_fn (map f) p) :=
  sorry

@[simp] theorem rename_rename {σ : Type u_1} {τ : Type u_2} {α : Type u_3} {R : Type u_4}
    [comm_semiring R] (f : σ → τ) (g : τ → α) (p : mv_polynomial σ R) :
    coe_fn (rename g) (coe_fn (rename f) p) = coe_fn (rename (g ∘ f)) p :=
  sorry

@[simp] theorem rename_id {σ : Type u_1} {R : Type u_4} [comm_semiring R] (p : mv_polynomial σ R) :
    coe_fn (rename id) p = p :=
  eval₂_eta p

theorem rename_monomial {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (d : σ →₀ ℕ) (r : R) : coe_fn (rename f) (monomial d r) = monomial (finsupp.map_domain f d) r :=
  sorry

theorem rename_eq {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (p : mv_polynomial σ R) : coe_fn (rename f) p = finsupp.map_domain (finsupp.map_domain f) p :=
  sorry

theorem rename_injective {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (hf : function.injective f) : function.injective ⇑(rename f) :=
  sorry

theorem eval₂_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (k : σ → τ) (g : τ → S) (p : mv_polynomial σ R) :
    eval₂ f g (coe_fn (rename k) p) = eval₂ f (g ∘ k) p :=
  sorry

theorem eval₂_hom_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5}
    [comm_semiring R] [comm_semiring S] (f : R →+* S) (k : σ → τ) (g : τ → S)
    (p : mv_polynomial σ R) :
    coe_fn (eval₂_hom f g) (coe_fn (rename k) p) = coe_fn (eval₂_hom f (g ∘ k)) p :=
  eval₂_rename f k (fun (n : τ) => g n) p

theorem aeval_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5} [comm_semiring R]
    [comm_semiring S] (k : σ → τ) (g : τ → S) (p : mv_polynomial σ R) [algebra R S] :
    coe_fn (aeval g) (coe_fn (rename k) p) = coe_fn (aeval (g ∘ k)) p :=
  eval₂_hom_rename (algebra_map R S) k (fun (n : τ) => g n) p

theorem rename_eval₂ {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (k : σ → τ)
    (p : mv_polynomial σ R) (g : τ → mv_polynomial σ R) :
    coe_fn (rename k) (eval₂ C (g ∘ k) p) = eval₂ C (⇑(rename k) ∘ g) (coe_fn (rename k) p) :=
  sorry

theorem rename_prodmk_eval₂ {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (p : mv_polynomial σ R) (j : τ) (g : σ → mv_polynomial σ R) :
    coe_fn (rename (Prod.mk j)) (eval₂ C g p) =
        eval₂ C (fun (x : σ) => coe_fn (rename (Prod.mk j)) (g x)) p :=
  sorry

theorem eval₂_rename_prodmk {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5}
    [comm_semiring R] [comm_semiring S] (f : R →+* S) (g : σ × τ → S) (i : σ)
    (p : mv_polynomial τ R) :
    eval₂ f g (coe_fn (rename (Prod.mk i)) p) = eval₂ f (fun (j : τ) => g (i, j)) p :=
  sorry

theorem eval_rename_prodmk {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (g : σ × τ → R) (i : σ) (p : mv_polynomial τ R) :
    coe_fn (eval g) (coe_fn (rename (Prod.mk i)) p) = coe_fn (eval fun (j : τ) => g (i, j)) p :=
  eval₂_rename_prodmk (ring_hom.id R) (fun (n : σ × τ) => g n) i p

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_finset_rename {σ : Type u_1} {R : Type u_4} [comm_semiring R]
    (p : mv_polynomial σ R) :
    ∃ (s : finset σ),
        ∃ (q : mv_polynomial (Subtype fun (x : σ) => x ∈ s) R), p = coe_fn (rename coe) q :=
  sorry

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_fin_rename {σ : Type u_1} {R : Type u_4} [comm_semiring R] (p : mv_polynomial σ R) :
    ∃ (n : ℕ),
        ∃ (f : fin n → σ),
          ∃ (hf : function.injective f), ∃ (q : mv_polynomial (fin n) R), p = coe_fn (rename f) q :=
  sorry

theorem eval₂_cast_comp {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (c : ℤ →+* R) (g : τ → R) (p : mv_polynomial σ ℤ) :
    eval₂ c (g ∘ f) p = eval₂ c g (coe_fn (rename f) p) :=
  sorry

@[simp] theorem coeff_rename_map_domain {σ : Type u_1} {τ : Type u_2} {R : Type u_4}
    [comm_semiring R] (f : σ → τ) (hf : function.injective f) (φ : mv_polynomial σ R) (d : σ →₀ ℕ) :
    coeff (finsupp.map_domain f d) (coe_fn (rename f) φ) = coeff d φ :=
  sorry

theorem coeff_rename_eq_zero {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ)
    (h : ∀ (u : σ →₀ ℕ), finsupp.map_domain f u = d → coeff u φ = 0) :
    coeff d (coe_fn (rename f) φ) = 0 :=
  sorry

theorem coeff_rename_ne_zero {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ) (h : coeff d (coe_fn (rename f) φ) ≠ 0) :
    ∃ (u : σ →₀ ℕ), finsupp.map_domain f u = d ∧ coeff u φ ≠ 0 :=
  sorry

@[simp] theorem constant_coeff_rename {σ : Type u_1} {R : Type u_4} [comm_semiring R] {τ : Type u_2}
    (f : σ → τ) (φ : mv_polynomial σ R) :
    coe_fn constant_coeff (coe_fn (rename f) φ) = coe_fn constant_coeff φ :=
  sorry

end Mathlib


import tactic
import tactic.induction

import .base .bounded .nice

noncomputable theory
open_locale classical

lemma lem_2_4 {pw N : ℕ}
  (h : ∃ (d : D), ∀ (a : A pw), A_trapped_in_for a d (bounded N)) :
  ∃ (d : D), d.nice pw ∧ ∀ (a : A pw), A_trapped_in_for a d (bounded N) :=
begin
  sorry
end


inductive Foo where
  | c1 (x : Nat) | c2 | c3 | c4

def bla : Foo → Nat
  | .c1 x => x + 1
  | _     => 2

example (x : Foo) : bla x > 0 := by
  cases x with
  | _  => decide -- Error
  | c1 => decide

example (x : Foo) : bla x > 0 := by
  induction x with
  | _  => decide -- Error
  | c1 => decide

example (x : Foo) : bla x > 0 := by
  cases x with
  | c1 x => simp_arith [bla]
  | _    => decide

example (x : Foo) : bla x > 0 := by
  induction x with
  | c1 x => simp_arith [bla]
  | _    => decide


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.concrete_category.bundled_hom
import Mathlib.category_theory.concrete_category.reflects_isomorphisms
import Mathlib.algebra.punit_instances
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Category instances for monoid, add_monoid, comm_monoid, and add_comm_monoid.

We introduce the bundled categories:
* `Mon`
* `AddMon`
* `CommMon`
* `AddCommMon`
along with the relevant forgetful functors between them.
-/

/-- The category of monoids and monoid morphisms. -/
def Mon := category_theory.bundled monoid

/-- The category of additive monoids and monoid morphisms. -/
namespace Mon

protected instance Mathlib.AddMon.bundled_hom : category_theory.bundled_hom add_monoid_hom :=
  category_theory.bundled_hom.mk add_monoid_hom.to_fun add_monoid_hom.id add_monoid_hom.comp

protected instance Mathlib.AddMon.concrete_category : category_theory.concrete_category AddMon :=
  category_theory.bundled_hom.category_theory.bundled.category_theory.concrete_category
    add_monoid_hom

/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
def Mathlib.AddMon.of (M : Type u) [add_monoid M] : AddMon := category_theory.bundled.of M

/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
-- The default instance for `monoid punit` is derived via `punit.comm_ring`,

protected instance Mathlib.AddMon.inhabited : Inhabited AddMon := { default := AddMon.of PUnit }

-- which breaks to_additive.

protected instance Mathlib.AddMon.add_monoid (M : AddMon) : add_monoid ↥M :=
  category_theory.bundled.str M

@[simp] theorem Mathlib.AddMon.coe_of (R : Type u) [add_monoid R] : ↥(AddMon.of R) = R := rfl

end Mon

/-- The category of commutative monoids and monoid morphisms. -/
def CommMon := category_theory.bundled comm_monoid

/-- The category of additive commutative monoids and monoid morphisms. -/
namespace CommMon

protected instance comm_monoid.to_monoid.category_theory.bundled_hom.parent_projection :
    category_theory.bundled_hom.parent_projection comm_monoid.to_monoid :=
  category_theory.bundled_hom.parent_projection.mk

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

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

/-- Construct a bundled `AddCommMon` from the underlying type and typeclass. -/
-- The default instance for `comm_monoid punit` is derived via `punit.comm_ring`,

protected instance Mathlib.AddCommMon.inhabited : Inhabited AddCommMon :=
  { default := AddCommMon.of PUnit }

-- which breaks to_additive.

protected instance Mathlib.AddCommMon.add_comm_monoid (M : AddCommMon) : add_comm_monoid ↥M :=
  category_theory.bundled.str M

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

protected instance Mathlib.AddCommMon.has_forget_to_AddMon :
    category_theory.has_forget₂ AddCommMon AddMon :=
  category_theory.bundled_hom.forget₂ add_monoid_hom add_comm_monoid.to_add_monoid

end CommMon

-- We verify that the coercions of morphisms to functions work correctly:

-- We verify that when constructing a morphism in `CommMon`,

-- when we construct the `to_fun` field, the types are presented as `↥R`,

-- rather than `R.α` or (as we used to have) `↥(bundled.map comm_monoid.to_monoid R)`.

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

@[simp] theorem mul_equiv.to_Mon_iso_hom {X : Type u} {Y : Type u} [monoid X] [monoid Y]
    {e : X ≃* Y} : category_theory.iso.hom (mul_equiv.to_Mon_iso e) = mul_equiv.to_monoid_hom e :=
  rfl

@[simp] theorem add_equiv.to_AddMon_iso_inv {X : Type u} {Y : Type u} [add_monoid X] [add_monoid Y]
    {e : X ≃+ Y} :
    category_theory.iso.inv (add_equiv.to_AddMon_iso e) =
        add_equiv.to_add_monoid_hom (add_equiv.symm e) :=
  rfl

/-- Build an isomorphism in the category `CommMon` from a `mul_equiv` between `comm_monoid`s. -/
def add_equiv.to_AddCommMon_iso {X : Type u} {Y : Type u} [add_comm_monoid X] [add_comm_monoid Y]
    (e : X ≃+ Y) : AddCommMon.of X ≅ AddCommMon.of Y :=
  category_theory.iso.mk (add_equiv.to_add_monoid_hom e)
    (add_equiv.to_add_monoid_hom (add_equiv.symm e))

@[simp] theorem add_equiv.to_AddCommMon_iso_hom {X : Type u} {Y : Type u} [add_comm_monoid X]
    [add_comm_monoid Y] {e : X ≃+ Y} :
    category_theory.iso.hom (add_equiv.to_AddCommMon_iso e) = add_equiv.to_add_monoid_hom e :=
  rfl

@[simp] theorem add_equiv.to_AddCommMon_iso_inv {X : Type u} {Y : Type u} [add_comm_monoid X]
    [add_comm_monoid Y] {e : X ≃+ Y} :
    category_theory.iso.inv (add_equiv.to_AddCommMon_iso e) =
        add_equiv.to_add_monoid_hom (add_equiv.symm e) :=
  rfl

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Mon`. -/
def AddMon_iso_to_add_equiv {X : AddMon} {Y : AddMon} (i : X ≅ Y) : ↥X ≃+ ↥Y :=
  add_monoid_hom.to_add_equiv (hom i) (inv i) (hom_inv_id i) (inv_hom_id i)

/-- Build a `mul_equiv` from an isomorphism in the category `CommMon`. -/
def CommMon_iso_to_add_equiv {X : AddCommMon} {Y : AddCommMon} (i : X ≅ Y) : ↥X ≃+ ↥Y :=
  add_monoid_hom.to_add_equiv (hom i) (inv i) (hom_inv_id i) (inv_hom_id i)

end category_theory.iso

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

/-- multiplicative equivalences between `comm_monoid`s are the same as (isomorphic to) isomorphisms
in `CommMon` -/
def add_equiv_iso_AddCommMon_iso {X : Type u} {Y : Type u} [add_comm_monoid X] [add_comm_monoid Y] :
    X ≃+ Y ≅ AddCommMon.of X ≅ AddCommMon.of Y :=
  category_theory.iso.mk (fun (e : X ≃+ Y) => add_equiv.to_AddCommMon_iso e)
    fun (i : AddCommMon.of X ≅ AddCommMon.of Y) => category_theory.iso.CommMon_iso_to_add_equiv i

protected instance AddMon.forget_reflects_isos :
    category_theory.reflects_isomorphisms (category_theory.forget AddMon) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : AddMon) (f : X ⟶ Y)
      (_x :
      category_theory.is_iso (category_theory.functor.map (category_theory.forget AddMon) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget AddMon) X ≅
          category_theory.functor.obj (category_theory.forget AddMon) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget AddMon) f);
      let e : ↥X ≃+ ↥Y :=
        add_equiv.mk (add_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 (add_equiv.to_AddMon_iso e))

protected instance CommMon.forget_reflects_isos :
    category_theory.reflects_isomorphisms (category_theory.forget CommMon) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : CommMon) (f : X ⟶ Y)
      (_x :
      category_theory.is_iso (category_theory.functor.map (category_theory.forget CommMon) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget CommMon) X ≅
          category_theory.functor.obj (category_theory.forget CommMon) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget CommMon) 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_CommMon_iso e))

end Mathlib