section basics
variable Sigma : Type

def word : Type := list Sigma

def lang : Type := word Sigma → Prop

end basics

section dfa
variable {Sigma : Type}

structure dfa(Sigma : Type)  : Type 1 :=
  (Q : Type)
  (init : Q)
  (final : Q → Prop)
  (δ : Q → Sigma → Q)

open dfa

def dfa_δ_star (A : dfa Sigma) : A.Q → word Sigma → A.Q
| q [] := q
| q (x :: w) := dfa_δ_star (A.δ q x) w

def dfa_lang (A : dfa Sigma) : lang Sigma
:= λ w , A.final (dfa_δ_star A A.init w)

end dfa

section nfa
variables {Sigma : Type}

structure nfa(Sigma : Type) : Type 1 :=
  (Q : Type)
  (inits : Q → Prop)
  (final : Q → Prop)
  (δ : Q → Sigma → Q → Prop)

open nfa

/--/
inductive nfa_δ_star (A : nfa Sigma) : A.Q → word Sigma → A.Q → Prop
| empty : ∀ q : A.Q , nfa_δ_star q [] q
| step : ∀ q0 q1 q2 : A.Q, ∀ x : Sigma, ∀ w : word Sigma,
            A.δ q0 x q1 → nfa_δ_star q1 w q2 → nfa_δ_star q1 (x :: w) q2
-/

def nfa_δ_star : Π A : nfa Sigma , A.Q → word Sigma → A.Q → Prop
| A q0 [] q1 := q0 = q1
| A q0 (x :: w) q1 := ∃ q2 : A.Q, A.δ q0 x q2 ∧ nfa_δ_star A q2 w q1

def nfa_lang (A : nfa Sigma) : lang Sigma
:= λ w , ∃ q0 q1 : A.Q, A.inits q0 ∧ nfa_δ_star A q0 w q1 ∧ A.final q1

end nfa

section dfa2nfa
variables {Sigma : Type}

def dfa2nfa(A : dfa Sigma) : nfa Sigma :=
  {
    Q := A.Q,
    inits := λ q , q = A.init,
    final := A.final,
    δ := λ q0 x q1 , q1 = A.δ q0 x
  }

lemma nfaδ2dfaδ : ∀ A : dfa Sigma, ∀ w : word Sigma,
  ∀ q0 q1 : A.Q, dfa_δ_star A q0 w = q1 ↔ nfa_δ_star (dfa2nfa A) q0 w q1 :=
begin
  assume A w,
  induction w,
  {
    assume q0 q1,
    constructor,
    dsimp [dfa_δ_star, nfa_δ_star],
    assume h,
    exact h,
    dsimp [dfa_δ_star, nfa_δ_star],
    assume h,
    exact h,
  },
  {
    assume q0 q1,
    constructor,
    {
      assume h,
      dsimp [nfa_δ_star],
      existsi A.δ q0 w_hd,
      constructor,
      dsimp [dfa2nfa],
      reflexivity,
      apply (iff.mp (w_ih (A.δ q0 w_hd) q1)),
      exact h,
    },
    {
      dsimp [dfa_δ_star, nfa_δ_star],
      assume g,
      apply (iff.mpr (w_ih (A.δ q0 w_hd) q1)),
      cases g with q00 gg,
      have eq: A.δ q0 w_hd = q00,
      dsimp [dfa2nfa] at gg,
      exact (eq.symm (and.elim_left gg)),
      rewrite eq,
      exact (and.elim_right gg),
    }
  }
end

lemma emb11 : ∀ A : dfa Sigma, ∀ w : word Sigma,
    dfa_lang A w → nfa_lang (dfa2nfa A) w :=
begin
  assume A w,
  dsimp [dfa_lang, nfa_lang],
  induction w,
  {
    dsimp [dfa_δ_star],
    assume h,
    existsi A.init,
    existsi A.init,
    constructor,
    dsimp [dfa2nfa],
    reflexivity,
    constructor,
    dsimp [nfa_δ_star],
    reflexivity,
    dsimp [dfa2nfa],
    exact h,
  },
  {
    assume h,
    existsi A.init,
    existsi (dfa_δ_star A A.init (w_hd :: w_tl)),
    constructor,
    dsimp [dfa2nfa],
    reflexivity,
    constructor,
    dsimp [nfa_δ_star],
    existsi A.δ A.init w_hd,
    constructor,
    dsimp [dfa2nfa],
    reflexivity,
    dsimp [dfa_δ_star],
    apply iff.mp (nfaδ2dfaδ A w_tl (A.δ A.init w_hd) (dfa_δ_star A (A.δ A.init w_hd) w_tl)),
    reflexivity,
    dsimp [dfa2nfa],
    exact h,
  }
end

lemma emb12 : ∀ A : dfa Sigma, ∀ w : word Sigma,
    nfa_lang (dfa2nfa A) w → dfa_lang A w :=
begin
  assume A w,
  dsimp [nfa_lang, dfa_lang],
  assume h,
  induction w,
  {
    dsimp [dfa_δ_star] at *,
    cases h with q0 h2,
    cases h2 with q1 h3,
    dsimp [nfa_δ_star, dfa2nfa] at h3,
    rewrite← (and.elim_left h3),
    rewrite (and.elim_left (and.elim_right h3)),
    exact (and.elim_right (and.elim_right h3)),
  },
  {
    dsimp [dfa_δ_star] at *,
    cases h with q0 h2,
    cases h2 with q1 h3,
    have eq: q0 = A.init,
    dsimp [dfa2nfa] at h3,
    exact and.elim_left h3,
    have g: dfa_δ_star A (A.δ A.init w_hd) w_tl = q1,
    rewrite← eq,
    change dfa_δ_star A q0 (w_hd :: w_tl) = q1,
    apply (iff.mpr (nfaδ2dfaδ A (w_hd :: w_tl) q0 q1)),
    exact and.elim_left (and.elim_right h3),
    rewrite g,
    exact and.elim_right (and.elim_right h3),
  }
end

lemma emb1 : ∀ A : dfa Sigma, ∀ w : word Sigma,
    dfa_lang A w ↔ nfa_lang (dfa2nfa A) w :=
begin
  assume A w,
  constructor,
  exact (emb11 A w),
  exact (emb12 A w),
end

end dfa2nfa

section nfa2dfa
variables {Sigma : Type}

def nfa2dfa(A : nfa Sigma) : dfa Sigma :=
  {
    Q := A.Q → Prop,
    init := A.inits,
    final := λ p , ∃ q : A.Q, p q ∧ A.final q,
    δ := λ p x q1 , ∃ q0 : A.Q, p q0 ∧ A.δ q0 x q1,
  }

lemma dfaδ2nfaδ : ∀ A : nfa Sigma, ∀ w : word Sigma,
  ∀ q1 : A.Q, ∀ p : (nfa2dfa A).Q,
  (∃ q0 : A.Q, p q0 ∧ nfa_δ_star A q0 w q1) ↔ dfa_δ_star (nfa2dfa A) p w q1
  :=
begin
  assume A w,
  induction w,
  {
    assume q1 p,
    dsimp [nfa_δ_star, dfa_δ_star],
    constructor,
    {
      assume h,
      cases h with q0 h2,
      rewrite← (and.elim_right h2),
      exact (and.elim_left h2),
    },
    {
      assume h,
      existsi q1,
      exact (and.intro h rfl),
    },
  },
  {
    assume q1 p,
    dsimp [nfa_δ_star, dfa_δ_star],
    constructor,
    {
      assume h,
      cases h with q0 h2,
      cases (and.elim_right h2) with q2 h3,
      have g: ((nfa2dfa A).δ p w_hd) q2,
      {
        dsimp [nfa2dfa],
        existsi q0,
        exact (and.intro (and.elim_left h2) (and.elim_left h3)),
      },
      apply (iff.mp (w_ih q1 ((nfa2dfa A).δ p w_hd))),
      existsi q2,
      exact (and.intro g (and.elim_right h3)),
    },
    {
      assume h,
      cases iff.mpr (w_ih q1 ((nfa2dfa A).δ p w_hd)) h with q2 h2,
      dsimp [nfa2dfa] at h2,
      cases (and.elim_left h2) with q0 h3,
      existsi q0,
      constructor,
      exact (and.elim_left h3),
      existsi q2,
      exact (and.intro (and.elim_right h3) (and.elim_right h2)),
    },
  }
end

lemma emb21 : ∀ A : nfa Sigma, ∀ w : word Sigma,
  nfa_lang A w → dfa_lang (nfa2dfa A) w :=
begin
  assume A w,
  dsimp [nfa_lang, dfa_lang],
  induction w,
  {
    dsimp [nfa_δ_star, dfa_δ_star],
    assume h,
    dsimp [nfa2dfa],
    cases h with q0 h2,
    cases h2 with q1 h3,
    existsi q0,
    constructor,
    exact (and.elim_left h3),
    rewrite (and.elim_left (and.elim_right h3)),
    exact (and.elim_right (and.elim_right h3)),
  },
  {
    dsimp [nfa_δ_star, dfa_δ_star],
    assume h,
    cases h with q0 h2,
    cases h2 with q1 h3,
    have g: dfa_δ_star (nfa2dfa A) ((nfa2dfa A).δ (nfa2dfa A).init w_hd) w_tl q1,
    {
      apply iff.mp (dfaδ2nfaδ A w_tl q1 ((nfa2dfa A).δ (nfa2dfa A).init w_hd)),
      cases (and.elim_left (and.elim_right h3)) with q2 h4,
      existsi q2,
      dsimp [nfa2dfa],
      constructor,
      existsi q0,
      exact (and.intro (and.elim_left h3) (and.elim_left h4)),
      exact (and.elim_right h4),
    },
    existsi q1,
    exact (and.intro g (and.elim_right (and.elim_right h3))),
  }
end

lemma emb22 : ∀ A : nfa Sigma, ∀ w : word Sigma,
  dfa_lang (nfa2dfa A) w → nfa_lang A w :=
begin
  assume A w,
  dsimp [nfa_lang, dfa_lang],
  induction w,
  {
    dsimp [nfa_δ_star, dfa_δ_star, nfa2dfa],
    assume h,
    cases h with q0 h2,
    existsi q0,
    existsi q0,
    simp,
    exact h2,
  },
  {
    assume h,
    cases h with q1 h2,
    have g: ∃ q0 : A.Q, (nfa2dfa A).init q0 ∧ nfa_δ_star A q0 (w_hd :: w_tl) q1,
    {
      apply iff.mpr (dfaδ2nfaδ A (w_hd :: w_tl) q1 (nfa2dfa A).init),
      exact (and.elim_left h2),
    },
    cases g with q0 gg,
    existsi q0,
    existsi q1,
    constructor,
    exact (and.elim_left gg),
    exact (and.intro (and.elim_right gg) (and.elim_right h2)),
  }
end

lemma emb2 : ∀ A : nfa Sigma, ∀ w : word Sigma,
  nfa_lang A w ↔ dfa_lang (nfa2dfa A) w :=
begin
  assume A w,
  constructor,
  exact emb21 A w,
  exact emb22 A w,
end

end nfa2dfa


namespace homework5

open nat

-- 1
theorem mul_add (m n k : nat) : m * (n + k) = (m * n) + (m * k) :=
nat.rec_on k
    (show m * (n + 0) = (m * n) + (m * 0), from calc
        m * (n + 0) = m * n             : by rw add_zero
                ... = (m * n) + 0       : by rw add_zero
                ... = (m * n) + (m * 0) : by rw mul_zero)
    (assume k,
        assume ih : m * (n + k) = (m * n) + (m * k),
        show m * (n + succ k) = (m * n) + (m * succ k), from calc
            m * (n + succ k) = m * (succ (n + k))       : rfl
                           ... = m * (n + k) + m          : by rw mul_succ
                           ... = (m * n) + (m * k) + m    : by rw ih
                           ... = (m * n) + ((m * k) + m)  : by rw add_assoc
                           ... = (m * n) + (m * succ k) : by rw mul_succ)

-- 2
theorem zero_mul (n : nat) : 0 * n = 0 :=
nat.rec_on n
    (show 0 * 0 = 0, from mul_zero 0)
    (assume n,
        assume ih : 0 * n = 0,
        show 0 * succ n = 0, from calc
            0 * succ n = 0 * n + 0 : by rw mul_succ
                   ... = 0 + 0     : by rw ih
                   ... = 0         : by rw add_zero)

-- 3
theorem one_mul (n : nat) : 1 * n = n :=
nat.rec_on n
    (show 1 * 0 = 0, from mul_zero 1)
    (assume n,
        assume ih : 1 * n = n,
        show 1 * succ n = succ n, from calc
            1 * succ n = 1 * n + 1 : by rw mul_succ
                   ... = n + 1     : by rw ih
                   ... = succ n    : rfl)

-- 4
theorem mul_assoc (m n k : nat) : (m * n) * k = m * (n * k) :=
nat.rec_on k
    (show (m * n) * 0 = m * (n * 0), from calc
        (m * n) * 0 = 0           : by rw mul_zero
                ... = m * 0       : by rw mul_zero
                ... = m * (n * 0) : by rw mul_zero n)

    (assume k,
        assume ih : (m * n) * k = m * (n * k),
        show (m * n) * succ k = m * (n * succ k), from calc
            (m * n) * succ k = (m * n) * k + (m * n) : by rw mul_succ
                           ... = m * (n * k) + (m * n) : by rw ih
                           ... = m * (n * k + n)       : by rw mul_add
                           ... = m * (n * succ k)    : by rw mul_succ)

