/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 5 : "iff" (`↔`)

We learn about how to manipulate `P ↔ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following two new tactics:

* `refl`
* `rw`

-/

variables (P Q R S : Prop)

example : P ↔ P :=
begin
  refl,
end

example : (P ↔ Q) → (Q ↔ P) :=
begin
  intro h,
  rw h,
end

example : (P ↔ Q) ↔ (Q ↔ P) :=
begin
  split;
  { intro h,
    rw h}
end

example : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intros h1 h2,
  rwa h1, -- rwa is rw + assumption
end

example : P ∧ Q ↔ Q ∧ P :=
begin
  split;
  { rintro ⟨h1, h2⟩,
    exact ⟨h2, h1⟩ }
end

example : ((P ∧ Q) ∧ R) ↔ (P ∧ (Q ∧ R)) :=
begin
  split,
  { intro h,
    cases h with hPaQ hR,
    cases hPaQ with hP hQ,
    split,
    { exact hP },
    { split,
      { exact hQ },
      { exact hR } } },
  { rintro ⟨hP, hQ, hR⟩,
    exact ⟨⟨hP, hQ⟩, hR⟩ }
end

example : P ↔ (P ∧ true) :=
begin
  split,
  { intro hP,
    split,
    { exact hP },
    { triv } },
  { rintro ⟨hP, -⟩,
    exact hP }
end

example : false ↔ (P ∧ false) :=
begin
  split,
  { rintro ⟨⟩ },
  { rintro ⟨-,⟨⟩⟩ }
end

example : (P ↔ Q) → (R ↔ S) → (P ∧ R ↔ Q ∧ S) :=
begin
  intros h1 h2,
  rw h1,
  rw h2,
end

example : ¬ (P ↔ ¬ P) :=
begin
  intro h,
  cases h with h1 h2,
  by_cases hP : P,
  { apply h1; assumption },
  { apply hP,
    apply h2,
    exact hP }
end

-- constructive proof
example : ¬ (P ↔ ¬ P) :=
begin
  intro h,
  have hnP : ¬ P,
  { cases h with h1 h2,
    intro hP,
    apply h1;
    assumption },
  apply hnP,
  rw h,
  exact hnP,
end


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

import data.polynomial.ring_division

/-!
# "Mirror" of a univariate polynomial

In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference
between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is
divisible by `X`. We also define `polynomial.norm2`, which is the sum of the squares of the
coefficients of a polynomial. It is also a coefficient of `p * p.mirror`.

## Main definitions

- `polynomial.mirror`
- `polynomial.norm2`

## Main results

- `polynomial.mirror_mul_of_domain`: `mirror` preserves multiplication.
- `polynomial.irreducible_of_mirror`: an irreducibility criterion involving `mirror`
- `polynomial.norm2_eq_mul_reverse_coeff`: `norm2` is a coefficient of `p * p.mirror`

-/

namespace polynomial

variables {R : Type*} [semiring R] (p : polynomial R)

section mirror

/-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/
noncomputable def mirror := p.reverse * X ^ p.nat_trailing_degree

@[simp] lemma mirror_zero : (0 : polynomial R).mirror = 0 := by simp [mirror]

lemma mirror_monomial (n : ℕ) (a : R) : (monomial n a).mirror = (monomial n a) :=
begin
  by_cases ha : a = 0,
  { rw [ha, monomial_zero_right, mirror_zero] },
  { rw [mirror, reverse, nat_degree_monomial n a ha, nat_trailing_degree_monomial ha,
        ←C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n),
        tsub_self, pow_zero, mul_one] },
end

lemma mirror_C (a : R) : (C a).mirror = C a :=
mirror_monomial 0 a

lemma mirror_X : X.mirror = (X : polynomial R) :=
mirror_monomial 1 (1 : R)

lemma mirror_nat_degree : p.mirror.nat_degree = p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  by_cases hR : nontrivial R,
  { haveI := hR,
    rw [mirror, nat_degree_mul', reverse_nat_degree, nat_degree_X_pow,
        tsub_add_cancel_of_le p.nat_trailing_degree_le_nat_degree],
    rwa [leading_coeff_X_pow, mul_one, reverse_leading_coeff, ne, trailing_coeff_eq_zero] },
  { haveI := not_nontrivial_iff_subsingleton.mp hR,
    exact congr_arg nat_degree (subsingleton.elim p.mirror p) },
end

lemma mirror_nat_trailing_degree : p.mirror.nat_trailing_degree = p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  { rw [mirror, nat_trailing_degree_mul_X_pow ((mt reverse_eq_zero.mp) hp),
        reverse_nat_trailing_degree, zero_add] },
end

lemma coeff_mirror (n : ℕ) :
  p.mirror.coeff n = p.coeff (rev_at (p.nat_degree + p.nat_trailing_degree) n) :=
begin
  by_cases h2 : p.nat_degree < n,
  { rw [coeff_eq_zero_of_nat_degree_lt (by rwa mirror_nat_degree)],
    by_cases h1 : n ≤ p.nat_degree + p.nat_trailing_degree,
    { rw [rev_at_le h1, coeff_eq_zero_of_lt_nat_trailing_degree],
      exact (tsub_lt_iff_left h1).mpr (nat.add_lt_add_right h2 _) },
    { rw [←rev_at_fun_eq, rev_at_fun, if_neg h1, coeff_eq_zero_of_nat_degree_lt h2] } },
  rw not_lt at h2,
  rw [rev_at_le (h2.trans (nat.le_add_right _ _))],
  by_cases h3 : p.nat_trailing_degree ≤ n,
  { rw [←tsub_add_eq_add_tsub h2, ←tsub_tsub_assoc h2 h3, mirror, coeff_mul_X_pow',
        if_pos h3, coeff_reverse, rev_at_le (tsub_le_self.trans h2)] },
  rw not_le at h3,
  rw coeff_eq_zero_of_nat_degree_lt (lt_tsub_iff_right.mpr (nat.add_lt_add_left h3 _)),
  exact coeff_eq_zero_of_lt_nat_trailing_degree (by rwa mirror_nat_trailing_degree),
end

--TODO: Extract `finset.sum_range_rev_at` lemma.

lemma mirror_mirror : p.mirror.mirror = p :=
polynomial.ext (λ n, by rw [coeff_mirror, coeff_mirror,
  mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol])

lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 :=
⟨λ h, by rw [←p.mirror_mirror, h, mirror_zero], λ h, by rw [h, mirror_zero]⟩

lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff :=
by rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror,
  rev_at_le (nat.le_add_left _ _), add_tsub_cancel_right]

lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff :=
by rw [←p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror]

lemma mirror_mul_of_domain {R : Type*} [ring R] [is_domain R] (p q : polynomial R) :
  (p * q).mirror = p.mirror * q.mirror :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, mirror_zero, zero_mul] },
  by_cases hq : q = 0,
  { rw [hq, mul_zero, mirror_zero, mul_zero] },
  rw [mirror, mirror, mirror, reverse_mul_of_domain, nat_trailing_degree_mul hp hq, pow_add],
  rw [mul_assoc, ←mul_assoc q.reverse],
  conv_lhs { congr, skip, congr, rw [←X_pow_mul] },
  repeat { rw [mul_assoc], },
end

lemma mirror_smul {R : Type*} [ring R] [is_domain R] (p : polynomial R) (a : R) :
  (a • p).mirror = a • p.mirror :=
by rw [←C_mul', ←C_mul', mirror_mul_of_domain, mirror_C]

lemma mirror_neg {R : Type*} [ring R] (p : polynomial R) : (-p).mirror = -(p.mirror) :=
by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul]

lemma irreducible_of_mirror {R : Type*} [comm_ring R] [is_domain R] {f : polynomial R}
  (h1 : ¬ is_unit f)
  (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror)
  (h3 : ∀ g, g ∣ f → g ∣ f.mirror → is_unit g) : irreducible f :=
begin
  split,
  { exact h1 },
  { intros g h fgh,
    let k := g * h.mirror,
    have key : f * f.mirror = k * k.mirror,
    { rw [fgh, mirror_mul_of_domain, mirror_mul_of_domain, mirror_mirror,
          mul_assoc, mul_comm h, mul_comm g.mirror, mul_assoc, ←mul_assoc] },
    have g_dvd_f : g ∣ f,
    { rw fgh,
      exact dvd_mul_right g h },
    have h_dvd_f : h ∣ f,
    { rw fgh,
      exact dvd_mul_left h g },
    have g_dvd_k : g ∣ k,
    { exact dvd_mul_right g h.mirror },
    have h_dvd_k_rev : h ∣ k.mirror,
    { rw [mirror_mul_of_domain, mirror_mirror],
      exact dvd_mul_left h g.mirror },
    have hk := h2 k key,
    rcases hk with hk | hk | hk | hk,
    { exact or.inr (h3 h h_dvd_f (by rwa ← hk)) },
    { exact or.inr (h3 h h_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, mirror_neg, dvd_neg])) },
    { exact or.inl (h3 g g_dvd_f (by rwa ← hk)) },
    { exact or.inl (h3 g g_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, dvd_neg])) } },
end

end mirror

end polynomial


import data.set
open set

-- 1. Replace "sorry" in these examples.
section
  variable {U : Type}
  variables A B C : set U

  example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
  assume a,
  assume h1 : a ∈ A ∩ C,

  show a ∈ A ∪ B, from or.inl (and.left h1)

  example : ∀ x, x ∈ (A ∪ B)ᶜ → x ∈ Aᶜ :=

  assume a,
  assume h1 : a ∈ (A ∪ B)ᶜ,

  show ¬ (a ∈ A), from
      (
      assume h2 : a ∈ A,
      have h3 : a ∈ A ∪ B, from or.inl h2,
      show false, from h1 h3
      )
end

-- 2. Replace "sorry" in the last example.
section
  variable {U : Type}

  /- defining "disjoint" -/
  def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

  example (A B : set U) (h : ∀ x, ¬ (x ∈ A ∧ x ∈ B)) : disj A B :=
  assume x,
  assume h1 : x ∈ A,
  assume h2 : x ∈ B,
  have h3 : x ∈ A ∧ x ∈ B, from and.intro h1 h2,
  show false, from h x h3

  -- notice that we do not have to mention x when applying
  --   h : disj A B
  example (A B : set U) (h1 : disj A B) (x : U) (h2 : x ∈ A) (h3 : x ∈ B) : false :=
  h1 h2 h3

  -- the same is true of ⊆
  example (A B : set U) (x : U) (h : A ⊆ B) (h1 : x ∈ A) : x ∈ B :=
  h h1

  example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A) (h3 : D ⊆ B) : disj C D :=
  assume a,
  assume e1 : a ∈ C,
  assume e2 : a ∈ D,

  have e3 : a ∈ A, from h2 e1,
  have e4 : a ∈ B, from h3 e2,

  show false, from h1 e3 e4
end

-- 3. Prove the following facts about indexed unions and
-- intersections, using the theorems Inter.intro, Inter.elim,
-- Union.intro, and Union.elim listed above.
section
  variables {I U : Type}
  variables {A : I → set U} {B : I → set U} {C : set U}

  theorem Inter.intro {x : U} (h : ∀ i, x ∈ A i) : x ∈ ⋂ i, A i :=
  by simp; assumption

  @[elab_simple]
  theorem Inter.elim {x : U} (h : x ∈ ⋂ i, A i) (i : I) : x ∈ A i :=
  by simp at h; apply h

  theorem Union.intro {x : U} (i : I) (h : x ∈ A i) : x ∈ ⋃ i, A i :=
  by {simp, existsi i, exact h}

  theorem Union.elim {b : Prop} {x : U}
  (h₁ : x ∈ ⋃ i, A i) (h₂ : ∀ (i : I), x ∈ A i → b) : b :=
  by {simp at h₁, cases h₁ with i h, exact h₂ i h}

  example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=

  assume a,

  assume h1 : a ∈ ((⋂ i, A i) ∩ (⋂ i, B i)),

  show a ∈ (⋂ i, A i ∩ B i), from Inter.intro
    (
      assume i : I,

      have h2 : a ∈ (⋂ i, B i), from and.right h1,
      have h3 : a ∈ (⋂ i, A i), from and.left h1,

      have h4 : a ∈ (B i), from Inter.elim h2 i,
      have h5 : a ∈ (A i), from Inter.elim h3 i,

      show a ∈ (A i ∩ B i), from and.intro h5 h4
    )

  example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=

  assume a,
  assume h1 : a ∈ C ∩ (⋃i, A i),

  have h2 : a ∈ (⋃i, A i), from and.right h1,
  have h3 : a ∈ C, from and.left h1,

  Union.elim h2
  (
    assume i : I,
    assume temp1 : a ∈ A i,
    have temp2 : a ∈ C ∩ A i, from and.intro h3 temp1,
    show a ∈ ⋃i, C ∩ A i, from Union.intro i temp2
  )
end

-- 4. Prove the following fact about power sets. You can use the
-- theorems subset.trans and subset.refl
section
  variable  {U : Type}
  variables A B C : set U

  -- For this exercise these two facts are useful
  example (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
  subset.trans h1 h2

  example : A ⊆ A :=
  subset.refl A

  example (h : A ⊆ B) : powerset A ⊆ powerset B :=
  assume a,
  assume h1 : a ∈ powerset A,

  show a ∈ powerset B, from subset.trans h1 h

  example (h : powerset A ⊆ powerset B) : A ⊆ B :=

  show A ⊆ B, from h (subset.refl A)
end

-- 5. Replace the sorry commands in the following proofs to show that
-- we can create a partial order R' out of a strict partial order R.
section
  parameters {A : Type} {R : A → A → Prop}
  parameter (irreflR : irreflexive R)
  parameter (transR : transitive R)

  def R' (a b : A) : Prop := R a b ∨ a = b

  theorem reflR' (a : A) : R' a a :=
  have h1: a = a, from rfl,
  or.inr h1

  theorem transR' {a b c : A} (h1 : R' a b) (h2 : R' b c): R' a c :=

  or.elim h1
  (
    assume temp1 : R a b,

    or.elim h2
     (
      assume temp2 : R b c,
        have temp3 : R a c, from transR temp1 temp2,
        show R' a c, from or.inl temp3
     )

     (
      assume temp2 : b = c,
        show R' a c, from eq.subst temp2 h1
     )

  )
  (
    assume temp1 : a = b,
      have temp2 : b = a, from symm temp1,
      show R' a c, from eq.subst temp2 h2
  )

  theorem antisymmR' {a b : A} (h1 : R' a b) (h2 : R' b a) : a = b :=

  or.elim h1
  (
    assume temp1 : R a b,

    or.elim h2
      (
        assume temp2 : R b a,
          have temp3 : R a a, from transR temp1 temp2,
          show a = b, from false.elim (irreflR a temp3)
      )
      (
        assume temp2 : b = a,
          show a = b, from symm temp2
      )
  )
  (
    assume temp1 : a = b,
      show a = b, from temp1
  )
end

-- 6
section
  parameters {A : Type} {R : A → A → Prop}
  parameter (reflR : reflexive R)
  parameter (transR : transitive R)

  def S (a b : A) : Prop := R a b ∧ R b a

  example : transitive S :=

  assume x y z : A,
  assume a1 : S x y,
  assume a2 : S y z,

  have h1 : R x z, from transR a1.left a2.left,
  have h2 : R z x, from transR a2.right a1.right,

  show S x z, from ⟨h1, h2⟩
end

-- 7. Only one of the following two theorems is provable. Figure out
-- which one is true, and replace the sorry command with a complete
-- proof.
section
  parameters {A : Type} {a b c : A} {R : A → A → Prop}
  parameter (Rab : R a b)
  parameter (Rbc : R b c)
  parameter (nRac : ¬ R a c)

  theorem R_is_strict_partial_order : irreflexive R ∧ transitive R :=
  sorry

  theorem R_is_not_strict_partial_order : ¬(irreflexive R ∧ transitive R) :=
  assume h1 : irreflexive R ∧ transitive R,

  show false, from nRac (h1.right Rab Rbc)
end

-- 8
section
  open nat

  example : 1 ≤ 4 :=

  have h1 : 1 ≤ 2, from nat.le_succ 1,
  have h2 : 2 ≤ 3, from nat.le_succ 2,

  have h3 : 1 ≤ 3, from nat.le_trans h1 h2,
  have h4 : 3 ≤ 4, from nat.le_succ 3,

  show 1 ≤ 4, from nat.le_trans h3 h4
end


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

! This file was ported from Lean 3 source module representation_theory.invariants
! leanprover-community/mathlib commit 55b3f8206b8596db8bb1804d8a92814a0b6670c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RepresentationTheory.Basic
import Mathbin.RepresentationTheory.FdRep

/-!
# Subspace of invariants a group representation

This file introduces the subspace of invariants of a group representation
and proves basic results about it.
The main tool used is the average of all elements of the group, seen as an element of
`monoid_algebra k G`. The action of this special element gives a projection onto the
subspace of invariants.
In order for the definition of the average element to make sense, we need to assume for most of the
results that the order of `G` is invertible in `k` (e. g. `k` has characteristic `0`).
-/

open BigOperators

open MonoidAlgebra

open Representation

namespace GroupAlgebra

variable (k G : Type _) [CommSemiring k] [Group G]

variable [Fintype G] [Invertible (Fintype.card G : k)]

/-- The average of all elements of the group `G`, considered as an element of `monoid_algebra k G`.
-/
noncomputable def average : MonoidAlgebra k G :=
  ⅟ (Fintype.card G : k) • ∑ g : G, of k G g
#align group_algebra.average GroupAlgebra.average

/-- `average k G` is invariant under left multiplication by elements of `G`.
-/
@[simp]
theorem mul_average_left (g : G) :
    (Finsupp.single g 1 * average k G : MonoidAlgebra k G) = average k G :=
  by
  simp only [mul_one, Finset.mul_sum, Algebra.mul_smul_comm, average, MonoidAlgebra.of_apply,
    Finset.sum_congr, MonoidAlgebra.single_mul_single]
  set f : G → MonoidAlgebra k G := fun x => Finsupp.single x 1
  show (⅟ ↑(Fintype.card G) • ∑ x : G, f (g * x)) = ⅟ ↑(Fintype.card G) • ∑ x : G, f x
  rw [Function.Bijective.sum_comp (Group.mulLeft_bijective g) _]
#align group_algebra.mul_average_left GroupAlgebra.mul_average_left

/-- `average k G` is invariant under right multiplication by elements of `G`.
-/
@[simp]
theorem mul_average_right (g : G) : average k G * Finsupp.single g 1 = average k G :=
  by
  simp only [mul_one, Finset.sum_mul, Algebra.smul_mul_assoc, average, MonoidAlgebra.of_apply,
    Finset.sum_congr, MonoidAlgebra.single_mul_single]
  set f : G → MonoidAlgebra k G := fun x => Finsupp.single x 1
  show (⅟ ↑(Fintype.card G) • ∑ x : G, f (x * g)) = ⅟ ↑(Fintype.card G) • ∑ x : G, f x
  rw [Function.Bijective.sum_comp (Group.mulRight_bijective g) _]
#align group_algebra.mul_average_right GroupAlgebra.mul_average_right

end GroupAlgebra

namespace Representation

section Invariants

open GroupAlgebra

variable {k G V : Type _} [CommSemiring k] [Group G] [AddCommMonoid V] [Module k V]

variable (ρ : Representation k G V)

/-- The subspace of invariants, consisting of the vectors fixed by all elements of `G`.
-/
def invariants : Submodule k V
    where
  carrier := setOf fun v => ∀ g : G, ρ g v = v
  zero_mem' g := by simp only [map_zero]
  add_mem' v w hv hw g := by simp only [hv g, hw g, map_add]
  smul_mem' r v hv g := by simp only [hv g, LinearMap.map_smulₛₗ, RingHom.id_apply]
#align representation.invariants Representation.invariants

@[simp]
theorem mem_invariants (v : V) : v ∈ invariants ρ ↔ ∀ g : G, ρ g v = v := by rfl
#align representation.mem_invariants Representation.mem_invariants

theorem invariants_eq_inter : (invariants ρ).carrier = ⋂ g : G, Function.fixedPoints (ρ g) :=
  by
  ext
  simp [Function.IsFixedPt]
#align representation.invariants_eq_inter Representation.invariants_eq_inter

variable [Fintype G] [Invertible (Fintype.card G : k)]

/-- The action of `average k G` gives a projection map onto the subspace of invariants.
-/
@[simp]
noncomputable def averageMap : V →ₗ[k] V :=
  asAlgebraHom ρ (average k G)
#align representation.average_map Representation.averageMap

/-- The `average_map` sends elements of `V` to the subspace of invariants.
-/
theorem averageMap_invariant (v : V) : averageMap ρ v ∈ invariants ρ := fun g => by
  rw [average_map, ← as_algebra_hom_single_one, ← LinearMap.mul_apply, ← map_mul (as_algebra_hom ρ),
    mul_average_left]
#align representation.average_map_invariant Representation.averageMap_invariant

/-- The `average_map` acts as the identity on the subspace of invariants.
-/
theorem averageMap_id (v : V) (hv : v ∈ invariants ρ) : averageMap ρ v = v :=
  by
  rw [mem_invariants] at hv
  simp [average, map_sum, hv, Finset.card_univ, nsmul_eq_smul_cast k _ v, smul_smul]
#align representation.average_map_id Representation.averageMap_id

theorem isProj_averageMap : LinearMap.IsProj ρ.invariants ρ.averageMap :=
  ⟨ρ.averageMap_invariant, ρ.averageMap_id⟩
#align representation.is_proj_average_map Representation.isProj_averageMap

end Invariants

namespace LinHom

universe u

open CategoryTheory Action

section Rep

variable {k : Type u} [CommRing k] {G : GroupCat.{u}}

theorem mem_invariants_iff_comm {X Y : Rep k G} (f : X.V →ₗ[k] Y.V) (g : G) :
    (linHom X.ρ Y.ρ) g f = f ↔ f.comp (X.ρ g) = (Y.ρ g).comp f :=
  by
  dsimp
  erw [← ρ_Aut_apply_inv]
  rw [← LinearMap.comp_assoc, ← ModuleCat.comp_def, ← ModuleCat.comp_def, iso.inv_comp_eq,
    ρ_Aut_apply_hom]
  exact comm
#align representation.lin_hom.mem_invariants_iff_comm Representation.linHom.mem_invariants_iff_comm

/-- The invariants of the representation `lin_hom X.ρ Y.ρ` correspond to the the representation
homomorphisms from `X` to `Y` -/
@[simps]
def invariantsEquivRepHom (X Y : Rep k G) : (linHom X.ρ Y.ρ).invariants ≃ₗ[k] X ⟶ Y
    where
  toFun f := ⟨f.val, fun g => (mem_invariants_iff_comm _ g).1 (f.property g)⟩
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
  invFun f := ⟨f.hom, fun g => (mem_invariants_iff_comm _ g).2 (f.comm g)⟩
  left_inv _ := by
    ext
    rfl
  right_inv _ := by
    ext
    rfl
#align representation.lin_hom.invariants_equiv_Rep_hom Representation.linHom.invariantsEquivRepHom

end Rep

section FdRep

variable {k : Type u} [Field k] {G : GroupCat.{u}}

/-- The invariants of the representation `lin_hom X.ρ Y.ρ` correspond to the the representation
homomorphisms from `X` to `Y` -/
def invariantsEquivFdRepHom (X Y : FdRep k G) : (linHom X.ρ Y.ρ).invariants ≃ₗ[k] X ⟶ Y :=
  by
  rw [← FdRep.forget₂_ρ, ← FdRep.forget₂_ρ]
  exact lin_hom.invariants_equiv_Rep_hom _ _ ≪≫ₗ FdRep.forget₂HomLinearEquiv X Y
#align representation.lin_hom.invariants_equiv_fdRep_hom Representation.linHom.invariantsEquivFdRepHom

end FdRep

end LinHom

end Representation


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import solutions.section14polynomials.sheet01degree

/-!

# Noetherian rings

`is_noetherian_ring R` is the predicate that `R` is Noetherian,
i.e., that all ideals of `R` are finitely generated. The theorem
saying that a ring is Noetherian iff all ideals are finitely
generated is called `is_noetherian_ring_iff_ideal_fg R`.

Let me explain the definition of `gens` below.

`is_noetherian_ring_iff_ideal_fg R` is the statement that R is
  Noetherian ↔ all ideals are finitely generated. An `↔` statement
  is made in Lean by giving two things; the `→` implication and the `←`
  implication.

`(is_noetherian_ring_iff_ideal_fg R).1` is the first implication,
namely that if `R` is Noetherian then all ideals are finitely generated.

If `hR : is_noetherian_ring R` then
`(is_noetherian_ring_iff_ideal_fg R).1 hR` is thus the statement
that for all ideals of `R`, they're finitely generated. So it's
a function which eats an ideal of `R` and returns a proof that
it's finitely generated.

If furthermore `J` is an ideal of `R` then
`(is_noetherian_ring_iff_ideal_fg R).1 hR J` is thus the proof that `J`
is finitely-generated. In other words, it's a proof there exists
a finite set `S : finset R` of elements of `R` such that `S` generates `J`
as an ideal.

`exists.some` is the function which takes a proof
that there exists something with a property, and spits out
a something. It moves from the `Prop` universe to the `Type` universe
and is hence noncomputable. The proof that the something satisfies
the property is `exists.some_spec`.

With that in mind, I present `is_noetherian_ring.gens`, a function
which eats an ideal of a Noetherian ring and produces a finite
generating set.

-/

variables {R : Type} [comm_ring R] (I : ideal (polynomial R))

open polynomial

-- this definition and these lemmas should perhaps be in mathlib?
namespace is_noetherian_ring

/-- If `hR : is_noetherian_ring R` and `J : ideal R` then `hR.gens J` is a finite generating set for `J`,
  expressed as a term of type `finset R`. See `hR.span_gens J` for a proof that it spans. -/
noncomputable def gens (hR : is_noetherian_ring R) (J : ideal R) : finset R :=
((is_noetherian_ring_iff_ideal_fg R).1 hR J).some

/-

The `gens` function spits out a `finset`, which is the type of finite subsets
of `R`. There's a coercion to `set R` of course.

The proof that the generating set does actually span is the same as the
definition, except that you change `some` to `some_spec`.

-/

lemma span_gens (hR : is_noetherian_ring R) (J : ideal R) : ideal.span (hR.gens J : set R) = J :=
((is_noetherian_ring_iff_ideal_fg R).1 hR J).some_spec

/-

See if you can prove the useful lemma that the generators of `J` are a subset
of `J`. The lemma you need from the library is called `ideal.subset_span`.
-/

lemma gens_subset (hR : is_noetherian_ring R) (J : ideal R) :
  (hR.gens J : set R) ⊆ J :=
begin
  have h := hR.span_gens J,
  nth_rewrite 1 ← h,
  exact ideal.subset_span,
end

end is_noetherian_ring


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.convex.integral
import measure_theory.integral.interval_integral

/-!
# Integral average over an interval

In this file we introduce notation `⨍ x in a..b, f x` for the average `⨍ x in Ι a b, f x` of `f`
over the interval `Ι a b = set.Ioc (min a b) (max a b)` w.r.t. the Lebesgue measure, then prove
formulas for this average:

* `interval_average_eq`: `⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x`;
* `interval_average_eq_div`: `⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a)`.

We also prove that `⨍ x in a..b, f x = ⨍ x in b..a, f x`, see `interval_average_symm`.

## Notation

`⨍ x in a..b, f x`: average of `f` over the interval `Ι a b` w.r.t. the Lebesgue measure.

-/

open measure_theory set topological_space
open_locale interval

variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]

notation `⨍` binders ` in ` a `..` b `, `
  r:(scoped:60 f, average (measure.restrict volume (Ι a b)) f) := r

lemma interval_average_symm (f : ℝ → E) (a b : ℝ) : ⨍ x in a..b, f x = ⨍ x in b..a, f x :=
by rw [set_average_eq, set_average_eq, interval_oc_swap]

lemma interval_average_eq (f : ℝ → E) (a b : ℝ) : ⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x :=
begin
  cases le_or_lt a b with h h,
  { rw [set_average_eq, interval_oc_of_le h, real.volume_Ioc, interval_integral.integral_of_le h,
      ennreal.to_real_of_real (sub_nonneg.2 h)] },
  { rw [set_average_eq, interval_oc_of_lt h, real.volume_Ioc, interval_integral.integral_of_ge h.le,
     ennreal.to_real_of_real (sub_nonneg.2 h.le), smul_neg, ← neg_smul, ← inv_neg, neg_sub] }
end

lemma interval_average_eq_div (f : ℝ → ℝ) (a b : ℝ) :
  ⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a) :=
by rw [interval_average_eq, smul_eq_mul, div_eq_inv_mul]


/-
Copyright (c) 2018 Mitchell Rowett. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mitchell Rowett, Scott Morrison
-/

import algebra.quotient
import group_theory.subgroup.basic
import tactic.group

/-!
# Cosets

This file develops the basic theory of left and right cosets.

## Main definitions

* `left_coset a s`: the left coset `a * s` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `left_add_coset a s`.
* `right_coset s a`: the right coset `s * a` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `right_add_coset s a`.
* `quotient_group.quotient s`: the quotient type representing the left cosets with respect to a
  subgroup `s`, for an `add_group` this is `quotient_add_group.quotient s`.
* `quotient_group.mk`: the canonical map from `α` to `α/s` for a subgroup `s` of `α`, for an
  `add_group` this is `quotient_add_group.mk`.
* `subgroup.left_coset_equiv_subgroup`: the natural bijection between a left coset and the subgroup,
  for an `add_group` this is `add_subgroup.left_coset_equiv_add_subgroup`.

## Notation

* `a *l s`: for `left_coset a s`.
* `a +l s`: for `left_add_coset a s`.
* `s *r a`: for `right_coset s a`.
* `s +r a`: for `right_add_coset s a`.

* `G ⧸ H` is the quotient of the (additive) group `G` by the (additive) subgroup `H`

## TODO

Add `to_additive` to `preimage_mk_equiv_subgroup_times_set`.
-/

open set function

variable {α : Type*}

/-- The left coset `a * s` for an element `a : α` and a subset `s : set α` -/
@[to_additive left_add_coset "The left coset `a+s` for an element `a : α`
and a subset `s : set α`"]
def left_coset [has_mul α] (a : α) (s : set α) : set α := (λ x, a * x) '' s

/-- The right coset `s * a` for an element `a : α` and a subset `s : set α` -/
@[to_additive right_add_coset "The right coset `s+a` for an element `a : α`
and a subset `s : set α`"]
def right_coset [has_mul α] (s : set α) (a : α) : set α := (λ x, x * a) '' s

localized "infix ` *l `:70 := left_coset" in coset
localized "infix ` +l `:70 := left_add_coset" in coset
localized "infix ` *r `:70 := right_coset" in coset
localized "infix ` +r `:70 := right_add_coset" in coset

section coset_mul
variable [has_mul α]

@[to_additive mem_left_add_coset]
lemma mem_left_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : a * x ∈ a *l s :=
mem_image_of_mem (λ b : α, a * b) hxS

@[to_additive mem_right_add_coset]
lemma mem_right_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : x * a ∈ s *r a :=
mem_image_of_mem (λ b : α, b * a) hxS

/-- Equality of two left cosets `a * s` and `b * s`. -/
@[to_additive left_add_coset_equivalence "Equality of two left cosets `a + s` and `b + s`."]
def left_coset_equivalence (s : set α) (a b : α) := a *l s = b *l s

@[to_additive left_add_coset_equivalence_rel]
lemma left_coset_equivalence_rel (s : set α) : equivalence (left_coset_equivalence s) :=
mk_equivalence (left_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

/-- Equality of two right cosets `s * a` and `s * b`. -/
@[to_additive right_add_coset_equivalence "Equality of two right cosets `s + a` and `s + b`."]
def right_coset_equivalence (s : set α) (a b : α) := s *r a = s *r b

@[to_additive right_add_coset_equivalence_rel]
lemma right_coset_equivalence_rel (s : set α) : equivalence (right_coset_equivalence s) :=
mk_equivalence (right_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

end coset_mul

section coset_semigroup
variable [semigroup α]

@[simp, to_additive left_add_coset_assoc] lemma left_coset_assoc (s : set α) (a b : α) :
  a *l (b *l s) = (a * b) *l s :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

@[simp, to_additive right_add_coset_assoc] lemma right_coset_assoc (s : set α) (a b : α) :
  s *r a *r b = s *r (a * b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

@[to_additive left_add_coset_right_add_coset]
lemma left_coset_right_coset (s : set α) (a b : α) : a *l s *r b = a *l (s *r b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

end coset_semigroup

section coset_monoid
variables [monoid α] (s : set α)

@[simp, to_additive zero_left_add_coset] lemma one_left_coset : 1 *l s = s :=
set.ext $ by simp [left_coset]

@[simp, to_additive right_add_coset_zero] lemma right_coset_one : s *r 1 = s :=
set.ext $ by simp [right_coset]

end coset_monoid

section coset_submonoid
open submonoid
variables [monoid α] (s : submonoid α)

@[to_additive mem_own_left_add_coset]
lemma mem_own_left_coset (a : α) : a ∈ a *l s :=
suffices a * 1 ∈ a *l s, by simpa,
mem_left_coset a (one_mem s)

@[to_additive mem_own_right_add_coset]
lemma mem_own_right_coset (a : α) : a ∈ (s : set α) *r a :=
suffices 1 * a ∈ (s : set α) *r a, by simpa,
mem_right_coset a (one_mem s)

@[to_additive mem_left_add_coset_left_add_coset]
lemma mem_left_coset_left_coset {a : α} (ha : a *l s = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_left_coset s a

@[to_additive mem_right_add_coset_right_add_coset]
lemma mem_right_coset_right_coset {a : α} (ha : (s : set α) *r a = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_right_coset s a

end coset_submonoid

section coset_group
variables [group α] {s : set α} {x : α}

@[to_additive mem_left_add_coset_iff]
lemma mem_left_coset_iff (a : α) : x ∈ a *l s ↔ a⁻¹ * x ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨a⁻¹ * x, h, by simp⟩)

@[to_additive mem_right_add_coset_iff]
lemma mem_right_coset_iff (a : α) : x ∈ s *r a ↔ x * a⁻¹ ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨x * a⁻¹, h, by simp⟩)

end coset_group

section coset_subgroup
open subgroup

variables [group α] (s : subgroup α)

@[to_additive left_add_coset_mem_left_add_coset]
lemma left_coset_mem_left_coset {a : α} (ha : a ∈ s) : a *l s = s :=
set.ext $ by simp [mem_left_coset_iff, mul_mem_cancel_left s (s.inv_mem ha)]

@[to_additive right_add_coset_mem_right_add_coset]
lemma right_coset_mem_right_coset {a : α} (ha : a ∈ s) : (s : set α) *r a = s :=
set.ext $ assume b, by simp [mem_right_coset_iff, mul_mem_cancel_right s (s.inv_mem ha)]

@[to_additive eq_add_cosets_of_normal]
theorem eq_cosets_of_normal (N : s.normal) (g : α) : g *l s = s *r g :=
set.ext $ assume a, by simp [mem_left_coset_iff, mem_right_coset_iff]; rw [N.mem_comm_iff]

@[to_additive normal_of_eq_add_cosets]
theorem normal_of_eq_cosets (h : ∀ g : α, g *l s = s *r g) : s.normal :=
⟨assume a ha g, show g * a * g⁻¹ ∈ (s : set α),
  by rw [← mem_right_coset_iff, ← h]; exact mem_left_coset g ha⟩

@[to_additive normal_iff_eq_add_cosets]
theorem normal_iff_eq_cosets : s.normal ↔ ∀ g : α, g *l s = s *r g :=
⟨@eq_cosets_of_normal _ _ s, normal_of_eq_cosets s⟩

@[to_additive left_add_coset_eq_iff]
lemma left_coset_eq_iff {x y : α} : left_coset x s = left_coset y s ↔ x⁻¹ * y ∈ s :=
begin
  rw set.ext_iff,
  simp_rw [mem_left_coset_iff, set_like.mem_coe],
  split,
  { intro h, apply (h y).mpr, rw mul_left_inv, exact s.one_mem },
  { intros h z, rw ←mul_inv_cancel_right x⁻¹ y, rw mul_assoc, exact s.mul_mem_cancel_left h },
end

@[to_additive right_add_coset_eq_iff]
lemma right_coset_eq_iff {x y : α} : right_coset ↑s x = right_coset s y ↔ y * x⁻¹ ∈ s :=
begin
  rw set.ext_iff,
  simp_rw [mem_right_coset_iff, set_like.mem_coe],
  split,
  { intro h, apply (h y).mpr, rw mul_right_inv, exact s.one_mem },
  { intros h z, rw ←inv_mul_cancel_left y x⁻¹, rw ←mul_assoc, exact s.mul_mem_cancel_right h },
end

end coset_subgroup

run_cmd to_additive.map_namespace `quotient_group `quotient_add_group

namespace quotient_group

variables [group α] (s : subgroup α)

/-- The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup.-/
@[to_additive "The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup."]
def left_rel : setoid α :=
⟨λ x y, x⁻¹ * y ∈ s, by { simp_rw ←left_coset_eq_iff, exact left_coset_equivalence_rel s }⟩

lemma left_rel_r_eq_left_coset_equivalence :
  @setoid.r _ (quotient_group.left_rel s) = left_coset_equivalence s :=
by { ext, exact (left_coset_eq_iff s).symm }

@[to_additive]
instance left_rel_decidable [decidable_pred (∈ s)] :
  decidable_rel (left_rel s).r := λ x y, ‹decidable_pred (∈ s)› _

/-- `α ⧸ s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `α ⧸ s` is a group -/
@[to_additive "`α ⧸ s` is the quotient type representing the left cosets of `s`.  If `s` is a
normal subgroup, `α ⧸ s` is a group"]
instance : has_quotient α (subgroup α) := ⟨λ s, quotient (left_rel s)⟩

/-- The equivalence relation corresponding to the partition of a group by right cosets of a
subgroup. -/
@[to_additive "The equivalence relation corresponding to the partition of a group by right cosets of
a subgroup."]
def right_rel : setoid α :=
⟨λ x y, y * x⁻¹ ∈ s, by { simp_rw ←right_coset_eq_iff, exact right_coset_equivalence_rel s }⟩

lemma right_rel_r_eq_right_coset_equivalence :
  @setoid.r _ (quotient_group.right_rel s) = right_coset_equivalence s :=
by { ext, exact (right_coset_eq_iff s).symm }

@[to_additive]
instance right_rel_decidable [decidable_pred (∈ s)] :
  decidable_rel (right_rel s).r := λ x y, ‹decidable_pred (∈ s)› _

/-- Right cosets are in bijection with left cosets. -/
@[to_additive "Right cosets are in bijection with left cosets."]
def quotient_right_rel_equiv_quotient_left_rel : quotient (quotient_group.right_rel s) ≃ α ⧸ s :=
{ to_fun := quotient.map' (λ g, g⁻¹) (λ a b h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h)),
  inv_fun := quotient.map' (λ g, g⁻¹) (λ a b h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h)),
  left_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
  { simp only [inv_inv],
    exact quotient.exact' rfl })),
  right_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
  { simp only [inv_inv],
    exact quotient.exact' rfl })) }

end quotient_group

namespace quotient_group

variables [group α] {s : subgroup α}

@[to_additive]
instance fintype [fintype α] (s : subgroup α) [decidable_rel (left_rel s).r] :
  fintype (α ⧸ s) :=
quotient.fintype (left_rel s)

/-- The canonical map from a group `α` to the quotient `α ⧸ s`. -/
@[to_additive "The canonical map from an `add_group` `α` to the quotient `α ⧸ s`."]
abbreviation mk (a : α) : α ⧸ s :=
quotient.mk' a

@[to_additive]
lemma mk_surjective : function.surjective $ @mk _ _ s := quotient.surjective_quotient_mk'

@[elab_as_eliminator, to_additive]
lemma induction_on {C : α ⧸ s → Prop} (x : α ⧸ s)
  (H : ∀ z, C (quotient_group.mk z)) : C x :=
quotient.induction_on' x H

@[to_additive]
instance : has_coe_t α (α ⧸ s) := ⟨mk⟩ -- note [use has_coe_t]

@[elab_as_eliminator, to_additive]
lemma induction_on' {C : α ⧸ s → Prop} (x : α ⧸ s)
  (H : ∀ z : α, C z) : C x :=
quotient.induction_on' x H

@[simp, to_additive]
lemma quotient_lift_on_coe {β} (f : α → β) (h) (x : α) :
  quotient.lift_on' (x : α ⧸ s) f h = f x := rfl

@[to_additive]
lemma forall_coe {C : α ⧸ s → Prop} :
  (∀ x : α ⧸ s, C x) ↔ ∀ x : α, C x :=
⟨λ hx x, hx _, quot.ind⟩

@[to_additive]
instance (s : subgroup α) : inhabited (α ⧸ s) :=
⟨((1 : α) : α ⧸ s)⟩

@[to_additive quotient_add_group.eq]
protected lemma eq {a b : α} : (a : α ⧸ s) = b ↔ a⁻¹ * b ∈ s :=
quotient.eq'

@[to_additive quotient_add_group.eq']
lemma eq' {a b : α} : (mk a : α ⧸ s) = mk b ↔ a⁻¹ * b ∈ s :=
quotient_group.eq

@[to_additive quotient_add_group.out_eq']
lemma out_eq' (a : α ⧸ s) : mk a.out' = a :=
quotient.out_eq' a

variables (s)

/- It can be useful to write `obtain ⟨h, H⟩ := mk_out'_eq_mul ...`, and then `rw [H]` or
  `simp_rw [H]` or `simp only [H]`. In order for `simp_rw` and `simp only` to work, this lemma is
  stated in terms of an arbitrary `h : s`, rathern that the specific `h = g⁻¹ * (mk g).out'`. -/
@[to_additive quotient_add_group.mk_out'_eq_mul]
lemma mk_out'_eq_mul (g : α) : ∃ h : s, (mk g : α ⧸ s).out' = g * h :=
⟨⟨g⁻¹ * (mk g).out', eq'.mp (mk g).out_eq'.symm⟩, by rw [s.coe_mk, mul_inv_cancel_left]⟩

variables {s}

@[to_additive quotient_add_group.mk_mul_of_mem]
lemma mk_mul_of_mem (g₁ g₂ : α) (hg₂ : g₂ ∈ s) : (mk (g₁ * g₂) : α ⧸ s) = mk g₁ :=
by rwa [eq', mul_inv_rev, inv_mul_cancel_right, s.inv_mem_iff]

@[to_additive]
lemma eq_class_eq_left_coset (s : subgroup α) (g : α) :
  {x : α | (x : α ⧸ s) = g} = left_coset g s :=
set.ext $ λ z,
  by rw [mem_left_coset_iff, set.mem_set_of_eq, eq_comm, quotient_group.eq, set_like.mem_coe]

@[to_additive]
lemma preimage_image_coe (N : subgroup α) (s : set α) :
  coe ⁻¹' ((coe : α → α ⧸ N) '' s) = ⋃ x : N, (λ y : α, y * x) ⁻¹' s :=
begin
  ext x,
  simp only [quotient_group.eq, set_like.exists, exists_prop, set.mem_preimage, set.mem_Union,
    set.mem_image, subgroup.coe_mk, ← eq_inv_mul_iff_mul_eq],
  exact ⟨λ ⟨y, hs, hN⟩, ⟨_, N.inv_mem hN, by simpa using hs⟩,
         λ ⟨z, hz, hxz⟩, ⟨x*z, hxz, by simpa using hz⟩⟩,
end

end quotient_group

namespace subgroup
open quotient_group
variables [group α] {s : subgroup α}

/-- The natural bijection between a left coset `g * s` and `s`. -/
@[to_additive "The natural bijection between the cosets `g + s` and `s`."]
def left_coset_equiv_subgroup (g : α) : left_coset g s ≃ s :=
⟨λ x, ⟨g⁻¹ * x.1, (mem_left_coset_iff _).1 x.2⟩,
 λ x, ⟨g * x.1, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- The natural bijection between a right coset `s * g` and `s`. -/
@[to_additive "The natural bijection between the cosets `s + g` and `s`."]
def right_coset_equiv_subgroup (g : α) : right_coset ↑s g ≃ s :=
⟨λ x, ⟨x.1 * g⁻¹, (mem_right_coset_iff _).1 x.2⟩,
 λ x, ⟨x.1 * g, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- A (non-canonical) bijection between a group `α` and the product `(α/s) × s` -/
@[to_additive "A (non-canonical) bijection between an add_group `α` and the product `(α/s) × s`"]
noncomputable def group_equiv_quotient_times_subgroup :
  α ≃ (α ⧸ s) × s :=
calc α ≃ Σ L : α ⧸ s, {x : α // (x : α ⧸ s) = L} :
  (equiv.sigma_preimage_equiv quotient_group.mk).symm
    ... ≃ Σ L : α ⧸ s, left_coset (quotient.out' L) s :
  equiv.sigma_congr_right (λ L,
    begin
      rw ← eq_class_eq_left_coset,
      show _root_.subtype (λ x : α, quotient.mk' x = L) ≃
        _root_.subtype (λ x : α, quotient.mk' x = quotient.mk' _),
      simp [-quotient.eq'],
    end)
    ... ≃ Σ L : α ⧸ s, s :
  equiv.sigma_congr_right (λ L, left_coset_equiv_subgroup _)
    ... ≃ (α ⧸ s) × s :
  equiv.sigma_equiv_prod _ _

variables {t : subgroup α}

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`. -/
@[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`.", simps]
def quotient_equiv_prod_of_le' (h_le : s ≤ t)
  (f : α ⧸ t → α) (hf : function.right_inverse f quotient_group.mk) :
  α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
{ to_fun := λ a, ⟨a.map' id (λ b c h, h_le h),
    a.map' (λ g : α, ⟨(f (quotient.mk' g))⁻¹ * g, quotient.exact' (hf g)⟩) (λ b c h, by
    { change ((f b)⁻¹ * b)⁻¹ * ((f c)⁻¹ * c) ∈ s,
      have key : f b = f c := congr_arg f (quotient.sound' (h_le h)),
      rwa [key, mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_left] })⟩,
  inv_fun := λ a, a.2.map' (λ b, f a.1 * b) (λ b c h, by
  { change (f a.1 * b)⁻¹ * (f a.1 * c) ∈ s,
    rwa [mul_inv_rev, mul_assoc, inv_mul_cancel_left] }),
  left_inv := by
  { refine quotient.ind' (λ a, _),
    simp_rw [quotient.map'_mk', id.def, t.coe_mk, mul_inv_cancel_left] },
  right_inv := by
  { refine prod.rec _,
    refine quotient.ind' (λ a, _),
    refine quotient.ind' (λ b, _),
    have key : quotient.mk' (f (quotient.mk' a) * b) = quotient.mk' a :=
      (quotient_group.mk_mul_of_mem (f a) ↑b b.2).trans (hf a),
    simp_rw [quotient.map'_mk', id.def, key, inv_mul_cancel_left, subtype.coe_eta] } }

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotient_equiv_prod_of_le'`. -/
@[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotient_equiv_prod_of_le'`.", simps]
noncomputable def quotient_equiv_prod_of_le (h_le : s ≤ t) :
  α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
quotient_equiv_prod_of_le' h_le quotient.out' quotient.out_eq'

/-- If `K ≤ L`, then there is an embedding `K ⧸ (H.subgroup_of K) ↪ L ⧸ (H.subgroup_of L)`. -/
@[to_additive "If `K ≤ L`, then there is an embedding
  `K ⧸ (H.add_subgroup_of K) ↪ L ⧸ (H.add_subgroup_of L)`."]
def quotient_subgroup_of_embedding_of_le (H : subgroup α) {K L : subgroup α} (h : K ≤ L) :
  K ⧸ (H.subgroup_of K) ↪ L ⧸ (H.subgroup_of L) :=
{ to_fun := quotient.map' (set.inclusion h) (λ a b, id),
  inj' := by refine quotient.ind₂' (λ a b, _); exact quotient.eq'.mpr ∘ quotient.eq'.mp }

@[to_additive] lemma card_eq_card_quotient_mul_card_subgroup
  [fintype α] (s : subgroup α) [fintype s] [decidable_pred (λ a, a ∈ s)] :
  fintype.card α = fintype.card (α ⧸ s) * fintype.card s :=
by rw ← fintype.card_prod;
  exact fintype.card_congr (subgroup.group_equiv_quotient_times_subgroup)

/-- **Lagrange's Theorem**: The order of a subgroup divides the order of its ambient group. -/
@[to_additive] lemma card_subgroup_dvd_card [fintype α] (s : subgroup α) [fintype s] :
  fintype.card s ∣ fintype.card α :=
by classical; simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_left ℕ]

@[to_additive] lemma card_quotient_dvd_card [fintype α] (s : subgroup α)
  [decidable_pred (λ a, a ∈ s)] [fintype s] : fintype.card (α ⧸ s) ∣ fintype.card α :=
by simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_right ℕ]

open fintype

variables {H : Type*} [group H]

@[to_additive] lemma card_dvd_of_injective [fintype α] [fintype H] (f : α →* H)
  (hf : function.injective f) : card α ∣ card H :=
by classical;
calc card α = card (f.range : subgroup H) : card_congr (equiv.of_injective f hf)
...∣ card H : card_subgroup_dvd_card _

@[to_additive] lemma card_dvd_of_le {H K : subgroup α} [fintype H] [fintype K] (hHK : H ≤ K) :
  card H ∣ card K :=
card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)

@[to_additive] lemma card_comap_dvd_of_injective (K : subgroup H) [fintype K]
  (f : α →* H) [fintype (K.comap f)] (hf : function.injective f) :
  fintype.card (K.comap f) ∣ fintype.card K :=
by haveI : fintype ((K.comap f).map f) :=
  fintype.of_equiv _ (equiv_map_of_injective _ _ hf).to_equiv;
calc fintype.card (K.comap f) = fintype.card ((K.comap f).map f) :
       fintype.card_congr (equiv_map_of_injective _ _ hf).to_equiv
... ∣ fintype.card K : card_dvd_of_le (map_comap_le _ _)

end subgroup

namespace quotient_group

variables [group α]

-- FIXME -- why is there no `to_additive`?

/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α/s`, then
there is a (typically non-canonical) bijection between the preimage of `t` in
`α` and the product `s × t`. -/
noncomputable def preimage_mk_equiv_subgroup_times_set
  (s : subgroup α) (t : set (α ⧸ s)) : quotient_group.mk ⁻¹' t ≃ s × t :=
have h : ∀ {x : α ⧸ s} {a : α}, x ∈ t → a ∈ s →
  (quotient.mk' (quotient.out' x * a) : α ⧸ s) = quotient.mk' (quotient.out' x) :=
    λ x a hx ha, quotient.sound' (show (quotient.out' x * a)⁻¹ * quotient.out' x ∈ s,
      from (s.inv_mem_iff).1 $
        by rwa [mul_inv_rev, inv_inv, ← mul_assoc, inv_mul_self, one_mul]),
{ to_fun := λ ⟨a, ha⟩, ⟨⟨(quotient.out' (quotient.mk' a))⁻¹ * a,
    @quotient.exact' _ (left_rel s) _ _ $ (quotient.out_eq' _)⟩,
      ⟨quotient.mk' a, ha⟩⟩,
  inv_fun := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, ⟨quotient.out' x * a, show quotient.mk' _ ∈ t,
    by simp [h hx ha, hx]⟩,
  left_inv := λ ⟨a, ha⟩, subtype.eq $ show _ * _ = a, by simp,
  right_inv := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, show (_, _) = _, by simp [h hx ha] }

end quotient_group

/--
We use the class `has_coe_t` instead of `has_coe` if the first argument is a variable,
or if the second argument is a variable not occurring in the first.
Using `has_coe` would cause looping of type-class inference. See
<https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/remove.20all.20instances.20with.20variable.20domain>
-/
library_note "use has_coe_t"


import tactic data.nat.basic
open nat

/--------------------------------------------------------------------------

  ``rw``

    If ``f`` is a term of type ``P = Q`` (or ``P ↔ Q``), then
    ``rw f`` replaces ``P`` with ``Q`` in the target.
    Other variants:
      ``rw f at hp``, ``rw ←f``, ``rw ←f at hr``.

  Delete the ``sorry,`` below and replace them with a legitimate proof.

  --------------------------------------------------------------------------/

theorem add_self_self_eq_double
  (x : ℕ)
: x + x = 2 * x :=
begin
  rw two_mul,
end

/-
For the following problem, use
  mul_comm a b : a * b = b * a
-/

example (a b c d : ℕ)
  (hyp : c = d * a + b)
  (hyp' : b = a * d)
: c = 2 * (a * d) :=
begin
  sorry,
end

/-
For the following problem, use
  nat.sub_self (x : ℕ) : x - x = 0
-/

example (a b c d : ℕ)
  (hyp : c = b * a - d)
  (hyp' : d = a * b)
: c = 0 :=
begin
  sorry,
end


/-
Copyright (c) 2021 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.prime_counting
! leanprover-community/mathlib commit 16de0889b9e841c59af6cfece272b9276f9bf5ae
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.PrimeFin
import Mathbin.Data.Nat.Totient
import Mathbin.Data.Finset.LocallyFinite
import Mathbin.Data.Nat.Count
import Mathbin.Data.Nat.Nth

/-!
# The Prime Counting Function

In this file we define the prime counting function: the function on natural numbers that returns
the number of primes less than or equal to its input.

## Main Results

The main definitions for this file are

- `nat.prime_counting`: The prime counting function π
- `nat.prime_counting'`: π(n - 1)

We then prove that these are monotone in `nat.monotone_prime_counting` and
`nat.monotone_prime_counting'`. The last main theorem `nat.prime_counting'_add_le` is an upper
bound on `π'` which arises by observing that all numbers greater than `k` and not coprime to `k`
are not prime, and so only at most `φ(k)/k` fraction of the numbers from `k` to `n` are prime.

## Notation

We use the standard notation `π` to represent the prime counting function (and `π'` to represent
the reindexed version).

-/

namespace Nat

open Finset

/-- A variant of the traditional prime counting function which gives the number of primes
*strictly* less than the input. More convenient for avoiding off-by-one errors.
-/
def primeCounting' : ℕ → ℕ :=
  Nat.count Prime
#align nat.prime_counting' Nat.primeCounting'

/-- The prime counting function: Returns the number of primes less than or equal to the input. -/
def primeCounting (n : ℕ) : ℕ :=
  primeCounting' (n + 1)
#align nat.prime_counting Nat.primeCounting

-- mathport name: prime_counting
scoped notation "π" => Nat.primeCounting

-- mathport name: prime_counting'
scoped notation "π'" => Nat.primeCounting'

theorem monotone_primeCounting' : Monotone primeCounting' :=
  count_monotone Prime
#align nat.monotone_prime_counting' Nat.monotone_primeCounting'

theorem monotone_primeCounting : Monotone primeCounting :=
  monotone_primeCounting'.comp (monotone_id.AddConst _)
#align nat.monotone_prime_counting Nat.monotone_primeCounting

@[simp]
theorem primeCounting'_nth_eq (n : ℕ) : π' (nth Prime n) = n :=
  count_nth_of_infinite _ infinite_setOf_prime _
#align nat.prime_counting'_nth_eq Nat.primeCounting'_nth_eq

@[simp]
theorem prime_nth_prime (n : ℕ) : Prime (nth Prime n) :=
  nth_mem_of_infinite _ infinite_setOf_prime _
#align nat.prime_nth_prime Nat.prime_nth_prime

/-- A linear upper bound on the size of the `prime_counting'` function -/
theorem primeCounting'_add_le {a k : ℕ} (h0 : 0 < a) (h1 : a < k) (n : ℕ) :
    π' (k + n) ≤ π' k + Nat.totient a * (n / a + 1) :=
  calc
    π' (k + n) ≤ ((range k).filterₓ Prime).card + ((Ico k (k + n)).filterₓ Prime).card :=
      by
      rw [prime_counting', count_eq_card_filter_range, range_eq_Ico, ←
        Ico_union_Ico_eq_Ico (zero_le k) le_self_add, filter_union]
      apply card_union_le
    _ ≤ π' k + ((Ico k (k + n)).filterₓ Prime).card := by
      rw [prime_counting', count_eq_card_filter_range]
    _ ≤ π' k + ((Ico k (k + n)).filterₓ (coprime a)).card :=
      by
      refine' add_le_add_left (card_le_of_subset _) k.prime_counting'
      simp only [subset_iff, and_imp, mem_filter, mem_Ico]
      intro p succ_k_le_p p_lt_n p_prime
      constructor
      · exact ⟨succ_k_le_p, p_lt_n⟩
      · rw [coprime_comm]
        exact coprime_of_lt_prime h0 (gt_of_ge_of_gt succ_k_le_p h1) p_prime
    _ ≤ π' k + totient a * (n / a + 1) :=
      by
      rw [add_le_add_iff_left]
      exact Ico_filter_coprime_le k n h0

#align nat.prime_counting'_add_le Nat.primeCounting'_add_le

end Nat


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

! This file was ported from Lean 3 source module linear_algebra.affine_space.slope
! 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.LinearAlgebra.AffineSpace.AffineMap
import Mathlib.Tactic.FieldSimp

/-!
# Slope of a function

In this file we define the slope of a function `f : k → PE` taking values in an affine space over
`k` and prove some basic theorems about `slope`. The `slope` function naturally appears in the Mean
Value Theorem, and in the proof of the fact that a function with nonnegative second derivative on an
interval is convex on this interval.

## Tags

affine space, slope
-/

-- Porting note: Workaround for lean4#2074
attribute [-instance] Ring.toNonAssocRing

open AffineMap

variable {k E PE : Type _} [Field k] [AddCommGroup E] [Module k E] [AddTorsor E PE]

/-- `slope f a b = (b - a)⁻¹ • (f b -ᵥ f a)` is the slope of a function `f` on the interval
`[a, b]`. Note that `slope f a a = 0`, not the derivative of `f` at `a`. -/
def slope (f : k → PE) (a b : k) : E :=
  (b - a)⁻¹ • (f b -ᵥ f a)
#align slope slope

theorem slope_fun_def (f : k → PE) : slope f = fun a b => (b - a)⁻¹ • (f b -ᵥ f a) :=
  rfl
#align slope_fun_def slope_fun_def

theorem slope_def_field (f : k → k) (a b : k) : slope f a b = (f b - f a) / (b - a) :=
  (div_eq_inv_mul _ _).symm
#align slope_def_field slope_def_field

theorem slope_fun_def_field (f : k → k) (a : k) : slope f a = fun b => (f b - f a) / (b - a) :=
  (div_eq_inv_mul _ _).symm
#align slope_fun_def_field slope_fun_def_field

@[simp]
theorem slope_same (f : k → PE) (a : k) : (slope f a a : E) = 0 := by
  rw [slope, sub_self, inv_zero, zero_smul]
#align slope_same slope_same

theorem slope_def_module (f : k → E) (a b : k) : slope f a b = (b - a)⁻¹ • (f b - f a) :=
  rfl
#align slope_def_module slope_def_module

@[simp]
theorem sub_smul_slope (f : k → PE) (a b : k) : (b - a) • slope f a b = f b -ᵥ f a := by
  rcases eq_or_ne a b with (rfl | hne)
  · rw [sub_self, zero_smul, vsub_self]
  · rw [slope, smul_inv_smul₀ (sub_ne_zero.2 hne.symm)]
#align sub_smul_slope sub_smul_slope

theorem sub_smul_slope_vadd (f : k → PE) (a b : k) : (b - a) • slope f a b +ᵥ f a = f b := by
  rw [sub_smul_slope, vsub_vadd]
#align sub_smul_slope_vadd sub_smul_slope_vadd

@[simp]
theorem slope_vadd_const (f : k → E) (c : PE) : (slope fun x => f x +ᵥ c) = slope f := by
  ext (a b)
  simp only [slope, vadd_vsub_vadd_cancel_right, vsub_eq_sub]
#align slope_vadd_const slope_vadd_const

@[simp]
theorem slope_sub_smul (f : k → E) {a b : k} (h : a ≠ b) :
    slope (fun x => (x - a) • f x) a b = f b := by
  simp [slope, inv_smul_smul₀ (sub_ne_zero.2 h.symm)]
#align slope_sub_smul slope_sub_smul

theorem eq_of_slope_eq_zero {f : k → PE} {a b : k} (h : slope f a b = (0 : E)) : f a = f b := by
  rw [← sub_smul_slope_vadd f a b, h, smul_zero, zero_vadd]
#align eq_of_slope_eq_zero eq_of_slope_eq_zero

theorem AffineMap.slope_comp {F PF : Type _} [AddCommGroup F] [Module k F] [AddTorsor F PF]
    (f : PE →ᵃ[k] PF) (g : k → PE) (a b : k) : slope (f ∘ g) a b = f.linear (slope g a b) := by
  simp only [slope, (· ∘ ·), f.linear.map_smul, f.linearMap_vsub]
#align affine_map.slope_comp AffineMap.slope_comp

theorem LinearMap.slope_comp {F : Type _} [AddCommGroup F] [Module k F] (f : E →ₗ[k] F) (g : k → E)
    (a b : k) : slope (f ∘ g) a b = f (slope g a b) :=
  f.toAffineMap.slope_comp g a b
#align linear_map.slope_comp LinearMap.slope_comp

theorem slope_comm (f : k → PE) (a b : k) : slope f a b = slope f b a := by
  rw [slope, slope, ← neg_vsub_eq_vsub_rev, smul_neg, ← neg_smul, neg_inv, neg_sub]
#align slope_comm slope_comm

/-- `slope f a c` is a linear combination of `slope f a b` and `slope f b c`. This version
explicitly provides coefficients. If `a ≠ c`, then the sum of the coefficients is `1`, so it is
actually an affine combination, see `lineMap_slope_slope_sub_div_sub`. -/
theorem sub_div_sub_smul_slope_add_sub_div_sub_smul_slope (f : k → PE) (a b c : k) :
    ((b - a) / (c - a)) • slope f a b + ((c - b) / (c - a)) • slope f b c = slope f a c := by
  by_cases hab : a = b
  · subst hab
    rw [sub_self, zero_div, zero_smul, zero_add]
    by_cases hac : a = c
    · simp [hac]
    · rw [div_self (sub_ne_zero.2 <| Ne.symm hac), one_smul]
  by_cases hbc : b = c;
  · subst hbc
    simp [sub_ne_zero.2 (Ne.symm hab)]
  rw [add_comm]
  simp_rw [slope, div_eq_inv_mul, mul_smul, ← smul_add,
    smul_inv_smul₀ (sub_ne_zero.2 <| Ne.symm hab), smul_inv_smul₀ (sub_ne_zero.2 <| Ne.symm hbc),
    vsub_add_vsub_cancel]
#align sub_div_sub_smul_slope_add_sub_div_sub_smul_slope sub_div_sub_smul_slope_add_sub_div_sub_smul_slope

/-- `slope f a c` is an affine combination of `slope f a b` and `slope f b c`. This version uses
`lineMap` to express this property. -/
theorem lineMap_slope_slope_sub_div_sub (f : k → PE) (a b c : k) (h : a ≠ c) :
    lineMap (slope f a b) (slope f b c) ((c - b) / (c - a)) = slope f a c := by
  field_simp [sub_ne_zero.2 h.symm, ← sub_div_sub_smul_slope_add_sub_div_sub_smul_slope f a b c,
    lineMap_apply_module]
#align line_map_slope_slope_sub_div_sub lineMap_slope_slope_sub_div_sub

/-- `slope f a b` is an affine combination of `slope f a (lineMap a b r)` and
`slope f (lineMap a b r) b`. We use `lineMap` to express this property. -/
theorem lineMap_slope_lineMap_slope_lineMap (f : k → PE) (a b r : k) :
    lineMap (slope f (lineMap a b r) b) (slope f a (lineMap a b r)) r = slope f a b := by
  obtain rfl | hab : a = b ∨ a ≠ b := Classical.em _; · simp
  rw [slope_comm _ a, slope_comm _ a, slope_comm _ _ b]
  convert lineMap_slope_slope_sub_div_sub f b (lineMap a b r) a hab.symm using 2
  rw [lineMap_apply_ring, eq_div_iff (sub_ne_zero.2 hab), sub_mul, one_mul, mul_sub, ← sub_sub,
    sub_sub_cancel]
#align line_map_slope_line_map_slope_line_map lineMap_slope_lineMap_slope_lineMap


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard.
Thanks: Imperial College London, leanprover-community
-/

-- import the definition and basic properties of ℂ
import complex.Level_00_basic

/-! # Level 1 : the map from ℝ to ℂ

This file sets up the coercion from the reals to the complexes,
sending `r` to `⟨r, 0⟩`. Mathematically it is straightforward.

All the proofs below are sorried. You can try them in tactic mode
by replacing `sorry` with `begin sorry end` and then starting to write
tactics in the `begin end` block.

-/

namespace complex

-- fill in the definition of the map below,
-- sending the real number r to the complex number ⟨r, 0⟩

/-- The canonical map from ℝ to ℂ. -/
def of_real (r : ℝ) : ℂ := ⟨r, 0⟩

/-
We make this map into a *coercion*, which means that if `(r : ℝ)` is a real
number, then `(r : ℂ)` or `(↑r : ℂ)` will indicate the corresponding
complex number with no imaginary part. This is the notation we shall
use in our `simp` lemmas.
-/

/-- The coercion from ℝ to ℂ sending `r` to the complex number `⟨r, 0⟩` -/
instance : has_coe ℝ ℂ := ⟨of_real⟩

/-
As usual, we need to train the `simp` tactic. But we also need to train
the `norm_cast` tactic. The `norm_cast` tactic enables Lean to prove
results like r^2=2*s for reals `r` and `s`, if it knows that
`(r : ℂ)^2 = 2*(s : ℂ)`. Such results are intuitive for matheamticians
but involve "invisible maps" in Lean
-/

@[simp, norm_cast] lemma of_real_re (r : ℝ) : (r : ℂ).re = r :=
begin
  refl
end

@[simp, norm_cast] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl

-- The map from the reals to the complexes is injective, something we
-- write in iff form so `simp` can use it; `simp` also works on `iff` goals.

local attribute [simp] ext_iff

@[simp, norm_cast] theorem of_real_inj {r s : ℝ} : (r : ℂ) = s ↔ r = s :=
begin
  simp
end

-- what does norm_cast do?? Here are two examples of usage:

/-

example (r s : ℝ) (h : (r : ℂ) = s) : r = s :=
begin
  norm_cast at h,
  exact h,
end

example (r s : ℝ) (h : r = s) : (r : ℂ) = (s : ℂ) :=
begin
  norm_cast,
  exact h,
end

-/

/-
We now go through all the basic constants and constructions we've defined so
far, namely 0, 1, +, -, *, and tell the simplifier how they behave with respect
to this new function.
-/

/-! ## zero -/

@[simp, norm_cast] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {r : ℝ} : (r : ℂ) = 0 ↔ r = 0 :=
begin
  simp,
end

theorem of_real_ne_zero {r : ℝ} : (r : ℂ) ≠ 0 ↔ r ≠ 0 :=
begin
  simp
end

/-! ## one -/

@[simp, norm_cast] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

/-! ## add -/

@[simp, norm_cast] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s :=
begin
  simp
end

/-! ## neg -/

@[simp, norm_cast] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r :=
begin
  simp
end

/-! ## mul -/

@[simp, norm_cast] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s :=
begin
  simp
end

/-- The canonical ring homomorphism from ℝ to ℂ -/
def Of_real : ℝ →+* ℂ :=
{ to_fun := coe, -- use the coercion from ℝ to ℂ
  map_zero' := of_real_zero,
  map_one' := of_real_one,
  map_add' := of_real_add,
  map_mul' := of_real_mul,
}

/-! ## numerals.

This is quite a computer-sciency bit.

These last two lemmas are to do with the canonical map from numerals
into the complexes, e.g. `(23 : ℂ)`. Lean stores the numeral in binary.
See for example

set_option pp.numerals false
#check (37 : ℂ)-- bit1 (bit0 (bit1 (bit0 (bit0 has_one.one)))) : ℂ

`bit0 x` is defined to be `x + x`, and `bit1 x` is defined to be `bit0 x + 1`.

We need these results so that `norm_cast` can prove results such
as (↑(37 : ℝ) : ℂ) = 37 : ℂ (i.e. coercion commutes with numerals)

-/

@[simp, norm_cast] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r :=
begin
  simp [bit0],
end

@[simp, norm_cast] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r :=
begin
  simp [bit1],
end

end complex

/-! ## norm_cast examples

The idea is that the "invisible map" from the reals to the complexes should not
create any trouble to mathematicians who just want things to work as normal

https://xenaproject.wordpress.com/2020/04/30/the-invisible-map/

example (a b c : ℝ) : ((a * b : ℝ) : ℂ) * c = (a : ℂ) * b * c :=
begin
  norm_cast,
end

example (a b c : ℝ) : ((a : ℂ) + b) * c = ((a + b) * c : ℝ) :=
begin
  norm_cast,
end

example : (37 : ℂ) = (37 : ℝ) :=
begin
  norm_cast,
end

-/


/-
Copyright (c) 2019 Tim Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baanen, Lu-Ming Zhang
-/
import algebra.regular.smul
import linear_algebra.matrix.adjugate
import linear_algebra.matrix.polynomial

/-!
# Nonsingular inverses

In this file, we define an inverse for square matrices of invertible determinant.

For matrices that are not square or not of full rank, there is a more general notion of
pseudoinverses which we do not consider here.

The definition of inverse used in this file is the adjugate divided by the determinant.
We show that dividing the adjugate by `det A` (if possible), giving a matrix `A⁻¹` (`nonsing_inv`),
will result in a multiplicative inverse to `A`.

Note that there are at least three different inverses in mathlib:

* `A⁻¹` (`has_inv.inv`): alone, this satisfies no properties, although it is usually used in
  conjunction with `group` or `group_with_zero`. On matrices, this is defined to be zero when no
  inverse exists.
* `⅟A` (`inv_of`): this is only available in the presence of `[invertible A]`, which guarantees an
  inverse exists.
* `ring.inverse A`: this is defined on any `monoid_with_zero`, and just like `⁻¹` on matrices, is
  defined to be zero when no inverse exists.

We start by working with `invertible`, and show the main results:

* `matrix.invertible_of_det_invertible`
* `matrix.det_invertible_of_invertible`
* `matrix.is_unit_iff_is_unit_det`
* `matrix.mul_eq_one_comm`

After this we define `matrix.has_inv` and show it matches `⅟A` and `ring.inverse A`.
The rest of the results in the file are then about `A⁻¹`

## References

  * https://en.wikipedia.org/wiki/Cramer's_rule#Finding_inverse_matrix

## Tags

matrix inverse, cramer, cramer's rule, adjugate
-/

namespace matrix
universes u u' v
variables {m : Type u} {n : Type u'} {α : Type v}
open_locale matrix big_operators
open equiv equiv.perm finset

/-! ### Matrices are `invertible` iff their determinants are -/

section invertible
variables [fintype n] [decidable_eq n] [comm_ring α]

/-- A copy of `inv_of_mul_self` using `⬝` not `*`. -/
protected lemma inv_of_mul_self (A : matrix n n α) [invertible A] : ⅟A ⬝ A = 1 := inv_of_mul_self A

/-- A copy of `mul_inv_of_self` using `⬝` not `*`. -/
protected lemma mul_inv_of_self (A : matrix n n α) [invertible A] : A ⬝ ⅟A = 1 := mul_inv_of_self A

/-- A copy of `inv_of_mul_self_assoc` using `⬝` not `*`. -/
protected lemma inv_of_mul_self_assoc (A : matrix n n α) (B : matrix n m α) [invertible A] :
  ⅟A ⬝ (A ⬝ B) = B :=
by rw [←matrix.mul_assoc, matrix.inv_of_mul_self, matrix.one_mul]

/-- A copy of `mul_inv_of_self_assoc` using `⬝` not `*`. -/
protected lemma mul_inv_of_self_assoc (A : matrix n n α) (B : matrix n m α) [invertible A] :
  A ⬝ (⅟A ⬝ B) = B :=
by rw [←matrix.mul_assoc, matrix.mul_inv_of_self, matrix.one_mul]

/-- A copy of `mul_inv_of_mul_self_cancel` using `⬝` not `*`. -/
protected lemma mul_inv_of_mul_self_cancel (A : matrix m n α) (B : matrix n n α)
  [invertible B] : A ⬝ ⅟B ⬝ B = A :=
by rw [matrix.mul_assoc, matrix.inv_of_mul_self, matrix.mul_one]

/-- A copy of `mul_mul_inv_of_self_cancel` using `⬝` not `*`. -/
protected lemma mul_mul_inv_of_self_cancel (A : matrix m n α) (B : matrix n n α)
  [invertible B] : A ⬝ B ⬝ ⅟B = A :=
by rw [matrix.mul_assoc, matrix.mul_inv_of_self, matrix.mul_one]

variables (A : matrix n n α) (B : matrix n n α)

/-- If `A.det` has a constructive inverse, produce one for `A`. -/
def invertible_of_det_invertible [invertible A.det] : invertible A :=
{ inv_of := ⅟A.det • A.adjugate,
  mul_inv_of_self :=
    by rw [mul_smul_comm, matrix.mul_eq_mul, mul_adjugate, smul_smul, inv_of_mul_self, one_smul],
  inv_of_mul_self :=
    by rw [smul_mul_assoc, matrix.mul_eq_mul, adjugate_mul, smul_smul, inv_of_mul_self, one_smul] }

lemma inv_of_eq [invertible A.det] [invertible A] : ⅟A = ⅟A.det • A.adjugate :=
by { letI := invertible_of_det_invertible A, convert (rfl : ⅟A = _) }

/-- `A.det` is invertible if `A` has a left inverse. -/
def det_invertible_of_left_inverse (h : B ⬝ A = 1) : invertible A.det :=
{ inv_of := B.det,
  mul_inv_of_self := by rw [mul_comm, ← det_mul, h, det_one],
  inv_of_mul_self := by rw [← det_mul, h, det_one] }

/-- `A.det` is invertible if `A` has a right inverse. -/
def det_invertible_of_right_inverse (h : A ⬝ B = 1) : invertible A.det :=
{ inv_of := B.det,
  mul_inv_of_self := by rw [← det_mul, h, det_one],
  inv_of_mul_self := by rw [mul_comm, ← det_mul, h, det_one] }

/-- If `A` has a constructive inverse, produce one for `A.det`. -/
def det_invertible_of_invertible [invertible A] : invertible A.det :=
det_invertible_of_left_inverse A (⅟A) (inv_of_mul_self _)

lemma det_inv_of [invertible A] [invertible A.det] : (⅟A).det = ⅟A.det :=
by { letI := det_invertible_of_invertible A, convert (rfl : _ = ⅟A.det) }

/-- Together `matrix.det_invertible_of_invertible` and `matrix.invertible_of_det_invertible` form an
equivalence, although both sides of the equiv are subsingleton anyway. -/
@[simps]
def invertible_equiv_det_invertible : invertible A ≃ invertible A.det :=
{ to_fun := @det_invertible_of_invertible _ _ _ _ _ A,
  inv_fun := @invertible_of_det_invertible _ _ _ _ _ A,
  left_inv := λ _, subsingleton.elim _ _,
  right_inv := λ _, subsingleton.elim _ _ }

variables {A B}

lemma mul_eq_one_comm : A ⬝ B = 1 ↔ B ⬝ A = 1 :=
suffices ∀ A B, A ⬝ B = 1 → B ⬝ A = 1, from ⟨this A B, this B A⟩, assume A B h,
begin
  letI : invertible B.det := det_invertible_of_left_inverse _ _ h,
  letI : invertible B := invertible_of_det_invertible B,
  calc B ⬝ A = (B ⬝ A) ⬝ (B ⬝ ⅟B) : by rw [matrix.mul_inv_of_self, matrix.mul_one]
        ... = B ⬝ ((A ⬝ B) ⬝ ⅟B) : by simp only [matrix.mul_assoc]
        ... = B ⬝ ⅟B : by rw [h, matrix.one_mul]
        ... = 1 : matrix.mul_inv_of_self B,
end

variables (A B)

/-- We can construct an instance of invertible A if A has a left inverse. -/
def invertible_of_left_inverse (h : B ⬝ A = 1) : invertible A :=
⟨B, h, mul_eq_one_comm.mp h⟩

/-- We can construct an instance of invertible A if A has a right inverse. -/
def invertible_of_right_inverse (h : A ⬝ B = 1) : invertible A :=
⟨B, mul_eq_one_comm.mp h, h⟩

/-- Given a proof that `A.det` has a constructive inverse, lift `A` to `(matrix n n α)ˣ`-/
def unit_of_det_invertible [invertible A.det] : (matrix n n α)ˣ :=
@unit_of_invertible _ _ A (invertible_of_det_invertible A)

/-- When lowered to a prop, `matrix.invertible_equiv_det_invertible` forms an `iff`. -/
lemma is_unit_iff_is_unit_det : is_unit A ↔ is_unit A.det :=
begin
  split; rintros ⟨x, hx⟩; refine @is_unit_of_invertible _ _ _ (id _),
  { haveI : invertible A := hx.rec x.invertible,
    apply det_invertible_of_invertible, },
  { haveI : invertible A.det := hx.rec x.invertible,
    apply invertible_of_det_invertible, },
end

/-! #### Variants of the statements above with `is_unit`-/

lemma is_unit_det_of_invertible [invertible A] : is_unit A.det :=
@is_unit_of_invertible _ _ _ (det_invertible_of_invertible A)

variables {A B}

lemma is_unit_det_of_left_inverse (h : B ⬝ A = 1) : is_unit A.det :=
@is_unit_of_invertible _ _ _ (det_invertible_of_left_inverse _ _ h)

lemma is_unit_det_of_right_inverse (h : A ⬝ B = 1) : is_unit A.det :=
@is_unit_of_invertible _ _ _ (det_invertible_of_right_inverse _ _ h)

lemma det_ne_zero_of_left_inverse [nontrivial α] (h : B ⬝ A = 1) : A.det ≠ 0 :=
(is_unit_det_of_left_inverse h).ne_zero

lemma det_ne_zero_of_right_inverse [nontrivial α] (h : A ⬝ B = 1) : A.det ≠ 0 :=
(is_unit_det_of_right_inverse h).ne_zero

end invertible

variables [fintype m] [fintype n] [decidable_eq m] [decidable_eq n] [comm_ring α]
variables (A : matrix n n α) (B : matrix n n α)

lemma is_unit_det_transpose (h : is_unit A.det) : is_unit Aᵀ.det :=
by { rw det_transpose, exact h, }

/-! ### A noncomputable `has_inv` instance  -/

/-- The inverse of a square matrix, when it is invertible (and zero otherwise).-/
noncomputable instance : has_inv (matrix n n α) := ⟨λ A, ring.inverse A.det • A.adjugate⟩

lemma inv_def (A : matrix n n α) : A⁻¹ = ring.inverse A.det • A.adjugate := rfl

lemma nonsing_inv_apply_not_is_unit (h : ¬ is_unit A.det) :
  A⁻¹ = 0 :=
by rw [inv_def, ring.inverse_non_unit _ h, zero_smul]

lemma nonsing_inv_apply (h : is_unit A.det) :
  A⁻¹ = (↑h.unit⁻¹ : α) • A.adjugate :=
by rw [inv_def, ←ring.inverse_unit h.unit, is_unit.unit_spec]

/-- The nonsingular inverse is the same as `inv_of` when `A` is invertible. -/
@[simp] lemma inv_of_eq_nonsing_inv [invertible A] : ⅟A = A⁻¹ :=
begin
  letI := det_invertible_of_invertible A,
  rw [inv_def, ring.inverse_invertible, inv_of_eq],
end

/-- Coercing the result of `units.has_inv` is the same as coercing first and applying the
nonsingular inverse. -/
@[simp, norm_cast] lemma coe_units_inv (A : (matrix n n α)ˣ) :
  ↑(A⁻¹) = (A⁻¹ : matrix n n α) :=
begin
  letI := A.invertible,
  rw [←inv_of_eq_nonsing_inv, inv_of_units],
end

/-- The nonsingular inverse is the same as the general `ring.inverse`. -/
lemma nonsing_inv_eq_ring_inverse : A⁻¹ = ring.inverse A :=
begin
  by_cases h_det : is_unit A.det,
  { casesI (A.is_unit_iff_is_unit_det.mpr h_det).nonempty_invertible,
    rw [←inv_of_eq_nonsing_inv, ring.inverse_invertible], },
  { have h := mt A.is_unit_iff_is_unit_det.mp h_det,
    rw [ring.inverse_non_unit _ h, nonsing_inv_apply_not_is_unit A h_det], },
end

lemma transpose_nonsing_inv : (A⁻¹)ᵀ = (Aᵀ)⁻¹ :=
by rw [inv_def, inv_def, transpose_smul, det_transpose, adjugate_transpose]

lemma conj_transpose_nonsing_inv [star_ring α] : (A⁻¹)ᴴ = (Aᴴ)⁻¹ :=
by rw [inv_def, inv_def, conj_transpose_smul, det_conj_transpose, adjugate_conj_transpose,
       ring.inverse_star]

/-- The `nonsing_inv` of `A` is a right inverse. -/
@[simp] lemma mul_nonsing_inv (h : is_unit A.det) : A ⬝ A⁻¹ = 1 :=
begin
  casesI (A.is_unit_iff_is_unit_det.mpr h).nonempty_invertible,
  rw [←inv_of_eq_nonsing_inv, matrix.mul_inv_of_self],
end

/-- The `nonsing_inv` of `A` is a left inverse. -/
@[simp] lemma nonsing_inv_mul (h : is_unit A.det) : A⁻¹ ⬝ A = 1 :=
begin
  casesI (A.is_unit_iff_is_unit_det.mpr h).nonempty_invertible,
  rw [←inv_of_eq_nonsing_inv, matrix.inv_of_mul_self],
end

@[simp] lemma mul_inv_of_invertible [invertible A] : A ⬝ A⁻¹ = 1 :=
mul_nonsing_inv A (is_unit_det_of_invertible A)

@[simp] lemma inv_mul_of_invertible [invertible A] : A⁻¹ ⬝ A = 1 :=
nonsing_inv_mul A (is_unit_det_of_invertible A)

lemma nonsing_inv_cancel_or_zero :
  (A⁻¹ ⬝ A = 1 ∧ A ⬝ A⁻¹ = 1) ∨ A⁻¹ = 0 :=
begin
  by_cases h : is_unit A.det,
  { exact or.inl ⟨nonsing_inv_mul _ h, mul_nonsing_inv _ h⟩ },
  { exact or.inr (nonsing_inv_apply_not_is_unit _ h) }
end

lemma det_nonsing_inv_mul_det (h : is_unit A.det) : A⁻¹.det * A.det = 1 :=
by rw [←det_mul, A.nonsing_inv_mul h, det_one]

@[simp] lemma det_nonsing_inv : A⁻¹.det = ring.inverse A.det :=
begin
  by_cases h : is_unit A.det,
  { casesI h.nonempty_invertible, letI := invertible_of_det_invertible A,
    rw [ring.inverse_invertible, ←inv_of_eq_nonsing_inv, det_inv_of] },
  casesI is_empty_or_nonempty n,
  { rw [det_is_empty, det_is_empty, ring.inverse_one] },
  { rw [ring.inverse_non_unit _ h, nonsing_inv_apply_not_is_unit _ h, det_zero ‹_›] },
end

lemma is_unit_nonsing_inv_det (h : is_unit A.det) : is_unit A⁻¹.det :=
is_unit_of_mul_eq_one _ _ (A.det_nonsing_inv_mul_det h)

@[simp] lemma nonsing_inv_nonsing_inv (h : is_unit A.det) : (A⁻¹)⁻¹ = A :=
calc (A⁻¹)⁻¹ = 1 ⬝ (A⁻¹)⁻¹        : by rw matrix.one_mul
         ... = A ⬝ A⁻¹ ⬝ (A⁻¹)⁻¹  : by rw A.mul_nonsing_inv h
         ... = A                  : by { rw [matrix.mul_assoc,
                                         (A⁻¹).mul_nonsing_inv (A.is_unit_nonsing_inv_det h),
                                         matrix.mul_one], }

lemma is_unit_nonsing_inv_det_iff {A : matrix n n α} :
  is_unit A⁻¹.det ↔ is_unit A.det :=
by rw [matrix.det_nonsing_inv, is_unit_ring_inverse]

/- `is_unit.invertible` lifts the proposition `is_unit A` to a constructive inverse of `A`. -/

/-- A version of `matrix.invertible_of_det_invertible` with the inverse defeq to `A⁻¹` that is
therefore noncomputable. -/
noncomputable def invertible_of_is_unit_det (h : is_unit A.det) : invertible A :=
⟨A⁻¹, nonsing_inv_mul A h, mul_nonsing_inv A h⟩

/-- A version of `matrix.units_of_det_invertible` with the inverse defeq to `A⁻¹` that is therefore
noncomputable. -/
noncomputable def nonsing_inv_unit (h : is_unit A.det) : (matrix n n α)ˣ :=
@unit_of_invertible _ _ _ (invertible_of_is_unit_det A h)

lemma unit_of_det_invertible_eq_nonsing_inv_unit [invertible A.det] :
  unit_of_det_invertible A = nonsing_inv_unit A (is_unit_of_invertible _) :=
by { ext, refl }

variables {A} {B}

/-- If matrix A is left invertible, then its inverse equals its left inverse. -/
lemma inv_eq_left_inv (h : B ⬝ A = 1) : A⁻¹ = B :=
begin
  letI := invertible_of_left_inverse _ _ h,
  exact inv_of_eq_nonsing_inv A ▸ inv_of_eq_left_inv h,
end

/-- If matrix A is right invertible, then its inverse equals its right inverse. -/
lemma inv_eq_right_inv (h : A ⬝ B = 1) : A⁻¹ = B :=
inv_eq_left_inv (mul_eq_one_comm.2 h)

section inv_eq_inv

variables {C : matrix n n α}

/-- The left inverse of matrix A is unique when existing. -/

/-- The right inverse of matrix A is unique when existing. -/
lemma right_inv_eq_right_inv (h : A ⬝ B = 1) (g : A ⬝ C = 1) : B = C :=
by rw [←inv_eq_right_inv h, ←inv_eq_right_inv g]

/-- The right inverse of matrix A equals the left inverse of A when they exist. -/
lemma right_inv_eq_left_inv (h : A ⬝ B = 1) (g : C ⬝ A = 1) : B = C :=
by rw [←inv_eq_right_inv h, ←inv_eq_left_inv g]

lemma inv_inj (h : A⁻¹ = B⁻¹) (h' : is_unit A.det) : A = B :=
begin
  refine left_inv_eq_left_inv (mul_nonsing_inv _ h') _,
  rw h,
  refine mul_nonsing_inv _ _,
  rwa [←is_unit_nonsing_inv_det_iff, ←h, is_unit_nonsing_inv_det_iff]
end

end inv_eq_inv

variable (A)

@[simp] lemma inv_zero : (0 : matrix n n α)⁻¹ = 0 :=
begin
  casesI (subsingleton_or_nontrivial α) with ht ht,
  { simp },
  cases (fintype.card n).zero_le.eq_or_lt with hc hc,
  { rw [eq_comm, fintype.card_eq_zero_iff] at hc,
    haveI := hc,
    ext i,
    exact (is_empty.false i).elim },
  { have hn : nonempty n := fintype.card_pos_iff.mp hc,
    refine nonsing_inv_apply_not_is_unit _ _,
    simp [hn] },
end

@[simp] lemma inv_one : (1 : matrix n n α)⁻¹ = 1 :=
inv_eq_left_inv (by simp)

lemma inv_smul (k : α) [invertible k] (h : is_unit A.det) : (k • A)⁻¹ = ⅟k • A⁻¹ :=
inv_eq_left_inv (by simp [h, smul_smul])

lemma inv_smul' (k : αˣ) (h : is_unit A.det) : (k • A)⁻¹ = k⁻¹ • A⁻¹ :=
inv_eq_left_inv (by simp [h, smul_smul])

lemma inv_adjugate (A : matrix n n α) (h : is_unit A.det) :
  (adjugate A)⁻¹ = h.unit⁻¹ • A :=
begin
  refine inv_eq_left_inv _,
  rw [smul_mul, mul_adjugate, units.smul_def, smul_smul, h.coe_inv_mul, one_smul]
end

@[simp] lemma inv_inv_inv (A : matrix n n α) : A⁻¹⁻¹⁻¹ = A⁻¹ :=
begin
  by_cases h : is_unit A.det,
  { rw [nonsing_inv_nonsing_inv _ h] },
  { simp [nonsing_inv_apply_not_is_unit _ h] }
end

lemma mul_inv_rev (A B : matrix n n α) : (A ⬝ B)⁻¹ = B⁻¹ ⬝ A⁻¹ :=
begin
  simp only [inv_def],
  rw [matrix.smul_mul, matrix.mul_smul, smul_smul, det_mul, adjugate_mul_distrib,
    ring.mul_inverse_rev],
end

/-- A version of `list.prod_inv_reverse` for `matrix.has_inv`. -/
lemma list_prod_inv_reverse : ∀ l : list (matrix n n α), l.prod⁻¹ = (l.reverse.map has_inv.inv).prod
| [] := by rw [list.reverse_nil, list.map_nil, list.prod_nil, inv_one]
| (A :: Xs) := by rw [list.reverse_cons', list.map_concat, list.prod_concat, list.prod_cons,
                      matrix.mul_eq_mul, matrix.mul_eq_mul, mul_inv_rev, list_prod_inv_reverse]

/-- One form of **Cramer's rule**. See `matrix.mul_vec_cramer` for a stronger form. -/
@[simp] lemma det_smul_inv_mul_vec_eq_cramer (A : matrix n n α) (b : n → α) (h : is_unit A.det) :
  A.det • A⁻¹.mul_vec b = cramer A b :=
begin
  rw [cramer_eq_adjugate_mul_vec, A.nonsing_inv_apply h, ← smul_mul_vec_assoc,
      smul_smul, h.mul_coe_inv, one_smul]
end

/-- One form of **Cramer's rule**. See `matrix.mul_vec_cramer` for a stronger form. -/
@[simp] lemma det_smul_inv_vec_mul_eq_cramer_transpose
  (A : matrix n n α) (b : n → α) (h : is_unit A.det) :
  A.det • A⁻¹.vec_mul b = cramer Aᵀ b :=
by rw [← (A⁻¹).transpose_transpose, vec_mul_transpose, transpose_nonsing_inv, ← det_transpose,
    Aᵀ.det_smul_inv_mul_vec_eq_cramer _ (is_unit_det_transpose A h)]

/-! ### More results about determinants -/

/-- A variant of `matrix.det_units_conj`. -/
lemma det_conj {M : matrix m m α} (h : is_unit M) (N : matrix m m α) :
  det (M ⬝ N ⬝ M⁻¹) = det N :=
by rw [←h.unit_spec, ←coe_units_inv, det_units_conj]

/-- A variant of `matrix.det_units_conj'`. -/
lemma det_conj' {M : matrix m m α} (h : is_unit M) (N : matrix m m α) :
  det (M⁻¹ ⬝ N ⬝ M) = det N :=
by rw [←h.unit_spec, ←coe_units_inv, det_units_conj']

/-- Determinant of a 2×2 block matrix, expanded around an invertible top left element in terms of
the Schur complement. -/
lemma det_from_blocks₁₁ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
  [invertible A] : (matrix.from_blocks A B C D).det = det A * det (D - C ⬝ (⅟A) ⬝ B) :=
begin
  have : from_blocks A B C D =
    from_blocks 1 0 (C ⬝ ⅟A) 1 ⬝ from_blocks A 0 0 (D - C ⬝ (⅟A) ⬝ B) ⬝ from_blocks 1 (⅟A ⬝ B) 0 1,
  { simp only [from_blocks_multiply, matrix.mul_zero, matrix.zero_mul, add_zero, zero_add,
      matrix.one_mul, matrix.mul_one, matrix.inv_of_mul_self, matrix.mul_inv_of_self_assoc,
        matrix.mul_inv_of_mul_self_cancel, matrix.mul_assoc, add_sub_cancel'_right] },
  rw [this, det_mul, det_mul, det_from_blocks_zero₂₁, det_from_blocks_zero₂₁,
    det_from_blocks_zero₁₂, det_one, det_one, one_mul, one_mul, mul_one],
end

@[simp] lemma det_from_blocks_one₁₁ (B : matrix m n α) (C : matrix n m α) (D : matrix n n α) :
  (matrix.from_blocks 1 B C D).det = det (D - C ⬝ B) :=
begin
  haveI : invertible (1 : matrix m m α) := invertible_one,
  rw [det_from_blocks₁₁, inv_of_one, matrix.mul_one, det_one, one_mul],
end

/-- Determinant of a 2×2 block matrix, expanded around an invertible bottom right element in terms
of the Schur complement. -/
lemma det_from_blocks₂₂ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
  [invertible D] : (matrix.from_blocks A B C D).det = det D * det (A - B ⬝ (⅟D) ⬝ C) :=
begin
  have : from_blocks A B C D = (from_blocks D C B A).minor (sum_comm _ _) (sum_comm _ _),
  { ext i j,
    cases i; cases j; refl },
  rw [this, det_minor_equiv_self, det_from_blocks₁₁],
end

@[simp] lemma det_from_blocks_one₂₂ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) :
  (matrix.from_blocks A B C 1).det = det (A - B ⬝ C) :=
begin
  haveI : invertible (1 : matrix n n α) := invertible_one,
  rw [det_from_blocks₂₂, inv_of_one, matrix.mul_one, det_one, one_mul],
end

/-- The **Weinstein–Aronszajn identity**. Note the `1` on the LHS is of shape m×m, while the `1` on
the RHS is of shape n×n. -/
lemma det_one_add_mul_comm (A : matrix m n α) (B : matrix n m α) :
  det (1 + A ⬝ B) = det (1 + B ⬝ A) :=
calc  det (1 + A ⬝ B)
    = det (from_blocks 1 (-A) B 1) : by rw [det_from_blocks_one₂₂, matrix.neg_mul, sub_neg_eq_add]
... = det (1 + B ⬝ A)              : by rw [det_from_blocks_one₁₁, matrix.mul_neg, sub_neg_eq_add]

/-- Alternate statement of the **Weinstein–Aronszajn identity** -/
lemma det_mul_add_one_comm (A : matrix m n α) (B : matrix n m α) :
  det (A ⬝ B + 1) = det (B ⬝ A + 1) :=
by rw [add_comm, det_one_add_mul_comm, add_comm]

lemma det_one_sub_mul_comm (A : matrix m n α) (B : matrix n m α) :
  det (1 - A ⬝ B) = det (1 - B ⬝ A) :=
by rw [sub_eq_add_neg, ←matrix.neg_mul, det_one_add_mul_comm, matrix.mul_neg, ←sub_eq_add_neg]

/-- A special case of the **Matrix determinant lemma** for when `A = I`.

TODO: show this more generally. -/
lemma det_one_add_col_mul_row (u v : m → α) : det (1 + col u ⬝ row v) = 1 + v ⬝ᵥ u :=
by rw [det_one_add_mul_comm, det_unique, pi.add_apply, pi.add_apply, matrix.one_apply_eq,
       matrix.row_mul_col_apply]

end matrix


import data.real.basic
open function
open real

/-
Classic eps-delta definition of continuity.
Use it to prove continuity at one point for a simple function.
To be proved equivalent to topological definition in topology world.

Work in progress.
-/

notation `|` x `|` := abs x

def continuous_at_x (f : ℝ → ℝ) (x : ℝ) :=
    ∀ ε : ℝ, 0 < ε → ∃ δ : ℝ, 0 < δ ∧ ∀ y : ℝ, |x - y| < δ → |f x - f y| < ε
def square_f (x : ℝ) := x^2

/- Lemma
The function $f(x) = x^2$ is continuous at $x=3$.
-/
lemma square_continuous_at_3 : continuous_at_x square_f (3:ℝ) :=
begin
    intros ε hε,
    set d := min (1:ℝ) (ε/7) with hdefd,
    use d,
    split,
    { -- prove this d is positive
        have h1 : 0 < (1:ℝ), linarith,
        have h2 : 0 < (ε/7), linarith,
        simp, split, exact h1, exact h2,
    },
    intros y hy,
    unfold square_f,
    have H : 3^2 - y^2 = (3-y)*(3+y), ring,
    have G : | 3^2 - y^2 | = | (3-y)*(3+y) |, rw H,
    have F : | (3-y)*(3+y) | = |3-y| * |3+y|, exact abs_mul _ _,
    rw F at G, rw G,
    have h1 := abs_lt.1 hy,
    cases h1 with h11 h12,
    have h1y : y < 3 + d, linarith,
    have h2y : 3 - d < y, linarith,
    have hdd : d ≤ 1, exact min_le_left (1:ℝ) (ε/7),
    have h3y : y < 4, linarith,
    have h4y : 2 < y, linarith,
    have h44 : 0 < |3+y|,
        have h45 : 0 < 3 + y, linarith,
        have h46 := abs_of_pos h45,
        rw ← h46 at h45, exact h45,
    have h5y :=  (mul_lt_mul_right h44).mpr hy,
    have h6y : 3+y < 7, linarith,
    have h7y : |3+y| < 7,
        have h45 : 0 < 3 + y, linarith, --reusing, should only do once
        have h46 := abs_of_pos h45,
        rw ← h46 at h6y, exact h6y,
    -- I shouldn't need to prove this twice, how to fix?
    have hd : 0 < d,
    { -- prove this d is positive
        have h1 : 0 < (1:ℝ), linarith,
        have h2 : 0 < (ε/7), linarith,
        simp, split, exact h1, exact h2,
    },
    have D := (mul_lt_mul_right hd).mpr h7y,
    rw mul_comm at D, rw mul_comm 7 d at D,
    have h9y : |3 - y| * |3 + y| <  d * 7, linarith,
    have h10y : d ≤ (ε/7), exact min_le_right (1:ℝ) (ε/7),
    have h11y : |3 - y| * |3 + y| < (ε/7) * 7, linarith,
    have h12y : (ε/7) * 7 = ε, linarith,
    rw h12y at h11y, exact h11y,
end


import SciLean.Basic
import SciLean.Tactic
-- import Lean

-- open Lean
-- open Lean.Meta

set_option synthInstance.maxHeartbeats 5000
-- set_option synthInstance.maxSize 1000

-- set_option trace.Meta.Tactic.simp true
-- set_option trace.Meta.synthInstance true

namespace SciLean.NDVector.Tests

section NDVector

  variable {α β γ : Type}
  variable {X Y Z : Type} [Vec X] [Vec Y] [Vec Z]

  variable {dims} (x dx : NDVector dims) (i : Fin dims.product)
  example : ∂ (λ x => x[i]) x dx = dx[i] := by simp done
  example : ∂ (λ x => x[i]*x[i]) x dx = dx[i]*x[i] + x[i]*dx[i] := by simp done
  example : ∂ (λ x i => x[i]*x[i]) x dx i = dx[i]*x[i] + x[i]*dx[i] := by simp done

  example : Vec (NDVector dims) := by infer_instance
  example : Hilbert (NDVector dims) := by infer_instance

  example : (λ x : NDVector dims => sum fun i => getOp x i)† 1 = (lmk fun i => 1) := by autoadjoint done
  example (a : Fin _) [NonZero dims.product] : (fun (x : NDVector dims) i => x[i - a])† = (fun x => lmk fun i => x (i + a)) := by autoadjoint done
  example (x : NDVector dims) (i) : (fun (y : NDVector dims) => y[i] * x[i])† 1 = (lmk (λ j => (kron i j) * x[i])) := by autoadjoint simp done

  example (x) : gradient (λ (x : ℝ) => x) x = 1 := by autograd done
  example : ∇ (λ (x : NDVector dims) => x[i]) x = (lmk fun j => kron i j) := by autograd done
  example {dims} (i) (x : NDVector dims) : ∇ (λ (x : NDVector dims) => x[i]) x = lmk (kron i) := by autograd done
  example {dims} (i) (x : NDVector dims) : ∇ (λ (x : NDVector dims) => x[i]*x[i]) x = ((2 : ℝ) * lmk fun j => kron i j * x[i]) := by autograd done

end NDVector


import data.real.basic
import tactic
-- import C_Limits.fae_solutions.Course
-- open vilnius

namespace vilnius

local notation `|` x `|` := abs x

-- Recall the
definition is_limit (a : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

example {a : ℕ → ℝ} {l : ℝ} (c : ℝ) (ha : is_limit a l) :
  is_limit (λ i, a i + c) (l + c) :=
begin
  sorry,
end

example (a : ℕ → ℝ) (l : ℝ) :
  is_limit a l ↔ is_limit (λ i, a i - l) 0 :=
begin
  sorry,
end

/- Helpful things:
`abs_pos : 0 < |a| ↔ a ≠ 0`
`div_pos : 0 < a → 0 < b → 0 < a / b`
`abs_mul x y : |x * y| = |x| * |y|`
`lt_div_iff' : 0 < c → (a < b / c ↔ c * a < b)`
I typically find these things myself with a combination of
the "guess the name of the lemma" game (and ctrl-space).

Recall also that we have proved the-/
theorem is_limit_add {a b : ℕ → ℝ} {l m : ℝ}
  (h1 : is_limit a l) (h2 : is_limit b m) :
  is_limit (a + b) (l + m) := sorry

-- And now, over to you!

-- A hint for starting:
-- It might be worth dealing with `c = 0` as a special case. You
-- can start with
-- `by_cases hc : c = 0`

theorem is_limit_mul_const_left {a : ℕ → ℝ} {l c : ℝ} (h : is_limit a l) :
  is_limit (λ n, c * (a n)) (c * l) :=
begin
  sorry,
end

theorem sandwich (a b c : ℕ → ℝ)
  (l : ℝ) (ha : is_limit a l) (hc : is_limit c l)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) : is_limit b l :=
begin
  sorry,
end

example (a : ℕ → ℝ) (b : ℕ → ℝ) (α β c d : ℝ)
    (ha : is_limit a α) (hb : is_limit b β) :
    is_limit ( λ n, c * (a n) + d * (b n) ) (c * α + d * β) :=
begin
  -- intros ε hε,**BAD IDEA**, you can do this much faster using the above theorems!
  sorry,
end

example (a : ℕ → ℝ) (b : ℕ → ℝ)
  (l : ℝ) (m : ℝ) (hl : is_limit a l) (hm : is_limit b m)
  (hle : ∀ n, a n ≤ b n) : l ≤ m :=
begin
  sorry,
end

end vilnius


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div

namespace Nat

private def gcdF (x : Nat) : (∀ x₁, x₁ < x → Nat → Nat) → Nat → Nat :=
  match x with
  | 0      => fun _ y => y
  | succ x => fun f y => f (y % succ x) (mod_lt _ (zero_lt_succ  _)) (succ x)

@[extern "lean_nat_gcd"]
def gcd (a b : @& Nat) : Nat :=
  WellFounded.fix (measure id).wf gcdF a b

@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y :=
  rfl

theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
  rfl

@[simp] theorem gcd_one_left (n : Nat) : gcd 1 n = 1 := by
  rw [gcd_succ, mod_one]
  rfl

@[simp] theorem gcd_zero_right (n : Nat) : gcd n 0 = n := by
  cases n <;> simp [gcd_succ]

@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
  cases n <;> simp [gcd_succ]

end Nat


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import set_theory.continuum
import analysis.specific_limits
import data.rat.denumerable
import data.set.intervals.image_preimage

/-!
# The cardinality of the reals

This file shows that the real numbers have cardinality continuum, i.e. `#ℝ = 𝔠`.

We show that `#ℝ ≤ 𝔠` by noting that every real number is determined by a Cauchy-sequence of the
form `ℕ → ℚ`, which has cardinality `𝔠`. To show that `#ℝ ≥ 𝔠` we define an injection from
`{0, 1} ^ ℕ` to `ℝ` with `f ↦ Σ n, f n * (1 / 3) ^ n`.

We conclude that all intervals with distinct endpoints have cardinality continuum.

## Main definitions

* `cardinal.cantor_function` is the function that sends `f` in `{0, 1} ^ ℕ` to `ℝ` by
  `f ↦ Σ' n, f n * (1 / 3) ^ n`

## Main statements

* `cardinal.mk_real : #ℝ = 𝔠`: the reals have cardinality continuum.
* `cardinal.not_countable_real`: the universal set of real numbers is not countable.
  We can use this same proof to show that all the other sets in this file are not countable.
* 8 lemmas of the form `mk_Ixy_real` for `x,y ∈ {i,o,c}` state that intervals on the reals
  have cardinality continuum.

## Notation

* `𝔠` : notation for `cardinal.continuum` in locale `cardinal`, defined in `set_theory.continuum`.

## Tags
continuum, cardinality, reals, cardinality of the reals
-/

open nat set
open_locale cardinal
noncomputable theory

namespace cardinal

variables {c : ℝ} {f g : ℕ → bool} {n : ℕ}

/-- The body of the sum in `cantor_function`.
`cantor_function_aux c f n = c ^ n` if `f n = tt`;
`cantor_function_aux c f n = 0` if `f n = ff`. -/
def cantor_function_aux (c : ℝ) (f : ℕ → bool) (n : ℕ) : ℝ := cond (f n) (c ^ n) 0

@[simp] lemma cantor_function_aux_tt (h : f n = tt) : cantor_function_aux c f n = c ^ n :=
by simp [cantor_function_aux, h]

@[simp] lemma cantor_function_aux_ff (h : f n = ff) : cantor_function_aux c f n = 0 :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_nonneg (h : 0 ≤ c) : 0 ≤ cantor_function_aux c f n :=
by { cases h' : f n; simp [h'], apply pow_nonneg h }

lemma cantor_function_aux_eq (h : f n = g n) :
  cantor_function_aux c f n = cantor_function_aux c g n :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_succ (f : ℕ → bool) :
  (λ n, cantor_function_aux c f (n + 1)) = λ n, c * cantor_function_aux c (λ n, f (n + 1)) n :=
by { ext n, cases h : f (n + 1); simp [h, pow_succ] }

lemma summable_cantor_function (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  summable (cantor_function_aux c f) :=
begin
  apply (summable_geometric_of_lt_1 h1 h2).summable_of_eq_zero_or_self,
  intro n, cases h : f n; simp [h]
end

/-- `cantor_function c (f : ℕ → bool)` is `Σ n, f n * c ^ n`, where `tt` is interpreted as `1` and
`ff` is interpreted as `0`. It is implemented using `cantor_function_aux`. -/
def cantor_function (c : ℝ) (f : ℕ → bool) : ℝ := ∑' n, cantor_function_aux c f n

lemma cantor_function_le (h1 : 0 ≤ c) (h2 : c < 1) (h3 : ∀ n, f n → g n) :
  cantor_function c f ≤ cantor_function c g :=
begin
  apply tsum_le_tsum _ (summable_cantor_function f h1 h2) (summable_cantor_function g h1 h2),
  intro n, cases h : f n, simp [h, cantor_function_aux_nonneg h1],
  replace h3 : g n = tt := h3 n h, simp [h, h3]
end

lemma cantor_function_succ (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  cantor_function c f = cond (f 0) 1 0 + c * cantor_function c (λ n, f (n+1)) :=
begin
  rw [cantor_function, tsum_eq_zero_add (summable_cantor_function f h1 h2)],
  rw [cantor_function_aux_succ, tsum_mul_left, cantor_function_aux, pow_zero],
  refl
end

/-- `cantor_function c` is strictly increasing with if `0 < c < 1/2`, if we endow `ℕ → bool` with a
lexicographic order. The lexicographic order doesn't exist for these infinitary products, so we
explicitly write out what it means. -/
lemma increasing_cantor_function (h1 : 0 < c) (h2 : c < 1 / 2) {n : ℕ} {f g : ℕ → bool}
  (hn : ∀(k < n), f k = g k) (fn : f n = ff) (gn : g n = tt) :
  cantor_function c f < cantor_function c g :=
begin
  have h3 : c < 1, { apply h2.trans, norm_num },
  induction n with n ih generalizing f g,
  { let f_max : ℕ → bool := λ n, nat.rec ff (λ _ _, tt) n,
    have hf_max : ∀n, f n → f_max n,
    { intros n hn, cases n, rw [fn] at hn, contradiction, apply rfl },
    let g_min : ℕ → bool := λ n, nat.rec tt (λ _ _, ff) n,
    have hg_min : ∀n, g_min n → g n,
    { intros n hn, cases n, rw [gn], apply rfl, contradiction },
    apply (cantor_function_le (le_of_lt h1) h3 hf_max).trans_lt,
    refine lt_of_lt_of_le _ (cantor_function_le (le_of_lt h1) h3 hg_min),
    have : c / (1 - c) < 1,
    { rw [div_lt_one, lt_sub_iff_add_lt],
      { convert add_lt_add h2 h2, norm_num },
      rwa sub_pos },
    convert this,
    { rw [cantor_function_succ _ (le_of_lt h1) h3, div_eq_mul_inv,
          ←tsum_geometric_of_lt_1 (le_of_lt h1) h3],
      apply zero_add },
    { convert tsum_eq_single 0 _,
      { apply_instance },
      { intros n hn, cases n, contradiction, refl } } },
  rw [cantor_function_succ f (le_of_lt h1) h3, cantor_function_succ g (le_of_lt h1) h3],
  rw [hn 0 $ zero_lt_succ n],
  apply add_lt_add_left, rw mul_lt_mul_left h1, exact ih (λ k hk, hn _ $ succ_lt_succ hk) fn gn
end

/-- `cantor_function c` is injective if `0 < c < 1/2`. -/
lemma cantor_function_injective (h1 : 0 < c) (h2 : c < 1 / 2) :
  function.injective (cantor_function c) :=
begin
  intros f g hfg, classical, by_contra h, revert hfg,
  have : ∃n, f n ≠ g n,
  { rw [←not_forall], intro h', apply h, ext, apply h' },
  let n := nat.find this,
  have hn : ∀ (k : ℕ), k < n → f k = g k,
  { intros k hk, apply of_not_not, exact nat.find_min this hk },
  cases fn : f n,
  { apply ne_of_lt, refine increasing_cantor_function h1 h2 hn fn _,
    apply eq_tt_of_not_eq_ff, rw [←fn], apply ne.symm, exact nat.find_spec this },
  { apply ne_of_gt, refine increasing_cantor_function h1 h2 (λ k hk, (hn k hk).symm) _ fn,
    apply eq_ff_of_not_eq_tt, rw [←fn], apply ne.symm, exact nat.find_spec this }
end

/-- The cardinality of the reals, as a type. -/
lemma mk_real : #ℝ = 𝔠 :=
begin
  apply le_antisymm,
  { rw real.equiv_Cauchy.cardinal_eq,
    apply mk_quotient_le.trans, apply (mk_subtype_le _).trans_eq,
    rw [← power_def, mk_nat, mk_rat, omega_power_omega] },
  { convert mk_le_of_injective (cantor_function_injective _ _),
    rw [←power_def, mk_bool, mk_nat, two_power_omega], exact 1 / 3, norm_num, norm_num }
end

/-- The cardinality of the reals, as a set. -/
lemma mk_univ_real : #(set.univ : set ℝ) = 𝔠 :=
by rw [mk_univ, mk_real]

/-- **Non-Denumerability of the Continuum**: The reals are not countable. -/
lemma not_countable_real : ¬ countable (set.univ : set ℝ) :=
by { rw [← mk_set_le_omega, not_le, mk_univ_real], apply cantor }

/-- The cardinality of the interval (a, ∞). -/
lemma mk_Ioi_real (a : ℝ) : #(Ioi a) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  rw [← not_lt], intro h,
  refine ne_of_lt _ mk_univ_real,
  have hu : Iio a ∪ {a} ∪ Ioi a = set.univ,
  { convert Iic_union_Ioi, exact Iio_union_right },
  rw ← hu,
  refine lt_of_le_of_lt (mk_union_le _ _) _,
  refine lt_of_le_of_lt (add_le_add_right (mk_union_le _ _) _) _,
  have h2 : (λ x, a + a - x) '' Ioi a = Iio a,
  { convert image_const_sub_Ioi _ _, simp },
  rw ← h2,
  refine add_lt_of_lt (cantor _).le _ h,
  refine add_lt_of_lt (cantor _).le (mk_image_le.trans_lt h) _,
  rw mk_singleton,
  exact one_lt_omega.trans (cantor _)
end

/-- The cardinality of the interval [a, ∞). -/
lemma mk_Ici_real (a : ℝ) : #(Ici a) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioi_real a ▸ mk_le_mk_of_subset Ioi_subset_Ici_self)

/-- The cardinality of the interval (-∞, a). -/
lemma mk_Iio_real (a : ℝ) : #(Iio a) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h2 : (λ x, a + a - x) '' Iio a = Ioi a,
  { convert image_const_sub_Iio _ _, simp },
  exact mk_Ioi_real a ▸ h2 ▸ mk_image_le
end

/-- The cardinality of the interval (-∞, a]. -/
lemma mk_Iic_real (a : ℝ) : #(Iic a) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Iio_real a ▸ mk_le_mk_of_subset Iio_subset_Iic_self)

/-- The cardinality of the interval (a, b). -/
lemma mk_Ioo_real {a b : ℝ} (h : a < b) : #(Ioo a b) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h1 : #((λ x, x - a) '' Ioo a b) ≤ #(Ioo a b) := mk_image_le,
  refine le_trans _ h1,
  rw [image_sub_const_Ioo, sub_self],
  replace h := sub_pos_of_lt h,
  have h2 : #(has_inv.inv '' Ioo 0 (b - a)) ≤ #(Ioo 0 (b - a)) := mk_image_le,
  refine le_trans _ h2,
  rw [image_inv_Ioo_0_left h, mk_Ioi_real]
end

/-- The cardinality of the interval [a, b). -/

/-- The cardinality of the interval [a, b]. -/
lemma mk_Icc_real {a b : ℝ} (h : a < b) : #(Icc a b) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Icc_self)

/-- The cardinality of the interval (a, b]. -/
lemma mk_Ioc_real {a b : ℝ} (h : a < b) : #(Ioc a b) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Ioc_self)

end cardinal


/-
  Presheaf (of types).

  https://stacks.math.columbia.edu/tag/006D
-/

import topology.basic
import topology.opens

universes u v

-- Definition of a presheaf.

open topological_space lattice

structure presheaf (α : Type u) [topological_space α] :=
(F     : opens α → Type v)
(res   : ∀ (U V) (HVU : V ⊆ U), F U → F V)
(Hid   : ∀ (U), res U U (set.subset.refl U) = id)
(Hcomp : ∀ (U V W) (HWV : W ⊆ V) (HVU : V ⊆ U),
  res U W (set.subset.trans HWV HVU) = res V W HWV ∘ res U V HVU)

namespace presheaf

variables {α : Type u} [topological_space α]

instance : has_coe_to_fun (presheaf α) :=
{ F := λ _, opens α → Type v,
  coe := presheaf.F }

-- Simplification lemmas for Hid and Hcomp.

@[simp] lemma Hcomp' (F : presheaf α) :
∀ (U V W) (HWV : W ⊆ V) (HVU : V ⊆ U) (s : F U),
  (F.res U W (set.subset.trans HWV HVU)) s =
  (F.res V W HWV) ((F.res U V HVU) s) :=
λ U V W HWV HVU s, by rw F.Hcomp U V W HWV HVU

@[simp] lemma Hid' (F : presheaf α) :
∀ (U) (s : F U),
  (F.res U U (set.subset.refl U)) s = s :=
λ U s, by rw F.Hid U; simp

-- Morphism of presheaves.

structure morphism (F G : presheaf α) :=
(map      : ∀ (U), F U → G U)
(commutes : ∀ (U V) (HVU : V ⊆ U),
  (G.res U V HVU) ∘ (map U) = (map V) ∘ (F.res U V HVU))

infix `⟶`:80 := morphism

section morphism

def comp {F G H : presheaf α} (fg : F ⟶ G) (gh : G ⟶ H) : F ⟶ H :=
{ map := λ U, gh.map U ∘ fg.map U,
  commutes := λ U V HVU,
    begin
      rw [←function.comp.assoc, gh.commutes U V HVU], symmetry,
      rw [function.comp.assoc, ←fg.commutes U V HVU]
    end }

infix `⊚`:80 := comp

def id (F : presheaf α) : F ⟶ F :=
{ map := λ U, id,
  commutes := λ U V HVU, by simp, }

structure iso (F G : presheaf α) :=
(mor : F ⟶ G)
(inv : G ⟶ F)
(mor_inv_id : mor ⊚ inv = id F)
(inv_mor_id : inv ⊚ mor = id G)

infix `≅`:80 := λ A B, nonempty (iso A B)

end morphism

-- Equality lemma

lemma presheaf_eq_of_subset_eq (F : presheaf α) (U V : opens α)
: U = V → F U = F V :=
λ h, by rw h

end presheaf