import graph_theory.path
variables {V V' V'': Type*}
open function

namespace simple_graph
open walk

structure path_embedding (G : simple_graph V) (G' : simple_graph V') :=
  (f        : V ↪ V')
  (df       : Π e : G.dart, G'.walk (f e.fst) (f e.snd))
  --
  (nodup    : ∀ e : G.dart, (df e).support.nodup)
  (sym      : ∀ e : G.dart, df e.symm = (df e).reverse)
  --
  (endpoint : ∀ {e x}, f x ∈ (df e).support → x ∈ e.edge)
  --
  (disjoint : ∀ {e e' z}, z ∈ (df e).support → z ∈ (df e').support →
    e.edge = e'.edge ∨ ∃ x, z = f x)

def embeds_into (G : simple_graph V) (G' : simple_graph V') := nonempty (path_embedding G G')

infix ` ≼t `:50 := embeds_into -- TODO rename as topological minor

namespace path_embedding

variables {G : simple_graph V} {G' : simple_graph V'} {G'' : simple_graph V''}
variables (F : path_embedding G G')
variables {x y z : V} {x' y' z' : V'} {p : walk G x y} {p' : walk G y z}

lemma nop {e : G.dart} : 0 < (F.df e).length :=
pos_iff_ne_zero.mpr $ λ h, G.ne_of_adj e.is_adj $ F.f.injective $ point_of_size_0 h

@[simp] def follow : Π {x y : V}, walk G x y → walk G' (F.f x) (F.f y)
| _ _ nil        := nil
| _ _ (cons h p) := F.df ⟨⟨_,_⟩,h⟩ ++ follow p

@[simp] lemma follow_append : follow F (p ++ p') = follow F p ++ follow F p' :=
by { induction p, refl, simp only [cons_append,append_assoc,p_ih,follow] }

lemma mem_follow (h₁ : 0 < p.length) (h₂ : z' ∈ (follow F p).support) :
  ∃ e ∈ darts p, z' ∈ (F.df e).support :=
begin
  induction p with u u v w h p ih, {simp at h₁, contradiction}, clear h₁,
  simp only [follow, mem_support_append_iff] at h₂, cases h₂,
  { exact ⟨⟨⟨_,_⟩, h⟩, or.inl rfl, h₂⟩ },
  { cases p,
    { refine ⟨⟨⟨_,_⟩,h⟩, or.inl rfl, _⟩, simp only [follow, support_nil, list.mem_singleton] at h₂,
      rw h₂, exact end_mem_support _ },
    { specialize ih _ h₂, simp only [length_cons, nat.succ_pos'],
      choose e h₃ h₄ using ih, exact ⟨e, or.inr h₃, h₄⟩ } }
end

lemma follow_nodup {p : walk G x y} (h : p.support.nodup) : (follow F p).support.nodup :=
begin
  induction p with u u v w h p ih,
  { simp only [follow, support_nil, list.nodup_cons, list.not_mem_nil, not_false_iff,
    list.nodup_nil, and_self] },
  { simp only [follow], simp only [support_cons, list.nodup_cons] at h, apply nodup_concat.mpr,
    refine ⟨F.nodup _, ih h.2, _⟩, rintros z h3 h4,
    cases nat.eq_zero_or_pos p.length with h5 h5,
    { cases p,
      { simp only [follow, support_nil, list.mem_singleton] at h4, exact h4 },
      { simp only [length_cons, nat.succ_ne_zero] at h5, contradiction } },
    { obtain ⟨e,h7,h8⟩ := mem_follow F h5 h4,
      cases F.disjoint h3 h8 with h9 h9,
      { exfalso, apply h.1, apply (mem_of_edges h5).mpr ⟨e,h7,_⟩, rw <-h9,
        exact sym2.mem_mk_left _ _ },
      { obtain ⟨v,_⟩ := h9, subst z, have h10 := F.endpoint h3,
        cases sym2.mem_iff.mp h10 with h10 h10,
        { subst h10, exfalso, apply h.1,
          have := F.endpoint h8, rw [dart.edge] at this, rcases e with ⟨⟨ex,ey⟩,he⟩, simp at this,
          cases this with h12 h12,
          { rw h12, exact p.dart_fst_mem_support_of_mem_darts h7 },
          { rw h12, exact p.dart_snd_mem_support_of_mem_darts h7 } },
        { rw h10 } } } }
end

lemma follow_rev {p : walk G x y} : follow F p.reverse = (follow F p).reverse :=
begin
  induction p with u u v w h p ih, refl,
  simp only [ih.symm, follow, reverse_cons, follow_append, append_nil, reverse_append],
  congr, exact F.sym ⟨⟨_,_⟩,h⟩
end

def comp (F : path_embedding G G') (F' : path_embedding G' G'') : path_embedding G G'' :=
{ f := ⟨F'.f ∘ F.f, injective.comp F'.f.inj' F.f.inj'⟩,
  df := λ e, follow F' (F.df e),
  --
  nodup := λ e, (follow_nodup F') (F.nodup _),
  sym := by { intro e, rewrite F.sym e, apply follow_rev },
  --
  endpoint := by {
    intros e x h1, obtain ⟨e',h4,h5⟩ := mem_follow F' (nop F) h1,
    exact F.endpoint ((walk.mem_of_edges (nop _)).mpr ⟨e',h4,F'.endpoint h5⟩)
  },
  --
  disjoint := by {
    intros e e' z h1 h2,
    replace h1 := mem_follow _ (nop _) h1, obtain ⟨e1,h3,h4⟩ := h1,
    replace h2 := mem_follow _ (nop _) h2, obtain ⟨e2,h5,h6⟩ := h2,
    have h7 := F'.disjoint h4 h6, cases h7,
    { left, clear h4 h6, replace h3 := walk.mem_edges h3, replace h5 := walk.mem_edges h5,
      replace h5 : e1.fst ∈ (F.df e').support ∧ e1.snd ∈ (F.df e').support :=
      by { cases (dart_edge_eq_iff e1 e2).mp h7; subst e1,
        exact h5, simp only [dart.symm], exact h5.symm },
      cases F.disjoint h3.1 h5.1 with h10 h10, exact h10, obtain ⟨x,h10⟩ := h10, rw h10 at h3 h5,
      cases F.disjoint h3.2 h5.2 with h11 h11, exact h11, obtain ⟨y,h11⟩ := h11, rw h11 at h3 h5,
      have h12 := F.endpoint h3.1, have h13 := F.endpoint h3.2,
      have h14 := F.endpoint h5.1, have h15 := F.endpoint h5.2,
      have h16 : x ≠ y := by { intro h, apply G'.ne_of_adj e1.is_adj, convert congr_arg F.f h },
      exact sym2.eq_of_ne_mem h16 h12 h13 h14 h15 },
    { obtain ⟨y,h8⟩ := h7, subst z, replace h4 := F'.endpoint h4, replace h6 := F'.endpoint h6,
      replace h3 := walk.mem_edges h3, replace h5 := walk.mem_edges h5,
      replace h3 : y ∈ (F.df e).support, by { simp only [dart.edge, sym2.mem_iff] at h4,
        rcases e1 with ⟨⟨e1x,e1y⟩,e1h⟩, simp at h4,
        cases h4; subst h4, exact h3.1, exact h3.2 },
      replace h5 : y ∈ (F.df e').support, by { simp only [dart.edge, sym2.mem_iff] at h6,
        rcases e2 with ⟨⟨e2x,e2y⟩,e2h⟩, simp at h6,
        cases h6; subst h6, exact h5.1, exact h5.2 },
      cases F.disjoint h3 h5 with h9 h9,
      { left, exact h9 },
      { obtain ⟨x,h9⟩ := h9, subst h9, right, use x, refl } } } }

theorem trans : embeds_into G G' → embeds_into G' G'' → embeds_into G G'' :=
λ ⟨F⟩ ⟨F'⟩, ⟨comp F F'⟩

def from_hom (f : G →g G') (inj : injective f) : path_embedding G G' :=
{ f := ⟨f, inj⟩,
  df := λ e, cons (f.map_rel' e.is_adj) nil,
  nodup := λ e, by {
    simp only [support_cons, embedding.coe_fn_mk, support_nil, rel_hom.coe_fn_to_fun,
              list.nodup_cons, list.mem_singleton, list.not_mem_nil, not_false_iff,
              list.nodup_nil, and_true],
    exact G'.ne_of_adj (f.map_rel' e.is_adj) },
  sym := λ e, by {
    simp only [dart.symm, reverse_cons, reverse_nil, nil_append, rel_hom.coe_fn_to_fun,
              embedding.coe_fn_mk, eq_self_iff_true, heq_iff_eq, and_self], simp },
  --
  endpoint := λ e x h, by {
    simp only [embedding.coe_fn_mk, support_cons, support_nil, rel_hom.coe_fn_to_fun,
              list.mem_cons_iff, list.mem_singleton] at h,
    simp only [dart.edge, sym2.mem_iff], rcases e with ⟨⟨ex,ey⟩,eh⟩, simp,
    cases h, { left, exact inj h }, { right, exact inj h } },
  --
  disjoint := by { intros e e' z h₁ h₂, right, cases h₁, subst h₁, exact ⟨e.fst,rfl⟩,
    cases h₁, subst h₁, exact ⟨e.snd,rfl⟩, cases h₁ } }

end path_embedding
end simple_graph


/-
Copyright (c) 2021 Mario Carneiro All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.big_operators.norm_num
import data.nat.squarefree
import data.int.gcd
import data.nat.fib
import data.nat.prime
import data.nat.sqrt_norm_num
import analysis.special_functions.pow
import number_theory.legendre_symbol.norm_num

/-!
# Tests for `norm_num` extensions
-/

-- coverage tests
example : nat.sqrt 0 = 0 := by norm_num
example : nat.sqrt 1 = 1 := by norm_num
example : nat.sqrt 2 = 1 := by norm_num
example : nat.sqrt 3 = 1 := by norm_num
example : nat.sqrt 4 = 2 := by norm_num
example : nat.sqrt 9 = 3 := by norm_num
example : nat.sqrt 10 = 3 := by norm_num
example : nat.sqrt 100 = 10 := by norm_num
example : nat.sqrt 120 = 10 := by norm_num
example : nat.sqrt 121 = 11 := by norm_num

example : nat.coprime 1 2 := by norm_num
example : nat.coprime 2 1 := by norm_num
example : ¬ nat.coprime 0 0 := by norm_num
example : ¬ nat.coprime 0 3 := by norm_num
example : ¬ nat.coprime 2 0 := by norm_num
example : nat.coprime 2 3 := by norm_num
example : ¬ nat.coprime 2 4 := by norm_num

example : nat.gcd 1 2 = 1 := by norm_num
example : nat.gcd 2 1 = 1 := by norm_num
example : nat.gcd 0 0 = 0 := by norm_num
example : nat.gcd 0 3 = 3 := by norm_num
example : nat.gcd 2 0 = 2 := by norm_num
example : nat.gcd 2 3 = 1 := by norm_num
example : nat.gcd 2 4 = 2 := by norm_num

example : nat.lcm 1 2 = 2 := by norm_num
example : nat.lcm 2 1 = 2 := by norm_num
example : nat.lcm 0 0 = 0 := by norm_num
example : nat.lcm 0 3 = 0 := by norm_num
example : nat.lcm 2 0 = 0 := by norm_num
example : nat.lcm 2 3 = 6 := by norm_num
example : nat.lcm 2 4 = 4 := by norm_num

example : int.gcd 2 3 = 1 := by norm_num
example : int.gcd (-2) 3 = 1 := by norm_num
example : int.gcd 2 (-3) = 1 := by norm_num
example : int.gcd (-2) (-3) = 1 := by norm_num

example : int.lcm 2 3 = 6 := by norm_num
example : int.lcm (-2) 3 = 6 := by norm_num
example : int.lcm 2 (-3) = 6 := by norm_num
example : int.lcm (-2) (-3) = 6 := by norm_num

example : ¬ nat.prime 0 := by norm_num
example : ¬ nat.prime 1 := by norm_num
example : nat.prime 2 := by norm_num
example : nat.prime 3 := by norm_num
example : ¬ nat.prime 4 := by norm_num
example : nat.prime 5 := by norm_num
example : nat.prime 109 := by norm_num
example : nat.prime 1277 := by norm_num
example : ¬ nat.prime 1000000000000000000000000000000000000000000000000 := by norm_num

example : nat.min_fac 0 = 2 := by norm_num
example : nat.min_fac 1 = 1 := by norm_num
example : nat.min_fac 2 = 2 := by norm_num
example : nat.min_fac 3 = 3 := by norm_num
example : nat.min_fac 4 = 2 := by norm_num
example : nat.min_fac 121 = 11 := by norm_num
example : nat.min_fac 221 = 13 := by norm_num

example : nat.factors 0 = [] := by norm_num
example : nat.factors 1 = [] := by norm_num
example : nat.factors 2 = [2] := by norm_num
example : nat.factors 3 = [3] := by norm_num
example : nat.factors 4 = [2, 2] := by norm_num
example : nat.factors 12 = [2, 2, 3] := by norm_num
example : nat.factors 221 = [13, 17] := by norm_num

-- randomized tests
example : nat.gcd 35 29 = 1 := by norm_num
example : int.gcd 35 29 = 1 := by norm_num
example : nat.lcm 35 29 = 1015 := by norm_num
example : int.gcd 35 29 = 1 := by norm_num
example : nat.coprime 35 29 := by norm_num

example : nat.gcd 80 2 = 2 := by norm_num
example : int.gcd 80 2 = 2 := by norm_num
example : nat.lcm 80 2 = 80 := by norm_num
example : int.gcd 80 2 = 2 := by norm_num
example : ¬ nat.coprime 80 2 := by norm_num

example : nat.gcd 19 17 = 1 := by norm_num
example : int.gcd 19 17 = 1 := by norm_num
example : nat.lcm 19 17 = 323 := by norm_num
example : int.gcd 19 17 = 1 := by norm_num
example : nat.coprime 19 17 := by norm_num

example : nat.gcd 11 18 = 1 := by norm_num
example : int.gcd 11 18 = 1 := by norm_num
example : nat.lcm 11 18 = 198 := by norm_num
example : int.gcd 11 18 = 1 := by norm_num
example : nat.coprime 11 18 := by norm_num

example : nat.gcd 23 73 = 1 := by norm_num
example : int.gcd 23 73 = 1 := by norm_num
example : nat.lcm 23 73 = 1679 := by norm_num
example : int.gcd 23 73 = 1 := by norm_num
example : nat.coprime 23 73 := by norm_num

example : nat.gcd 73 68 = 1 := by norm_num
example : int.gcd 73 68 = 1 := by norm_num
example : nat.lcm 73 68 = 4964 := by norm_num
example : int.gcd 73 68 = 1 := by norm_num
example : nat.coprime 73 68 := by norm_num

example : nat.gcd 28 16 = 4 := by norm_num
example : int.gcd 28 16 = 4 := by norm_num
example : nat.lcm 28 16 = 112 := by norm_num
example : int.gcd 28 16 = 4 := by norm_num
example : ¬ nat.coprime 28 16 := by norm_num

example : nat.gcd 44 98 = 2 := by norm_num
example : int.gcd 44 98 = 2 := by norm_num
example : nat.lcm 44 98 = 2156 := by norm_num
example : int.gcd 44 98 = 2 := by norm_num
example : ¬ nat.coprime 44 98 := by norm_num

example : nat.gcd 21 79 = 1 := by norm_num
example : int.gcd 21 79 = 1 := by norm_num
example : nat.lcm 21 79 = 1659 := by norm_num
example : int.gcd 21 79 = 1 := by norm_num
example : nat.coprime 21 79 := by norm_num

example : nat.gcd 93 34 = 1 := by norm_num
example : int.gcd 93 34 = 1 := by norm_num
example : nat.lcm 93 34 = 3162 := by norm_num
example : int.gcd 93 34 = 1 := by norm_num
example : nat.coprime 93 34 := by norm_num

example : ¬ nat.prime 912 := by norm_num
example : nat.min_fac 912 = 2 := by norm_num
example : nat.factors 912 = [2, 2, 2, 2, 3, 19] := by norm_num

example : ¬ nat.prime 681 := by norm_num
example : nat.min_fac 681 = 3 := by norm_num
example : nat.factors 681 = [3, 227] := by norm_num

example : ¬ nat.prime 728 := by norm_num
example : nat.min_fac 728 = 2 := by norm_num
example : nat.factors 728 = [2, 2, 2, 7, 13] := by norm_num

example : ¬ nat.prime 248 := by norm_num
example : nat.min_fac 248 = 2 := by norm_num
example : nat.factors 248 = [2, 2, 2, 31] := by norm_num

example : ¬ nat.prime 682 := by norm_num
example : nat.min_fac 682 = 2 := by norm_num
example : nat.factors 682 = [2, 11, 31] := by norm_num

example : ¬ nat.prime 115 := by norm_num
example : nat.min_fac 115 = 5 := by norm_num
example : nat.factors 115 = [5, 23] := by norm_num

example : ¬ nat.prime 824 := by norm_num
example : nat.min_fac 824 = 2 := by norm_num
example : nat.factors 824 = [2, 2, 2, 103] := by norm_num

example : ¬ nat.prime 942 := by norm_num
example : nat.min_fac 942 = 2 := by norm_num
example : nat.factors 942 = [2, 3, 157] := by norm_num

example : ¬ nat.prime 34 := by norm_num
example : nat.min_fac 34 = 2 := by norm_num
example : nat.factors 34 = [2, 17] := by norm_num

example : ¬ nat.prime 754 := by norm_num
example : nat.min_fac 754 = 2 := by norm_num
example : nat.factors 754 = [2, 13, 29] := by norm_num

example : ¬ nat.prime 663 := by norm_num
example : nat.min_fac 663 = 3 := by norm_num
example : nat.factors 663 = [3, 13, 17] := by norm_num

example : ¬ nat.prime 923 := by norm_num
example : nat.min_fac 923 = 13 := by norm_num
example : nat.factors 923 = [13, 71] := by norm_num

example : ¬ nat.prime 77 := by norm_num
example : nat.min_fac 77 = 7 := by norm_num
example : nat.factors 77 = [7, 11] := by norm_num

example : ¬ nat.prime 162 := by norm_num
example : nat.min_fac 162 = 2 := by norm_num
example : nat.factors 162 = [2, 3, 3, 3, 3] := by norm_num

example : ¬ nat.prime 669 := by norm_num
example : nat.min_fac 669 = 3 := by norm_num
example : nat.factors 669 = [3, 223] := by norm_num

example : ¬ nat.prime 476 := by norm_num
example : nat.min_fac 476 = 2 := by norm_num
example : nat.factors 476 = [2, 2, 7, 17] := by norm_num

example : nat.prime 251 := by norm_num
example : nat.min_fac 251 = 251 := by norm_num
example : nat.factors 251 = [251] := by norm_num

example : ¬ nat.prime 129 := by norm_num
example : nat.min_fac 129 = 3 := by norm_num
example : nat.factors 129 = [3, 43] := by norm_num

example : ¬ nat.prime 471 := by norm_num
example : nat.min_fac 471 = 3 := by norm_num
example : nat.factors 471 = [3, 157] := by norm_num

example : ¬ nat.prime 851 := by norm_num
example : nat.min_fac 851 = 23 := by norm_num
example : nat.factors 851 = [23, 37] := by norm_num

example : ¬ squarefree 0 := by norm_num
example : squarefree 1 := by norm_num
example : squarefree 2 := by norm_num
example : squarefree 3 := by norm_num
example : ¬ squarefree 4 := by norm_num
example : squarefree 5 := by norm_num
example : squarefree 6 := by norm_num
example : squarefree 7 := by norm_num
example : ¬ squarefree 8 := by norm_num
example : ¬ squarefree 9 := by norm_num
example : squarefree 10 := by norm_num
example : squarefree (2*3*5*17) := by norm_num
example : ¬ squarefree (2*3*5*5*17) := by norm_num
example : squarefree 251 := by norm_num

example : nat.fib 0 = 0 := by norm_num
example : nat.fib 1 = 1 := by norm_num
example : nat.fib 2 = 1 := by norm_num
example : nat.fib 3 = 2 := by norm_num
example : nat.fib 4 = 3 := by norm_num
example : nat.fib 5 = 5 := by norm_num
example : nat.fib 6 = 8 := by norm_num
example : nat.fib 7 = 13 := by norm_num
example : nat.fib 8 = 21 := by norm_num
example : nat.fib 9 = 34 := by norm_num
example : nat.fib 10 = 55 := by norm_num
example : nat.fib 37 = 24157817 := by norm_num
example : nat.fib 64 = 10610209857723 := by norm_num
example : nat.fib 100 + nat.fib 101 = nat.fib 102 := by norm_num

example : (2 : ℝ) ^ (3 : ℝ) = 8 := by norm_num
example : (1 : ℝ) ^ (20 : ℝ) = 1 := by norm_num
example : (2 : ℝ) ^ (-3 : ℝ) = 1/8 := by norm_num

section big_operators

variables {α : Type*} [comm_ring α]

open_locale big_operators

-- Lists:
example : ([1, 2, 1, 3]).sum = 7 := by norm_num [-list.sum_cons]
example : (([1, 2, 1, 3] : list ℚ).map (λ i, i^2)).sum = 15 := by norm_num [-list.map]
example : (list.range 10).sum = 45 := by norm_num [-list.range_succ]
example : (list.fin_range 10).sum = 45 := by norm_num [-list.fin_range_succ]

-- Multisets:
example : (1 ::ₘ 2 ::ₘ 1 ::ₘ 3 ::ₘ {}).sum = 7 := by norm_num [-multiset.sum_cons]
example : ((1 ::ₘ 2 ::ₘ 1 ::ₘ 3 ::ₘ {}).map (λ i, i^2)).sum = 15 := by norm_num [-multiset.map_cons]
example : (({1, 2, 1, 3} : multiset ℚ).map (λ i, i^2)).sum = 15 := by norm_num [-multiset.map_cons]
example : (multiset.range 10).sum = 45 := by norm_num [-multiset.map_cons, -multiset.range_succ]
example : (↑[1, 2, 1, 3] : multiset ℕ).sum = 7 := by norm_num

-- Finsets:
example (f : fin 0 → α) : ∑ i : fin 0, f i = 0 := by norm_num
example (f : ℕ → α) : ∑ i in (∅ : finset ℕ), f i = 0 := by norm_num
example (f : fin 3 → α) : ∑ i : fin 3, f i = f 0 + f 1 + f 2 := by norm_num; ring
example (f : fin 4 → α) : ∑ i : fin 4, f i = f 0 + f 1 + f 2 + f 3 := by norm_num; ring
example (f : ℕ → α) : ∑ i in {0, 1, 2}, f i = f 0 + f 1 + f 2 := by norm_num; ring
example (f : ℕ → α) : ∑ i in {0, 2, 2, 3, 1, 0}, f i = f 0 + f 1 + f 2 + f 3 := by norm_num; ring
example (f : ℕ → α) : ∑ i in {0, 2, 2 - 3, 3 - 1, 1, 0}, f i = f 0 + f 1 + f 2 := by norm_num; ring
example : (∑ i in finset.range 10, (i^2 : ℕ)) = 285 := by norm_num
example : (∑ i in finset.Icc 5 10, (i^2 : ℕ)) = 355 := by norm_num
example : (∑ i in finset.Ico 5 10, (i^2 : ℕ)) = 255 := by norm_num
example : (∑ i in finset.Ioc 5 10, (i^2 : ℕ)) = 330 := by norm_num
example : (∑ i in finset.Ioo 5 10, (i^2 : ℕ)) = 230 := by norm_num
example : (∑ i : ℤ in finset.Ioo (-5) 5, i^2) = 60 := by norm_num
example (f : ℕ → α) : ∑ i in finset.mk {0, 1, 2} dec_trivial, f i = f 0 + f 1 + f 2 :=
  by norm_num; ring

-- Combined with other `norm_num` extensions:
example : ∏ i in finset.range 9, nat.sqrt (i + 1) = 96 := by norm_num
example : ∏ i in {1, 4, 9, 16}, nat.sqrt i = 24 := by norm_num
example : ∏ i in finset.Icc 0 8, nat.sqrt (i + 1) = 96 := by norm_num

-- Nested operations:
example : ∑ i : fin 2, ∑ j : fin 2, ![![0, 1], ![2, 3]] i j = 6 := by norm_num

end big_operators

section jacobi

-- Jacobi and Legendre symbols

open_locale number_theory_symbols

example : J(123 | 335) = -1 := by norm_num
example : J(-2345 | 6789) = -1 := by norm_num
example : J(-1 | 1655801) = 1 := by norm_num
example : J(-102334155 | 165580141) = -1 := by norm_num

example : J(58378362899022564339483801989973056405585914719065 |
            53974350278769849773003214636618718468638750007307) = -1 := by norm_num

example : J(3 + 4 | 3 * 5) = -1 := by norm_num
example : J(J(-1 | 7) | 11) = -1 := by norm_num

instance prime_1000003 : fact (nat.prime 1000003) := ⟨by norm_num⟩
example : legendre_sym 1000003 7 = -1 := by norm_num

end jacobi


import M4R.Algebra.Ring.Defs

namespace M4R

  namespace NCSemiring

    protected instance Product (α₁ : Type _) (α₂ : Type _) [NCSemiring α₁] [NCSemiring α₂] : NCSemiring (α₁ × α₂) where
      one               := (1, 1)
      mul               := fun (a₁, a₂) (b₁, b₂) => (a₁ * b₁, a₂ * b₂)
      mul_one           := fun (a₁, a₂) => by simp [HMul.hMul, Mul.mul]; exact ⟨mul_one a₁, mul_one a₂⟩
      one_mul           := fun (a₁, a₂) => by simp [HMul.hMul, Mul.mul]; exact ⟨one_mul a₁, one_mul a₂⟩
      mul_assoc         := fun (a₁, a₂) (b₁, b₂) (c₁, c₂) => by
        simp [HMul.hMul, Mul.mul];exact ⟨mul_assoc a₁ b₁ c₁, mul_assoc a₂ b₂ c₂⟩
      mul_distrib_left  := fun (a₁, a₂) (b₁, b₂) (c₁, c₂) => by
        simp [HMul.hMul, Mul.mul, HAdd.hAdd, Add.add]; exact ⟨mul_distrib_left a₁ b₁ c₁, mul_distrib_left a₂ b₂ c₂⟩
      mul_distrib_right := fun (a₁, a₂) (b₁, b₂) (c₁, c₂) => by
        simp [HMul.hMul, Mul.mul, HAdd.hAdd, Add.add]; exact ⟨mul_distrib_right a₁ b₁ c₁, mul_distrib_right a₂ b₂ c₂⟩
      mul_zero          := fun (a₁, a₂) => by
        simp [HMul.hMul, Mul.mul, Monoid.product_zero]; exact ⟨mul_zero a₁, mul_zero a₂⟩
      zero_mul          := fun (a₁, a₂) => by
        simp [HMul.hMul, Mul.mul, Monoid.product_zero]; exact ⟨zero_mul a₁, zero_mul a₂⟩

    theorem product_mul {α₁ : Type _} {α₂ : Type _} [NCSemiring α₁] [NCSemiring α₂] : ∀ x y : α₁ × α₂, x * y = (x.fst * y.fst, x.snd * y.snd) :=
      fun (x₁, x₂) (y₁, y₂) => rfl

    protected instance multi_product.One {ι : Type _} (fι : ι → Type _) [∀ i, One (fι i)] : One (MultiProd fι) where
      one := fun _ => 1
    protected theorem multi_product.One_def {ι : Type _} {fι : ι → Type _} [∀ i, One (fι i)] : ∀ i, (1 : MultiProd fι) i = 1 :=
      fun _ => rfl

    protected instance multi_product.Mul {ι : Type _} (fι : ι → Type _) [∀ i, Mul (fι i)] : Mul (MultiProd fι) where
      mul := fun a b i => a i * b i
    protected theorem multi_product.Mul_def {ι : Type _} {fι : ι → Type _} [∀ i, Mul (fι i)] (a b : MultiProd fι) :
      ∀ i, (a * b) i = a i * b i := fun _ => rfl

    protected instance multi_product {ι : Type _} (fι : ι → Type _) [∀ i, NCSemiring (fι i)] : NCSemiring (MultiProd fι) where
      mul_one           := fun a => funext fun i => NCSemiring.mul_one (a i)
      one_mul           := fun a => funext fun i => NCSemiring.one_mul (a i)
      mul_assoc         := fun a b c => funext fun i => NCSemiring.mul_assoc (a i) (b i) (c i)
      mul_distrib_left  := fun a b c => funext fun i => NCSemiring.mul_distrib_left (a i) (b i) (c i)
      mul_distrib_right := fun a b c => funext fun i => NCSemiring.mul_distrib_right (a i) (b i) (c i)
      mul_zero          := fun a => funext fun i => NCSemiring.mul_zero (a i)
      zero_mul          := fun a => funext fun i => NCSemiring.zero_mul (a i)

    theorem ofNat.preserve_succ [NCSemiring α] (n : Nat) : n.succ = (n : α) + 1 := by
      induction n with
      | zero => simp only [NCSemiring.ofNat, Monoid.zero_add]
      | succ k ih => rfl

    theorem ofNat.preserve_add [NCSemiring α] (m n : Nat) : m + n = (m : α) + n := by
      induction n with
      | zero => simp only [NCSemiring.ofNat, Monoid.add_zero]; rfl
      | succ k ih => rw [Nat.add_succ, preserve_succ, preserve_succ, ih, Monoid.add_assoc]

    theorem mul_nat_succ [NCSemiring α] (a : α) (n : Nat) : n.succ * a = n * a + a := by
      rw [ofNat.preserve_succ, mul_distrib_right, one_mul]

    theorem pow_nat_succ [NCSemiring α] (a : α) (x : Nat) : a ^ (Nat.succ x) = a^x * a :=
      match x with
      | Nat.zero => by simp only [HPow.hPow, Pow.pow, NCSemiring.pow_nat, one_mul]
      | Nat.succ k  => rfl

    theorem pow_nat_one [NCSemiring α] (n : Nat) : (1 : α)^n = 1 := by
      induction n with
      | zero      => rfl
      | succ k ih => rw [pow_nat_succ, ih, one_mul]
    theorem pow_nat_0 [NCSemiring α] (a : α) : a ^ (0 : Nat) = 1 := rfl
    theorem pow_nat_1 [NCSemiring α] (a : α) : a ^ (1 : Nat) = a := rfl

    theorem pow_nat_add_distrib [NCSemiring α] (a : α) (m n : Nat) : a^(m + n) = a^m * a^n := by
      induction n with
      | zero      => rw [Nat.add_zero, pow_nat_0, mul_one]
      | succ k ih => rw [Nat.add_succ, pow_nat_succ, pow_nat_succ, ←mul_assoc, ih]

    protected class constructor_ncsr (α : Type _) extends CommMonoid.constructor_cm α, One α, Mul α where
      mul_one           : ∀ a : α, a * 1 = a
      one_mul           : ∀ a : α, 1 * a = a
      mul_assoc         : ∀ a b c : α, (a * b) * c = a * (b * c)
      mul_distrib_left  : ∀ a b c : α, a * (b + c) = a * b + a * c
      mul_distrib_right : ∀ a b c : α, (a + b) * c = a * c + b * c
      mul_zero          : ∀ a : α, a * 0 = 0
      zero_mul          : ∀ a : α, 0 * a = 0

    protected def construct {α : Type _} (c : NCSemiring.constructor_ncsr α) : NCSemiring α where
      toCommMonoid := CommMonoid.construct c.toconstructor_cm
      mul_one           := c.mul_one
      one_mul           := c.one_mul
      mul_assoc         := c.mul_assoc
      mul_distrib_left  := c.mul_distrib_left
      mul_distrib_right := c.mul_distrib_right
      mul_zero          := c.mul_zero
      zero_mul          := c.zero_mul

    protected def to_constructor (α : Type _) [NCSemiring α] : NCSemiring.constructor_ncsr α where
      toconstructor_cm := CommMonoid.to_constructor α
      mul_one           := NCSemiring.mul_one
      one_mul           := NCSemiring.one_mul
      mul_assoc         := NCSemiring.mul_assoc
      mul_distrib_left  := NCSemiring.mul_distrib_left
      mul_distrib_right := NCSemiring.mul_distrib_right
      mul_zero          := NCSemiring.mul_zero
      zero_mul          := NCSemiring.zero_mul

  end NCSemiring

  namespace Semiring
    open NCSemiring

    protected instance Product (α₁ : Type _) (α₂ : Type _) [Semiring α₁] [Semiring α₂] : Semiring (α₁ × α₂) where
      mul_comm := fun (a₁, a₂) (b₁, b₂) => by simp [HMul.hMul, Mul.mul]; exact ⟨mul_comm a₁ b₁, mul_comm a₂ b₂⟩

    protected instance multi_product {ι : Type _} (fι : ι → Type _) [∀ i, Semiring (fι i)] : Semiring (MultiProd fι) where
      mul_comm := fun a b => funext fun i => Semiring.mul_comm (a i) (b i)

    theorem mul_right_comm [Semiring α] (a b c : α) : a * b * c = a * c * b := by
      rw [mul_assoc, mul_comm b, ←mul_assoc]
    theorem mul_left_comm [Semiring α] (a b c : α) : a * (b * c) = b * (a * c) := by
      rw [←mul_assoc, mul_comm a, mul_assoc]

    theorem divides_self [Semiring α] (a : α) : a ÷ a := ⟨1, mul_one a⟩
    theorem divides_zero [Semiring α] (a : α) : a ÷ 0 := ⟨0, mul_zero a⟩
    theorem divides_add [Semiring α] {a b c : α} : a ÷ b → a ÷ c → a ÷ (b + c)
    | ⟨x, axb⟩, ⟨y, ayc⟩ => ⟨x + y, by rw [mul_distrib_left, axb, ayc]⟩
    theorem divides_mul [Semiring α] {a b : α} (c : α) : a ÷ b → a ÷ (b * c)
    | ⟨x, axb⟩ => ⟨x * c, by rw [←mul_assoc, axb]⟩
    theorem divides_mul' [Semiring α] {a c : α} (b : α) : a ÷ c → a ÷ (b * c) := by
      rw [mul_comm]; exact divides_mul b

    theorem isUnit_1 [Semiring α] : isUnit (1 : α) := ⟨1, by simp [one_mul]⟩
    theorem notUnit_0 [Semiring α] : (0 : α) ≠ (1 : α) → ¬isUnit (0 : α) := by
      intro h₁ ⟨_, h₂⟩; rw [zero_mul] at h₂; exact h₁ h₂
    theorem unit_mul [Semiring α] {a b : α} : isUnit a → isUnit b → isUnit (a * b)
    | ⟨x, xs⟩, ⟨y, ys⟩ => by
      apply Exists.intro (y * x); rw [mul_assoc, ←mul_assoc b, ys, one_mul, xs]
    theorem divides_unit [Semiring α] {a b : α} : isUnit b → a ÷ b → isUnit a := by
      intro ub ab
      let ⟨binv, bbinv⟩ := Classical.indefiniteDescription _ ub
      let ⟨c, ac⟩ := Classical.indefiniteDescription _ ab
      exact ⟨c * binv, by rw [←mul_assoc, ac, bbinv]⟩
    theorem unit_divides [Semiring α] : ∀ a b : α, isUnit a → a ÷ b := by
      intro a b ⟨c, ac⟩; exact ⟨c * b, by rw [←mul_assoc, ac, one_mul]⟩

    def unit_set (α : Type _) [Semiring α] : Set α := {x | isUnit x}

    noncomputable def unit_inv [Semiring α] {a : α} (h : isUnit a) : α :=
      Classical.choose h
    theorem mul_unit_inv [Semiring α] {a : α} (h : isUnit a) : a * unit_inv h = 1 :=
      Classical.choose_spec h
    theorem unit_inv_mul [Semiring α] {a : α} (h : isUnit a) : unit_inv h * a = 1 := by
      rw [mul_comm]; exact mul_unit_inv h

    noncomputable instance UnitGroup [Semiring α] : Group ↑(unit_set α) := Group.construct
    {
      zero := ⟨1, ⟨1, by rw [mul_one]⟩⟩
      add := fun a b => ⟨a.val * b.val, unit_mul a.property b.property⟩
      neg := fun ⟨x, xs⟩ => ⟨unit_inv xs, x, unit_inv_mul xs⟩
      add_zero := fun ⟨a, _⟩ => Set.elementExt (mul_one a)
      add_assoc := fun ⟨a, _⟩ ⟨b, _⟩ ⟨c, _⟩ => Set.elementExt (mul_assoc a b c)
      add_neg := fun ⟨a, as⟩ => Set.elementExt (mul_unit_inv as)
    }

    theorem pow_nat_mul_distrib [Semiring α] (a b : α) (m : Nat) : (a * b)^m = a^m * b^m := by
      induction m with
      | zero      => simp only [Nat.zero_eq, pow_nat_0, mul_one]
      | succ k ih => simp only [pow_nat_succ, ←mul_assoc, ih, mul_comm]

    theorem pow_nat_comp [Semiring α] (a : α) (m n : Nat) : (a^m)^n = a^(m*n) := by
      induction m with
      | zero => rw [Nat.zero_mul, pow_nat_0, pow_nat_one]
      | succ k ih => rw [pow_nat_succ, Nat.succ_mul, pow_nat_mul_distrib, ih, pow_nat_add_distrib]

    protected class constructor_sr (α : Type _) extends CommMonoid.constructor_cm α, One α, Mul α where
      mul_one           : ∀ a : α, a * 1 = a
      mul_assoc         : ∀ a b c : α, (a * b) * c = a * (b * c)
      mul_distrib_left  : ∀ a b c : α, a * (b + c) = a * b + a * c
      mul_zero          : ∀ a : α, a * 0 = 0
      mul_comm          : ∀ a b : α, a * b = b * a

    protected def construct {α : Type _} (c : Semiring.constructor_sr α) : Semiring α where
      toCommMonoid      := CommMonoid.construct c.toconstructor_cm
      mul_one           := c.mul_one
      one_mul           := fun a => by rw [c.mul_comm]; exact c.mul_one a
      mul_assoc         := c.mul_assoc
      mul_distrib_left  := c.mul_distrib_left
      mul_distrib_right := fun a b _ => by rw [c.mul_comm, c.mul_comm a, c.mul_comm b]; exact c.mul_distrib_left _ _ _
      mul_zero          := c.mul_zero
      zero_mul          := fun a => by rw [c.mul_comm]; exact c.mul_zero a
      mul_comm          := c.mul_comm

    protected def to_constructor (α : Type _) [Semiring α] : Semiring.constructor_sr α where
      toconstructor_cm  := CommMonoid.to_constructor α
      mul_one           := mul_one
      mul_assoc         := mul_assoc
      mul_distrib_left  := mul_distrib_left
      mul_zero          := mul_zero
      mul_comm          := mul_comm

  end Semiring

  instance NatSemiring : Semiring Nat := Semiring.construct
    {
      toconstructor_cm  := NatMonoid.to_constructor
      mul_one           := Nat.mul_one
      mul_assoc         := Nat.mul_assoc
      mul_distrib_left  := Nat.left_distrib
      mul_zero          := Nat.mul_zero
      mul_comm          := Nat.mul_comm
    }

end M4R


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

import group_theory.finiteness
import ring_theory.adjoin.tower
import ring_theory.finiteness
import ring_theory.noetherian

/-!
# Finiteness conditions in commutative algebra

In this file we define a notion of finiteness that is common in commutative algebra.

## Main declarations

- `algebra.finite_type`, `ring_hom.finite_type`, `alg_hom.finite_type`
  all of these express that some object is finitely generated *as algebra* over some base ring.

-/

open function (surjective)
open_locale big_operators polynomial

section module_and_algebra

variables (R A B M N : Type*)

/-- An algebra over a commutative semiring is of `finite_type` if it is finitely generated
over the base ring as algebra. -/
class algebra.finite_type [comm_semiring R] [semiring A] [algebra R A] : Prop :=
(out : (⊤ : subalgebra R A).fg)

namespace module

variables [semiring R] [add_comm_monoid M] [module R M] [add_comm_monoid N] [module R N]

namespace finite
open _root_.submodule set

variables {R M N}

section algebra

@[priority 100] -- see Note [lower instance priority]
instance finite_type {R : Type*} (A : Type*) [comm_semiring R] [semiring A]
  [algebra R A] [hRA : finite R A] : algebra.finite_type R A :=
⟨subalgebra.fg_of_submodule_fg hRA.1⟩

end algebra

end finite

end module

namespace algebra

variables [comm_ring R] [comm_ring A] [algebra R A] [comm_ring B] [algebra R B]
variables [add_comm_group M] [module R M]
variables [add_comm_group N] [module R N]

namespace finite_type

lemma self : finite_type R R := ⟨⟨{1}, subsingleton.elim _ _⟩⟩

protected lemma polynomial : finite_type R R[X] :=
⟨⟨{polynomial.X}, by { rw finset.coe_singleton, exact polynomial.adjoin_X }⟩⟩

open_locale classical

protected lemma mv_polynomial (ι : Type*) [finite ι] : finite_type R (mv_polynomial ι R) :=
by casesI nonempty_fintype ι; exact ⟨⟨finset.univ.image mv_polynomial.X,
  by {rw [finset.coe_image, finset.coe_univ, set.image_univ], exact mv_polynomial.adjoin_range_X}⟩⟩

variables {R A B}

lemma of_surjective (hRA : finite_type R A) (f : A →ₐ[R] B) (hf : surjective f) :
  finite_type R B :=
⟨begin
  convert hRA.1.map f,
  simpa only [map_top f, @eq_comm _ ⊤, eq_top_iff, alg_hom.mem_range] using hf
end⟩

lemma equiv (hRA : finite_type R A) (e : A ≃ₐ[R] B) : finite_type R B :=
hRA.of_surjective e e.surjective

lemma trans [algebra A B] [is_scalar_tower R A B] (hRA : finite_type R A) (hAB : finite_type A B) :
  finite_type R B :=
⟨fg_trans' hRA.1 hAB.1⟩

/-- An algebra is finitely generated if and only if it is a quotient
of a polynomial ring whose variables are indexed by a finset. -/
lemma iff_quotient_mv_polynomial : (finite_type R A) ↔ ∃ (s : finset A)
  (f : (mv_polynomial {x // x ∈ s} R) →ₐ[R] A), (surjective f) :=
begin
  split,
  { rintro ⟨s, hs⟩,
    use [s, mv_polynomial.aeval coe],
    intro x,
    have hrw : (↑s : set A) = (λ (x : A), x ∈ s.val) := rfl,
    rw [← set.mem_range, ← alg_hom.coe_range, ← adjoin_eq_range, ← hrw, hs],
    exact set.mem_univ x },
  { rintro ⟨s, ⟨f, hsur⟩⟩,
    exact finite_type.of_surjective (finite_type.mv_polynomial R {x // x ∈ s}) f hsur }
end

/-- An algebra is finitely generated if and only if it is a quotient
of a polynomial ring whose variables are indexed by a fintype. -/
lemma iff_quotient_mv_polynomial' : (finite_type R A) ↔ ∃ (ι : Type u_2) (_ : fintype ι)
  (f : (mv_polynomial ι R) →ₐ[R] A), (surjective f) :=
begin
  split,
  { rw iff_quotient_mv_polynomial,
    rintro ⟨s, ⟨f, hsur⟩⟩,
    use [{x // x ∈ s}, by apply_instance, f, hsur] },
  { rintro ⟨ι, ⟨hfintype, ⟨f, hsur⟩⟩⟩,
    letI : fintype ι := hfintype,
    exact finite_type.of_surjective (finite_type.mv_polynomial R ι) f hsur }
end

/-- An algebra is finitely generated if and only if it is a quotient of a polynomial ring in `n`
variables. -/
lemma iff_quotient_mv_polynomial'' : (finite_type R A) ↔ ∃ (n : ℕ)
  (f : (mv_polynomial (fin n) R) →ₐ[R] A), (surjective f) :=
begin
  split,
  { rw iff_quotient_mv_polynomial',
    rintro ⟨ι, hfintype, ⟨f, hsur⟩⟩,
    resetI,
    have equiv := mv_polynomial.rename_equiv R (fintype.equiv_fin ι),
    exact ⟨fintype.card ι, alg_hom.comp f equiv.symm, function.surjective.comp hsur
      (alg_equiv.symm equiv).surjective⟩ },
  { rintro ⟨n, ⟨f, hsur⟩⟩,
    exact finite_type.of_surjective (finite_type.mv_polynomial R (fin n)) f hsur }
end

instance prod [hA : finite_type R A] [hB : finite_type R B] : finite_type R (A × B) :=
⟨begin
  rw ← subalgebra.prod_top,
  exact hA.1.prod hB.1
end⟩

lemma is_noetherian_ring (R S : Type*) [comm_ring R] [comm_ring S] [algebra R S]
  [h : algebra.finite_type R S] [is_noetherian_ring R] : is_noetherian_ring S :=
begin
  obtain ⟨s, hs⟩ := h.1,
  apply is_noetherian_ring_of_surjective
    (mv_polynomial s R) S (mv_polynomial.aeval coe : mv_polynomial s R →ₐ[R] S),
  rw [← set.range_iff_surjective, alg_hom.coe_to_ring_hom, ← alg_hom.coe_range,
    ← algebra.adjoin_range_eq_range_aeval, subtype.range_coe_subtype, finset.set_of_mem, hs],
  refl
end

lemma _root_.subalgebra.fg_iff_finite_type {R A : Type*} [comm_semiring R] [semiring A]
  [algebra R A] (S : subalgebra R A) : S.fg ↔ algebra.finite_type R S :=
S.fg_top.symm.trans ⟨λ h, ⟨h⟩, λ h, h.out⟩

end finite_type

end algebra

end module_and_algebra

namespace ring_hom
variables {A B C : Type*} [comm_ring A] [comm_ring B] [comm_ring C]

/-- A ring morphism `A →+* B` is of `finite_type` if `B` is finitely generated as `A`-algebra. -/
def finite_type (f : A →+* B) : Prop := @algebra.finite_type A B _ _ f.to_algebra

namespace finite

variables {A}

lemma finite_type {f : A →+* B} (hf : f.finite) : finite_type f :=
@module.finite.finite_type _ _ _ _ f.to_algebra hf

end finite

namespace finite_type

variables (A)

lemma id : finite_type (ring_hom.id A) := algebra.finite_type.self A

variables {A}

lemma comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.finite_type) (hg : surjective g) :
  (g.comp f).finite_type :=
@algebra.finite_type.of_surjective A B C _ _ f.to_algebra _ (g.comp f).to_algebra hf
{ to_fun := g, commutes' := λ a, rfl, .. g } hg

lemma of_surjective (f : A →+* B) (hf : surjective f) : f.finite_type :=
by { rw ← f.comp_id, exact (id A).comp_surjective hf }

lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite_type) (hf : f.finite_type) :
  (g.comp f).finite_type :=
@algebra.finite_type.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
begin
  fconstructor,
  intros a b c,
  simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
  refl
end
hf hg

lemma of_finite {f : A →+* B} (hf : f.finite) : f.finite_type :=
@module.finite.finite_type _ _ _ _ f.to_algebra hf

alias of_finite ← _root_.ring_hom.finite.to_finite_type

lemma of_comp_finite_type {f : A →+* B} {g : B →+* C} (h : (g.comp f).finite_type) :
  g.finite_type :=
begin
  letI := f.to_algebra,
  letI := g.to_algebra,
  letI := (g.comp f).to_algebra,
  letI : is_scalar_tower A B C := restrict_scalars.is_scalar_tower A B C,
  letI : algebra.finite_type A C := h,
  exact algebra.finite_type.of_restrict_scalars_finite_type A B C
end

end finite_type

end ring_hom

namespace alg_hom

variables {R A B C : Type*} [comm_ring R]
variables [comm_ring A] [comm_ring B] [comm_ring C]
variables [algebra R A] [algebra R B] [algebra R C]

/-- An algebra morphism `A →ₐ[R] B` is of `finite_type` if it is of finite type as ring morphism.
In other words, if `B` is finitely generated as `A`-algebra. -/
def finite_type (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite_type

namespace finite

variables {R A}

lemma finite_type {f : A →ₐ[R] B} (hf : f.finite) : finite_type f :=
ring_hom.finite.finite_type hf

end finite

namespace finite_type

variables (R A)

lemma id : finite_type (alg_hom.id R A) := ring_hom.finite_type.id A

variables {R A}

lemma comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.finite_type) (hf : f.finite_type) :
  (g.comp f).finite_type :=
ring_hom.finite_type.comp hg hf

lemma comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.finite_type) (hg : surjective g) :
  (g.comp f).finite_type :=
ring_hom.finite_type.comp_surjective hf hg

lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) : f.finite_type :=
ring_hom.finite_type.of_surjective f hf

lemma of_comp_finite_type {f : A →ₐ[R] B} {g : B →ₐ[R] C} (h : (g.comp f).finite_type) :
g.finite_type :=
ring_hom.finite_type.of_comp_finite_type h

end finite_type

end alg_hom

section monoid_algebra

variables {R : Type*} {M : Type*}

namespace add_monoid_algebra

open algebra add_submonoid submodule

section span

section semiring

variables [comm_semiring R] [add_monoid M]

/-- An element of `add_monoid_algebra R M` is in the subalgebra generated by its support. -/
lemma mem_adjoin_support (f : add_monoid_algebra R M) : f ∈ adjoin R (of' R M '' f.support) :=
begin
  suffices : span R (of' R M '' f.support) ≤ (adjoin R (of' R M '' f.support)).to_submodule,
  { exact this (mem_span_support f) },
  rw submodule.span_le,
  exact subset_adjoin
end

/-- If a set `S` generates, as algebra, `add_monoid_algebra R M`, then the set of supports of
elements of `S` generates `add_monoid_algebra R M`. -/
lemma support_gen_of_gen {S : set (add_monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
  algebra.adjoin R (⋃ f ∈ S, (of' R M '' (f.support : set M))) = ⊤ :=
begin
  refine le_antisymm le_top _,
  rw [← hS, adjoin_le_iff],
  intros f hf,
  have hincl : of' R M '' f.support ⊆
    ⋃ (g : add_monoid_algebra R M) (H : g ∈ S), of' R M '' g.support,
  { intros s hs,
    exact set.mem_Union₂.2 ⟨f, ⟨hf, hs⟩⟩ },
  exact adjoin_mono hincl (mem_adjoin_support f)
end

/-- If a set `S` generates, as algebra, `add_monoid_algebra R M`, then the image of the union of
the supports of elements of `S` generates `add_monoid_algebra R M`. -/
lemma support_gen_of_gen' {S : set (add_monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
  algebra.adjoin R (of' R M '' (⋃ f ∈ S, (f.support : set M))) = ⊤ :=
begin
  suffices : of' R M '' (⋃ f ∈ S, (f.support : set M)) = ⋃ f ∈ S, (of' R M '' (f.support : set M)),
  { rw this,
    exact support_gen_of_gen hS },
  simp only [set.image_Union]
end

end semiring

section ring

variables [comm_ring R] [add_comm_monoid M]

/-- If `add_monoid_algebra R M` is of finite type, there there is a `G : finset M` such that its
image generates, as algera, `add_monoid_algebra R M`. -/
lemma exists_finset_adjoin_eq_top [h : finite_type R (add_monoid_algebra R M)] :
  ∃ G : finset M, algebra.adjoin R (of' R M '' G) = ⊤ :=
begin
  unfreezingI { obtain ⟨S, hS⟩ := h },
  letI : decidable_eq M := classical.dec_eq M,
  use finset.bUnion S (λ f, f.support),
  have : (finset.bUnion S (λ f, f.support) : set M) = ⋃ f ∈ S, (f.support : set M),
  { simp only [finset.set_bUnion_coe, finset.coe_bUnion] },
  rw [this],
  exact support_gen_of_gen' hS
end

/-- The image of an element `m : M` in `add_monoid_algebra R M` belongs the submodule generated by
`S : set M` if and only if `m ∈ S`. -/
lemma of'_mem_span [nontrivial R] {m : M} {S : set M} :
  of' R M m ∈ span R (of' R M '' S) ↔ m ∈ S :=
begin
  refine ⟨λ h, _, λ h, submodule.subset_span $ set.mem_image_of_mem (of R M) h⟩,
  rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported,
    finsupp.support_single_ne_zero _ (one_ne_zero' R)] at h,
  simpa using h
end

/--If the image of an element `m : M` in `add_monoid_algebra R M` belongs the submodule generated by
the closure of some `S : set M` then `m ∈ closure S`. -/
lemma mem_closure_of_mem_span_closure [nontrivial R] {m : M} {S : set M}
  (h : of' R M m ∈ span R (submonoid.closure (of' R M '' S) : set (add_monoid_algebra R M))) :
  m ∈ closure S :=
begin
  suffices : multiplicative.of_add m ∈ submonoid.closure (multiplicative.to_add ⁻¹' S),
  { simpa [← to_submonoid_closure] },
  let S' := @submonoid.closure M multiplicative.mul_one_class S,
  have h' : submonoid.map (of R M) S' = submonoid.closure ((λ (x : M), (of R M) x) '' S) :=
    monoid_hom.map_mclosure _ _,
  rw [set.image_congr' (show ∀ x, of' R M x = of R M x, from λ x, of'_eq_of x), ← h'] at h,
  simpa using of'_mem_span.1 h
end

end ring

end span

variables [add_comm_monoid M]

/-- If a set `S` generates an additive monoid `M`, then the image of `M` generates, as algebra,
`add_monoid_algebra R M`. -/
lemma mv_polynomial_aeval_of_surjective_of_closure [comm_semiring R] {S : set M}
  (hS : closure S = ⊤) : function.surjective (mv_polynomial.aeval
  (λ (s : S), of' R M ↑s) : mv_polynomial S R → add_monoid_algebra R M) :=
begin
  refine λ f, induction_on f (λ m, _) _ _,
  { have : m ∈ closure S := hS.symm ▸ mem_top _,
    refine closure_induction this (λ m hm, _) _ _,
    { exact ⟨mv_polynomial.X ⟨m, hm⟩, mv_polynomial.aeval_X _ _⟩ },
    { exact ⟨1, alg_hom.map_one _⟩ },
    { rintro m₁ m₂ ⟨P₁, hP₁⟩ ⟨P₂, hP₂⟩,
      exact ⟨P₁ * P₂, by rw [alg_hom.map_mul, hP₁, hP₂, of_apply, of_apply, of_apply,
        single_mul_single, one_mul]; refl⟩ } },
  { rintro f g ⟨P, rfl⟩ ⟨Q, rfl⟩,
    exact ⟨P + Q, alg_hom.map_add _ _ _⟩ },
  { rintro r f ⟨P, rfl⟩,
    exact ⟨r • P, alg_hom.map_smul _ _ _⟩ }
end

variables (R M)

/-- If an additive monoid `M` is finitely generated then `add_monoid_algebra R M` is of finite
type. -/
instance finite_type_of_fg [comm_ring R] [h : add_monoid.fg M] :
  finite_type R (add_monoid_algebra R M) :=
begin
  obtain ⟨S, hS⟩ := h.out,
  exact (finite_type.mv_polynomial R (S : set M)).of_surjective (mv_polynomial.aeval
    (λ (s : (S : set M)), of' R M ↑s)) (mv_polynomial_aeval_of_surjective_of_closure hS)
end

variables {R M}

/-- An additive monoid `M` is finitely generated if and only if `add_monoid_algebra R M` is of
finite type. -/
lemma finite_type_iff_fg [comm_ring R] [nontrivial R] :
  finite_type R (add_monoid_algebra R M) ↔ add_monoid.fg M :=
begin
  refine ⟨λ h, _, λ h, @add_monoid_algebra.finite_type_of_fg _ _ _ _ h⟩,
  obtain ⟨S, hS⟩ := @exists_finset_adjoin_eq_top R M _ _ h,
  refine add_monoid.fg_def.2 ⟨S, (eq_top_iff' _).2 (λ m, _)⟩,
  have hm : of' R M m ∈ (adjoin R (of' R M '' ↑S)).to_submodule,
  { simp only [hS, top_to_submodule, submodule.mem_top], },
  rw [adjoin_eq_span] at hm,
  exact mem_closure_of_mem_span_closure hm
end

/-- If `add_monoid_algebra R M` is of finite type then `M` is finitely generated. -/
lemma fg_of_finite_type [comm_ring R] [nontrivial R] [h : finite_type R (add_monoid_algebra R M)] :
  add_monoid.fg M :=
finite_type_iff_fg.1 h

/-- An additive group `G` is finitely generated if and only if `add_monoid_algebra R G` is of
finite type. -/
lemma finite_type_iff_group_fg {G : Type*} [add_comm_group G] [comm_ring R] [nontrivial R] :
  finite_type R (add_monoid_algebra R G) ↔ add_group.fg G :=
by simpa [add_group.fg_iff_add_monoid.fg] using finite_type_iff_fg

end add_monoid_algebra

namespace monoid_algebra

open algebra submonoid submodule

section span

section semiring

variables [comm_semiring R] [monoid M]

/-- An element of `monoid_algebra R M` is in the subalgebra generated by its support. -/
lemma mem_adjoin_support (f : monoid_algebra R M) : f ∈ adjoin R (of R M '' f.support) :=
begin
  suffices : span R (of R M '' f.support) ≤ (adjoin R (of R M '' f.support)).to_submodule,
  { exact this (mem_span_support f) },
  rw submodule.span_le,
  exact subset_adjoin
end

/-- If a set `S` generates, as algebra, `monoid_algebra R M`, then the set of supports of elements
of `S` generates `monoid_algebra R M`. -/
lemma support_gen_of_gen {S : set (monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
  algebra.adjoin R (⋃ f ∈ S, (of R M '' (f.support : set M))) = ⊤ :=
begin
  refine le_antisymm le_top _,
  rw [← hS, adjoin_le_iff],
  intros f hf,
  have hincl : (of R M) '' f.support ⊆
    ⋃ (g : monoid_algebra R M) (H : g ∈ S), of R M '' g.support,
  { intros s hs,
    exact set.mem_Union₂.2 ⟨f, ⟨hf, hs⟩⟩ },
  exact adjoin_mono hincl (mem_adjoin_support f)
end

/-- If a set `S` generates, as algebra, `monoid_algebra R M`, then the image of the union of the
supports of elements of `S` generates `monoid_algebra R M`. -/
lemma support_gen_of_gen' {S : set (monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
  algebra.adjoin R (of R M '' (⋃ f ∈ S, (f.support : set M))) = ⊤ :=
begin
  suffices : of R M '' (⋃ f ∈ S, (f.support : set M)) = ⋃ f ∈ S, (of R M '' (f.support : set M)),
  { rw this,
    exact support_gen_of_gen hS },
  simp only [set.image_Union]
end

end semiring

section ring

variables [comm_ring R] [comm_monoid M]

/-- If `monoid_algebra R M` is of finite type, there there is a `G : finset M` such that its image
generates, as algera, `monoid_algebra R M`. -/
lemma exists_finset_adjoin_eq_top [h :finite_type R (monoid_algebra R M)] :
  ∃ G : finset M, algebra.adjoin R (of R M '' G) = ⊤ :=
begin
  unfreezingI { obtain ⟨S, hS⟩ := h },
  letI : decidable_eq M := classical.dec_eq M,
  use finset.bUnion S (λ f, f.support),
  have : (finset.bUnion S (λ f, f.support) : set M) = ⋃ f ∈ S, (f.support : set M),
  { simp only [finset.set_bUnion_coe, finset.coe_bUnion] },
  rw [this],
  exact support_gen_of_gen' hS
end

/-- The image of an element `m : M` in `monoid_algebra R M` belongs the submodule generated by
`S : set M` if and only if `m ∈ S`. -/
lemma of_mem_span_of_iff [nontrivial R] {m : M} {S : set M} :
  of R M m ∈ span R (of R M '' S) ↔ m ∈ S :=
begin
  refine ⟨λ h, _, λ h, submodule.subset_span $ set.mem_image_of_mem (of R M) h⟩,
  rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported,
    finsupp.support_single_ne_zero _ (one_ne_zero' R)] at h,
  simpa using h
end

/--If the image of an element `m : M` in `monoid_algebra R M` belongs the submodule generated by the
closure of some `S : set M` then `m ∈ closure S`. -/
lemma mem_closure_of_mem_span_closure [nontrivial R] {m : M} {S : set M}
  (h : of R M m ∈ span R (submonoid.closure (of R M '' S) : set (monoid_algebra R M))) :
  m ∈ closure S :=
begin
  rw ← monoid_hom.map_mclosure at h,
  simpa using of_mem_span_of_iff.1 h
end

end ring

end span

variables [comm_monoid M]

/-- If a set `S` generates a monoid `M`, then the image of `M` generates, as algebra,
`monoid_algebra R M`. -/
lemma mv_polynomial_aeval_of_surjective_of_closure [comm_semiring R] {S : set M}
  (hS : closure S = ⊤) : function.surjective (mv_polynomial.aeval
  (λ (s : S), of R M ↑s) : mv_polynomial S R → monoid_algebra R M) :=
begin
  refine λ f, induction_on f (λ m, _) _ _,
  { have : m ∈ closure S := hS.symm ▸ mem_top _,
    refine closure_induction this (λ m hm, _) _ _,
    { exact ⟨mv_polynomial.X ⟨m, hm⟩, mv_polynomial.aeval_X _ _⟩ },
    { exact ⟨1, alg_hom.map_one _⟩ },
    { rintro m₁ m₂ ⟨P₁, hP₁⟩ ⟨P₂, hP₂⟩,
      exact ⟨P₁ * P₂, by rw [alg_hom.map_mul, hP₁, hP₂, of_apply, of_apply, of_apply,
        single_mul_single, one_mul]⟩ } },
  { rintro f g ⟨P, rfl⟩ ⟨Q, rfl⟩,
    exact ⟨P + Q, alg_hom.map_add _ _ _⟩ },
  { rintro r f ⟨P, rfl⟩,
    exact ⟨r • P, alg_hom.map_smul _ _ _⟩ }
end

/-- If a monoid `M` is finitely generated then `monoid_algebra R M` is of finite type. -/
instance finite_type_of_fg [comm_ring R] [monoid.fg M] : finite_type R (monoid_algebra R M) :=
(add_monoid_algebra.finite_type_of_fg R (additive M)).equiv (to_additive_alg_equiv R M).symm

/-- A monoid `M` is finitely generated if and only if `monoid_algebra R M` is of finite type. -/
lemma finite_type_iff_fg [comm_ring R] [nontrivial R] :
  finite_type R (monoid_algebra R M) ↔ monoid.fg M :=
⟨λ h, monoid.fg_iff_add_fg.2 $ add_monoid_algebra.finite_type_iff_fg.1 $ h.equiv $
  to_additive_alg_equiv R M, λ h, @monoid_algebra.finite_type_of_fg _ _ _ _ h⟩

/-- If `monoid_algebra R M` is of finite type then `M` is finitely generated. -/
lemma fg_of_finite_type [comm_ring R] [nontrivial R] [h : finite_type R (monoid_algebra R M)] :
  monoid.fg M :=
finite_type_iff_fg.1 h

/-- A group `G` is finitely generated if and only if `add_monoid_algebra R G` is of finite type. -/
lemma finite_type_iff_group_fg {G : Type*} [comm_group G] [comm_ring R] [nontrivial R] :
  finite_type R (monoid_algebra R G) ↔ group.fg G :=
by simpa [group.fg_iff_monoid.fg] using finite_type_iff_fg

end monoid_algebra

end monoid_algebra

section vasconcelos
variables {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M] (f : M →ₗ[R] M)

noncomputable theory

/-- The structure of a module `M` over a ring `R` as a module over `R[X]` when given a
choice of how `X` acts by choosing a linear map `f : M →ₗ[R] M` -/
def module_polynomial_of_endo : module R[X] M :=
module.comp_hom M (polynomial.aeval f).to_ring_hom

lemma module_polynomial_of_endo_smul_def (n : R[X]) (a : M) :
  @@has_smul.smul (module_polynomial_of_endo f).to_has_smul n a = polynomial.aeval f n a := rfl

local attribute [simp] module_polynomial_of_endo_smul_def

include f
lemma module_polynomial_of_endo.is_scalar_tower : @is_scalar_tower R R[X] M _
  (by { letI := module_polynomial_of_endo f, apply_instance }) _ :=
begin
  letI := module_polynomial_of_endo f,
  constructor,
  intros x y z,
  simp,
end

open polynomial module

/-- A theorem/proof by Vasconcelos, given a finite module `M` over a commutative ring, any
surjective endomorphism of `M` is also injective. Based on,
https://math.stackexchange.com/a/239419/31917,
https://www.ams.org/journals/tran/1969-138-00/S0002-9947-1969-0238839-5/.
This is similar to `is_noetherian.injective_of_surjective_endomorphism` but only applies in the
commutative case, but does not use a Noetherian hypothesis. -/
theorem module.finite.injective_of_surjective_endomorphism [hfg : finite R M]
  (f_surj : function.surjective f) : function.injective f :=
begin
  letI := module_polynomial_of_endo f,
  haveI : is_scalar_tower R R[X] M := module_polynomial_of_endo.is_scalar_tower f,
  have hfgpoly : finite R[X] M, from finite.of_restrict_scalars_finite R _ _,
  have X_mul : ∀ o, (X : R[X]) • o = f o,
  { intro,
    simp, },
  have : (⊤ : submodule R[X] M) ≤ ideal.span {X} • ⊤,
  { intros a ha,
    obtain ⟨y, rfl⟩ := f_surj a,
    rw [← X_mul y],
    exact submodule.smul_mem_smul (ideal.mem_span_singleton.mpr (dvd_refl _)) trivial, },
  obtain ⟨F, hFa, hFb⟩ := submodule.exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul _
    (⊤ : submodule R[X] M) (finite_def.mp hfgpoly) this,
  rw [← linear_map.ker_eq_bot, linear_map.ker_eq_bot'],
  intros m hm,
  rw ideal.mem_span_singleton' at hFa,
  obtain ⟨G, hG⟩ := hFa,
  suffices : (F - 1) • m = 0,
  { have Fmzero := hFb m (by simp),
    rwa [← sub_add_cancel F 1, add_smul, one_smul, this, zero_add] at Fmzero, },
  rw [← hG, mul_smul, X_mul m, hm, smul_zero],
end

end vasconcelos


variables p q : Prop

theorem t1 : p → q → p := λ (hp : p) (hq : q), hp


import .free
-- import .orthogonal -- not being used yet, so commenting out because it takes a while to compile.

universes u v w

#check my_unit.{u}
#check my_unit.star

open category_theory

-- todo : maybe the definition of initial and final objects should be in another file?

section

variables (C : Type u) [CC : category.{v u} C]
include CC

def initial_object (I : C) : Prop :=
	forall (X : C), ∃! ( i : I ⟶  X), true

end

#check initial_object

#check my_empty.cases_on

#check empty.cases_on

def emptyf {X : Type w} (impossibility : my_empty.{u} ) :  X :=
begin
induction impossibility
end

#check emptyf

section

variables (c : Type u -> Type v) (hom : (Pi {alpha beta : Type u}, c alpha -> c beta -> (alpha -> beta) -> Prop))

#check concrete_category

variable C : concrete_category @hom

#check @is_free_over

variable [C2 : category (bundled c)]

#check @initial_object
#check @initial_object (bundled c)
#check @initial_object (bundled c) C2

theorem free_over_empty_implies_initial (A : (bundled c)) [C3 : category (bundled c)]: (@is_free_over c @hom C A my_empty.{u} emptyf) -> (@initial_object (bundled c) C3 A) :=
	sorry

end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johan Commelin
-/
import category_theory.limits.shapes.terminal

/-!
# Zero objects

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

A category "has a zero object" if it has an object which is both initial and terminal. Having a
zero object provides zero morphisms, as the unique morphisms factoring through the zero object;
see `category_theory.limits.shapes.zero_morphisms`.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable theory

universes v u v' u'

open category_theory
open category_theory.category

variables {C : Type u} [category.{v} C]
variables {D : Type u'} [category.{v'} D]

namespace category_theory

namespace limits

/-- An object `X` in a category is a *zero object* if for every object `Y`
there is a unique morphism `to : X → Y` and a unique morphism `from : Y → X`.

This is a characteristic predicate for `has_zero_object`. -/
structure is_zero (X : C) : Prop :=
(unique_to   : ∀ Y, nonempty (unique (X ⟶ Y)))
(unique_from : ∀ Y, nonempty (unique (Y ⟶ X)))

namespace is_zero

variables {X Y : C}

/-- If `h : is_zero X`, then `h.to Y` is a choice of unique morphism `X → Y`. -/
protected def «to» (h : is_zero X) (Y : C) : X ⟶ Y :=
@default (X ⟶ Y) $ @unique.inhabited _ $ (h.unique_to Y).some

lemma eq_to (h : is_zero X) (f : X ⟶ Y) : f = h.to Y :=
@unique.eq_default _ (id _) _

lemma to_eq (h : is_zero X) (f : X ⟶ Y) : h.to Y = f :=
(h.eq_to f).symm

/-- If `h : is_zero X`, then `h.from Y` is a choice of unique morphism `Y → X`. -/
protected def «from» (h : is_zero X) (Y : C) : Y ⟶ X :=
@default (Y ⟶ X) $ @unique.inhabited _ $ (h.unique_from Y).some

lemma eq_from (h : is_zero X) (f : Y ⟶ X) : f = h.from Y :=
@unique.eq_default _ (id _) _

lemma from_eq (h : is_zero X) (f : Y ⟶ X) : h.from Y = f :=
(h.eq_from f).symm

lemma eq_of_src (hX : is_zero X) (f g : X ⟶ Y) : f = g :=
(hX.eq_to f).trans (hX.eq_to g).symm

lemma eq_of_tgt (hX : is_zero X) (f g : Y ⟶ X) : f = g :=
(hX.eq_from f).trans (hX.eq_from g).symm

/-- Any two zero objects are isomorphic. -/
def iso (hX : is_zero X) (hY : is_zero Y) : X ≅ Y :=
{ hom := hX.to Y,
  inv := hX.from Y,
  hom_inv_id' := hX.eq_of_src _ _,
  inv_hom_id' := hY.eq_of_src _ _, }

/-- A zero object is in particular initial. -/
protected def is_initial (hX : is_zero X) : is_initial X :=
@is_initial.of_unique _ _ X $ λ Y, (hX.unique_to Y).some

/-- A zero object is in particular terminal. -/
protected def is_terminal (hX : is_zero X) : is_terminal X :=
@is_terminal.of_unique _ _ X $ λ Y, (hX.unique_from Y).some

/-- The (unique) isomorphism between any initial object and the zero object. -/
def iso_is_initial (hX : is_zero X) (hY : is_initial Y) : X ≅ Y :=
hX.is_initial.unique_up_to_iso hY

/-- The (unique) isomorphism between any terminal object and the zero object. -/
def iso_is_terminal (hX : is_zero X) (hY : is_terminal Y) : X ≅ Y :=
hX.is_terminal.unique_up_to_iso hY

lemma of_iso (hY : is_zero Y) (e : X ≅ Y) : is_zero X :=
begin
  refine ⟨λ Z, ⟨⟨⟨e.hom ≫ hY.to Z⟩, λ f, _⟩⟩, λ Z, ⟨⟨⟨hY.from Z ≫ e.inv⟩, λ f, _⟩⟩⟩,
  { rw ← cancel_epi e.inv, apply hY.eq_of_src, },
  { rw ← cancel_mono e.hom, apply hY.eq_of_tgt, },
end

lemma op (h : is_zero X) : is_zero (opposite.op X) :=
⟨λ Y, ⟨⟨⟨(h.from (opposite.unop Y)).op⟩, λ f, quiver.hom.unop_inj (h.eq_of_tgt _ _)⟩⟩,
  λ Y, ⟨⟨⟨(h.to (opposite.unop Y)).op⟩, λ f, quiver.hom.unop_inj (h.eq_of_src _ _)⟩⟩⟩

lemma unop {X : Cᵒᵖ} (h : is_zero X) : is_zero (opposite.unop X) :=
⟨λ Y, ⟨⟨⟨(h.from (opposite.op Y)).unop⟩, λ f, quiver.hom.op_inj (h.eq_of_tgt _ _)⟩⟩,
  λ Y, ⟨⟨⟨(h.to (opposite.op Y)).unop⟩, λ f, quiver.hom.op_inj (h.eq_of_src _ _)⟩⟩⟩

end is_zero

end limits

open category_theory.limits

lemma iso.is_zero_iff {X Y : C} (e : X ≅ Y) :
  is_zero X ↔ is_zero Y :=
⟨λ h, h.of_iso e.symm, λ h, h.of_iso e⟩

lemma functor.is_zero (F : C ⥤ D) (hF : ∀ X, is_zero (F.obj X)) :
  is_zero F :=
begin
  split; intros G; refine ⟨⟨⟨_⟩, _⟩⟩,
  { refine { app := λ X, (hF _).to _, naturality' := _ },
    intros, exact (hF _).eq_of_src _ _ },
  { intro f, ext, apply (hF _).eq_of_src _ _ },
  { refine { app := λ X, (hF _).from _, naturality' := _ },
    intros, exact (hF _).eq_of_tgt _ _ },
  { intro f, ext, apply (hF _).eq_of_tgt _ _ },
end

namespace limits

variables (C)

/-- A category "has a zero object" if it has an object which is both initial and terminal. -/
class has_zero_object : Prop :=
(zero : ∃ X : C, is_zero X)

instance has_zero_object_punit : has_zero_object (discrete punit) :=
{ zero := ⟨⟨⟨⟩⟩, by tidy, by tidy⟩, }

section

variables [has_zero_object C]

/--
Construct a `has_zero C` for a category with a zero object.
This can not be a global instance as it will trigger for every `has_zero C` typeclass search.
-/
protected def has_zero_object.has_zero : has_zero C :=
{ zero := has_zero_object.zero.some }

localized "attribute [instance] category_theory.limits.has_zero_object.has_zero" in zero_object

lemma is_zero_zero : is_zero (0 : C) :=
has_zero_object.zero.some_spec

instance has_zero_object_op : has_zero_object Cᵒᵖ := ⟨⟨opposite.op 0, is_zero.op (is_zero_zero C)⟩⟩

end

open_locale zero_object

lemma has_zero_object_unop [has_zero_object Cᵒᵖ] : has_zero_object C :=
⟨⟨opposite.unop 0, is_zero.unop (is_zero_zero Cᵒᵖ)⟩⟩

variables {C}

lemma is_zero.has_zero_object {X : C} (hX : is_zero X) : has_zero_object C := ⟨⟨X, hX⟩⟩

/-- Every zero object is isomorphic to *the* zero object. -/
def is_zero.iso_zero [has_zero_object C] {X : C} (hX : is_zero X) : X ≅ 0 :=
hX.iso (is_zero_zero C)

lemma is_zero.obj [has_zero_object D] {F : C ⥤ D} (hF : is_zero F) (X : C) :
  is_zero (F.obj X) :=
begin
  let G : C ⥤ D := (category_theory.functor.const C).obj 0,
  have hG : is_zero G := functor.is_zero _ (λ X, is_zero_zero _),
  let e : F ≅ G := hF.iso hG,
  exact (is_zero_zero _).of_iso (e.app X),
end

namespace has_zero_object
variables [has_zero_object C]

/-- There is a unique morphism from the zero object to any object `X`. -/
protected def unique_to (X : C) : unique (0 ⟶ X) :=
((is_zero_zero C).unique_to X).some

/-- There is a unique morphism from any object `X` to the zero object. -/
protected def unique_from (X : C) : unique (X ⟶ 0) :=
((is_zero_zero C).unique_from X).some

localized "attribute [instance] category_theory.limits.has_zero_object.unique_to" in zero_object
localized "attribute [instance] category_theory.limits.has_zero_object.unique_from" in zero_object

@[ext]
lemma to_zero_ext {X : C} (f g : X ⟶ 0) : f = g :=
(is_zero_zero C).eq_of_tgt _ _

@[ext]
lemma from_zero_ext {X : C} (f g : 0 ⟶ X) : f = g :=
(is_zero_zero C).eq_of_src _ _

instance (X : C) : subsingleton (X ≅ 0) := by tidy

instance {X : C} (f : 0 ⟶ X) : mono f :=
{ right_cancellation := λ Z g h w, by ext, }

instance {X : C} (f : X ⟶ 0) : epi f :=
{ left_cancellation := λ Z g h w, by ext, }

instance zero_to_zero_is_iso (f : (0 : C) ⟶ 0) :
  is_iso f :=
by convert (show is_iso (𝟙 (0 : C)), by apply_instance)

/-- A zero object is in particular initial. -/
def zero_is_initial : is_initial (0 : C) :=
(is_zero_zero C).is_initial

/-- A zero object is in particular terminal. -/
def zero_is_terminal : is_terminal (0 : C) :=
(is_zero_zero C).is_terminal

/-- A zero object is in particular initial. -/
@[priority 10]
instance has_initial : has_initial C :=
has_initial_of_unique 0

/-- A zero object is in particular terminal. -/
@[priority 10]
instance has_terminal : has_terminal C :=
has_terminal_of_unique 0

/-- The (unique) isomorphism between any initial object and the zero object. -/
def zero_iso_is_initial {X : C} (t : is_initial X) : 0 ≅ X :=
zero_is_initial.unique_up_to_iso t

/-- The (unique) isomorphism between any terminal object and the zero object. -/
def zero_iso_is_terminal {X : C} (t : is_terminal X) : 0 ≅ X :=
zero_is_terminal.unique_up_to_iso t

/-- The (unique) isomorphism between the chosen initial object and the chosen zero object. -/
def zero_iso_initial [has_initial C] : 0 ≅ ⊥_ C :=
zero_is_initial.unique_up_to_iso initial_is_initial

/-- The (unique) isomorphism between the chosen terminal object and the chosen zero object. -/
def zero_iso_terminal [has_terminal C] : 0 ≅ ⊤_ C :=
zero_is_terminal.unique_up_to_iso terminal_is_terminal

@[priority 100]
instance has_strict_initial : initial_mono_class C :=
initial_mono_class.of_is_initial zero_is_initial (λ X, category_theory.mono _)

end has_zero_object

end limits

open category_theory.limits
open_locale zero_object

lemma functor.is_zero_iff [has_zero_object D] (F : C ⥤ D) :
  is_zero F ↔ ∀ X, is_zero (F.obj X) :=
⟨λ hF X, hF.obj X, functor.is_zero _⟩

end category_theory


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ordered_group
import Mathlib.algebra.group_with_zero.default
import Mathlib.algebra.group_with_zero.power
import Mathlib.tactic.abel
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

/-!
# Linearly ordered commutative groups and monoids with a zero element adjoined

This file sets up a special class of linearly ordered commutative monoids
that show up as the target of so-called “valuations” in algebraic number theory.

Usually, in the informal literature, these objects are constructed
by taking a linearly ordered commutative group Γ and formally adjoining a zero element: Γ ∪ {0}.

The disadvantage is that a type such as `nnreal` is not of that form,
whereas it is a very common target for valuations.
The solutions is to use a typeclass, and that is exactly what we do in this file.

Note that to avoid issues with import cycles, `linear_ordered_comm_monoid_with_zero` is defined
in another file. However, the lemmas about it are stated here.
-/

/-- A linearly ordered commutative group with a zero element. -/
class linear_ordered_comm_group_with_zero (α : Type u_1)
    extends comm_group_with_zero α, linear_ordered_comm_monoid_with_zero α where

/-
The following facts are true more generally in a (linearly) ordered commutative monoid.
-/

theorem one_le_pow_of_one_le' {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α]
    {n : ℕ} (H : 1 ≤ x) : 1 ≤ x ^ n :=
  Nat.rec (le_refl 1) (fun (n : ℕ) (ih : 1 ≤ x ^ n) => one_le_mul H ih) n

theorem pow_le_one_of_le_one {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ}
    (H : x ≤ 1) : x ^ n ≤ 1 :=
  Nat.rec (le_refl 1) (fun (n : ℕ) (ih : x ^ n ≤ 1) => mul_le_one' H ih) n

theorem eq_one_of_pow_eq_one {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ}
    (hn : n ≠ 0) (H : x ^ n = 1) : x = 1 :=
  sorry

theorem pow_eq_one_iff {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ}
    (hn : n ≠ 0) : x ^ n = 1 ↔ x = 1 :=
  { mp := eq_one_of_pow_eq_one hn, mpr := fun (ᾰ : x = 1) => Eq._oldrec (one_pow n) (Eq.symm ᾰ) }

theorem one_le_pow_iff {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ}
    (hn : n ≠ 0) : 1 ≤ x ^ n ↔ 1 ≤ x :=
  sorry

theorem pow_le_one_iff {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ}
    (hn : n ≠ 0) : x ^ n ≤ 1 ↔ x ≤ 1 :=
  sorry

theorem zero_le_one' {α : Type u_1} [linear_ordered_comm_monoid_with_zero α] : 0 ≤ 1 :=
  linear_ordered_comm_monoid_with_zero.zero_le_one

@[simp] theorem zero_le' {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] : 0 ≤ a :=
  sorry

@[simp] theorem not_lt_zero' {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] :
    ¬a < 0 :=
  not_lt_of_le zero_le'

@[simp] theorem le_zero_iff {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] :
    a ≤ 0 ↔ a = 0 :=
  { mp := fun (h : a ≤ 0) => le_antisymm h zero_le', mpr := fun (h : a = 0) => h ▸ le_refl a }

theorem zero_lt_iff {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] :
    0 < a ↔ a ≠ 0 :=
  { mp := ne_of_gt, mpr := fun (h : a ≠ 0) => lt_of_le_of_ne zero_le' (ne.symm h) }

theorem ne_zero_of_lt {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_monoid_with_zero α]
    (h : b < a) : a ≠ 0 :=
  fun (h1 : a = 0) => not_lt_zero' ((fun (this : b < 0) => this) (h1 ▸ h))

theorem zero_lt_one'' {α : Type u_1} [linear_ordered_comm_group_with_zero α] : 0 < 1 :=
  lt_of_le_of_ne zero_le_one' zero_ne_one

theorem le_of_le_mul_right {α : Type u_1} {a : α} {b : α} {c : α}
    [linear_ordered_comm_group_with_zero α] (h : c ≠ 0) (hab : a * c ≤ b * c) : a ≤ b :=
  sorry

theorem le_mul_inv_of_mul_le {α : Type u_1} {a : α} {b : α} {c : α}
    [linear_ordered_comm_group_with_zero α] (h : c ≠ 0) (hab : a * c ≤ b) : a ≤ b * (c⁻¹) :=
  sorry

theorem mul_inv_le_of_le_mul {α : Type u_1} {a : α} {b : α} {c : α}
    [linear_ordered_comm_group_with_zero α] (h : c ≠ 0) (hab : a ≤ b * c) : a * (c⁻¹) ≤ b :=
  sorry

theorem div_le_div' {α : Type u_1} [linear_ordered_comm_group_with_zero α] (a : α) (b : α) (c : α)
    (d : α) (hb : b ≠ 0) (hd : d ≠ 0) : a * (b⁻¹) ≤ c * (d⁻¹) ↔ a * d ≤ c * b :=
  sorry

@[simp] theorem units.zero_lt {α : Type u_1} [linear_ordered_comm_group_with_zero α] (u : units α) :
    0 < ↑u :=
  iff.mpr zero_lt_iff (units.ne_zero u)

theorem mul_lt_mul'''' {α : Type u_1} {a : α} {b : α} {c : α} {d : α}
    [linear_ordered_comm_group_with_zero α] (hab : a < b) (hcd : c < d) : a * c < b * d :=
  sorry

theorem mul_inv_lt_of_lt_mul' {α : Type u_1} {x : α} {y : α} {z : α}
    [linear_ordered_comm_group_with_zero α] (h : x < y * z) : x * (z⁻¹) < y :=
  sorry

theorem mul_lt_right' {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_group_with_zero α] (c : α)
    (h : a < b) (hc : c ≠ 0) : a * c < b * c :=
  sorry

theorem pow_lt_pow_succ {α : Type u_1} [linear_ordered_comm_group_with_zero α] {x : α} {n : ℕ}
    (hx : 1 < x) : x ^ n < x ^ Nat.succ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ^ n < x ^ Nat.succ n)) (Eq.symm (one_mul (x ^ n)))))
    (mul_lt_right' (x ^ n) hx (pow_ne_zero n (ne_of_gt (lt_trans zero_lt_one'' hx))))

theorem pow_lt_pow' {α : Type u_1} [linear_ordered_comm_group_with_zero α] {x : α} {m : ℕ} {n : ℕ}
    (hx : 1 < x) (hmn : m < n) : x ^ m < x ^ n :=
  nat.less_than_or_equal.drec (pow_lt_pow_succ hx)
    (fun {n : ℕ} (hmn : nat.less_than_or_equal (Nat.succ m) n) (ih : x ^ m < x ^ n) =>
      lt_trans ih (pow_lt_pow_succ hx))
    hmn

theorem inv_lt_inv'' {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_group_with_zero α]
    (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ < (b⁻¹) ↔ b < a :=
  inv_lt_inv_iff

theorem inv_le_inv'' {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_group_with_zero α]
    (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ ≤ (b⁻¹) ↔ b ≤ a :=
  inv_le_inv_iff

namespace monoid_hom

theorem map_neg_one {α : Type u_1} [linear_ordered_comm_group_with_zero α] {R : Type u_2} [ring R]
    (f : R →* α) : coe_fn f (-1) = 1 :=
  sorry

@[simp] theorem map_neg {α : Type u_1} [linear_ordered_comm_group_with_zero α] {R : Type u_2}
    [ring R] (f : R →* α) (x : R) : coe_fn f (-x) = coe_fn f x :=
  sorry

theorem map_sub_swap {α : Type u_1} [linear_ordered_comm_group_with_zero α] {R : Type u_2} [ring R]
    (f : R →* α) (x : R) (y : R) : coe_fn f (x - y) = coe_fn f (y - x) :=
  sorry

end Mathlib


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

universes u v w

namespace d_array
variables {n : ℕ} {α : fin n → Type u}

instance [∀ i, inhabited (α i)] : inhabited (d_array n α) :=
⟨⟨default⟩⟩

end d_array

namespace array

instance {n α} [inhabited α] : inhabited (array n α) :=
d_array.inhabited

theorem to_list_of_heq {n₁ n₂ α} {a₁ : array n₁ α} {a₂ : array n₂ α}
  (hn : n₁ = n₂) (ha : a₁ == a₂) : a₁.to_list = a₂.to_list :=
by congr; assumption

/- rev_list -/

section rev_list
variables {n : ℕ} {α : Type u} {a : array n α}

theorem rev_list_reverse_aux : ∀ i (h : i ≤ n) (t : list α),
  (a.iterate_aux (λ _, (::)) i h []).reverse_core t = a.rev_iterate_aux (λ _, (::)) i h t
| 0     h t := rfl
| (i+1) h t := rev_list_reverse_aux i _ _

@[simp] theorem rev_list_reverse : a.rev_list.reverse = a.to_list :=
rev_list_reverse_aux _ _ _

@[simp] theorem to_list_reverse : a.to_list.reverse = a.rev_list :=
by rw [←rev_list_reverse, list.reverse_reverse]

end rev_list

/- mem -/

section mem
variables {n : ℕ} {α : Type u} {v : α} {a : array n α}

theorem mem.def : v ∈ a ↔ ∃ i, a.read i = v :=
iff.rfl

theorem mem_rev_list_aux : ∀ {i} (h : i ≤ n),
  (∃ (j : fin n), (j : ℕ) < i ∧ read a j = v) ↔ v ∈ a.iterate_aux (λ _, (::)) i h []
| 0     _ := ⟨λ ⟨i, n, _⟩, absurd n i.val.not_lt_zero, false.elim⟩
| (i+1) h := let IH := mem_rev_list_aux (le_of_lt h) in
  ⟨λ ⟨j, ji1, e⟩, or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ ji1)
    (λ ji, list.mem_cons_of_mem _ $ IH.1 ⟨j, ji, e⟩)
    (λ je, by simp [d_array.iterate_aux]; apply or.inl; unfold read at e;
          have H : j = ⟨i, h⟩ := fin.eq_of_veq je; rwa [←H, e]),
  λ m, begin
    simp [d_array.iterate_aux, list.mem] at m,
    cases m with e m',
    exact ⟨⟨i, h⟩, nat.lt_succ_self _, eq.symm e⟩,
    exact let ⟨j, ji, e⟩ := IH.2 m' in
    ⟨j, nat.le_succ_of_le ji, e⟩
  end⟩

@[simp] theorem mem_rev_list : v ∈ a.rev_list ↔ v ∈ a :=
iff.symm $ iff.trans
  (exists_congr $ λ j, iff.symm $
    show j.1 < n ∧ read a j = v ↔ read a j = v,
    from and_iff_right j.2)
  (mem_rev_list_aux _)

@[simp] theorem mem_to_list : v ∈ a.to_list ↔ v ∈ a :=
by rw ←rev_list_reverse; exact list.mem_reverse.trans mem_rev_list

end mem

/- foldr -/

section foldr
variables {n : ℕ} {α : Type u} {β : Type w} {b : β} {f : α → β → β} {a : array n α}

theorem rev_list_foldr_aux : ∀ {i} (h : i ≤ n),
  (d_array.iterate_aux a (λ _, (::)) i h []).foldr f b = d_array.iterate_aux a (λ _, f) i h b
| 0     h := rfl
| (j+1) h := congr_arg (f (read a ⟨j, h⟩)) (rev_list_foldr_aux _)

theorem rev_list_foldr : a.rev_list.foldr f b = a.foldl b f :=
rev_list_foldr_aux _

end foldr

/- foldl -/

section foldl
variables {n : ℕ} {α : Type u} {β : Type w} {b : β} {f : β → α → β} {a : array n α}

theorem to_list_foldl : a.to_list.foldl f b = a.foldl b (function.swap f) :=
by rw [←rev_list_reverse, list.foldl_reverse, rev_list_foldr]

end foldl

/- length -/

section length
variables {n : ℕ} {α : Type u}

theorem rev_list_length_aux (a : array n α) (i h) :
  (a.iterate_aux (λ _, (::)) i h []).length = i :=
by induction i; simp [*, d_array.iterate_aux]

@[simp] theorem rev_list_length (a : array n α) : a.rev_list.length = n :=
rev_list_length_aux a _ _

@[simp] theorem to_list_length (a : array n α) : a.to_list.length = n :=
by rw[←rev_list_reverse, list.length_reverse, rev_list_length]

end length

/- nth -/

section nth
variables {n : ℕ} {α : Type u} {a : array n α}

theorem to_list_nth_le_aux (i : ℕ) (ih : i < n) : ∀ j {jh t h'},
  (∀ k tl, j + k = i → list.nth_le t k tl = a.read ⟨i, ih⟩) →
  (a.rev_iterate_aux (λ _, (::)) j jh t).nth_le i h' = a.read ⟨i, ih⟩
| 0     _  _ _  al := al i _ $ zero_add _
| (j+1) jh t h' al := to_list_nth_le_aux j $ λ k tl hjk,
  show list.nth_le (a.read ⟨j, jh⟩ :: t) k tl = a.read ⟨i, ih⟩, from
  match k, hjk, tl with
  | 0,    e, tl := match i, e, ih with ._, rfl, _ := rfl end
  | k'+1, _, tl := by simp[list.nth_le]; exact al _ _ (by simp [add_comm, add_assoc, *]; cc)
  end

theorem to_list_nth_le (i : ℕ) (h h') : list.nth_le a.to_list i h' = a.read ⟨i, h⟩ :=
to_list_nth_le_aux _ _ _ (λ k tl, absurd tl k.not_lt_zero)

@[simp] theorem to_list_nth_le' (a : array n α) (i : fin n) (h') :
  list.nth_le a.to_list i h' = a.read i :=
by cases i; apply to_list_nth_le

theorem to_list_nth {i v} : list.nth a.to_list i = some v ↔ ∃ h, a.read ⟨i, h⟩ = v :=
begin
  rw list.nth_eq_some,
  have ll := to_list_length a,
  split; intro h; cases h with h e; subst v,
  { exact ⟨ll ▸ h, (to_list_nth_le _ _ _).symm⟩ },
  { exact ⟨ll.symm ▸ h, to_list_nth_le _ _ _⟩ }
end

theorem write_to_list {i v} : (a.write i v).to_list = a.to_list.update_nth i v :=
list.ext_le (by simp) $ λ j h₁ h₂, begin
  have h₃ : j < n, {simpa using h₁},
  rw [to_list_nth_le _ h₃],
  refine let ⟨_, e⟩ := list.nth_eq_some.1 _ in e.symm,
  by_cases ij : (i : ℕ) = j,
  { subst j, rw [show (⟨(i : ℕ), h₃⟩ : fin _) = i, from fin.eq_of_veq rfl,
      array.read_write, list.nth_update_nth_of_lt],
    simp [h₃] },
  { rw [list.nth_update_nth_ne _ _ ij, a.read_write_of_ne,
        to_list_nth.2 ⟨h₃, rfl⟩],
    exact fin.ne_of_vne ij }
end

end nth

/- enum -/

section enum
variables {n : ℕ} {α : Type u} {a : array n α}

theorem mem_to_list_enum {i v} : (i, v) ∈ a.to_list.enum ↔ ∃ h, a.read ⟨i, h⟩ = v :=
by simp [list.mem_iff_nth, to_list_nth, and.comm, and.assoc, and.left_comm]

end enum

/- to_array -/

section to_array
variables {n : ℕ} {α : Type u}

@[simp] theorem to_list_to_array (a : array n α) : a.to_list.to_array == a :=
heq_of_heq_of_eq
  (@@eq.drec_on (λ m (e : a.to_list.length = m), (d_array.mk (λ v, a.to_list.nth_le v.1 v.2)) ==
    (@d_array.mk m (λ _, α) $ λ v, a.to_list.nth_le v.1 $ e.symm ▸ v.2)) a.to_list_length heq.rfl) $
  d_array.ext $ λ ⟨i, h⟩, to_list_nth_le i h _

@[simp] theorem to_array_to_list (l : list α) : l.to_array.to_list = l :=
list.ext_le (to_list_length _) $ λ n h1 h2, to_list_nth_le _ h2 _

end to_array

/- push_back -/

section push_back
variables {n : ℕ} {α : Type u} {v : α} {a : array n α}

lemma push_back_rev_list_aux : ∀ i h h',
  d_array.iterate_aux (a.push_back v) (λ _, (::)) i h [] = d_array.iterate_aux a (λ _, (::)) i h' []
| 0 h h' := rfl
| (i+1) h h' := begin
  simp [d_array.iterate_aux],
  refine ⟨_, push_back_rev_list_aux _ _ _⟩,
  dsimp [read, d_array.read, push_back],
  rw [dif_neg], refl,
  exact ne_of_lt h',
end

@[simp] theorem push_back_rev_list : (a.push_back v).rev_list = v :: a.rev_list :=
begin
  unfold push_back rev_list foldl iterate d_array.iterate,
  dsimp [d_array.iterate_aux, read, d_array.read, push_back],
  rw [dif_pos (eq.refl n)],
  apply congr_arg,
  apply push_back_rev_list_aux
end

@[simp] theorem push_back_to_list : (a.push_back v).to_list = a.to_list ++ [v] :=
by rw [←rev_list_reverse, ←rev_list_reverse, push_back_rev_list, list.reverse_cons]

@[simp] lemma read_push_back_left (i : fin n) : (a.push_back v).read i.cast_succ = a.read i :=
begin
  cases i with i hi,
  have : ¬ i = n := ne_of_lt hi,
  simp [push_back, this, fin.cast_succ, fin.cast_add, fin.cast_le, fin.cast_lt, read, d_array.read]
end

@[simp] lemma read_push_back_right : (a.push_back v).read (fin.last _) = v :=
begin
  cases hn : fin.last n with k hk,
  have : k = n := by simpa [fin.eq_iff_veq ] using hn.symm,
  simp [push_back, this, fin.cast_succ, fin.cast_add, fin.cast_le, fin.cast_lt, read, d_array.read]
end

end push_back

/- foreach -/

section foreach
variables {n : ℕ} {α : Type u} {β : Type v} {i : fin n} {f : fin n → α → β} {a : array n α}

@[simp] theorem read_foreach : (foreach a f).read i = f i (a.read i) :=
rfl

end foreach

/- map -/

section map
variables {n : ℕ} {α : Type u} {β : Type v} {i : fin n} {f : α → β} {a : array n α}

theorem read_map : (a.map f).read i = f (a.read i) :=
read_foreach

end map

/- map₂ -/

section map₂
variables {n : ℕ} {α : Type u} {i : fin n} {f : α → α → α} {a₁ a₂ : array n α}

@[simp] theorem read_map₂ : (map₂ f a₁ a₂).read i = f (a₁.read i) (a₂.read i) :=
read_foreach

end map₂

end array


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.sigma
import Mathlib.testing.slim_check.sampleable
import Mathlib.testing.slim_check.testable
import Mathlib.tactic.pretty_cases
import Mathlib.PostPort

universes u v l u_1 u_2 w

namespace Mathlib

/-!
## `slim_check`: generators for functions

This file defines `sampleable` instances for `α → β` functions and
`ℤ → ℤ` injective functions.

Functions are generated by creating a list of pairs and one more value
using the list as a lookup table and resorting to the additional value
when a value is not found in the table.

Injective functions are generated by creating a list of numbers and
a permutation of that list. The permutation insures that every input
is mapped to a unique output. When an input is not found in the list
the input itself is used as an output.

Injective functions `f : α → α` could be generated easily instead of
`ℤ → ℤ` by generating a `list α`, removing duplicates and creating a
permutations. One has to be careful when generating the domain to make
if vast enough that, when generating arguments to apply `f` to,
they argument should be likely to lie in the domain of `f`. This is
the reason that injective functions `f : ℤ → ℤ` are generated by
fixing the domain to the range `[-2*size .. -2*size]`, with `size`
the size parameter of the `gen` monad.

Much of the machinery provided in this file is applicable to generate
injective functions of type `α → α` and new instances should be easy
to define.

Other classes of functions such as monotone functions can generated using
similar techniques. For monotone functions, generating two lists, sorting them
and matching them should suffice, with appropriate default values.
Some care must be taken for shrinking such functions to make sure
their defining property is invariant through shrinking. Injective
functions are an example of how complicated it can get.
-/

namespace slim_check

/-- Data structure specifying a total function using a list of pairs
and a default value returned when the input is not in the domain of
the partial function.

`with_default f y` encodes `x ↦ f x` when `x ∈ f` and `x ↦ y`
otherwise.

We use `Σ` to encode mappings instead of `×` because we
rely on the association list API defined in `data.list.sigma`.
 -/
inductive total_function (α : Type u) (β : Type v)
where
| with_default : List (sigma fun (_x : α) => β) → β → total_function α β

protected instance total_function.inhabited {α : Type u_1} {β : Type u_2} [Inhabited β] : Inhabited (total_function α β) :=
  { default := total_function.with_default ∅ Inhabited.default }

namespace total_function

/-- Apply a total function to an argument. -/
def apply {α : Type u_1} {β : Type u_2} [DecidableEq α] : total_function α β → α → β :=
  sorry

/--
Implementation of `has_repr (total_function α β)`.

Creates a string for a given `finmap` and output, `x₀ ↦ y₀, .. xₙ ↦ yₙ`
for each of the entries. The brackets are provided by the calling function.
-/
def repr_aux {α : Type u} [has_repr α] {β : Type v} [has_repr β] (m : List (sigma fun (_x : α) => β)) : string :=
  string.join
    (list.qsort (fun (x y : string) => to_bool (x < y))
      (list.map
        (fun (x : sigma fun (_x : α) => β) =>
          string.empty ++ to_string (repr (sigma.fst x)) ++
            (string.str
                  (string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))
                    (char.of_nat
                      (bit0 (bit1 (bit1 (bit0 (bit0 (bit1 (bit0 (bit1 (bit1 (bit0 (bit0 (bit0 (bit0 1)))))))))))))))
                  (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
                to_string (repr (sigma.snd x)) ++
              string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit0 1)))))))
                (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1))))))))
        m))

/--
Produce a string for a given `total_function`.
The output is of the form `[x₀ ↦ f x₀, .. xₙ ↦ f xₙ, _ ↦ y]`.
-/
protected def repr {α : Type u} [has_repr α] {β : Type v} [has_repr β] : total_function α β → string :=
  sorry

protected instance has_repr (α : Type u) (β : Type v) [has_repr α] [has_repr β] : has_repr (total_function α β) :=
  has_repr.mk total_function.repr

/-- Create a `finmap` from a list of pairs. -/
def list.to_finmap' {α : Type u_1} {β : Type u_2} (xs : List (α × β)) : List (sigma fun (_x : α) => β) :=
  list.map prod.to_sigma xs

/-- Redefine `sizeof` to follow the structure of `sampleable` instances. -/
def total.sizeof {α : Type u} {β : Type v} [sampleable α] [sampleable β] : total_function α β → ℕ :=
  sorry

protected instance has_sizeof {α : Type u} {β : Type v} [sampleable α] [sampleable β] : SizeOf (total_function α β) :=
  { sizeOf := total.sizeof }

/-- Shrink a total function by shrinking the lists that represent it. -/
protected def shrink {α : Type u} {β : Type v} [sampleable α] [sampleable β] [DecidableEq α] : shrink_fn (total_function α β) :=
  sorry

protected instance pi.sampleable_ext {α : Type u} {β : Type v} [sampleable α] [sampleable β] [DecidableEq α] [has_repr α] [has_repr β] : sampleable_ext (α → β) :=
  sampleable_ext.mk (total_function α β)
    (do
      sample (List (α × β))
      uliftable.up (sample β)
      sorry)
    total_function.shrink

protected instance pi_pred.sampleable_ext {α : Type u} [sampleable_ext (α → Bool)] : sampleable_ext (α → Prop) :=
  sampleable_ext.mk (sampleable_ext.proxy_repr (α → Bool)) (sampleable_ext.sample (α → Bool)) sampleable_ext.shrink

protected instance pi_uncurry.sampleable_ext {α : Type u} {β : Type v} {γ : Sort w} [sampleable_ext (α × β → γ)] : sampleable_ext (α → β → γ) :=
  sampleable_ext.mk (sampleable_ext.proxy_repr (α × β → γ)) (sampleable_ext.sample (α × β → γ)) sampleable_ext.shrink

end total_function

/--
Data structure specifying a total function using a list of pairs
and a default value returned when the input is not in the domain of
the partial function.

`map_to_self f` encodes `x ↦ f x` when `x ∈ f` and `x ↦ x`,
i.e. `x` to itself, otherwise.

We use `Σ` to encode mappings instead of `×` because we
rely on the association list API defined in `data.list.sigma`.
-/
inductive injective_function (α : Type u)
where
| map_to_self : (xs : List (sigma fun (_x : α) => α)) →
  list.map sigma.fst xs ~ list.map sigma.snd xs → list.nodup (list.map sigma.snd xs) → injective_function α

protected instance injective_function.inhabited {α : Type u_1} : Inhabited (injective_function α) :=
  { default := injective_function.map_to_self [] list.perm.nil list.nodup_nil }

namespace injective_function

/-- Apply a total function to an argument. -/
def apply {α : Type u} [DecidableEq α] : injective_function α → α → α :=
  sorry

/--
Produce a string for a given `total_function`.
The output is of the form `[x₀ ↦ f x₀, .. xₙ ↦ f xₙ, x ↦ x]`.
Unlike for `total_function`, the default value is not a constant
but the identity function.
-/
protected def repr {α : Type u} [has_repr α] : injective_function α → string :=
  sorry

protected instance has_repr (α : Type u) [has_repr α] : has_repr (injective_function α) :=
  has_repr.mk injective_function.repr

/-- Interpret a list of pairs as a total function, defaulting to
the identity function when no entries are found for a given function -/
def list.apply_id {α : Type u} [DecidableEq α] (xs : List (α × α)) (x : α) : α :=
  option.get_or_else (list.lookup x (list.map prod.to_sigma xs)) x

@[simp] theorem list.apply_id_cons {α : Type u} [DecidableEq α] (xs : List (α × α)) (x : α) (y : α) (z : α) : list.apply_id ((y, z) :: xs) x = ite (y = x) z (list.apply_id xs x) := sorry

theorem list.apply_id_zip_eq {α : Type u} [DecidableEq α] {xs : List α} {ys : List α} (h₀ : list.nodup xs) (h₁ : list.length xs = list.length ys) (x : α) (y : α) (i : ℕ) (h₂ : list.nth xs i = some x) : list.apply_id (list.zip xs ys) x = y ↔ list.nth ys i = some y := sorry

theorem apply_id_mem_iff {α : Type u} [DecidableEq α] {xs : List α} {ys : List α} (h₀ : list.nodup xs) (h₁ : xs ~ ys) (x : α) : list.apply_id (list.zip xs ys) x ∈ ys ↔ x ∈ xs := sorry

theorem list.apply_id_eq_self {α : Type u} [DecidableEq α] {xs : List α} {ys : List α} (x : α) : ¬x ∈ xs → list.apply_id (list.zip xs ys) x = x := sorry

theorem apply_id_injective {α : Type u} [DecidableEq α] {xs : List α} {ys : List α} (h₀ : list.nodup xs) (h₁ : xs ~ ys) : function.injective (list.apply_id (list.zip xs ys)) := sorry

/--
Remove a slice of length `m` at index `n` in a list and a permutation, maintaining the property
that it is a permutation.
-/
def perm.slice {α : Type u_1} [DecidableEq α] (n : ℕ) (m : ℕ) : (psigma fun (xs : List α) => psigma fun (ys : List α) => xs ~ ys ∧ list.nodup ys) →
  psigma fun (xs : List α) => psigma fun (ys : List α) => xs ~ ys ∧ list.nodup ys :=
  sorry

/--
A lazy list, in decreasing order, of sizes that should be
sliced off a list of length `n`
-/
def slice_sizes : ℕ → lazy_list ℕ+ :=
  sorry

/--
Shrink a permutation of a list, slicing a segment in the middle.

The sizes of the slice being removed start at `n` (with `n` the length
of the list) and then `n / 2`, then `n / 4`, etc down to 1. The slices
will be taken at index `0`, `n / k`, `2n / k`, `3n / k`, etc.
-/
protected def shrink_perm {α : Type} [DecidableEq α] [SizeOf α] : shrink_fn (psigma fun (xs : List α) => psigma fun (ys : List α) => xs ~ ys ∧ list.nodup ys) :=
  sorry

protected instance has_sizeof {α : Type u_1} [SizeOf α] : SizeOf (injective_function α) :=
  { sizeOf := fun (_x : injective_function α) => sorry }

/--
Shrink an injective function slicing a segment in the middle of the domain and removing
the corresponding elements in the codomain, hence maintaining the property that
one is a permutation of the other.
-/
protected def shrink {α : Type} [SizeOf α] [DecidableEq α] : shrink_fn (injective_function α) :=
  sorry

/-- Create an injective function from one list and a permutation of that list. -/
protected def mk {α : Type (max u_1 u_2)} (xs : List α) (ys : List α) (h : xs ~ ys) (h' : list.nodup ys) : injective_function α :=
  (fun (h₀ : list.length xs ≤ list.length ys) =>
      (fun (h₁ : list.length ys ≤ list.length xs) =>
          map_to_self (total_function.list.to_finmap' (list.zip xs ys)) sorry sorry)
        sorry)
    sorry

protected theorem injective {α : Type u} [DecidableEq α] (f : injective_function α) : function.injective (apply f) := sorry

protected instance pi_injective.sampleable_ext : sampleable_ext (Subtype fun (f : ℤ → ℤ) => function.injective f) :=
  sampleable_ext.mk (injective_function ℤ)
    (gen.sized
      fun (sz : ℕ) =>
        let xs' : List ℤ := int.range (-(bit0 1 * ↑sz + bit0 1)) (bit0 1 * ↑sz + bit0 1);
        do
          let ys ← gen.permutation_of xs'
          (fun (Hinj : function.injective fun (r : ℕ) => -(bit0 1 * ↑sz + bit0 1) + ↑r) =>
                let r : injective_function ℤ := injective_function.mk xs' (subtype.val ys) sorry sorry;
                pure r)
              sorry)
    injective_function.shrink

end injective_function

protected instance injective.testable {α : Sort u_1} {β : Sort u_2} (f : α → β) [I : testable
  (named_binder (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit1 (bit1 1))))))))
    (∀ (x : α),
      named_binder (string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit1 (bit1 1))))))))
        (∀ (y : α),
          named_binder (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 (bit0 1))))))))
            (f x = f y → x = y))))] : testable (function.injective f) :=
  I

protected instance monotone.testable {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α → β) [I : testable
  (named_binder (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit1 (bit1 1))))))))
    (∀ (x : α),
      named_binder (string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit1 (bit1 1))))))))
        (∀ (y : α),
          named_binder (string.str string.empty (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 (bit0 1))))))))
            (x ≤ y → f x ≤ f y))))] : testable (monotone f) :=
  I


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

/-!
# 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.
-/

universes u v

open category_theory

/-- The category of groups and group morphisms. -/
@[to_additive AddGroup]
def Group : Type (u+1) := bundled group

/-- The category of additive groups and group morphisms -/
add_decl_doc AddGroup

namespace Group

@[to_additive]
instance : bundled_hom.parent_projection group.to_monoid := ⟨⟩

attribute [derive [large_category, concrete_category]] Group
attribute [to_additive] Group.large_category Group.concrete_category

@[to_additive] instance : has_coe_to_sort Group Type* := bundled.has_coe_to_sort

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

/-- Construct a bundled `AddGroup` from the underlying type and typeclass. -/
add_decl_doc AddGroup.of

/-- Typecheck a `monoid_hom` as a morphism in `Group`. -/
@[to_additive] def of_hom {X Y : Type u} [group X] [group Y] (f : X →* Y) : of X ⟶ of Y := f

/-- Typecheck a `add_monoid_hom` as a morphism in `AddGroup`. -/
add_decl_doc AddGroup.of_hom

@[simp, to_additive] lemma of_hom_apply {X Y : Type*} [group X] [group Y] (f : X →* Y) (x : X) :
  of_hom f x = f x := rfl

@[to_additive]
instance (G : Group) : group G := G.str

@[simp, to_additive] lemma coe_of (R : Type u) [group R] : (Group.of R : Type u) = R := rfl

@[to_additive]
instance : has_one Group := ⟨Group.of punit⟩

@[to_additive]
instance : inhabited Group := ⟨1⟩

@[to_additive]
instance one.unique : unique (1 : Group) :=
{ default := 1,
  uniq := λ a, begin cases a, refl, end }

@[simp, to_additive]
lemma one_apply (G H : Group) (g : G) : (1 : G ⟶ H) g = 1 := rfl

@[ext, to_additive]

@[to_additive has_forget_to_AddMon]
instance has_forget_to_Mon : has_forget₂ Group Mon := bundled_hom.forget₂ _ _

end Group

/-- The category of commutative groups and group morphisms. -/
@[to_additive AddCommGroup]
def CommGroup : Type (u+1) := bundled comm_group

/-- The category of additive commutative groups and group morphisms. -/
add_decl_doc AddCommGroup

/-- `Ab` is an abbreviation for `AddCommGroup`, for the sake of mathematicians' sanity. -/
abbreviation Ab := AddCommGroup

namespace CommGroup

@[to_additive]
instance : bundled_hom.parent_projection comm_group.to_group := ⟨⟩

attribute [derive [large_category, concrete_category]] CommGroup
attribute [to_additive] CommGroup.large_category CommGroup.concrete_category

@[to_additive] instance : has_coe_to_sort CommGroup Type* := bundled.has_coe_to_sort

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

/-- Construct a bundled `AddCommGroup` from the underlying type and typeclass. -/
add_decl_doc AddCommGroup.of

/-- Typecheck a `monoid_hom` as a morphism in `CommGroup`. -/
@[to_additive] def of_hom {X Y : Type u} [comm_group X] [comm_group Y] (f : X →* Y) :
  of X ⟶ of Y := f

/-- Typecheck a `add_monoid_hom` as a morphism in `AddCommGroup`. -/
add_decl_doc AddCommGroup.of_hom

@[simp, to_additive] lemma of_hom_apply {X Y : Type*} [comm_group X] [comm_group Y] (f : X →* Y)
  (x : X) : of_hom f x = f x := rfl

@[to_additive]
instance comm_group_instance (G : CommGroup) : comm_group G := G.str

@[simp, to_additive] lemma coe_of (R : Type u) [comm_group R] : (CommGroup.of R : Type u) = R := rfl

@[to_additive] instance : has_one CommGroup := ⟨CommGroup.of punit⟩

@[to_additive] instance : inhabited CommGroup := ⟨1⟩

@[to_additive]
instance one.unique : unique (1 : CommGroup) :=
{ default := 1,
  uniq := λ a, begin cases a, refl, end }

@[simp, to_additive]
lemma one_apply (G H : CommGroup) (g : G) : (1 : G ⟶ H) g = 1 := rfl

@[ext, to_additive]
lemma ext (G H : CommGroup) (f₁ f₂ : G ⟶ H) (w : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
by { ext1, apply w }

@[to_additive has_forget_to_AddGroup]
instance has_forget_to_Group : has_forget₂ CommGroup Group := bundled_hom.forget₂ _ _

@[to_additive has_forget_to_AddCommMon]
instance has_forget_to_CommMon : has_forget₂ CommGroup CommMon :=
induced_category.has_forget₂ (λ G : CommGroup, CommMon.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.
@[to_additive]
example {R S : CommGroup} (i : R ⟶ S) (r : R) (h : r = 1) : i r = 1 :=
by simp [h]

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.{0}} (g : G) : (AddCommGroup.of ℤ) ⟶ G :=
zmultiples_hom G g

@[simp]
lemma as_hom_apply {G : AddCommGroup.{0}} (g : G) (i : ℤ) : (as_hom g) i = i • g := rfl

lemma as_hom_injective {G : AddCommGroup.{0}} : function.injective (@as_hom G) :=
λ h k w, by convert congr_arg (λ k : (AddCommGroup.of ℤ) ⟶ G, (k : ℤ → G) (1 : ℤ)) w; simp

@[ext]
lemma int_hom_ext
  {G : AddCommGroup.{0}} (f g : (AddCommGroup.of ℤ) ⟶ G) (w : f (1 : ℤ) = 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.
lemma injective_of_mono {G H : AddCommGroup.{0}} (f : G ⟶ H) [mono f] : function.injective f :=
λ g₁ g₂ h,
begin
  have t0 : as_hom g₁ ≫ f = as_hom g₂ ≫ f :=
  begin
    ext,
    simpa [as_hom_apply] using h,
  end,
  have t1 : as_hom g₁ = as_hom g₂ := (cancel_mono _).1 t0,
  apply as_hom_injective t1,
end

end AddCommGroup

/-- Build an isomorphism in the category `Group` from a `mul_equiv` between `group`s. -/
@[to_additive add_equiv.to_AddGroup_iso, simps]
def mul_equiv.to_Group_iso {X Y : Group} (e : X ≃* Y) : X ≅ Y :=
{ hom := e.to_monoid_hom,
  inv := e.symm.to_monoid_hom }

/-- Build an isomorphism in the category `AddGroup` from an `add_equiv` between `add_group`s. -/
add_decl_doc add_equiv.to_AddGroup_iso

/-- Build an isomorphism in the category `CommGroup` from a `mul_equiv` between `comm_group`s. -/
@[to_additive add_equiv.to_AddCommGroup_iso, simps]
def mul_equiv.to_CommGroup_iso {X Y : CommGroup} (e : X ≃* Y) : X ≅ Y :=
{ hom := e.to_monoid_hom,
  inv := e.symm.to_monoid_hom }

/-- Build an isomorphism in the category `AddCommGroup` from a `add_equiv` between
`add_comm_group`s. -/
add_decl_doc add_equiv.to_AddCommGroup_iso

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Group`. -/
@[to_additive AddGroup_iso_to_add_equiv "Build an `add_equiv` from an isomorphism in the category
`AddGroup`.", simps]
def Group_iso_to_mul_equiv {X Y : Group} (i : X ≅ Y) : X ≃* Y :=
i.hom.to_mul_equiv i.inv i.hom_inv_id i.inv_hom_id

/-- Build a `mul_equiv` from an isomorphism in the category `CommGroup`. -/
@[to_additive AddCommGroup_iso_to_add_equiv "Build an `add_equiv` from an isomorphism
in the category `AddCommGroup`.", simps]
def CommGroup_iso_to_mul_equiv {X Y : CommGroup} (i : X ≅ Y) : X ≃* Y :=
i.hom.to_mul_equiv i.inv i.hom_inv_id i.inv_hom_id

end category_theory.iso

/-- multiplicative equivalences between `group`s are the same as (isomorphic to) isomorphisms
in `Group` -/
@[to_additive add_equiv_iso_AddGroup_iso "additive equivalences between `add_group`s are the same
as (isomorphic to) isomorphisms in `AddGroup`"]
def mul_equiv_iso_Group_iso {X Y : Group.{u}} : (X ≃* Y) ≅ (X ≅ Y) :=
{ hom := λ e, e.to_Group_iso,
  inv := λ i, i.Group_iso_to_mul_equiv, }

/-- multiplicative equivalences between `comm_group`s are the same as (isomorphic to) isomorphisms
in `CommGroup` -/
@[to_additive add_equiv_iso_AddCommGroup_iso "additive equivalences between `add_comm_group`s are
the same as (isomorphic to) isomorphisms in `AddCommGroup`"]
def mul_equiv_iso_CommGroup_iso {X Y : CommGroup.{u}} : X ≃* Y ≅ (X ≅ Y) :=
{ hom := λ e, e.to_CommGroup_iso,
  inv := λ i, i.CommGroup_iso_to_mul_equiv, }

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 α) :=
{ hom := ⟨λ g, g.to_equiv, (by tidy), (by tidy)⟩,
  inv := ⟨λ g, g.to_iso, (by tidy), (by tidy)⟩ }

/-- 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_perm.Group_iso_to_mul_equiv

end category_theory.Aut

@[to_additive]
instance Group.forget_reflects_isos : reflects_isomorphisms (forget Group.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Group).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Group_iso).1⟩,
  end }

@[to_additive]
instance CommGroup.forget_reflects_isos : reflects_isomorphisms (forget CommGroup.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget CommGroup).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_CommGroup_iso).1⟩,
  end }