-- 5
theorem mul_comm (m n : nat) : m * n = n * m :=
nat.rec_on n
    (show m * 0 = 0 * m, from calc
        m * 0 = 0     : by rw mul_zero
          ... = 0 * m : by rw zero_mul)
    (assume n,
        assume ih : m * n = n * m,
        show m * succ n = succ n * m, from calc
            m * succ n = m * n + m : by rw mul_succ
                     ... = n * m + m : by rw ih
                     ... = succ n * m : by rw succ_mul)
end homework5


import tactic
import data.real.basic
import data.real.irrational

-- Q1) what's the biggest element of {x ∈ ℝ | x < 1}?

theorem soln1 : ∀ a ∈ {x : ℝ | x < 1}, ∃ b ∈ {x : ℝ | x < 1}, a < b :=
begin
  intro a,
  rintro (ha : a < 1),
  use (a + 1) / 2,
  split,
  { simp,
    linarith },
  linarith,
end

open real

-- Q2) Prove that for every positive intger n ≠ 3, √n - √3 is irrational
theorem soln2 : ∀ n : ℕ, 0 < n ∧ n ≠ 3 → irrational (sqrt (n : ℝ) - sqrt 3) :=
begin
  rintros n ⟨hn0, hn3⟩ hq,
  rw set.mem_range at hq,
  cases hq with q hq,
  have hq1 := add_eq_of_eq_sub hq,
  apply_fun (λ x, x * x) at hq1,
  have h3 : (0 : ℝ) ≤ 3 := by norm_num,
  simp [mul_add, add_mul, h3] at hq1,
  have hq2 : (2 : ℝ) * q * sqrt 3 = n - q * q - 3,
    rw ← hq1, ring,
  let r : ℚ := n - q * q - 3,
  have hq3 : (2 : ℝ) * q * sqrt 3 = r,
    convert hq2,
    norm_cast,
  clear hq1,
  clear hq2,
  have s3 : irrational (sqrt ((3 : ℕ) : ℝ)),
    apply nat.prime.irrational_sqrt,
    norm_num,
  simp at s3,
  have temp : (2 : ℝ) * q * sqrt 3 = sqrt 3 * ((2 : ℚ) * q : ℚ),
    rw mul_comm ((2 : ℝ) * _),
    norm_cast,
  rw temp at hq3,
  apply irrational.mul_rat s3,
  swap,
  use r,
  exact hq3.symm,
  clear hq3 r s3 temp,
  intro h,
  rw mul_eq_zero at h,
  cases h, linarith,
  rw h at hq,
  simp at hq,
  symmetry' at hq,
  rw sub_eq_zero at hq,
  apply hn3,
  apply_fun (λ x, x * x) at hq,
  simp [h3] at hq,
  norm_cast at hq,
end


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import order.conditionally_complete_lattice.basic

/-!
# Extension of a monotone function from a set to the whole space

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

In this file we prove that if a function is monotone and is bounded on a set `s`, then it admits a
monotone extension to the whole space.
-/

open set

variables {α β : Type*} [linear_order α] [conditionally_complete_linear_order β]
  {f : α → β} {s : set α} {a b : α}

/-- If a function is monotone and is bounded on a set `s`, then it admits a monotone extension to
the whole space. -/
lemma monotone_on.exists_monotone_extension (h : monotone_on f s) (hl : bdd_below (f '' s))
  (hu : bdd_above (f '' s)) :
  ∃ g : α → β, monotone g ∧ eq_on f g s :=
begin
  /- The extension is defined by `f x = f a` for `x ≤ a`, and `f x` is the supremum of the values
  of `f`  to the left of `x` for `x ≥ a`. -/
  classical,
  rcases hl with ⟨a, ha⟩,
  have hu' : ∀ x, bdd_above (f '' (Iic x ∩ s)),
    from λ x, hu.mono (image_subset _ (inter_subset_right _ _)),
  set g : α → β := λ x, if disjoint (Iic x) s then a else Sup (f '' (Iic x ∩ s)),
  have hgs : eq_on f g s,
  { intros x hx,
    simp only [g],
    have : is_greatest (Iic x ∩ s) x, from ⟨⟨right_mem_Iic, hx⟩, λ y hy, hy.1⟩,
    rw [if_neg this.nonempty.not_disjoint,
      ((h.mono $ inter_subset_right _ _).map_is_greatest this).cSup_eq] },
  refine ⟨g, λ x y hxy, _, hgs⟩,
  by_cases hx : disjoint (Iic x) s; by_cases hy : disjoint (Iic y) s;
    simp only [g, if_pos, if_neg, not_false_iff, *],
  { rcases not_disjoint_iff_nonempty_inter.1 hy with ⟨z, hz⟩,
    exact le_cSup_of_le (hu' _) (mem_image_of_mem _ hz) (ha $ mem_image_of_mem _ hz.2) },
  { exact (hx $ hy.mono_left $ Iic_subset_Iic.2 hxy).elim },
  { rw [not_disjoint_iff_nonempty_inter] at hx hy,
    refine cSup_le_cSup (hu' _) (hx.image _) (image_subset _ _),
    exact inter_subset_inter_left _ (Iic_subset_Iic.2 hxy) },
end

/-- If a function is antitone and is bounded on a set `s`, then it admits an antitone extension to
the whole space. -/
lemma antitone_on.exists_antitone_extension (h : antitone_on f s) (hl : bdd_below (f '' s))
  (hu : bdd_above (f '' s)) :
  ∃ g : α → β, antitone g ∧ eq_on f g s :=
h.dual_right.exists_monotone_extension hu hl


import data.real.basic
import tactic

open function real

namespace vilnius

example (X Y Z : Type) (f : X → Y) (g : Y → Z)
  (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  intro z,
  have h1 : exists (y:Y), g y = z,
  apply hg,
  cases h1 with y hy,
  have h2 : exists (a:X), f a = y,
  apply hf,
  cases h2 with a ha,
  --use a,
  split,
  rw <- hy,
  rw <- ha,
end

/- ### The λ notation:
In Lean (or in Type Theory, rather) the way to define a function is to use λ expressions: here, you
should think that `λ = ∀`: so, the function
`λ x, 3*x ^ 2 + 1`
is nothing else that the function
`f(x)=3*x ^ 2 + 1` or `f : x ↦ 3*x ^ 2 + 1`.

As for usual functions, the name of the variable does not matter, so
`λ x, 3*x ^ 2 + 1` is the same as `λ w, 3*w ^ 2 + 1`

The tactic to get rid of a `λ` term is
* `simp only` (possibly: at h)
because it "evaluates a λ-term", transforming, for instance
`(λ x, 2 * x + 1) 3` into `2 * 3 + 1`.
-/

definition A : ℕ → ℕ := λ n, n + 1

example : injective A :=
begin
  intros x1 x2 hx,
  rewrite <- add_left_inj 1,
  assumption,
end

example : ¬ surjective A :=
begin
  intro h,
  rewrite A at h,
  rewrite surjective at h,
  specialize h 0,
  cases h with a h,
  --contrapose h,
  rewrite <- nat.succ_eq_add_one at h,
  apply nat.succ_ne_zero a h,
end

-- Recall the-
definition is_linear (f : ℝ → ℝ) : Prop := ∀ c x y, f (c * x + y) = c * f (x) + f(y)

--as well as
theorem linear_at_0 (f : ℝ → ℝ) (H : is_linear f) : f 0 = 0 :=
begin
  rewrite <- add_left_inj (f 0),
  rewrite zero_add,
  nth_rewrite_lhs 0 <- one_mul (f 0),
  rw <- H,
  rw one_mul,
  rw add_zero,
end

-- And now a new

definition is_linear' (f : ℝ → ℝ) : Prop :=
(∀ x y, f ( x + y) = f (x) + f (y)) ∧ (∀ c x, f (c * x) = c * f (x))

theorem linear_eq (f : ℝ → ℝ) : is_linear f ↔ is_linear' f :=
begin
  split,
    intros hl,
    split,
      intros x1 x2,
      nth_rewrite_lhs 0 <- one_mul x1,
      rw hl,
      rw one_mul,

      intros c x,
      rw <- add_zero (c*x:real),
      rw hl,
      rw linear_at_0 f,
      rw add_zero,
      assumption,

    intro hl,
    cases hl with hs hp,
    intros c x y,
    rw hs,
    rw hp,
end

--Recall the
definition is_affine (f : ℝ → ℝ) : Prop := ∃ a, ∀ x y, f (y) - f(x) = a * (y - x)

-- together with the
theorem linear_add_cnst_of_affine (f : ℝ → ℝ) : is_affine f → (∃ a : ℝ, ∃ g : ℝ → ℝ,
  (f = g + (λ x, a)) ∧ is_linear g) :=
  begin
    intro haf,
    cases haf with a haf,
    use (f 0),
    use (λ (x : ℝ), a*x),
    split,
    swap,
      intros c x y,
      simp only,
      rewrite mul_add a (c*x) y,
      rewrite <- mul_assoc,
      rewrite <- mul_assoc,
      rewrite mul_comm a c,

      ext,
      simp,
      rw <- sub_eq_iff_eq_add,
      nth_rewrite_rhs 0 <- sub_zero x,
      specialize haf (0:ℝ) x,
      assumption,
  end

-- as well as

theorem affine_of_linear_add_cnst (f : ℝ → ℝ) : (∃ b : ℝ, ∃ g : ℝ → ℝ,
  (f = g + (λ x, b)) ∧ is_linear g) → is_affine f :=
  begin
    intros ht,
    cases ht with b ht,
    cases ht with g ht,
    cases ht with ha hl,
      rw linear_eq at hl,
      cases hl with hs hp,
    use (g 1),
    intros x y,
    rewrite ha,
    simp,
    rw mul_sub,
    rewrite mul_comm,
    nth_rewrite_rhs 1 mul_comm,
    rw <- hp,
    rw mul_one,
    rw <- hp,
    rw mul_one,
  end

-- that we proved in the lesson.

example (f : ℝ → ℝ) : is_affine f ↔ ∃ a : ℝ, ∃ g : ℝ → ℝ, (f = g + (λ x, a)) ∧ is_linear g := -- iff.intro (linear_add_cnst_of_affine _) (affine_of_linear_add_cnst _)
begin
  split,
  apply linear_add_cnst_of_affine f,
  apply affine_of_linear_add_cnst f,
end

end vilnius


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen

! This file was ported from Lean 3 source module linear_algebra.matrix.dot_product
! leanprover-community/mathlib commit 738c19f572805cff525a93aa4ffbdf232df05aa8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Basic
import Mathbin.LinearAlgebra.StdBasis

/-!
# Dot product of two vectors

This file contains some results on the map `matrix.dot_product`, which maps two
vectors `v w : n → R` to the sum of the entrywise products `v i * w i`.

## Main results

* `matrix.dot_product_std_basis_one`: the dot product of `v` with the `i`th
  standard basis vector is `v i`
* `matrix.dot_product_eq_zero_iff`: if `v`'s' dot product with all `w` is zero,
  then `v` is zero

## Tags

matrix, reindex

-/

universe v w

namespace Matrix

variable {R : Type v} [Semiring R] {n : Type w} [Fintype n]

@[simp]
theorem dotProduct_stdBasis_eq_mul [DecidableEq n] (v : n → R) (c : R) (i : n) :
    dotProduct v (LinearMap.stdBasis R (fun _ => R) i c) = v i * c :=
  by
  rw [dot_product, Finset.sum_eq_single i, LinearMap.stdBasis_same]
  exact fun _ _ hb => by rw [LinearMap.stdBasis_ne _ _ _ _ hb, MulZeroClass.mul_zero]
  exact fun hi => False.elim (hi <| Finset.mem_univ _)
#align matrix.dot_product_std_basis_eq_mul Matrix.dotProduct_stdBasis_eq_mul

@[simp]
theorem dotProduct_stdBasis_one [DecidableEq n] (v : n → R) (i : n) :
    dotProduct v (LinearMap.stdBasis R (fun _ => R) i 1) = v i := by
  rw [dot_product_std_basis_eq_mul, mul_one]
#align matrix.dot_product_std_basis_one Matrix.dotProduct_stdBasis_one

theorem dotProduct_eq (v w : n → R) (h : ∀ u, dotProduct v u = dotProduct w u) : v = w :=
  by
  funext x
  classical rw [← dot_product_std_basis_one v x, ← dot_product_std_basis_one w x, h]
#align matrix.dot_product_eq Matrix.dotProduct_eq

theorem dotProduct_eq_iff {v w : n → R} : (∀ u, dotProduct v u = dotProduct w u) ↔ v = w :=
  ⟨fun h => dotProduct_eq v w h, fun h _ => h ▸ rfl⟩
#align matrix.dot_product_eq_iff Matrix.dotProduct_eq_iff

theorem dotProduct_eq_zero (v : n → R) (h : ∀ w, dotProduct v w = 0) : v = 0 :=
  dotProduct_eq _ _ fun u => (h u).symm ▸ (zero_dotProduct u).symm
#align matrix.dot_product_eq_zero Matrix.dotProduct_eq_zero

theorem dotProduct_eq_zero_iff {v : n → R} : (∀ w, dotProduct v w = 0) ↔ v = 0 :=
  ⟨fun h => dotProduct_eq_zero v h, fun h w => h.symm ▸ zero_dotProduct w⟩
#align matrix.dot_product_eq_zero_iff Matrix.dotProduct_eq_zero_iff

end Matrix


import algebra.group_power tactic.norm_num algebra.big_operators

theorem Q3a (n : ℕ) : ∃ k, (n+1)+(n+2)+(n+3)+(n+4) = 4*k+2 :=
begin
induction n with d Hd,
  existsi 2,trivial,
cases Hd with k Hk, -- why is this so horrible!
existsi k+1,
rw [nat.succ_eq_add_one],
have : ((d + 1 + (d + 2) + (d + 3) + (d + 4))+4)=(4*k+2)+4
        := Hk ▸ @eq.refl ℕ ((d + 1 + (d + 2) + (d + 3) + (d + 4))+4),
simp, -- have given in -- anything will now do.
simp at this,
rw this,
simp [add_mul],
end
--#check @eq_of_add_eq_add_right
--#check @eq.refl

--#check (by apply_instance : has_mul (fin 4))
lemma of_nat_pow : ∀ a b: ℕ, int.of_nat(a^b)=(int.of_nat a)^b :=
begin
intros a b,
induction b with k Hk,
  unfold monoid.pow,
  simp [int.of_nat_one],
unfold monoid.pow nat.pow, -- pow_nat nat.pow has_pow_nat.pow_nat monoid.pow,
--show int.of_nat (a^k*a) = (int.of_nat a) * (int.of_nat a)^k,
rw [int.of_nat_mul,mul_comm,Hk,mul_comm],
end

theorem Q3helpful_lemma : ∀ (e : ℕ), 11^e ≥ 3^e :=
begin
intro e,
induction e with d Hd,
  exact dec_trivial,
exact calc 11^(nat.succ d) = 11*11^d : rfl
... ≥ 3*11^d : nat.mul_le_mul_right (11^d) (dec_trivial)
... ≥ 3*3^d : nat.mul_le_mul_left 3 Hd
... = 3^(nat.succ d) : rfl
end

theorem Q3helpful_lemma2 : ∀ (e : ℕ ), (((11^e-3^e):ℕ):ℤ) = (11:ℤ)^e-(3:ℤ)^e :=
begin
intro e,
show int.of_nat (11^e - 3^e) = (11:ℤ)^e - (3:ℤ)^e,
rw [int.of_nat_sub (Q3helpful_lemma e)],
rw [of_nat_pow,of_nat_pow],
refl,
end

theorem Q3b (n : ℕ) : 8 ∣ 11^n - 3^n :=
begin
have H : ∀ (e : ℕ), 11^e ≥ 3^e := Q3helpful_lemma,

have H311 : @Zmod.of_int 8 3 = Zmod.of_int 11,
apply quot.sound,
existsi (1:ℤ),
exact dec_trivial,

induction n with d Hd,
  exact ⟨0,rfl⟩,

cases Hd with k Hk,
rw [←int.of_nat_eq_of_nat_iff] at Hk,
rw [int.of_nat_sub (H d),int.of_nat_mul] at Hk,
rw [of_nat_pow,of_nat_pow] at Hk,
--have : (int.of_nat 11)^d - (int.of_nat 3)^d = 8 * (int.of_nat k),
--exact Hk,
have Heq : @Zmod.of_int 8 ((3:ℤ)^d) = Zmod.of_int ((11:ℤ)^d),
apply quot.sound,
existsi (k:ℤ),
rw [mul_comm],
exact eq.symm Hk,
have H1 : @Zmod.of_int 8 ((3:ℤ)^(nat.succ d)) = Zmod.of_int (11^(nat.succ d)) := calc
Zmod.of_int ((3:ℤ)^(nat.succ d)) = (Zmod.of_int 3)^(nat.succ d) : eq.symm Zmod.of_int_pow
... = (Zmod.of_int 3)^(d+1) : rfl
... = (Zmod.of_int 3) * (Zmod.of_int 3)^d : pow_succ (Zmod.of_int 3) d
... = (Zmod.of_int 3) * (Zmod.of_int (3^d)) : by rw [@Zmod.of_int_pow 8]
... = Zmod.of_int 3 * (Zmod.of_int (11^d)) : by rw [Heq]
... = Zmod.of_int 11 * (Zmod.of_int (11^d)) : by rw [H311]
... = Zmod.of_int (11^(nat.succ d)) : rfl,

unfold Zmod.of_int at H1,
have H2 := @quotient.exact ℤ (@Z_setoid 8) _ _ H1,
cases H2 with k2 Hk2,
--show (8:ℤ) ∣ 11^nat.succ d - 3^nat.succ d,
have H3 : k2 * ↑8 = (int.of_nat 11) ^ nat.succ d - (int.of_nat 3) ^ nat.succ d,
exact Hk2,
rw [←of_nat_pow,←of_nat_pow] at H3,
rw [←int.of_nat_sub (H (nat.succ d))] at H3,
have Hpos : k2 * ↑8 ≥ 0,
rw [H3], exact int.of_nat_nonneg (11^nat.succ d - 3^nat.succ d),
have Hpos2 : k2 ≥ 0 := nonneg_of_mul_nonneg_right Hpos (dec_trivial),
let k3 : ℕ := int.nat_abs k2,
have H4 : ↑k3 = k2 := int.nat_abs_of_nonneg Hpos2,
existsi k3,
apply int.of_nat_inj,
rw [eq.symm H3],
rw [←H4,int.of_nat_mul,mul_comm],
rw int.of_nat_eq_coe,
rw int.of_nat_eq_coe,
end

theorem Q3ca (n : ℕ) : ∃ k, (n+1)+(n+2)+(n+3)+(n+4) = 4*k+2 :=
begin
existsi (n+2),
change 4 with 1+1+1+1,
rw [add_mul,add_mul,add_mul],
simp,
end

def Q3sum (d : ℕ) (a b : ℤ) := finset.sum (finset.range (d+1)) (λ n, a^n*b^(d-n))

--finset.sum_image :
--  ∀ {α : Type u_1} {β : Type u_2} {γ : Type u_3} {f : α → β} [_inst_1 : add_comm_monoid β]
--  [_inst_2 : decidable_eq α] [_inst_3 : decidable_eq γ] {s : finset γ} {g : γ → α},
--    (∀ (x : γ), x ∈ s → ∀ (y : γ), y ∈ s → g x = g y → x = y) →
--    finset.sum (finset.image g s) f = finset.sum s (λ (x : γ), f (g x))

lemma lt_of_in_finset {x y: ℕ} : x ∈ finset.range y → x < y := by simp

lemma H8 (d : ℕ) : list.map (λ (i : ℕ), d - i) (list.range (d + 1))
    = list.reverse (list.range (d + 1)) :=
begin
admit, -- and ask Mario
end

lemma H7 : ∀ d : ℕ, (finset.range (d+1)).image (λ i,d-i) = finset.range (d+1) :=
begin
-- statement about finsets
intro d,
unfold finset.image,
unfold finset.range,
show multiset.to_finset (multiset.map (λ (i : ℕ), d - i)
      (multiset.range (d + 1))) =
    {val := multiset.range (d + 1), nodup := _},
unfold multiset.to_finset,
apply finset.eq_of_veq,
show multiset.erase_dup (multiset.map (λ (i : ℕ), d - i) (multiset.range (d + 1)))
    = multiset.range (d + 1),
-- now a statement about multisets
have this2 := multiset.nodup_range (d+1),
suffices : multiset.erase_dup (multiset.map (λ (i : ℕ), d - i) (multiset.range (d + 1)))
   = multiset.erase_dup (multiset.range (d + 1)),
  rw [this],
  exact multiset.erase_dup_eq_self.2 this2,
apply congr_arg,
clear this2,
show multiset.map (λ (i : ℕ), d - i) (multiset.range (d + 1))
    = ↑(list.range (d + 1)),
rw ←multiset.coe_reverse,
unfold multiset.range,
rw multiset.coe_map,
apply congr_arg,
-- now a statement about lists
exact H8 d,
end

lemma H0 (d : ℕ) (a b : ℤ) : Q3sum d a b = Q3sum d b a :=
begin
unfold Q3sum,
have : (finset.range (d+1)).image (λ i,d-i) = finset.range (d+1),
  exact H7 d,
/-
  unfold finset.range,
  unfold multiset.range,
  rw ←multiset.coe_reverse,
-/
rw ←this, -- aargh, rewrites both!
have H53 : ∀ (x : ℕ),
    x ∈ finset.range(d+1) → ∀ (y : ℕ), y ∈ finset.range (d+1) → d-x = d-y → x=y,
  introv Hx Hy Hxy,
  have : (d-x)+x=d,
    exact nat.sub_add_cancel (nat.le_of_lt_succ (lt_of_in_finset Hx)),
  rw Hxy at this,
  rw ←nat.sub_add_comm (nat.le_of_lt_succ (lt_of_in_finset Hy)) at this,
  have this2 : (d+x-y)+y=d+x,
    exact nat.sub_add_cancel (le_trans (nat.le_of_lt_succ (lt_of_in_finset Hy)) (nat.le_add_right _ _)),
  rw this at this2,
  exact eq.symm (nat.add_left_cancel this2),
rw [@finset.sum_image ℕ ℤ ℕ (λ (n : ℕ), a ^ n * b ^ (d - n)) _ _ _
     (finset.range (d+1)) (λ i : ℕ, d-i) H53],
rw [this],
apply finset.sum_congr,
introv H,
have := lt_of_in_finset H,
show a ^ (d - x) * b ^ (d - (d - x)) = b ^ x * a ^ (d - x),
rw [nat.sub_sub_self (nat.le_of_lt_succ this)],
apply mul_comm,
end

lemma H5 (e : ℕ) : finset.range (nat.succ e) = insert e (finset.range e) :=
begin
exact finset.range_succ,
end

lemma H1 (d : ℕ) (aa b : ℤ) : b * Q3sum d aa b = Q3sum (d+1) aa b - aa^(d+1) :=
begin
unfold Q3sum,
rw finset.mul_sum,
change d+1+1 with nat.succ(d+1),
rw (@finset.range_succ (d+1)),
rw finset.sum_insert,
  tactic.swap,
  intro H,
  apply lt_irrefl (d+1),
  exact lt_of_in_finset H,
rw [nat.sub_self (d+1)],
have : ∀ x : ℕ, x<(d+1) → b*(aa^x*b^(d-x))= aa^x*b^(d+1-x),
  intros x Hx,
  rw [mul_comm],
  have : d+1-x = (d-x)+1,
    rw [add_comm,nat.add_sub_assoc (nat.le_of_lt_succ Hx),add_comm],
  rw [this],
  rw [pow_succ],simp,
rw [pow_zero,mul_one],
rw [add_comm (aa^(d+1)),add_sub_cancel],
apply finset.sum_congr,
intros,
apply this x,
exact lt_of_in_finset H,
end

lemma H3 (d : ℕ) : 11 * Q3sum d 3 11 = Q3sum (d+1) 3 11 - 3^(d+1) := H1 d 3 11
lemma H2 (d : ℕ) : 3 * Q3sum d 3 11 = Q3sum (d+1) 3 11 - 11^(d+1) :=
begin
rw [H0],
rw H1 d 11 3,
rw [H0]
end

lemma Q3cb_helper : ∀ d : ℕ, 8*Q3sum d 3 11 = 11^(d+1)-3^(d+1) :=
begin
intro d,
change (8:ℤ) with (11:ℤ)-3,
rw [sub_mul,H3,H2],
simp,
end

theorem Q3cbint (n : ℕ) : 8 ∣ (11:ℤ)^n - 3^n :=
begin
cases n with d,
  simp,
show 8 ∣ (11:ℤ)^(d+1) - 3^(d+1),
rw [←Q3cb_helper d],
existsi Q3sum d 3 11,
refl,
end

theorem Q3cb (n : ℕ) : 8 ∣ 11^n - 3^n := -- non-inductive proof
begin
rw ←int.coe_nat_dvd,
rw [Q3helpful_lemma2],
apply Q3cbint,
end


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

! This file was ported from Lean 3 source module group_theory.subgroup.mul_opposite
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Actions

/-!
# Mul-opposite subgroups

## Tags
subgroup, subgroups

-/

variable {G : Type _} [Group G]

namespace Subgroup

/-- A subgroup `H` of `G` determines a subgroup `H.opposite` of the opposite group `Gᵐᵒᵖ`. -/
@[to_additive "An additive subgroup `H` of `G` determines an additive subgroup `H.opposite` of the
 opposite additive group `Gᵃᵒᵖ`."]
def opposite : Subgroup G ≃ Subgroup Gᵐᵒᵖ
    where
  toFun H :=
    { carrier := MulOpposite.unop ⁻¹' (H : Set G)
      one_mem' := H.one_mem
      mul_mem' := fun ha hb => H.mul_mem hb ha
      inv_mem' := H.inv_mem }
  invFun H :=
    { carrier := MulOpposite.op ⁻¹' (H : Set Gᵐᵒᵖ)
      one_mem' := H.one_mem
      mul_mem' := fun ha hb => H.mul_mem hb ha
      inv_mem' := H.inv_mem }
  left_inv _ := SetLike.coe_injective rfl
  right_inv _ := SetLike.coe_injective rfl
#align subgroup.opposite Subgroup.opposite
#align add_subgroup.opposite AddSubgroup.opposite

/-- Bijection between a subgroup `H` and its opposite. -/
@[to_additive (attr := simps!) "Bijection between an additive subgroup `H` and its opposite."]
def oppositeEquiv (H : Subgroup G) : H ≃ opposite H :=
  MulOpposite.opEquiv.subtypeEquiv fun _ => Iff.rfl
#align subgroup.opposite_equiv Subgroup.oppositeEquiv
#align add_subgroup.opposite_equiv AddSubgroup.oppositeEquiv
#align subgroup.opposite_equiv_symm_apply_coe Subgroup.oppositeEquiv_symm_apply_coe

@[to_additive]
instance (H : Subgroup G) [Encodable H] : Encodable (opposite H) :=
  Encodable.ofEquiv H H.oppositeEquiv.symm

@[to_additive]
instance (H : Subgroup G) [Countable H] : Countable (opposite H) :=
  Countable.of_equiv H H.oppositeEquiv

@[to_additive]
theorem smul_opposite_mul {H : Subgroup G} (x g : G) (h : opposite H) :
    h • (g * x) = g * h • x :=
  mul_assoc _ _ _
#align subgroup.smul_opposite_mul Subgroup.smul_opposite_mul
#align add_subgroup.vadd_opposite_add AddSubgroup.vadd_opposite_add

end Subgroup


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Yaël Dillies
-/
import linear_algebra.ray
import analysis.normed_space.basic

/-!
# Rays in a real normed vector space

In this file we prove some lemmas about the `same_ray` predicate in case of a real normed space. In
this case, for two vectors `x y` in the same ray, the norm of their sum is equal to the sum of their
norms and `‖y‖ • x = ‖x‖ • y`.
-/

open real

variables {E : Type*} [seminormed_add_comm_group E] [normed_space ℝ E]
  {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]

namespace same_ray

variables {x y : E}

/-- If `x` and `y` are on the same ray, then the triangle inequality becomes the equality: the norm
of `x + y` is the sum of the norms of `x` and `y`. The converse is true for a strictly convex
space. -/
lemma norm_add (h : same_ray ℝ x y) : ‖x + y‖ = ‖x‖ + ‖y‖ :=
begin
  rcases h.exists_eq_smul with ⟨u, a, b, ha, hb, -, rfl, rfl⟩,
  rw [← add_smul, norm_smul_of_nonneg (add_nonneg ha hb), norm_smul_of_nonneg ha,
    norm_smul_of_nonneg hb, add_mul]
end

lemma norm_sub (h : same_ray ℝ x y) : ‖x - y‖ = |‖x‖ - ‖y‖| :=
begin
  rcases h.exists_eq_smul with ⟨u, a, b, ha, hb, -, rfl, rfl⟩,
  wlog hab : b ≤ a,
  { rw same_ray_comm at h, rw [norm_sub_rev, abs_sub_comm],
    exact this u b a hb ha h (le_of_not_le hab), },
  rw ← sub_nonneg at hab,
  rw [← sub_smul, norm_smul_of_nonneg hab, norm_smul_of_nonneg ha,
    norm_smul_of_nonneg hb, ← sub_mul, abs_of_nonneg (mul_nonneg hab (norm_nonneg _))]
end

lemma norm_smul_eq (h : same_ray ℝ x y) : ‖x‖ • y = ‖y‖ • x :=
begin
  rcases h.exists_eq_smul with ⟨u, a, b, ha, hb, -, rfl, rfl⟩,
  simp only [norm_smul_of_nonneg, *, mul_smul, smul_comm (‖u‖)],
  apply smul_comm
end

end same_ray

variables {x y : F}

lemma norm_inj_on_ray_left (hx : x ≠ 0) : {y | same_ray ℝ x y}.inj_on norm :=
begin
  rintro y hy z hz h,
  rcases hy.exists_nonneg_left hx with ⟨r, hr, rfl⟩,
  rcases hz.exists_nonneg_left hx with ⟨s, hs, rfl⟩,
  rw [norm_smul, norm_smul, mul_left_inj' (norm_ne_zero_iff.2 hx), norm_of_nonneg hr,
    norm_of_nonneg hs] at h,
  rw h
end

lemma norm_inj_on_ray_right (hy : y ≠ 0) : {x | same_ray ℝ x y}.inj_on norm :=
by simpa only [same_ray_comm] using norm_inj_on_ray_left hy

lemma same_ray_iff_norm_smul_eq : same_ray ℝ x y ↔ ‖x‖ • y = ‖y‖ • x :=
⟨same_ray.norm_smul_eq, λ h, or_iff_not_imp_left.2 $ λ hx, or_iff_not_imp_left.2 $ λ hy,
  ⟨‖y‖, ‖x‖, norm_pos_iff.2 hy, norm_pos_iff.2 hx, h.symm⟩⟩

/-- Two nonzero vectors `x y` in a real normed space are on the same ray if and only if the unit
vectors `‖x‖⁻¹ • x` and `‖y‖⁻¹ • y` are equal. -/
lemma same_ray_iff_inv_norm_smul_eq_of_ne (hx : x ≠ 0) (hy : y ≠ 0) :
  same_ray ℝ x y ↔ ‖x‖⁻¹ • x = ‖y‖⁻¹ • y :=
by rw [inv_smul_eq_iff₀, smul_comm, eq_comm, inv_smul_eq_iff₀, same_ray_iff_norm_smul_eq];
    rwa norm_ne_zero_iff

alias same_ray_iff_inv_norm_smul_eq_of_ne ↔ same_ray.inv_norm_smul_eq _

/-- Two vectors `x y` in a real normed space are on the ray if and only if one of them is zero or
the unit vectors `‖x‖⁻¹ • x` and `‖y‖⁻¹ • y` are equal. -/
lemma same_ray_iff_inv_norm_smul_eq : same_ray ℝ x y ↔ x = 0 ∨ y = 0 ∨ ‖x‖⁻¹ • x = ‖y‖⁻¹ • y :=
begin
  rcases eq_or_ne x 0 with rfl|hx, { simp [same_ray.zero_left] },
  rcases eq_or_ne y 0 with rfl|hy, { simp [same_ray.zero_right] },
  simp only [same_ray_iff_inv_norm_smul_eq_of_ne hx hy, *, false_or]
end

/-- Two vectors of the same norm are on the same ray if and only if they are equal. -/
lemma same_ray_iff_of_norm_eq (h : ‖x‖ = ‖y‖) : same_ray ℝ x y ↔ x = y :=
begin
  obtain rfl | hy := eq_or_ne y 0,
  { rw [norm_zero, norm_eq_zero] at h,
    exact iff_of_true (same_ray.zero_right _) h },
  { exact ⟨λ hxy, norm_inj_on_ray_right hy hxy same_ray.rfl h, λ hxy, hxy ▸ same_ray.rfl⟩ }
end

lemma not_same_ray_iff_of_norm_eq (h : ‖x‖ = ‖y‖) : ¬ same_ray ℝ x y ↔ x ≠ y :=
(same_ray_iff_of_norm_eq h).not

/-- If two points on the same ray have the same norm, then they are equal. -/
lemma same_ray.eq_of_norm_eq (h : same_ray ℝ x y) (hn : ‖x‖ = ‖y‖) : x = y :=
(same_ray_iff_of_norm_eq hn).mp h

/-- The norms of two vectors on the same ray are equal if and only if they are equal. -/
lemma same_ray.norm_eq_iff (h : same_ray ℝ x y) : ‖x‖ = ‖y‖ ↔ x = y :=
⟨h.eq_of_norm_eq, λ h, h ▸ rfl⟩


-- La composición de funciones suprayectivas es suprayectiva
-- =========================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar que la composición de dos funciones
-- suprayectivas es una función suprayectiva.
-- ----------------------------------------------------

import tactic

open function

variables {X Y Z : Type}
variable  {f : X → Y}
variable  {g : Y → Z}

-- 1ª demostración
example
  (hf : surjective f)
  (hg : surjective g)
  : surjective (g ∘ f) :=
begin
  intro z,
  cases hg z with y hy,
  cases hf y with x hx,
  use x,
  simp,
  rw hx,
  exact hy,
end

-- 2ª demostración
example
  (hf : surjective f)
  (hg : surjective g)
  : surjective (g ∘ f) :=
begin
  intro z,
  cases hg z with y hy,
  cases hf y with x hx,
  use x,
  calc (g ∘ f) x = g (f x) : by rw comp_app
             ... = g y     : congr_arg g hx
             ... = z       : hy,
end

-- 3ª demostración
example
  (hf : surjective f)
  (hg : surjective g)
  : surjective (g ∘ f) :=
assume z,
exists.elim (hg z)
  ( assume y (hy : g y = z),
    exists.elim (hf y)
    ( assume x (hx : f x = y),
      have g (f x) = z, from eq.subst (eq.symm hx) hy,
      show ∃ x, g (f x) = z, from exists.intro x this))

-- 4ª demostración
example
  (hf : surjective f)
  (hg : surjective g)
  : surjective (g ∘ f) :=
-- by library_search
surjective.comp hg hf

-- 5ª demostración
example
  (hf : surjective f)
  (hg : surjective g)
  : surjective (g ∘ f) :=
λ z, exists.elim (hg z)
  (λ y hy, exists.elim (hf y)
     (λ x hx, exists.intro x
        (show g (f x) = z,
           from (eq.trans (congr_arg g hx) hy))))


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

Insertion sort and merge sort.
-/
import data.list.perm
open list.perm

namespace list

section sorted
universe variable uu
variables {α : Type uu} {r : α → α → Prop}

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted := @pairwise

@[simp] theorem sorted_nil : sorted r [] := pairwise.nil _

@[simp] theorem sorted_singleton (a : α) : sorted r [a] := pairwise_singleton _ _

theorem sorted_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) → sorted r l :=
pairwise_of_pairwise_cons

theorem rel_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) →
  ∀ b ∈ l, r a b :=
rel_of_pairwise_cons

@[simp] theorem sorted_cons {a : α} {l : list α} :
  sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ sorted r l :=
pairwise_cons

theorem eq_of_sorted_of_perm [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
begin
  induction s₁ with a l₁ h₁ s₁ IH generalizing l₂,
  { rw eq_nil_of_perm_nil p },
  { have : a ∈ l₂ := perm_subset p (mem_cons_self _ _),
    rcases mem_split this with ⟨u₂, v₂, rfl⟩,
    have p' := (perm_cons a).1 (p.trans perm_middle),
    have := IH p' (pairwise_of_sublist (by simp) s₂), subst l₁,
    change a::u₂ ++ v₂ = u₂ ++ ([a] ++ v₂), rw ← append_assoc, congr,
    have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m,
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _))
        (h₁ _ (by simp [m])),
    rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2,
        (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2];
    split; simp [iff_true_intro this, or_comm] }
end

end sorted

/-
  sorting procedures
-/

section sort
universe variable uu
parameters {α : Type uu} (r : α → α → Prop) [decidable_rel r]
local infix `≼` : 50 := r

/- insertion sort -/

section insertion_sort

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert (a : α) : list α → list α
| []       := [a]
| (b :: l) := if a ≼ b then a :: b :: l else b :: ordered_insert l

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort : list α → list α
| []       := []
| (b :: l) := ordered_insert b (insertion_sort l)

section correctness
open perm

theorem perm_ordered_insert (a) : ∀ l : list α, ordered_insert a l ~ a :: l
| []       := perm.refl _
| (b :: l) := by by_cases a ≼ b; [simp [ordered_insert, h],
  simpa [ordered_insert, h] using
    (perm.skip _ (perm_ordered_insert l)).trans (perm.swap _ _ _)]

theorem perm_insertion_sort : ∀ l : list α, insertion_sort l ~ l
| []       := perm.nil
| (b :: l) := by simpa [insertion_sort] using
  (perm_ordered_insert _ _ _).trans (perm.skip b (perm_insertion_sort l))

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted_ordered_insert (a : α) : ∀ l, sorted r l → sorted r (ordered_insert a l)
| []       h := sorted_singleton a
| (b :: l) h := begin
  by_cases h' : a ≼ b,
  { simpa [ordered_insert, h', h] using λ b' bm, trans h' (rel_of_sorted_cons h _ bm) },
  { suffices : ∀ (b' : α), b' ∈ ordered_insert r a l → r b b',
    { simpa [ordered_insert, h', sorted_ordered_insert l (sorted_of_sorted_cons h)] },
    intros b' bm,
    cases (show b' = a ∨ b' ∈ l, by simpa using
      perm_subset (perm_ordered_insert _ _ _) bm) with be bm,
    { subst b', exact (total_of r _ _).resolve_left h' },
    { exact rel_of_sorted_cons h _ bm } }
end

theorem sorted_insertion_sort : ∀ l, sorted r (insertion_sort l)
| []       := sorted_nil
| (a :: l) := sorted_ordered_insert a _ (sorted_insertion_sort l)

end total_and_transitive
end correctness
end insertion_sort

/- merge sort -/

section merge_sort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split : list α → list α × list α
| []       := ([], [])
| (a :: l) := let (l₁, l₂) := split l in (a :: l₂, l₁)

theorem split_cons_of_eq (a : α) {l l₁ l₂ : list α} (h : split l = (l₁, l₂)) :
  split (a :: l) = (a :: l₂, l₁) :=
by rw [split, h]; refl

theorem length_split_le : ∀ {l l₁ l₂ : list α},
  split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
| []     ._  ._  rfl := ⟨nat.le_refl 0, nat.le_refl 0⟩
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ h₂, nat.le_succ_of_le h₁⟩
end

theorem length_split_lt {a b} {l l₁ l₂ : list α} (h : split (a::b::l) = (l₁, l₂)) :
  length l₁ < length (a::b::l) ∧ length l₂ < length (a::b::l) :=
begin
  cases e : split l with l₁' l₂',
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h, substs l₁ l₂,
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ (nat.succ_le_succ h₁), nat.succ_le_succ (nat.succ_le_succ h₂)⟩
end

theorem perm_split : ∀ {l l₁ l₂ : list α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
| []     ._  ._  rfl := perm.refl _
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  exact perm.skip a ((perm_split e).trans perm_app_comm),
end

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : list α → list α → list α
| []       l'        := l'
| l        []        := l
| (a :: l) (b :: l') := if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'

include r
/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort : list α → list α
| []        := []
| [a]       := [a]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  exact merge r (merge_sort l₁) (merge_sort l₂)
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_cons_cons {a b} {l l₁ l₂ : list α}
  (h : split (a::b::l) = (l₁, l₂)) :
  merge_sort (a::b::l) = merge (merge_sort l₁) (merge_sort l₂) :=
begin
  suffices : ∀ (L : list α) h1, @@and.rec
    (λ a a (_ : length l₁ < length l + 1 + 1 ∧
      length l₂ < length l + 1 + 1), L) h1 h1 = L,
  { simp [merge_sort, h], apply this },
  intros, cases h1, refl
end

section correctness

theorem perm_merge : ∀ (l l' : list α), merge l l' ~ l ++ l'
| []       []        := perm.nil
| []       (b :: l') := by simp [merge]
| (a :: l) []        := by simp [merge]
| (a :: l) (b :: l') := begin
  by_cases a ≼ b,
  { simpa [merge, h] using skip _ (perm_merge _ _) },
  { suffices : b :: merge r (a :: l) l' ~ a :: (l ++ b :: l'), {simpa [merge, h]},
    exact (skip _ (perm_merge _ _)).trans ((swap _ _ _).trans (skip _ perm_middle.symm)) }
end

theorem perm_merge_sort : ∀ l : list α, merge_sort l ~ l
| []        := perm.refl _
| [a]       := perm.refl _
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  apply (perm_merge r _ _).trans,
  exact (perm_app (perm_merge_sort l₁) (perm_merge_sort l₂)).trans (perm_split e).symm
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted_merge : ∀ {l l' : list α}, sorted r l → sorted r l' → sorted r (merge l l')
| []       []        h₁ h₂ := sorted_nil
| []       (b :: l') h₁ h₂ := by simpa [merge] using h₂
| (a :: l) []        h₁ h₂ := by simpa [merge] using h₁
| (a :: l) (b :: l') h₁ h₂ := begin
  by_cases a ≼ b,
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b',
    { simpa [merge, h, sorted_merge (sorted_of_sorted_cons h₁) h₂] },
    intros b' bm,
    rcases (show b' = b ∨ b' ∈ l ∨ b' ∈ l', by simpa [or.left_comm] using
      perm_subset (perm_merge _ _ _) bm) with be | bl | bl',
    { subst b', assumption },
    { exact rel_of_sorted_cons h₁ _ bl },
    { exact trans h (rel_of_sorted_cons h₂ _ bl') } },
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b',
    { simpa [merge, h, sorted_merge h₁ (sorted_of_sorted_cons h₂)] },
    intros b' bm,
    have ba : b ≼ a := (total_of r _ _).resolve_left h,
    rcases (show b' = a ∨ b' ∈ l ∨ b' ∈ l', by simpa using
      perm_subset (perm_merge _ _ _) bm) with be | bl | bl',
    { subst b', assumption },
    { exact trans ba (rel_of_sorted_cons h₁ _ bl) },
    { exact rel_of_sorted_cons h₂ _ bl' } }
end

theorem sorted_merge_sort : ∀ l : list α, sorted r (merge_sort l)
| []        := sorted_nil
| [a]       := sorted_singleton _
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  exact sorted_merge r (sorted_merge_sort l₁) (sorted_merge_sort l₂)
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_eq_self [is_antisymm α r] {l : list α} : sorted r l → merge_sort l = l :=
eq_of_sorted_of_perm (perm_merge_sort _) (sorted_merge_sort _)

end total_and_transitive
end correctness
end merge_sort
end sort

/- try them out! -/

--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end list


variables p q: Prop

#check p -> ¬ p
#check p -> q -> p ∧ q

example (hp: p) (hq: q): p ∧ q := and.intro hp hq
example (h: p ∧ q): p := and.elim_left h
example (h: p ∧ q): q := and.elim_right h
#check assume (h: p ∧ q), and.elim_left h

example (h: p ∧ q): q ∧ p := and.intro (and.right h) (and.left h)

#check assume (hp: p) (hq: q), (⟨hp, hq⟩: p ∧ q)

example (h: p ∧ q): q ∧ p := ⟨h.right, h.left⟩

example (h: p ∧ q): q ∧ p ∧ q := ⟨h.right, h.left, h.right⟩

example (hp: p): p ∨ q := or.intro_left q hp

#print or.elim

example (h: p ∨ q) : q ∨ p :=
  or.elim h
    (assume hp: p, or.inr hp)
    (assume hq: q, or.inl hq)

example (hpq: p -> q) (hnq: ¬ q) : ¬ p :=
  assume hp: p,
  show false, from hnq (hpq hp)

#print absurd
example (hp: p) (hnp: ¬ p) : q := absurd hp hnp

theorem and_swap: p ∧ q ↔ q ∧ p := ⟨ λ h, ⟨h.right, h.left⟩, λ h, ⟨h.right, h.left⟩ ⟩

example (h: p ∧ q) : q ∧ p := (and_swap p q).mp h

example (h: p ∧ q): q ∧ p :=
  have hp: p, from h.left,
  have hq: q, from h.right,
  ⟨hq, hp⟩

example (h: p ∧ q): q ∧ p :=
  have hp: p, from h.left,
  suffices hq: q, from ⟨hq, hp⟩,
  show q, from h.right


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

! This file was ported from Lean 3 source module number_theory.lucas_primality
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Basic
import Mathlib.GroupTheory.OrderOfElement
import Mathlib.Tactic.Zify
import Mathlib.Data.Nat.Totient

/-!
# The Lucas test for primes.

This file implements the Lucas test for primes (not to be confused with the Lucas-Lehmer test for
Mersenne primes). A number `a` witnesses that `n` is prime if `a` has order `n-1` in the
multiplicative group of integers mod `n`. This is checked by verifying that `a^(n-1) = 1 (mod n)`
and `a^d ≠ 1 (mod n)` for any divisor `d | n - 1`. This test is the basis of the Pratt primality
certificate.

## TODO

- Bonus: Show the reverse implication i.e. if a number is prime then it has a Lucas witness.
  Use `Units.IsCyclic` from `RingTheory/IntegralDomain` to show the group is cyclic.
- Write a tactic that uses this theorem to generate Pratt primality certificates
- Integrate Pratt primality certificates into the norm_num primality verifier

## Implementation notes

Note that the proof for `lucas_primality` relies on analyzing the multiplicative group
modulo `p`. Despite this, the theorem still holds vacuously for `p = 0` and `p = 1`: In these
cases, we can take `q` to be any prime and see that `hd` does not hold, since `a^((p-1)/q)` reduces
to `1`.
-/

/-- If `a^(p-1) = 1 mod p`, but `a^((p-1)/q) ≠ 1 mod p` for all prime factors `q` of `p-1`, then `p`
is prime. This is true because `a` has order `p-1` in the multiplicative group mod `p`, so this
group must itself have order `p-1`, which only happens when `p` is prime.
-/
theorem lucas_primality (p : ℕ) (a : ZMod p) (ha : a ^ (p - 1) = 1)
    (hd : ∀ q : ℕ, q.Prime → q ∣ p - 1 → a ^ ((p - 1) / q) ≠ 1) : p.Prime := by
  have h0 : p ≠ 0 := by
    rintro ⟨⟩
    exact hd 2 Nat.prime_two (dvd_zero _) (pow_zero _)
  have h1 : p ≠ 1 := by
    rintro ⟨⟩
    exact hd 2 Nat.prime_two (dvd_zero _) (pow_zero _)
  have hp1 : 1 < p := lt_of_le_of_ne h0.bot_lt h1.symm
  have order_of_a : orderOf a = p - 1 := by
    apply orderOf_eq_of_pow_and_pow_div_prime _ ha hd
    exact tsub_pos_of_lt hp1
  haveI : NeZero p := ⟨h0⟩
  rw [Nat.prime_iff_card_units]
  -- Prove cardinality of `Units` of `ZMod p` is both `≤ p-1` and `≥ p-1`
  refine' le_antisymm (Nat.card_units_zMod_lt_sub_one hp1) _
  have hp' : p - 2 + 1 = p - 1 := tsub_add_eq_add_tsub hp1
  let a' : (ZMod p)ˣ := Units.mkOfMulEqOne a (a ^ (p - 2)) (by rw [← pow_succ, hp', ha])
  calc
    p - 1 = orderOf a := order_of_a.symm
    _ = orderOf a' := (orderOf_injective (Units.coeHom (ZMod p)) Units.ext a')
    _ ≤ Fintype.card (ZMod p)ˣ := orderOf_le_card_univ

#align lucas_primality lucas_primality


variable (p q r : Prop)

-- commutativity of ∧ and ∨

example : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (
      λ hpq : p ∧ q =>
        have hp : p := hpq.left
        have hq : q := hpq.right
        show q ∧ p
          from And.intro hq hp
    )
    (
      λ hqp : q ∧ p =>
        have hq : q := hqp.left
        have hp : p := hqp.right
        show p ∧ q
          from And.intro hp hq
    )

example : p ∨ q ↔ q ∨ p :=
  Iff.intro
    (
      λ hpq : p ∨ q =>
        Or.elim hpq
          (
            λ hp : p =>
              show q ∨ p
                from Or.inr hp
          )
          (
            λ hq : q =>
              show q ∨ p
                from Or.inl hq
          )
    )
    (
      λ hpq : q ∨ p =>
        Or.elim hpq
          (
            λ hq : q =>
              show p ∨ q
                from Or.inr hq
          )
          (
            λ hp : p =>
              show p ∨ q
                from Or.inl hp
          )
    )

-- associativity of ∧ and ∨

example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro
    (
      λ h : (p ∧ q) ∧ r =>
        have hp : p := h.left.left
        have hq : q := h.left.right
        have hr : r := h.right
        show p ∧ (q ∧ r)
          from And.intro hp (And.intro hq hr)
    )
    (
      λ h : p ∧ (q ∧ r) =>
        let hp : p := h.left
        let hq : q := h.right.left
        let hr : r := h.right.right
        ⟨⟨hp, hq⟩, hr⟩
    )

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  Iff.intro
    (
      λ h : (p ∨ q) ∨ r =>
        Or.elim h
          (
            λ h' : p ∨ q =>
              Or.elim h'
                (λ hp : p => Or.inl hp)
                (λ hq : q => Or.inr (Or.inl hq))
          )
          (λ hr : r => Or.inr (Or.inr hr))
    )
    (
      λ h : p ∨ (q ∨ r) =>
        Or.elim h
          (λ hp : p => Or.inl (Or.inl hp))
          (
            λ h' : q ∨ r =>
              Or.elim h'
                (λ hq : q => Or.inl (Or.inr hq))
                (λ hr : r => Or.inr hr)
          )
    )

-- distributivity

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  Iff.intro
    (
      λ h : p ∧ (q ∨ r) =>
        have hp : p := h.left
        Or.elim h.right
          (λ hq : q => Or.inl ⟨hp, hq⟩)
          (λ hr : r => Or.inr ⟨hp, hr⟩)
    )
    (
      λ h : (p ∧ q) ∨ (p ∧ r) =>
        Or.elim h
          (λ h' : p ∧ q => ⟨h'.left, Or.inl h'.right⟩)
          (λ h' : p ∧ r => ⟨h'.left, Or.inr h'.right⟩)
    )

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  Iff.intro
    (
      λ h : p ∨ (q ∧ r) =>
        Or.elim h
          (λ hp : p => ⟨Or.inl hp, Or.inl hp⟩)
          (λ h' : q ∧ r => ⟨Or.inr h'.left, Or.inr h'.right⟩)
    )
    (
      λ h : (p ∨ q) ∧ (p ∨ r) =>
        Or.elim h.left
          (λ hp : p => Or.inl hp)
          (
            λ hq : q =>
              Or.elim h.right
                (λ hp : p => Or.inl hp)
                (λ hr : r => Or.inr ⟨hq, hr⟩)
          )
    )

-- other properties

example : (p → (q → r)) ↔ (p ∧ q → r) :=
  Iff.intro
    (
      λ h : p → (q → r) =>
        λ h' : p ∧ q =>
          (h h'.left) h'.right
    )
    (
      λ h : p ∧ q → r =>
        λ hp : p =>
          λ hq : q =>
            h ⟨hp, hq⟩
    )

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  Iff.intro
    (
      λ h : (p ∨ q) → r =>
        ⟨
          λ hp : p => h (Or.inl hp)
        , λ hq : q => h (Or.inr hq)
        ⟩
    )
    (
      λ h : (p → r) ∧ (q → r) =>
        λ h' : p ∨ q =>
          Or.elim h'
            (λ hp : p => h.left hp)
            (λ hq : q => h.right hq)
    )

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  Iff.intro
    (
      λ h : ¬(p ∨ q) =>
        ⟨
          λ hp : p => show False from h (Or.inl hp)
        , λ hq : q => show False from h (Or.inr hq)
        ⟩
    )
    (
      λ h : ¬p ∧ ¬q =>
        λ h' : p ∨ q =>
          Or.elim h'
            (λ hp : p => h.left hp)
            (λ hq : q => h.right hq)
    )

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  λ h : ¬p ∨ ¬q =>
    λ h' : p ∧ q =>
      Or.elim h
        (λ hnp : ¬p => hnp h'.left)
        (λ hnq : ¬q => hnq h'.right)

example : ¬(p ∧ ¬p) :=
  λ h : p ∧ ¬p => h.right h.left

example : p ∧ ¬q → ¬(p → q) :=
  λ h : p ∧ ¬q =>
    λ h' : p → q =>
      have hnq : ¬q := h.right
      have hq : q := h' h.left
      show False
        from hnq hq

example : ¬p → (p → q) :=
  λ hnp : ¬p =>
    λ hp : p => absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
  λ h : ¬p ∨ q =>
    λ hp : p =>
      Or.elim h
        (λ hnp : ¬p => False.elim (hnp hp))
        (λ hq : q => hq)

example : p ∨ False ↔ p :=
  Iff.intro
    (
      λ h : p ∨ False =>
        Or.elim h
          (λ hp : p => hp)
          False.elim
    )
      Or.inl

example : p ∧ False ↔ False :=
  Iff.intro
    (
      λ h : p ∧ False =>
        h.right
    )
    False.elim

example : (p → q) → (¬q → ¬p) :=
  λ h : p → q =>
    λ hnq : ¬q =>
      λ hp : p =>
        absurd (h hp) hnq


import Math.CategoryTheory.Basic
import Math.CategoryTheory.Functor

open CategoryTheory

variable {C : Category} {X Y Z : C.obj}

-- # Exercise
-- Prove that, for any object `X : C`, the identity morphism is the only morphism
-- such that `C.comp g f = g` for all morphisms `g : C.hom Y X`.
example (f : C.hom X X) (hf : ∀ {Y : C.obj} (g : C.hom X Y), C.comp g f = g) : f = C.id X := by {
  specialize hf (C.id X);
  rw [C.id_comp] at hf;
  exact hf;
}

-- # Exercise
-- Prove that the identity morphism on `X` is mono.
theorem id_mono : mono (C.id X) := by {
  constructor;
  intros Z g h;
  rw [C.id_comp, C.id_comp];
  exact λ f => f;
}

-- # Exercise
-- Prove that the identity morphism on `X` is epi.
theorem id_epi : epi (C.id X) := by {
  constructor;
  intros Z g h;
  rw [C.comp_id, C.comp_id];
  exact λ f => f;
}

-- # Exercise
-- Prove that the composition of two monos is mono.
theorem comp_mono (hf : mono f) (hg : mono g) : mono (C.comp g f) := by {
  constructor;
  intros Z s t hgf;
  apply hf.cancel;
  apply hg.cancel;
  rw [C.assoc, C.assoc] at hgf;
  exact hgf;
}

-- # Exercise
-- Prove that the composition of two epis is epi.
theorem comp_epi (hf : epi f) (hg : epi g) : epi (C.comp g f) := by {
  constructor;
  intros Z s t hgf;
  apply hg.cancel;
  apply hf.cancel;
  rw [← C.assoc, ← C.assoc] at hgf;
  exact hgf;
}

-- # Exercise
-- Prove that the composition of two isomorphisms is an isomorphism.
theorem comp_iso (hf : iso f) (hg : iso g) : iso (C.comp g f) := by {
  cases hf.is_iso with | intro k hk =>
  cases hg.is_iso with | intro l hl =>
  constructor;
  apply Exists.intro (C.comp k l);
  constructor;
  rw [C.assoc, ← C.assoc l g f, hl.1, C.id_comp, hk.1];
  rw [C.assoc, ← C.assoc f k l, hk.2, C.id_comp, hl.2];
}

-- # Exercise
-- Prove that initial objects are unique up to isomorphism.
theorem initial_unique (X Y : C.obj) [hx : initial X] [hy : initial Y] : ∃ (f : C.hom X Y), iso f := by {
  -- sorry,
  cases hx.is_initial Y with | intro f hf =>
  cases hy.is_initial X with | intro g hg =>
  cases hx.is_initial X with | intro k hk =>
  cases hy.is_initial Y with | intro l hl =>
  apply Exists.intro f;
  constructor;
  apply Exists.intro g;
  constructor;
  rw [← hk (C.id X), ← hk (C.comp g f)];
  rw [← hl (C.id Y), ← hl (C.comp f g)];
}

-- # Exercise
-- Prove that terminal objects are unique up to isomorphism.
theorem terminal_unique (X Y : C.obj) [hx : terminal X] [hy : terminal Y] : ∃ (f : C.hom X Y), iso f := by {
  -- sorry,
  cases hx.is_terminal Y with | intro f hf =>
  cases hy.is_terminal X with | intro g hg =>
  cases hx.is_terminal X with | intro k hk =>
  cases hy.is_terminal Y with | intro l hl =>
  apply Exists.intro g;
  constructor;
  apply Exists.intro f;
  constructor;
  rw [← hk (C.id X), ← hk (C.comp f g)];
  rw [← hl (C.id Y), ← hl (C.comp g f)];
}

section

structure poset :=
  (α : Sort u)
  (R : α → α → Prop)
  (refl  : ∀ x, R x x)
  (asymm : ∀ {x y}, R x y → R y x → x = y)
  (trans : ∀ {x y z}, R y z → R x y → R x z)

-- # Exercise
-- Show that the type `Prop` has the structure of a partially ordered set,
-- where the relation `R` is given by implication, that is, `R P Q := P → Q`
def poset_Prop : poset := {
  α := Prop,
  R := λ P Q => P → Q,
  refl := λ P p => p, --sorry,
  asymm := λ pq qp => by dsimp; apply Eq.propIntro pq qp, --by ext; exact ⟨pq, qp⟩, -- sorry,
  trans := λ qr pq p => qr (pq p), -- sorry,
}

-- # Exercise
-- Show that every partially ordered set is naturally a category, where `hom x y`
-- is given by the proposition `x ≤ y`
def category_of_poset (P : poset) : Category := {
  obj := P.α,
  hom := λ x y => P.R x y,
  id := P.refl, -- sorry,
  comp := P.trans, -- sorry,
  comp_id := λ _ => by dsimp, -- sorry,
  id_comp := λ _ => by dsimp, -- sorry,
  assoc := λ _ _ _ => by dsimp, -- sorry,
}

end

-- # Exercise
-- Prove that a full and faithful functor reflects initial objects.
example (F : Functor C D) {Ffull : F.full} {Ffaith : F.faithful} {X : C.obj} [hFx : initial (F.obj X)] : initial X := by {
  constructor;
  intro Y;
  cases hFx.is_initial (F.obj Y) with | intro Ff hFf =>
  cases Ffull.intro Ff with | intro f hf =>
  apply Exists.intro f;
  intro g;
  specialize hFf (F.hom g);
  apply Ffaith.cancel;
  rw [← hFf, hf];
}

-- # Exercise
-- Prove that a full and faithful functor reflects terminal objects.
example (F : Functor C D) [Ffull : F.full] [Ffaith : F.faithful] {X : C.obj} [hFx : terminal (F.obj X)] : terminal X := by {
  constructor;
  intro Y;
  cases hFx.is_terminal (F.obj Y) with | intro Ff hFf =>
  cases Ffull.intro Ff with | intro f hf =>
  apply Exists.intro f;
  intro g;
  specialize hFf (F.hom g);
  apply Ffaith.cancel;
  rw [← hFf, hf];
}

-- # Exercise
-- Prove that a faithful functor reflects monos.
example (F : Functor C D) [Ffaith : F.faithful] {X Y : C.obj} {f : C.hom X Y} [hf : mono (F.hom f)] : mono f := by {
  constructor;
  intros Z g h hfgh;
  apply Ffaith.cancel;
  apply hf.cancel;
  rw [← F.map_comp, ← F.map_comp, hfgh];
}

-- # Exercise
-- Prove that a faithful functor reflects epis.
example (F : Functor C D) [Ffaith : F.faithful] {X Y : C.obj} {f : C.hom X Y} [hf : epi (F.hom f)] : epi f := by {
  constructor;
  intros Z g h hfgh;
  apply Ffaith.cancel;
  apply hf.cancel;
  rw [← F.map_comp, ← F.map_comp, hfgh];
}

-- # Exercise
-- Prove that if `F` is full and faithful, and `F X` is isomorphic to `F Y`, then `X` is isomorphic to `Y`
example (F : Functor C D) [Ffull : F.full] [Ffaith: F.faithful] {X Y : C.obj} {f : D.hom (F.obj X) (F.obj Y)} (hf : iso f) : ∃ (g : C.hom X Y), iso g := by {
  cases hf.is_iso with | intro g hg =>
  cases Ffull.intro f with | intro k hk =>
  cases Ffull.intro g with | intro l hl =>
  apply Exists.intro k;
  constructor;
  apply Exists.intro l;
  constructor;
  apply Ffaith.cancel;
  rw [F.map_comp, hk, hl, hg.1, F.map_id];
  apply Ffaith.cancel;
  rw [F.map_comp, hk, hl, hg.2, F.map_id];
}


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.int.units
! leanprover-community/mathlib commit 641b6a82006416ec431b2987b354af9311fed4f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Units
import Mathlib.Data.Int.Basic
import Mathlib.Algebra.Ring.Units
import Mathlib.Tactic.Tauto

/-!
# Lemmas about units in `ℤ`.
-/

namespace Int

/-! ### units -/

@[simp]
theorem units_natAbs (u : ℤˣ) : natAbs u = 1 :=
  Units.ext_iff.1 <|
    Nat.units_eq_one
      ⟨natAbs u, natAbs ↑u⁻¹, by rw [← natAbs_mul, Units.mul_inv]; rfl, by
        rw [← natAbs_mul, Units.inv_mul]; rfl⟩
#align int.units_nat_abs Int.units_natAbs

theorem units_eq_one_or (u : ℤˣ) : u = 1 ∨ u = -1 := by
  simpa only [Units.ext_iff, units_natAbs] using natAbs_eq u
#align int.units_eq_one_or Int.units_eq_one_or

theorem isUnit_eq_one_or {a : ℤ} : IsUnit a → a = 1 ∨ a = -1
  | ⟨_, hx⟩ => hx ▸ (units_eq_one_or _).imp (congr_arg Units.val) (congr_arg Units.val)
#align int.is_unit_eq_one_or Int.isUnit_eq_one_or

theorem isUnit_iff {a : ℤ} : IsUnit a ↔ a = 1 ∨ a = -1 := by
  refine' ⟨fun h => isUnit_eq_one_or h, fun h => _⟩
  rcases h with (rfl | rfl)
  · exact isUnit_one
  · exact isUnit_one.neg
#align int.is_unit_iff Int.isUnit_iff

theorem isUnit_eq_or_eq_neg {a b : ℤ} (ha : IsUnit a) (hb : IsUnit b) : a = b ∨ a = -b := by
  rcases isUnit_eq_one_or hb with (rfl | rfl)
  · exact isUnit_eq_one_or ha
  · rwa [or_comm, neg_neg, ← isUnit_iff]
#align int.is_unit_eq_or_eq_neg Int.isUnit_eq_or_eq_neg

theorem eq_one_or_neg_one_of_mul_eq_one {z w : ℤ} (h : z * w = 1) : z = 1 ∨ z = -1 :=
  isUnit_iff.mp (isUnit_of_mul_eq_one z w h)
#align int.eq_one_or_neg_one_of_mul_eq_one Int.eq_one_or_neg_one_of_mul_eq_one

theorem eq_one_or_neg_one_of_mul_eq_one' {z w : ℤ} (h : z * w = 1) :
    z = 1 ∧ w = 1 ∨ z = -1 ∧ w = -1 := by
  have h' : w * z = 1 := mul_comm z w ▸ h
  rcases eq_one_or_neg_one_of_mul_eq_one h with (rfl | rfl) <;>
      rcases eq_one_or_neg_one_of_mul_eq_one h' with (rfl | rfl) <;> tauto
#align int.eq_one_or_neg_one_of_mul_eq_one' Int.eq_one_or_neg_one_of_mul_eq_one'

theorem eq_of_mul_eq_one {z w : ℤ} (h : z * w = 1) : z = w :=
  (eq_one_or_neg_one_of_mul_eq_one' h).elim
    (and_imp.2 (·.trans ·.symm)) (and_imp.2 (·.trans ·.symm))
#align int.eq_of_mul_eq_one Int.eq_of_mul_eq_one

theorem mul_eq_one_iff_eq_one_or_neg_one {z w : ℤ} :
    z * w = 1 ↔ z = 1 ∧ w = 1 ∨ z = -1 ∧ w = -1 := by
  refine' ⟨eq_one_or_neg_one_of_mul_eq_one', fun h => Or.elim h (fun H => _) fun H => _⟩ <;>
      rcases H with ⟨rfl, rfl⟩ <;>
    rfl
#align int.mul_eq_one_iff_eq_one_or_neg_one Int.mul_eq_one_iff_eq_one_or_neg_one

theorem eq_one_or_neg_one_of_mul_eq_neg_one' {z w : ℤ} (h : z * w = -1) :
    z = 1 ∧ w = -1 ∨ z = -1 ∧ w = 1 := by
  rcases isUnit_eq_one_or (IsUnit.mul_iff.mp (Int.isUnit_iff.mpr (Or.inr h))).1 with (rfl | rfl)
  · exact Or.inl ⟨rfl, one_mul w ▸ h⟩
  · exact Or.inr ⟨rfl, neg_inj.mp (neg_one_mul w ▸ h)⟩
#align int.eq_one_or_neg_one_of_mul_eq_neg_one' Int.eq_one_or_neg_one_of_mul_eq_neg_one'

theorem mul_eq_neg_one_iff_eq_one_or_neg_one {z w : ℤ} :
    z * w = -1 ↔ z = 1 ∧ w = -1 ∨ z = -1 ∧ w = 1 := by
  refine' ⟨eq_one_or_neg_one_of_mul_eq_neg_one', fun h => Or.elim h (fun H => _) fun H => _⟩ <;>
      rcases H with ⟨rfl, rfl⟩ <;>
    rfl
#align int.mul_eq_neg_one_iff_eq_one_or_neg_one Int.mul_eq_neg_one_iff_eq_one_or_neg_one

theorem isUnit_iff_natAbs_eq {n : ℤ} : IsUnit n ↔ n.natAbs = 1 := by
  simp [natAbs_eq_iff, isUnit_iff, Nat.cast_zero]
#align int.is_unit_iff_nat_abs_eq Int.isUnit_iff_natAbs_eq

alias isUnit_iff_natAbs_eq ↔ IsUnit.natAbs_eq _
#align int.is_unit.nat_abs_eq Int.IsUnit.natAbs_eq

-- Porting note: `rw` didn't work on `natAbs_ofNat`, so had to change to `simp`,
-- presumably because `(n : ℤ)` is `Nat.cast` and not just `ofNat`
@[norm_cast]
theorem ofNat_isUnit {n : ℕ} : IsUnit (n : ℤ) ↔ IsUnit n := by
  simp [isUnit_iff_natAbs_eq]
#align int.of_nat_is_unit Int.ofNat_isUnit

theorem isUnit_mul_self {a : ℤ} (ha : IsUnit a) : a * a = 1 :=
  (isUnit_eq_one_or ha).elim (fun h => h.symm ▸ rfl) fun h => h.symm ▸ rfl
#align int.is_unit_mul_self Int.isUnit_mul_self

-- Porting note: this was proven in mathlib3 with `tidy` which hasn't been ported yet
theorem isUnit_add_isUnit_eq_isUnit_add_isUnit {a b c d : ℤ} (ha : IsUnit a) (hb : IsUnit b)
    (hc : IsUnit c) (hd : IsUnit d) : a + b = c + d ↔ a = c ∧ b = d ∨ a = d ∧ b = c := by
  rw [isUnit_iff] at ha hb hc hd
  cases ha <;> cases hb <;> cases hc <;> cases hd <;>
      subst a <;> subst b <;> subst c <;> subst d <;>
    simp
#align int.is_unit_add_is_unit_eq_is_unit_add_is_unit Int.isUnit_add_isUnit_eq_isUnit_add_isUnit

theorem eq_one_or_neg_one_of_mul_eq_neg_one {z w : ℤ} (h : z * w = -1) : z = 1 ∨ z = -1 :=
  Or.elim (eq_one_or_neg_one_of_mul_eq_neg_one' h) (fun H => Or.inl H.1) fun H => Or.inr H.1
#align int.eq_one_or_neg_one_of_mul_eq_neg_one Int.eq_one_or_neg_one_of_mul_eq_neg_one

end Int


/-
Copyright (c) 2017 Galois Inc.  All rights reserved.
Author: Joe Hendrix

This module defines operations for simplifying comparisons between
natural numbers.
-/
import data.nat.basic
import .simplify_eq

namespace nat

-- Reduce x < y to theorem with addition
protected theorem lt_is_succ_le (x y : ℕ) : x < y ↔ x + 1 ≤ y := by trivial

------------------------------------------------------------------------
-- le theorems

protected lemma le_zero_iff_eq_zero (n : nat) : n ≤ 0 ↔ n = 0 :=
begin
  cases n,
  simp,
  { apply iff.intro,
    { intro h,
      have pr := not_succ_le_zero _ h,
      contradiction,
    },
    { contradiction, },
  },
end

-- Reduce proof that product is greater than one to constraints
-- on variables.
lemma one_le_mul (m n : ℕ) : 1 ≤ m * n ↔ 1 ≤ m ∧ 1 ≤ n :=
begin
  cases n,
  case zero {
    simp [nat.le_zero_iff_eq_zero],
   },
  case succ n {
    simp [nat.mul_succ],
    cases (nat.eq_zero_or_pos m) with h h,
    {
      simp [h, le_zero_iff],
    },
    {
      have g : 1 ≤ m := h,
      simp [g, succ_le_succ_iff, nat.zero_le],
      transitivity,
      exact g,
      apply nat.le_add_right,
    },
  },
end

-- Reduce proof that power is greater than one to constraints
-- on variables.
lemma one_le_pow (m n : ℕ) : 1 ≤ m^n ↔ n = 0 ∨ 1 ≤ m :=
begin
  induction n,
  case zero { simp, },
  case succ n ind {
    simp [nat.pow, one_le_mul, ind],
    by_cases (1 ≤ m) with h,
    all_goals {
      simp [nat.lt_is_succ_le] at h,
      simp [h, not_succ_eq_zero],
    },
  },
end

-- This rewrites a subtraction on left-hand-side of inequality into an
-- addition, and one of two additional checks.
protected lemma sub_le_iff' (a m n : ℕ) : a - n ≤ m ↔ a ≤ m + n :=
begin
  revert a m,
  induction n,
  case nat.zero {
    simp,
  },
  case nat.succ n ind {
    intros a m,
    cases a,
    case nat.zero {
      simp [zero_le],
    },
    case nat.succ {
      simp [add_succ, nat.succ_le_succ_iff, ind],
    },
  },
end

------------------------------------------------------------------------
-- lt theorems

-- Reduce succ x < succ y
protected lemma succ_lt_succ_iff : ∀{m n : ℕ}, succ n < succ m ↔ n < m :=
begin
  intros m n,
  simp [nat.lt_is_succ_le, nat.succ_le_succ_iff],
end

-- This rewrites a subtraction on left-hand-side of inequality into an
-- addition, and one of two additional checks.
protected lemma sub_lt_iff' (a m n : ℕ) : a - n < m ↔ (a < m + n ∧ (n ≤ a ∨ 0 < m)) :=
begin
  revert a m,
  induction n,
  case nat.zero {
    intros a m,
    simp [zero_le],
  },
  case nat.succ n ind {
    intros a m,
    cases a,
    case nat.zero {
      simp [nat.zero_sub, zero_lt_succ, not_succ_le_zero],
    },
    case nat.succ {
      simp [add_succ, nat.succ_lt_succ_iff, nat.succ_le_succ_iff, ind],
    },
  },
end

-- This rewrites a subtraction on right-hand side of inequality into an addition.
protected lemma lt_sub_iff (a m n : ℕ) : a < m - n ↔ a + n < m :=
begin
  revert n,
  induction m with m ind,
  { simp [nat.lt_is_succ_le, add_succ, nat.not_succ_le_zero, nat.zero_sub],
  },
  { intro n,
    cases n with n,
    { simp, },
    { simp [nat.succ_lt_succ_iff, ind],
    },
  },
end

------------------------------------------------------------------------
-- Specialized lemmas

protected lemma sub_add_iff : ∀(m n p : ℕ),
   (m - n) + p = if n ≤ m then (m + p) - n else p :=
begin
  intros m n p,
  revert n,
  induction m,
  case zero {
    intro n,
    simp,
    cases n,
    case zero { simp, },
    case succ { simp [nat.not_succ_le_zero], },
  },
  case succ m ind {
    intro n,
    cases n,
    case zero {
      simp [nat.zero_le],
    },
    case succ n {
      simp only [nat.succ_sub_succ],
      by_cases (n ≤ m) with h,
      {
        simp only [succ_le_succ_iff, h, ind, if_pos, succ_add, succ_sub_succ],
      },
      {
        simp [ind, if_neg, succ_le_succ_iff, h],
      }
    }
  }
 end

lemma le_add (a b : ℕ) : a ≤ a + b :=
begin
  induction b,
  case zero {
    exact less_than_or_equal.refl a,
  },
  case succ b ind {
    exact less_than_or_equal.step ind,
  },
end

end nat


import algebra.comm_rings.basic
import algebra.comm_rings.ideals.basic

namespace comm_ring

universes u v

open set
open classical

def univ_as_ideal {R : Type u} [comm_ring R] : ideal R :=
{
  body := univ,
  contains_zero := trivial,
  minus_closure := λ _ _, trivial,
  add_closure := λ _ _ _ _, trivial,
  mul_absorb := λ _ _ _, trivial,
}

def ideal_generated_by_set_set {R : Type u} [comm_ring R] (S : set R) : set R := λ x, linear_combination univ S x

lemma ideal_gen_set_contains_zero {R : Type u} [l:comm_ring R] (S : set R) : l.zero ∈ ideal_generated_by_set_set S :=
begin
  exact linear_combination.empty_sum,
end

lemma ideal_gen_set_add_closure {R : Type u} [comm_ring R] (S : set R) :
   ∀ (a b : R), (a ∈ ideal_generated_by_set_set S) → (b ∈ ideal_generated_by_set_set S)
   → (a + b ∈ ideal_generated_by_set_set S) :=
begin
  intros a b ha hb,
  induction ha with x r s l hx hs hl sum hlb,
  rw add_comm,
  rw add_zero,
  exact hb,
  rw sum,
  rw ← add_assoc,
  apply linear_combination.add_term,
  exact hx,
  exact hs,
  exact hlb,
  refl,
end

lemma ideal_gen_set_minus_closure {R : Type u} [comm_ring R] (S : set R)
  : ∀ r : R, r ∈ ideal_generated_by_set_set S → -r ∈ ideal_generated_by_set_set S :=
begin
  intros r hr,
  induction hr with r a b l hainuniv hbinS hl hr hminusl,
  rw minus_zero_zero,
  exact ideal_gen_set_contains_zero S,
  rw [hr,minus_dis,minus_mul],
  apply linear_combination.add_term,
  trivial,
  exact hbinS,
  exact hminusl,
  refl,
end

lemma ideal_gen_set_mul_absorb {R : Type u} [comm_ring R] (S : set R)
  : ∀ r : R, ∀ {i : R}, i ∈ ideal_generated_by_set_set S → (r * i) ∈ ideal_generated_by_set_set S :=
begin
  intros r i hi,
  induction hi with  i y s l hy hs hl sum hlb,
  rw mul_zero,
  exact linear_combination.empty_sum,
  rw sum,
  rw [mul_dis,mul_assoc],
  apply linear_combination.add_term,
  trivial,
  exact hs,
  exact hlb,
  refl,
end

def ideal_generated_by_set {R : Type u} [comm_ring R] (S : set R) : ideal R :=
{
  body := ideal_generated_by_set_set S,
  contains_zero := ideal_gen_set_contains_zero S,
  minus_closure := ideal_gen_set_minus_closure S,
  mul_absorb := ideal_gen_set_mul_absorb S,
  add_closure := ideal_gen_set_add_closure S,
}

def zero_ideal (R : Type u) [comm_ring R] : ideal R := ideal_generated_by_set (λ x, x = 0)

theorem zero_ideal_is_just_zero {R : Type u} [comm_ring R] : ∀ {x : R} , x ∈ (zero_ideal R).body → x = 0 :=
begin
  intros x hx,
  induction hx with y s₁ s₂ l hs₁ hs₂ hl sum hsum,
  refl,
  rw sum,
  have zs₂ : s₂ = 0 := hs₂,
  rw [zs₂,mul_zero,hsum,add_zero],
end

theorem zero_ideal_proper {R : Type u} [comm_ring R] (not_zero : ∃ x : R , x ≠ 0) : ↑(zero_ideal R) ≠ @univ R :=
begin
  intro ab,
  let x := some not_zero,
  have hx : x ≠ 0 := some_spec not_zero,
  apply hx,
  have hxuniv : x ∈ @univ R := trivial,
  rw ← ab at hxuniv,
  apply zero_ideal_is_just_zero,
  exact hxuniv,
end

def product_of_ideals_set {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R) : set R :=
  λ x, linear_combination ↑I₁ ↑I₂ x

lemma product_of_ideals_contains_zero {R : Type u} [l:comm_ring R] (I₁ : ideal R) (I₂ : ideal R) : l.zero ∈ product_of_ideals_set I₁ I₂ :=
  linear_combination.empty_sum

lemma product_of_ideals_add_closure {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ∀ i₁ i₂ : R, i₁ ∈ product_of_ideals_set I₁ I₂ → i₂ ∈ product_of_ideals_set I₁ I₂
    → i₁ + i₂ ∈ product_of_ideals_set I₁ I₂ :=
begin
  intros i₁ i₂ hi₁ hi₂,
  induction hi₂ with i₂ s₁ s₂ l hs₁ hs₂ hl hi₂  hsum,
  rw add_zero,
  exact hi₁,
  rw hi₂,
  have sub : i₁ + (s₁ * s₂ + l) = s₁ * s₂ + (i₁ + l),
    simp [add_assoc,add_comm],
  rw sub,
  apply linear_combination.add_term,
  exact hs₁,
  exact hs₂,
  exact hsum,
  refl,
end

lemma product_of_ideals_mul_absorb {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ∀ r : R, ∀ {i : R}, i ∈ product_of_ideals_set I₁ I₂ → (r * i) ∈ product_of_ideals_set I₁ I₂ :=
begin
  intros r i hi,
  induction hi with i i₁ i₂ l hi₁ hi₂ hl hi hprod,
  rw mul_zero,
  exact linear_combination.empty_sum,
  rw hi,
  rw mul_dis,
  rw mul_assoc,
  apply linear_combination.add_term,
  apply I₁.mul_absorb,
  exact r,
  exact hi₁,
  exact hi₂,
  exact hprod,
  refl,
end

lemma product_of_ideals_minus_closure {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ∀ a, a ∈ product_of_ideals_set I₁ I₂ → -a ∈ product_of_ideals_set I₁ I₂ :=
begin
  intros a ha,
  induction ha with a i₁ i₂ l hi₁ hi₂ hl ha hlminus,
  rw minus_zero_zero,
  exact product_of_ideals_contains_zero I₁ I₂,
  rw [ha, minus_dis,minus_mul],
  apply linear_combination.add_term,
  apply I₁.minus_closure,
  exact hi₁,
  exact hi₂,
  exact hlminus,
  refl,
end

def product_of_ideals {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R) : ideal R :=
  {
    body          := product_of_ideals_set I₁ I₂,
    contains_zero := product_of_ideals_contains_zero I₁ I₂,
    minus_closure := product_of_ideals_minus_closure I₁ I₂,
    add_closure   := product_of_ideals_add_closure I₁ I₂,
    mul_absorb    := product_of_ideals_mul_absorb I₁ I₂
  }

instance mul_ideals {R : Type u} [comm_ring R] : has_mul (ideal R) := ⟨ λ I₁ I₂, product_of_ideals I₁ I₂⟩

def sum_of_ideals_set {R : Type u} [l:comm_ring R] (I₁ : ideal R) (I₂ : ideal R) : set R := λ r : R, ∃ i₁ i₂ : R, i₁ ∈ I₁.body ∧ i₂ ∈ I₂.body ∧ r = i₁ + i₂

lemma half_sum_of_pairs_set_commuative {R :Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : sum_of_ideals_set I₁ I₂ ⊆ sum_of_ideals_set I₂ I₁ :=
begin
  intros x hx,
  cases hx with x₁ hx₁,
  cases hx₁ with x₂ hx₁x₂,
  cases hx₁x₂ with hx₁inI₁ the_rest,
  cases the_rest with hx₂inI₂ hx,
  existsi x₂,
  existsi x₁,
  split,
  exact hx₂inI₂,
  split,
  exact hx₁inI₁,
  rw add_comm,
  exact hx,
end

lemma sum_of_pair_of_ideals_upper_bound {R :Type u} [l:comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ↑I₁ ⊆ sum_of_ideals_set I₁ I₂ :=
begin
  intros i hi,
  existsi i,
  existsi l.zero,
  split,
  exact hi,
  split,
  exact I₂.contains_zero,
  rw add_zero,
end

lemma sum_of_ideals_contains_zero {R : Type u} [l:comm_ring R] (I₁ : ideal R) (I₂ : ideal R) : l.zero ∈ sum_of_ideals_set I₁ I₂ :=
begin
  existsi l.zero,
  existsi l.zero,
  split,
  exact I₁.contains_zero,
  split,
  exact I₂.contains_zero,
  rw add_zero l.zero,
end

lemma sum_of_ideals_add_closure {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ∀ a b, a ∈ sum_of_ideals_set I₁ I₂ → b ∈ sum_of_ideals_set I₁ I₂ → a + b ∈ sum_of_ideals_set I₁ I₂ :=
begin
  intros a b ha hb,
  cases ha with a₁ ha₁,
  cases ha₁ with a₂ ha₁a₂,
  cases ha₁a₂ with ha₁inI₁ the_rest,
  cases the_rest with ha₂inI₂ ha,
  cases hb with b₁ hb₁,
  cases hb₁ with b₂ hb₁b₂,
  cases hb₁b₂ with hb₁inI₁ the_rest,
  cases the_rest with hb₂inI₂ hb,
  existsi a₁ + b₁,
  existsi a₂ + b₂,
  split,
  apply I₁.add_closure,
  exact ha₁inI₁,
  exact hb₁inI₁,
  split,
  apply I₂.add_closure,
  exact ha₂inI₂,
  exact hb₂inI₂,
  rw [ha,hb],
  exact calc (a₁ + a₂) + (b₁ + b₂) = a₁ + (a₂ + b₁) + b₂   : by simp [add_assoc]
                               ... = (a₁ + b₁) + (a₂ + b₂) : by {rw add_comm a₂ b₁,simp [add_assoc]},
end

lemma sum_of_ideals_mul_absorb {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ∀ r : R, ∀ {i}, i ∈ sum_of_ideals_set I₁ I₂ → r * i ∈ sum_of_ideals_set I₁ I₂ :=
begin
  intros r i hi,
  cases hi with i₁ hi₁,
  cases hi₁ with i₂ hi₁i₂,
  cases hi₁i₂ with hi₁inI₁ the_rest,
  cases the_rest with hi₂inI₂ hi,
  rw hi,
  rw mul_dis,
  apply sum_of_ideals_add_closure,
  apply sum_of_pair_of_ideals_upper_bound,
  apply I₁.mul_absorb,
  exact hi₁inI₁,
  apply half_sum_of_pairs_set_commuative,
  apply sum_of_pair_of_ideals_upper_bound,
  apply I₂.mul_absorb,
  exact hi₂inI₂,
end

lemma sum_of_ideals_minus_closure {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R)
  : ∀ i : R, i ∈ sum_of_ideals_set I₁ I₂ → -i ∈ sum_of_ideals_set I₁ I₂ :=
begin
  intros i hi,
  cases hi with i₁ hi₁,
  cases hi₁ with i₂ hi₁i₂,
  cases hi₁i₂ with hi₁inI₁ the_rest,
  cases the_rest with hi₂inI₂ hi,
  existsi -i₁,
  existsi -i₂,
  split,
  apply I₁.minus_closure,
  exact hi₁inI₁,
  split,
  apply I₂.minus_closure,
  exact hi₂inI₂,
  rw [hi,minus_dis],
end

def sum_of_ideals {R : Type u} [comm_ring R] (I₁ : ideal R) (I₂ : ideal R) : ideal R :=
  {
    body := sum_of_ideals_set I₁ I₂,
    contains_zero := sum_of_ideals_contains_zero I₁ I₂,
    minus_closure := sum_of_ideals_minus_closure I₁ I₂,
    add_closure := sum_of_ideals_add_closure I₁ I₂,
    mul_absorb := sum_of_ideals_mul_absorb I₁ I₂,
  }

instance add_ideals {R : Type u} [comm_ring R]  : has_add (ideal R) := ⟨λ I₁ I₂, sum_of_ideals I₁ I₂⟩

def princple_ideal {R : Type u} [comm_ring R] (r : R) : ideal R := ideal_generated_by_set (λ x, x = r)

lemma elements_of_princple_ideal {R : Type u} [comm_ring R] {x : R} {r : R} : r ∈ (princple_ideal x).body → ∃ a : R, r = a * x :=
begin
  intro h,
  induction h with r a₁ s l trv hs trv hr hl,
  existsi (0:R),
  rw [mul_comm, mul_zero],
  let a₂ := some hl,
  have ha₂ : l = a₂ * x := some_spec hl,
  existsi (a₁ + a₂),
  have hsx : s = x := hs,
  rw [mul_comm,mul_dis,mul_comm,hr,ha₂,hsx],
  simp [mul_comm],
end

lemma princple_ideal_membership {R : Type u} [comm_ring R] {x : R} {r : R} : (∃ a : R, r = a * x) → r ∈ (princple_ideal x).body :=
begin
  intro h,
  cases h with a ha,
  rw ha,
  apply linear_combination.add_term,
  trivial,
  exact rfl,
  apply linear_combination.empty_sum,
  rw add_zero,
end

theorem intersection_of_ideals_add_closure {R : Type u} [comm_ring R] (C : set (ideal R))
  : ∀ a b : R, (a ∈ ⋂₀ (image (λ I : ideal R, I.body) C)) → (b ∈ ⋂₀ (image (λ I : ideal R, I.body) C))
    → (a + b) ∈ ⋂₀ (image (λ I : ideal R, I.body) C) :=
begin
  intros a b ha hb,
  intros A hA,
  have hainA := ha A hA,
  have hbinA := hb A hA,
  cases hA with I hI,
  cases hI with hIinC hrw,
  simp at hrw,
  rw ← hrw at hainA,
  rw ← hrw at hbinA,
  rw ← hrw,
  apply I.add_closure,
  exact hainA,
  exact hbinA,
end

theorem intersection_of_ideals_contains_zero {R : Type u} [comm_ring R] (C : set (ideal R))
  : (0: R) ∈ ⋂₀ (image (λ I : ideal R, I.body) C) :=
begin
  intros A hA,
  cases hA with I hI,
  cases hI with hIinC hrw,
  simp at hrw,
  rw ← hrw,
  apply I.contains_zero,
end

theorem intersection_of_ideals_mul_absorb {R : Type u} [comm_ring R] (C : set (ideal R))
  : ∀ (r : R) {i}, i ∈ ⋂₀ (image (λ I : ideal R, I.body) C) → (r * i) ∈ ⋂₀ (image (λ I : ideal R, I.body) C) :=
begin
  intros r i hi A hA,
  have hiinA := hi A hA,
  cases hA with I hI,
  cases hI with hIinC hrw,
  simp at hrw,
  rw ← hrw,
  apply I.mul_absorb,
  rw hrw,
  exact hiinA,
end

theorem intersection_of_ideals_minus_closure {R : Type u} [comm_ring R] (C : set (ideal R))
  : ∀ i, i ∈  ⋂₀ (image (λ I : ideal R, I.body) C) → -i ∈  ⋂₀ (image (λ I : ideal R, I.body) C) :=
begin
  intros i hi A hA,
  have hiinA := hi A hA,
  cases hA with I hI,
  cases hI with hIinC hrw,
  simp at hrw,
  rw ← hrw,
  apply I.minus_closure,
  rw hrw,
  exact hiinA,
end

def intersection_of_ideals {R : Type u} [comm_ring R] (C : set (ideal R)) : ideal R :=
begin
  split,
  exact intersection_of_ideals_contains_zero C,
  exact intersection_of_ideals_minus_closure C,
  exact intersection_of_ideals_add_closure C,
  exact intersection_of_ideals_mul_absorb C,
end

prefix `⋂₀`:110 := intersection_of_ideals

instance ideals_have_inter {R : Type u} [comm_ring R] : has_inter (ideal R) := ⟨ λ I₁ I₂, ⋂₀ (list_to_set [I₁,I₂])⟩

theorem ideal_pairwise_inter_set {R : Type u} [comm_ring R] (I₁ I₂ : ideal R)
  : (↑(I₁ ∩ I₂) : set R) = ↑I₁ ∩ ↑I₂ :=
begin
  cases list_to_set_pair_mem ↑I₁ ↑I₂ with hI₁ hI₂,
  have trv₁ : I₁ ∩ I₂ = ⋂₀ (list_to_set [I₁,I₂]) := rfl,
  rw trv₁,
  have trv₂ : ↑I₁ = I₁.body := rfl,
  have trv₃ : ↑I₂ = I₂.body := rfl,
  have trv₄ : list.map (λ I :ideal R, I.body) [I₁,I₂] = [↑I₁,↑I₂],
    rw [trv₂,trv₃],
    refl,
  apply subset_antisymmetric,
  split,
  intros x hx,
  split,
  apply hx,
  rw image_of_list_to_set,
  rw trv₄,
  exact hI₁,
  apply hx,
  rw image_of_list_to_set,
  rw trv₄,
  exact hI₂,
  intros x hx,
  intros A hA,
  rw image_of_list_to_set at hA,
  rw trv₄ at hA,
  cases hA,
  rw hA,
  apply intersection_in_set,
  assumption,
  cases hA,
  rw hA,
  apply intersection_in_set,
  rw intersection_commuative,
  assumption,
  apply false.elim,
  exact hA,
end

def preimage_set {R₁ : Type u} [comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) (I : ideal R₂) : set R₁ :=
  λ r : R₁, φ r ∈ I.body

theorem preimage_add_closure {R₁ : Type u} [comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) (I : ideal R₂)
  : ∀ r₁ r₂ : R₁, r₁ ∈ (preimage_set φ I) → r₂ ∈ (preimage_set φ I) → (r₁ + r₂) ∈ (preimage_set φ I) :=
begin
  intros r₁ r₂ hr₁ hr₂,
  have h: φ.map (r₁ + r₂) ∈ ↑I,
    rw φ.prevs_add,
    apply I.add_closure,
    exact hr₁,
    exact hr₂,
  exact h,
end

theorem preimage_mul_absorb {R₁ : Type u} [comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) (I : ideal R₂)
  : ∀ r : R₁, ∀ {i : R₁}, i ∈ preimage_set φ I → (r * i) ∈ preimage_set φ I :=
begin
  intros r i hi,
  have h : φ.map (r * i) ∈ ↑I,
    rw φ.prevs_mul,
    apply I.mul_absorb,
    exact hi,
  exact h,
end

theorem preimage_contains_zero {R₁ : Type u} [l:comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) (I : ideal R₂)
  : l.zero ∈ preimage_set φ I :=
begin
  have trv : φ.map = ⇑φ := rfl,
  have h : φ.map 0 ∈ ↑I,
    rw trv,
    rw ring_hom_preserves_zero φ,
    exact I.contains_zero,
  exact h,
end

theorem preimage_of_ideal_minus_closure {R₁ : Type u} [comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) (I : ideal R₂)
  : ∀ x : R₁, x ∈ preimage_set φ I → -x ∈ preimage_set φ I :=
begin
  intros x hx,
  have h : φ (-x) ∈ ↑I,
    rw minus_commutes_with_hom,
    apply I.minus_closure,
    exact hx,
  exact h,
end

def preimage_of_ideal {R₁ : Type u} [l:comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) (I : ideal R₂) : ideal R₁ :=
  {
    body := preimage_set φ I,
    contains_zero := preimage_contains_zero φ I,
    minus_closure := preimage_of_ideal_minus_closure φ I,
    add_closure := preimage_add_closure φ I,
    mul_absorb := preimage_mul_absorb φ I,
  }

def ker {R₁ : Type u} [l:comm_ring R₁] {R₂ : Type v} [comm_ring R₂] (φ : R₁ →ᵣ R₂) : ideal R₁ := preimage_of_ideal φ (zero_ideal R₂)

end comm_ring