/-
Fichier pour les définitions génériques qui ne sont pas liées aux groupes mais peuvent être utiles
-/
namespace generique

def Union {α : Type*} {I : Type*} (F : I → set α) : set α :=
  {x | ∃ i, x ∈ F i}

def Inter {α : Type*} {I : Type*} (F : I → set α) : set α :=
  {x | ∀ i, x ∈ F i}

notation `⋃` binders `,` expr_i:(scoped f, Union f) := expr_i
notation `⋂` binders `,` expr_i:(scoped f, Inter f) := expr_i

instance {α : Type*} : has_subset (set α) :=
  ⟨λ A B, ∀ a ∈ A, a ∈ B ⟩
instance {α : Type*} : has_union (set α) :=
  ⟨λ A B, {x | x ∈ A ∨ x ∈ B}⟩
instance {α : Type*} : has_inter (set α) :=
  ⟨λ A B, {x | x ∈ A ∧ x ∈ B}⟩

def prod_all {α : Type*} {β : Type*} [has_mul β] [has_one β] : (list α) → (α → β) →  β
  | [] _ := (1 : β)
  | (a :: l) F := (F a) * prod_all l F

lemma mul_prod_of_concat {α: Type*} {β : Type*} [has_mul β] [has_one β]
  (l₁ l₂ : list α) (f : α → β) (h: ∀ x:β, (1:β)*x = x) (mul_assoc : ∀ x y z : β, x*y*z = x*(y*z))
  : prod_all (l₁++l₂) f = (prod_all l₁ f) * (prod_all l₂ f) :=
begin
  induction l₁,
  have h' : list.nil ++ l₂ = l₂, refl, rw h', unfold prod_all, rw h _, -- si l₁ = []
  rw list.cons_append, unfold prod_all, rw l₁_ih, rw mul_assoc,
end

class {u v} has_quotient_gauche (A : out_param (Type u)) (B : Type v) :=
  (quotient : B → Type max u v)
class {u v} has_quotient_droite (A : out_param (Type u)) (B : Type v) :=
  (quotient : B → Type max u v)

notation G ` /. `:35 H:34 := has_quotient_gauche.quotient H
notation H ` .\ `:35 H:34 := has_quotient_droite.quotient H

def nat_pow (n : ℕ) : ℕ → ℕ
  | 0 := 1
  | (nat.succ k) := n*(nat_pow k)

instance nat_has_pow : has_pow ℕ ℕ := ⟨nat_pow⟩

end generique


import mathlib.order
import set_theory.cardinal.basic

open set
open_locale cardinal

universe u
variables {ι α : Type u} {s : set α}

namespace cardinal

lemma mk_bUnion_le' (s : set ι) (f : Π i ∈ s, set α) :
  #(⋃ i (hi : i ∈ s), f i hi) ≤ #s * ⨆ i : s, #(f i.1 i.2) :=
by { rw bUnion_eq_Union, apply mk_Union_le }

lemma nonempty_compl_of_mk_lt_mk (h : #s < #α) : sᶜ.nonempty :=
begin
  simp_rw [set.nonempty_iff_ne_empty, ne.def, compl_eq_empty],
  rintro rfl,
  simpa using h,
end

end cardinal


import ..prooflab
import lectures.lec8_structure_bundled
import lectures.lec9_structure_unbundled
import data.matrix.notation
import linear_algebra.matrix.determinant
import data.real.basic

/-! # Homework 7: ...
Homework must be done individually.
Replace the placeholders (e.g., `:= sorry`) with your solutions.

You are allowed to use all the tactics we have learned so far.
-/

-- set_option pp.all true

open PROOFS

open PROOFS.STR

variables {X Y Z : Type}

/-! ## Question 1 (20 pts):
The following question has two parts.
-/

/- **Part I**
We define the structure `Q1` and `Q2` similar to `R1` and `R2` of the lecture. -/

@[ext]
structure Q1 := (x : ℚ)

@[ext]
structure Q2 := (x : ℚ) (y : ℚ)

@[ext]
lemma Q2_ext {a b : Q2} (h₁ : a.1 = b.1) (h₂ : a.2 = b.2) :
  a = b :=
begin
  rcases a with ⟨a_x,a_y⟩,
  rcases b with ⟨b_x,b_y⟩,
  simp at *,
  split,
  repeat{ assumption },
end

/-
Define the operations of addition and multiplication on `Q1` and `Q2` and prove that they are associative and commutative.
-/

@[simp]
def Q1.add (p q : Q1) : Q1 := sorry

@[simp]
def Q2.add (p q : Q2) : Q2 := sorry

theorem Q2.add_comm (p q : Q2) :
   p .add q = q .add p :=
begin
 sorry,
end

theorem Q2.add_assoc (p q r : Q2) :
   (p .add q) .add r = p .add (q .add r) :=
begin
 sorry,
end

/- **Part II** : Given two points `p` and `q` in `Q2`, define their midpoint (https://en.wikipedia.org/wiki/Midpoint).
-/

@[simp]
def Q2.midpoint (p q : Q2) : Q2 := sorry

/-!
## Question 2 (20 pts) :
We define the structure `bijection` in below. Show that every equivalence gives rise to a bijection by filling in `sorry` placeholders.
-/

structure bijection (X Y : Type) :=
  (to_fun : X → Y)
  (inj : is_injective to_fun)
  (surj : is_surjective to_fun)

def bijection_of_equiv (f : fun_equiv X Y) : bijection X Y :=
{
  to_fun := f.to_fun,
  inj :=    by { sorry, },
  surj :=   by { sorry, },
}

/-!  ## Question 3 (30 pts):
__Matrices__ in Lean are encoded as list of lists. Consider the 2x2 matrix with entries in ℝ whose first row is `[(1/2:ℚ), 0]` and whose second row is `[0, (1/2:ℚ)]`.  This matrix is encoded in Lean as follows:
-/

#check !![(1/2 :ℚ), 0; 0, (1/2 :ℚ)]

def M₁ := !![(1/2 :ℚ), 0 ; 0, (1/2 :ℚ)]

-- #check M₁
-- #print M₁

-- The entries `M_{0,0}` (first row, first column entry), `M_{0,1}` (first row, second column entry), etc can be accessed as in below

#check M₁ 0 0

#eval M₁ 0 0
#eval M₁ 0 1
#eval M₁ 1 0
#eval M₁ 1 1

/-
The usual representation of matrix M₁

       -                  -
      | M₁ 0 0  ,  M₁ 0 1  |
      |                    |
      | M₁ 1 0  ,  M₁ 1 1  |
       -                  -

-/

-- a new matrix
def M₂ := !![(1 : ℚ), -10; 0, 2]

-- #check M₂
-- #print M₂
-- #eval M₂ 0 0

/-
We can add and multiply matrices:

- addition: The sum `A + B` of two m-by-n matrices A and B is again an m-by-n matrix and is calculated entrywise:
(A + B)_{i,j} = A_{i,j} + B_{i,j}, where 0 ≤ i ≤ m - 1 and 0 ≤ j ≤ n - 1

- multiplication: if `M` is a matrix of the size
k-by-m and  `N` is matrix of the size m-by-n then the multiplication of `M` and `N` is a matrix of size k-by-n.
See https://en.wikipedia.org/wiki/Matrix_(mathematics)#Matrix_multiplication if you have not seen matrix multiplication before.
-/

#eval matrix.mul M₁ M₂

/- The following is a function Q2 → Q2 which takes a vector of Q2 and mutiplies that vector by the matrix `M₁`. Note that the type `Q2` is introduced in Question 1. -/

def M₁_transform (v : Q2)  : Q2 :=
{
  x := (matrix.mul M₁ !![(v.x) ; (v.y)]) 0 0,
  y := (matrix.mul M₁ !![(v.x) ; (v.y)]) 1 0,
}

section
variables a b : ℚ
#check M₁_transform
#check M₁_transform ⟨a, b⟩
#check M₁_transform ⟨0, 1⟩
#eval M₁_transform ⟨3, -4⟩
end

lemma M₁_mid (v : Q2) :
  M₁_transform (v : Q2) = Q2.midpoint v ⟨0,0⟩ :=
begin
  sorry,
end

def Q2.is_additive_fun (f : Q2 → Q2) :=
∀ x y : Q2, f (x .add  y) =  (f x) .add (f y)

/-
Prove that `M₁_transform` is an additive function.
-/

theorem M₁_mul_additive  :
  Q2.is_additive_fun M₁_transform :=
begin
  sorry,
end

/- **Questions 4 and 5 in below rely on the concept of sequences**.-/

/-
A __sequence__ in a type `X` is simply a function `a : ℕ → X`. The sequence `a` assigns to every natural number `n : ℕ` an element `a(n) : X` . In informal math texts, by convention, people write "a_{n}" for `a(n)` and "(a_{n})"" for the sequence `a : ℕ → X`. The notation "(a_{n})" communicates the idea of a sequence as an _infinite list_. Note that in lists, in contrast to sets, the order of appearance of elements matter.

Here are some examples of sequences:
- `a : ℕ → ℤ` where `a n = (-1)^(n)`; the sequence terms are `1,-1,1,-1,...`
- `b : ℕ → ℚ` in `ℚ` where `b n = n/(1+n : ℚ)`; the sequence terms are
`0,1/2, 2/3, 3/4,...`
-/

/-
We can add and multiply sequences in `ℝ` component-wise, i.e. the sum `a + b` of sequences
-/

section
variables a b : ℕ → ℝ
variable n : ℕ
#check a n
#check b n
#check a n + b n
#check (a + b) n
end

lemma sum_of_seq_component_wise {a b : ℕ → ℝ} :
  ∀ n : ℕ, (a + b) n = a n + b n  :=
begin
  intro n,
  refl,
end

/- As we saw in the lecture on bundled structures, an structure may depend on a parameter. Here we define the structure of __upper bounds__ for sequences. Note that the structure `upper_bound` depends on a sequence `a : ℕ → ℝ`. The structure `upper_bound` consists of all sequences in `ℝ` with an explicit upper bound.
-/

structure upper_bound (a : ℕ → ℝ) :=
(ub : ℝ) -- the explicit data of upper bound
(le_ub : ∀ (n : ℕ), a n ≤ ub) -- th property of `ub` being an upper bound: all values of the sequence `a` are less than the bound `ub`.

section

variables (a : ℕ → ℝ) (M : upper_bound a)
#check upper_bound
#print upper_bound

#check upper_bound a

#check @upper_bound.ub
#check @upper_bound.ub a
#check @upper_bound.ub a M
#check M.ub
end

/-! ## Question 4 (20 pts):
 Construct an upper bound for the sequence given by numbers `n/n+1` for `n : ℕ` by supplying correct expressions for `sorry` placeholders. The following lemmas might be useful. Also, the tactic `norm_cast` is useful when you want to prove something about a natural number treated as an integer, rational, or real number (or more generally when you have coercion). Here is a minial example of `norm_cast`. -/

example (n : ℕ) (h : 2 < n) :
  2 < (n : ℝ) :=
begin
  -- note that `exact h` does not work since `n` in the goal is a real numebr.
  norm_cast,
  exact h,
end

#check @div_le_iff
#check @div_le_div
#check @div_one
#check div_one (1 : ℝ)

def upbound_n_over_succ_n :
  upper_bound (λ n, n/(1 + n : ℝ)) :=
{
  ub := sorry,
  le_ub := by {sorry},
}

/-! ## Question 5 (20 pts) :
Construct an upper bound for the sum of two upper bounded sequences by completing the (instance) definition below. You might like to use the lemma `add_le_add`. -/

def ub_sum_of_ub_seq (a b : ℕ → ℝ) (Ma : upper_bound a) (Mb : upper_bound b) :
upper_bound (a + b) :=
{
  ub := sorry,
  le_ub := by {sorry},
}

/-! ## Question 6 (40 pts)
In geometry, a simplex (plural: simplexes or simplices) is a generalization of the notion of a triangle or tetrahedron to arbitrary dimensions.

https://en.wikipedia.org/wiki/Simplex

https://en.wikipedia.org/wiki/Simplex#/media/File:2D-simplex.svg

We define the __standard geometric one-dimensional and two-dimensional simplices__ as the following structures.

-/

@[ext]
structure standard_one_simplex :=
(x : ℝ)
(y : ℝ)
(x_nonneg : 0 ≤ x)
(y_nonneg : 0 ≤ y)
(sum_eq   : x + y = 1)

@[ext]
structure standard_two_simplex :=
(x : ℝ)
(y : ℝ)
(z : ℝ)
(x_nonneg : 0 ≤ x)
(y_nonneg : 0 ≤ y)
(z_nonneg : 0 ≤ z)
(sum_eq   : (x + y) + z = 1)

#check standard_two_simplex

/-
We introduce the following _notations_ for the `standard_one_simplex` and `standard_two_simplex`
 -/

notation `Δ_1` := standard_one_simplex
notation `Δ_2` := standard_two_simplex

/- **Part I** :
Construct three distinct points (i.e. instances) of `Δ_1`  and two points (i.e. instances) of `Δ_2` with the given constraints.
-/

def Δ_1.point1 : Δ_1 :=
{
  x := 1,
  y := sorry,
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  sum_eq := by {sorry},
}

def Δ_1.point2 : Δ_1 :=
{
  x := sorry,
  y := 1,
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  sum_eq := by {sorry},
}

noncomputable
def Δ_1.point3 : Δ_1 :=
{
  x := 1/(2 : ℚ),
  y := sorry,
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  sum_eq := by {sorry},
}

def Δ_2.point1 : Δ_2 :=
{
  x := 1,
  y := 0,
  z:= sorry,
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  z_nonneg := by {sorry},
  sum_eq := by {sorry},
}

noncomputable
def Δ_2.point2 : Δ_2 :=
{
  x := sorry,
  y := sorry,
  z:= 1/(2 : ℚ),
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  z_nonneg := by {sorry},
  sum_eq := by {sorry},
}

----------------------------------------
-- **Maps of standard n-simplices**
----------------------------------------

/-
Maps of standard simplices are induced from functions of affine plane (i.e. point3d, point2d, and point1d) with the extra constraints that they map the points in one simplex into the points of the other. The constraints become part of the data of the map between simplices.
-/

/-
 There are two __degeneracy maps__ from the standard 2-simplex to the standard 1-simplex: try to understand the geometric idea begind these maps.
-/

/-
**Part II** : Fill in `sorry` placeholders in below so that `dg_2d_to_1d_fst` and `dg_2d_to_1d_snd` are functions from the type `Δ_2` to `Δ_1`.
-/

def dg_2d_to_1d_fst  (a : Δ_2) : Δ_1
:=
{ x := a.x,
  y := a.y + a.z,
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  sum_eq := by {sorry},
}

def dg_2d_to_1d_snd  (a : Δ_2) : Δ_1
:=
{ x := a.x + a.y,
  y := a.z,
  x_nonneg := by {sorry},
  y_nonneg := by {sorry},
  sum_eq := by {sorry},
}

/- **Part III**:
Prove the following equality of points in `Δ_1`  (i.e. instance of structure `Δ_1`.) -/

example :
  dg_2d_to_1d_fst Δ_2.point1 = Δ_1.point1 :=
begin
   sorry,
end

example :
  dg_2d_to_1d_snd Δ_2.point2 = Δ_1.point3 :=
begin
   sorry,
end

/-  ## Question 7 (30 pts)
In below we define what it means for a sequence in `ℝ` to be positive. You are asked to prove the multiplication of two positive sequences is again positive.
-/
structure pos_seq (a : ℕ → ℝ) :=
(lb : ℝ) --  an explicit lower bound
(ge_lb : ∀ (n : ℕ), lb ≤ a n) -- lower bound condition: the values of the sequence `a` are greater than or equalto the lower bound.
(pos_lb : 0 < lb) -- the lower bound is positive

#print pos_seq
#check @pos_seq.lb

def pos_seq.succ : pos_seq (λ n : ℕ, n+1) :=
{
 lb := 1,
 ge_lb := by {intro n, norm_cast, linarith,},
 pos_lb := by {linarith,},
}

-- You may use the following lemma
#check mul_pos
#check @mul_le_mul
#check @mul_lt_mul
#check @mul_le_mul_of_nonneg_left
#check @mul_le_mul_of_nonneg_right

def pos_mul_of_pos_seq {a b : ℕ → ℝ} (Pa : pos_seq a) (Pb : pos_seq b):
pos_seq (a * b) :=
sorry


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import data.int.range
import data.zmod.basic
import number_theory.legendre_symbol.mul_character

/-!
# Quadratic characters on ℤ/nℤ

This file defines some quadratic characters on the rings ℤ/4ℤ and ℤ/8ℤ.

We set them up to be of type `mul_char (zmod n) ℤ`, where `n` is `4` or `8`.

## Tags

quadratic character, zmod
-/

/-!
### Quadratic characters mod 4 and 8

We define the primitive quadratic characters `χ₄`on `zmod 4`
and `χ₈`, `χ₈'` on `zmod 8`.
-/

namespace zmod

section quad_char_mod_p

/-- Define the nontrivial quadratic character on `zmod 4`, `χ₄`.
It corresponds to the extension `ℚ(√-1)/ℚ`. -/
@[simps] def χ₄ : mul_char (zmod 4) ℤ :=
{ to_fun := (![0,1,0,-1] : (zmod 4 → ℤ)),
  map_one' := rfl, map_mul' := dec_trivial, map_nonunit' := dec_trivial }

/-- `χ₄` takes values in `{0, 1, -1}` -/
lemma is_quadratic_χ₄ : χ₄.is_quadratic := by { intro a, dec_trivial!, }

/-- The value of `χ₄ n`, for `n : ℕ`, depends only on `n % 4`. -/
lemma χ₄_nat_mod_four (n : ℕ) : χ₄ n = χ₄ (n % 4 : ℕ) :=
by rw ← zmod.nat_cast_mod n 4

/-- The value of `χ₄ n`, for `n : ℤ`, depends only on `n % 4`. -/
lemma χ₄_int_mod_four (n : ℤ) : χ₄ n = χ₄ (n % 4 : ℤ) :=
by { rw ← zmod.int_cast_mod n 4, norm_cast, }

/-- An explicit description of `χ₄` on integers / naturals -/
lemma χ₄_int_eq_if_mod_four (n : ℤ) : χ₄ n = if n % 2 = 0 then 0 else if n % 4 = 1 then 1 else -1 :=
begin
  have help : ∀ (m : ℤ), 0 ≤ m → m < 4 → χ₄ m = if m % 2 = 0 then 0 else if m = 1 then 1 else -1 :=
  dec_trivial,
  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 4), ← zmod.int_cast_mod n 4],
  exact help (n % 4) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
end

lemma χ₄_nat_eq_if_mod_four (n : ℕ) : χ₄ n = if n % 2 = 0 then 0 else if n % 4 = 1 then 1 else -1 :=
by exact_mod_cast χ₄_int_eq_if_mod_four n

/-- Alternative description of `χ₄ n` for odd `n : ℕ` in terms of powers of `-1` -/
lemma χ₄_eq_neg_one_pow {n : ℕ} (hn : n % 2 = 1) : χ₄ n = (-1)^(n / 2) :=
begin
  rw χ₄_nat_eq_if_mod_four,
  simp only [hn, nat.one_ne_zero, if_false],
  nth_rewrite 0 ← nat.div_add_mod n 4,
  nth_rewrite 0 (by norm_num : 4 = 2 * 2),
  rw [mul_assoc, add_comm, nat.add_mul_div_left _ _ (by norm_num : 0 < 2),
      pow_add, pow_mul, neg_one_sq, one_pow, mul_one],
  have help : ∀ m : ℕ, m < 4 → m % 2 = 1 → ite (m = 1) (1 : ℤ) (-1) = (-1) ^ (m / 2) :=
  dec_trivial,
  exact help (n % 4) (nat.mod_lt n (by norm_num))
    ((nat.mod_mod_of_dvd n (by norm_num : 2 ∣ 4)).trans hn),
end

/-- If `n % 4 = 1`, then `χ₄ n = 1`. -/
lemma χ₄_nat_one_mod_four {n : ℕ} (hn : n % 4 = 1) : χ₄ n = 1 :=
by { rw [χ₄_nat_mod_four, hn], refl }

/-- If `n % 4 = 3`, then `χ₄ n = -1`. -/
lemma χ₄_nat_three_mod_four {n : ℕ} (hn : n % 4 = 3) : χ₄ n = -1 :=
by { rw [χ₄_nat_mod_four, hn], refl }

/-- If `n % 4 = 1`, then `χ₄ n = 1`. -/
lemma χ₄_int_one_mod_four {n : ℤ} (hn : n % 4 = 1) : χ₄ n = 1 :=
by { rw [χ₄_int_mod_four, hn], refl }

/-- If `n % 4 = 3`, then `χ₄ n = -1`. -/
lemma χ₄_int_three_mod_four {n : ℤ} (hn : n % 4 = 3) : χ₄ n = -1 :=
by { rw [χ₄_int_mod_four, hn], refl }

/-- If `n % 4 = 1`, then `(-1)^(n/2) = 1`. -/
lemma _root_.neg_one_pow_div_two_of_one_mod_four {n : ℕ} (hn : n % 4 = 1) :
  (-1 : ℤ) ^ (n / 2) = 1 :=
by { rw [← χ₄_eq_neg_one_pow (nat.odd_of_mod_four_eq_one hn), ← nat_cast_mod, hn], refl }

/-- If `n % 4 = 3`, then `(-1)^(n/2) = -1`. -/
lemma _root_.neg_one_pow_div_two_of_three_mod_four {n : ℕ} (hn : n % 4 = 3) :
  (-1 : ℤ) ^ (n / 2) = -1 :=
by { rw [← χ₄_eq_neg_one_pow (nat.odd_of_mod_four_eq_three hn), ← nat_cast_mod, hn], refl }

/-- Define the first primitive quadratic character on `zmod 8`, `χ₈`.
It corresponds to the extension `ℚ(√2)/ℚ`. -/
@[simps] def χ₈ : mul_char (zmod 8) ℤ :=
{ to_fun := (![0,1,0,-1,0,-1,0,1] : (zmod 8 → ℤ)),
  map_one' := rfl, map_mul' := dec_trivial, map_nonunit' := dec_trivial }

/-- `χ₈` takes values in `{0, 1, -1}` -/
lemma is_quadratic_χ₈ : χ₈.is_quadratic := by { intro a, dec_trivial!, }

/-- The value of `χ₈ n`, for `n : ℕ`, depends only on `n % 8`. -/
lemma χ₈_nat_mod_eight (n : ℕ) : χ₈ n = χ₈ (n % 8 : ℕ) :=
by rw ← zmod.nat_cast_mod n 8

/-- The value of `χ₈ n`, for `n : ℤ`, depends only on `n % 8`. -/
lemma χ₈_int_mod_eight (n : ℤ) : χ₈ n = χ₈ (n % 8 : ℤ) :=
by { rw ← zmod.int_cast_mod n 8, norm_cast, }

/-- An explicit description of `χ₈` on integers / naturals -/
lemma χ₈_int_eq_if_mod_eight (n : ℤ) :
  χ₈ n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 7 then 1 else -1 :=
begin
  have help : ∀ (m : ℤ), 0 ≤ m → m < 8 → χ₈ m = if m % 2 = 0 then 0
                                                else if m = 1 ∨ m = 7 then 1 else -1 :=
  dec_trivial,
  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 8), ← zmod.int_cast_mod n 8],
  exact help (n % 8) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
end

lemma χ₈_nat_eq_if_mod_eight (n : ℕ) :
  χ₈ n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 7 then 1 else -1 :=
by exact_mod_cast χ₈_int_eq_if_mod_eight n

/-- Define the second primitive quadratic character on `zmod 8`, `χ₈'`.
It corresponds to the extension `ℚ(√-2)/ℚ`. -/
@[simps] def χ₈' : mul_char (zmod 8) ℤ :=
{ to_fun := (![0,1,0,1,0,-1,0,-1] : (zmod 8 → ℤ)),
  map_one' := rfl, map_mul' := dec_trivial, map_nonunit' := dec_trivial }

/-- `χ₈'` takes values in `{0, 1, -1}` -/
lemma is_quadratic_χ₈' : χ₈'.is_quadratic := by { intro a, dec_trivial!, }

/-- An explicit description of `χ₈'` on integers / naturals -/
lemma χ₈'_int_eq_if_mod_eight (n : ℤ) :
  χ₈' n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 3 then 1 else -1 :=
begin
  have help : ∀ (m : ℤ), 0 ≤ m → m < 8 → χ₈' m = if m % 2 = 0 then 0
                                                 else if m = 1 ∨ m = 3 then 1 else -1 :=
  dec_trivial,
  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 8), ← zmod.int_cast_mod n 8],
  exact help (n % 8) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
end

lemma χ₈'_nat_eq_if_mod_eight (n : ℕ) :
  χ₈' n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 3 then 1 else -1 :=
by exact_mod_cast χ₈'_int_eq_if_mod_eight n

/-- The relation between `χ₄`, `χ₈` and `χ₈'` -/
lemma χ₈'_eq_χ₄_mul_χ₈ (a : zmod 8) : χ₈' a = χ₄ a * χ₈ a := by dec_trivial!

lemma χ₈'_int_eq_χ₄_mul_χ₈ (a : ℤ) : χ₈' a = χ₄ a * χ₈ a :=
begin
  rw ← @cast_int_cast 8 (zmod 4) _ 4 _ (by norm_num) a,
  exact χ₈'_eq_χ₄_mul_χ₈ a,
end

end quad_char_mod_p

end zmod


import Lean4Axiomatic.Integer.Impl.Difference.Core

namespace Lean4Axiomatic.Integer.Impl.Difference

/-! ## Addition of formal differences -/

variable {ℕ : Type} [Natural ℕ]

/--
Addition of differences.

**Definition intuition**: the sum of two differences should be the net effect
of applying both of them.
-/
def add : Difference ℕ → Difference ℕ → Difference ℕ
| a——b, c——d => (a + c)——(b + d)

instance addOp : Add (Difference ℕ) := {
  add := add
}

/--
Addition of natural number differences is commutative.

**Proof intuition**: Expand definitions to see that we need to show the
equivalence of two differences of natural number sums. The left and right
elements of the differences are directly equivalent via commutativity of
natural number addition, so convert the differences into ordered pairs and use
commutativity element-wise.
-/
theorem add_comm {a b : Difference ℕ} : a + b ≃ b + a := by
  revert a; intro (a₁——a₂); revert b; intro (b₁——b₂)
  show a₁——a₂ + b₁——b₂ ≃ b₁——b₂ + a₁——a₂
  show (a₁ + b₁)——(a₂ + b₂) ≃ (b₁ + a₁)——(b₂ + a₂)
  show from_prod (a₁ + b₁, a₂ + b₂) ≃ from_prod (b₁ + a₁, b₂ + a₂)
  apply AA.subst₁
  show (a₁ + b₁, a₂ + b₂) ≃ (b₁ + a₁, b₂ + a₂)
  calc
    (a₁ + b₁, a₂ + b₂) ≃ _ := AA.substL AA.comm
    (b₁ + a₁, a₂ + b₂) ≃ _ := AA.substR AA.comm
    (b₁ + a₁, b₂ + a₂) ≃ _ := Rel.refl

instance add_commutative : AA.Commutative (α := Difference ℕ) (· + ·) := {
  comm := add_comm
}

/--
Adding the same difference on the right of two equivalent differences preserves
their equivalence.

**Proof intuition**: The property is already intuitively true; imagine
extending two line segments of the same length by the same amount. So the proof
just expands all definitions into equalities of sums of natural numbers, and
performs algebra to obtain the desired result.
-/
theorem add_substL {a₁ a₂ b : Difference ℕ} : a₁ ≃ a₂ → a₁ + b ≃ a₂ + b := by
  revert a₁; intro (n——m); revert a₂; intro (k——j); revert b; intro (p——q)
  intro (_ : n——m ≃ k——j)
  have : n + j ≃ k + m := ‹n——m ≃ k——j›
  show n——m + p——q ≃ k——j + p——q
  show (n + p)——(m + q) ≃ (k + p)——(j + q)
  show (n + p) + (j + q) ≃ (k + p) + (m + q)
  calc
    (n + p) + (j + q) ≃ _ := AA.expr_xxfxxff_lr_swap_rl
    (n + j) + (p + q) ≃ _ := AA.substL ‹n + j ≃ k + m›
    (k + m) + (p + q) ≃ _ := AA.expr_xxfxxff_lr_swap_rl
    (k + p) + (m + q) ≃ _ := Rel.refl

def add_substitutiveL
    : AA.SubstitutiveOn Hand.L (α := Difference ℕ) (· + ·) AA.tc (· ≃ ·) (· ≃ ·)
    := {
  subst₂ := λ (_ : True) => add_substL
}

instance add_substitutive
    : AA.Substitutive₂ (α := Difference ℕ) (· + ·) AA.tc (· ≃ ·) (· ≃ ·)
    := {
  substitutiveL := add_substitutiveL
  substitutiveR := AA.substR_from_substL_swap (rS := (· ≃ ·)) add_substitutiveL
}

/--
Addition of natural number differences is associative.

**Proof intuition**: Expand definitions to see that we need to show the
equivalence of two differences of natural number sums. The left and right
elements of the differences are directly equivalent via associativity of
natural number addition, so convert the differences into ordered pairs and use
associativity element-wise.
-/
def add_assoc {a b c : Difference ℕ} : (a + b) + c ≃ a + (b + c) := by
  revert a; intro (n——m); revert b; intro (k——j); revert c; intro (p——q)
  show (n——m + k——j) + p——q ≃ n——m + (k——j + p——q)
  show (n + k)——(m + j) + p——q ≃ n——m + (k + p)——(j + q)
  show ((n + k) + p)——((m + j) + q) ≃ (n + (k + p))——(m + (j + q))
  show from_prod ((n + k) + p, (m + j) + q)
     ≃ from_prod (n + (k + p), m + (j + q))
  apply AA.subst₁
  show ((n + k) + p, (m + j) + q) ≃ (n + (k + p), m + (j + q))
  calc
    ((n + k) + p, (m + j) + q) ≃ _ := AA.substL AA.assoc
    (n + (k + p), (m + j) + q) ≃ _ := AA.substR AA.assoc
    (n + (k + p), m + (j + q)) ≃ _ := Rel.refl

def add_associative : AA.Associative (α := Difference ℕ) (· + ·) := {
  assoc := add_assoc
}

/--
The natural number difference `0` is a left additive identity element.

**Property intuition**: Adding nothing to a value should leave it unchanged.

**Proof intuition**: Both components of the literal `0` are also `0`, so we can
use the additive identity property on natural numbers elementwise.
-/
theorem add_identL {a : Difference ℕ} : 0 + a ≃ a := by
  revert a; intro (n——m)
  show 0——0 + n——m ≃ n——m
  show (0 + n)——(0 + m) ≃ n——m
  show from_prod (0 + n, 0 + m) ≃ from_prod (n, m)
  apply AA.subst₁
  show (0 + n, 0 + m) ≃ (n, m)
  calc
    (0 + n, 0 + m) ≃ _ := AA.substL AA.identL
    (n, 0 + m)     ≃ _ := AA.substR AA.identL
    (n, m)         ≃ _ := Rel.refl

def add_identityL : AA.IdentityOn Hand.L (α := Difference ℕ) 0 (· + ·) := {
  ident := add_identL
}

instance add_identity : AA.Identity (α := Difference ℕ) 0 (· + ·) := {
  identityL := add_identityL
  identityR := AA.identityR_from_identityL add_identityL
}

/--
Conversion from `ℕ` to `Difference ℕ` is compatible with addition.

**Proprty intuition**: One would hope this is true, otherwise we could not say
that the set of differences (integers) is a superset of the natural numbers.

**Proof intuition**: Expanding definitions is enough to get us nearly there --
just need to clean up an extra zero.
-/
theorem add_compat_natural
    {n m : ℕ} : (↑(n + m) : Difference ℕ) ≃ ↑n + ↑m
    := by
  show (n + m)——0 ≃ n——0 + m——0
  show (n + m)——0 ≃ (n + m)——(0 + 0)
  show (n + m) + (0 + 0) ≃ (n + m) + 0
  exact AA.substR AA.identR

def add_compatible_from_natural
    : AA.Compatible₂ (α := ℕ) (β := Difference ℕ) (↑·) (· + ·) (· + ·)
    := {
  compat₂ := add_compat_natural
}

instance addition : Addition (ℕ := ℕ) (Difference ℕ) := {
  addOp := addOp
  add_substitutive := add_substitutive
  add_commutative := add_commutative
  add_associative := add_associative
  add_identity := add_identity
  add_compatible_from_natural := add_compatible_from_natural
}

end Lean4Axiomatic.Integer.Impl.Difference


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.metric_space.basic
import topology.metric_space.emetric_paracompact
import topology.shrinking_lemma

/-!
# Shrinking lemma in a proper metric space

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

In this file we prove a few versions of the shrinking lemma for coverings by balls in a proper
(pseudo) metric space.

## Tags

shrinking lemma, metric space
-/

universes u v
open set metric
open_locale topology

variables {α : Type u} {ι : Type v} [metric_space α] [proper_space α] {c : ι → α}
variables {x : α} {r : ℝ} {s : set α}

/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a closed subset of a proper metric space by open balls can be shrunk to a new cover by open balls
so that each of the new balls has strictly smaller radius than the old one. This version assumes
that `λ x, ball (c i) (r i)` is a locally finite covering and provides a covering indexed by the
same type. -/
lemma exists_subset_Union_ball_radius_lt {r : ι → ℝ} (hs : is_closed s)
  (uf : ∀ x ∈ s, {i | x ∈ ball (c i) (r i)}.finite) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
  ∃ r' : ι → ℝ, s ⊆ (⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i < r i :=
begin
  rcases exists_subset_Union_closed_subset hs (λ i, @is_open_ball _ _ (c i) (r i)) uf us
    with ⟨v, hsv, hvc, hcv⟩,
  have := λ i, exists_lt_subset_ball (hvc i) (hcv i),
  choose r' hlt hsub,
  exact ⟨r', hsv.trans $ Union_mono $ hsub, hlt⟩
end

/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a proper metric space by open balls can be shrunk to a new cover by open balls so that each of
the new balls has strictly smaller radius than the old one. -/
lemma exists_Union_ball_eq_radius_lt {r : ι → ℝ} (uf : ∀ x, {i | x ∈ ball (c i) (r i)}.finite)
  (uU : (⋃ i, ball (c i) (r i)) = univ) :
  ∃ r' : ι → ℝ, (⋃ i, ball (c i) (r' i)) = univ ∧ ∀ i, r' i < r i :=
let ⟨r', hU, hv⟩ := exists_subset_Union_ball_radius_lt is_closed_univ (λ x _, uf x) uU.ge
in ⟨r', univ_subset_iff.1 hU, hv⟩

/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a closed subset of a proper metric space by nonempty open balls can be shrunk to a new cover by
nonempty open balls so that each of the new balls has strictly smaller radius than the old one. -/
lemma exists_subset_Union_ball_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i) (hs : is_closed s)
  (uf : ∀ x ∈ s, {i | x ∈ ball (c i) (r i)}.finite) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
  ∃ r' : ι → ℝ, s ⊆ (⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
begin
  rcases exists_subset_Union_closed_subset hs (λ i, @is_open_ball _ _ (c i) (r i)) uf us
    with ⟨v, hsv, hvc, hcv⟩,
  have := λ i, exists_pos_lt_subset_ball (hr i) (hvc i) (hcv i),
  choose r' hlt hsub,
  exact ⟨r', hsv.trans $ Union_mono hsub, hlt⟩
end

/-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
of a proper metric space by nonempty open balls can be shrunk to a new cover by nonempty open balls
so that each of the new balls has strictly smaller radius than the old one. -/
lemma exists_Union_ball_eq_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i)
  (uf : ∀ x, {i | x ∈ ball (c i) (r i)}.finite) (uU : (⋃ i, ball (c i) (r i)) = univ) :
  ∃ r' : ι → ℝ, (⋃ i, ball (c i) (r' i)) = univ ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
let ⟨r', hU, hv⟩ := exists_subset_Union_ball_radius_pos_lt hr is_closed_univ (λ x _, uf x) uU.ge
in ⟨r', univ_subset_iff.1 hU, hv⟩

/-- Let `R : α → ℝ` be a (possibly discontinuous) function on a proper metric space.
Let `s` be a closed set in `α` such that `R` is positive on `s`. Then there exists a collection of
pairs of balls `metric.ball (c i) (r i)`, `metric.ball (c i) (r' i)` such that

* all centers belong to `s`;
* for all `i` we have `0 < r i < r' i < R (c i)`;
* the family of balls `metric.ball (c i) (r' i)` is locally finite;
* the balls `metric.ball (c i) (r i)` cover `s`.

This is a simple corollary of `refinement_of_locally_compact_sigma_compact_of_nhds_basis_set`
and `exists_subset_Union_ball_radius_pos_lt`. -/
lemma exists_locally_finite_subset_Union_ball_radius_lt (hs : is_closed s)
  {R : α → ℝ} (hR : ∀ x ∈ s, 0 < R x) :
  ∃ (ι : Type u) (c : ι → α) (r r' : ι → ℝ),
    (∀ i, c i ∈ s ∧ 0 < r i ∧ r i < r' i ∧ r' i < R (c i)) ∧
    locally_finite (λ i, ball (c i) (r' i)) ∧ s ⊆ ⋃ i, ball (c i) (r i) :=
begin
  have : ∀ x ∈ s, (𝓝 x).has_basis (λ r : ℝ, 0 < r ∧ r < R x) (λ r, ball x r),
    from λ x hx, nhds_basis_uniformity (uniformity_basis_dist_lt (hR x hx)),
  rcases refinement_of_locally_compact_sigma_compact_of_nhds_basis_set hs this
    with ⟨ι, c, r', hr', hsub', hfin⟩,
  rcases exists_subset_Union_ball_radius_pos_lt (λ i, (hr' i).2.1) hs
    (λ x hx, hfin.point_finite x) hsub' with ⟨r, hsub, hlt⟩,
  exact ⟨ι, c, r, r', λ i, ⟨(hr' i).1, (hlt i).1, (hlt i).2, (hr' i).2.2⟩, hfin, hsub⟩
end

/-- Let `R : α → ℝ` be a (possibly discontinuous) positive function on a proper metric space. Then
there exists a collection of pairs of balls `metric.ball (c i) (r i)`, `metric.ball (c i) (r' i)`
such that

* for all `i` we have `0 < r i < r' i < R (c i)`;
* the family of balls `metric.ball (c i) (r' i)` is locally finite;
* the balls `metric.ball (c i) (r i)` cover the whole space.

This is a simple corollary of `refinement_of_locally_compact_sigma_compact_of_nhds_basis`
and `exists_Union_ball_eq_radius_pos_lt` or `exists_locally_finite_subset_Union_ball_radius_lt`. -/
lemma exists_locally_finite_Union_eq_ball_radius_lt {R : α → ℝ} (hR : ∀ x, 0 < R x) :
  ∃ (ι : Type u) (c : ι → α) (r r' : ι → ℝ), (∀ i, 0 < r i ∧ r i < r' i ∧ r' i < R (c i)) ∧
    locally_finite (λ i, ball (c i) (r' i)) ∧ (⋃ i, ball (c i) (r i)) = univ :=
let ⟨ι, c, r, r', hlt, hfin, hsub⟩ := exists_locally_finite_subset_Union_ball_radius_lt
  is_closed_univ (λ x _, hR x)
in ⟨ι, c, r, r', λ i, (hlt i).2, hfin, univ_subset_iff.1 hsub⟩


import .flat

/-
  A `loop` of a matroid is a one-element circuit. The set of loops of `M` is equal to `M.cl ∅`,
  and we prefer this notation instead of `{e | M.loop e}` or similar.
-/

open_locale classical

variables {E : Type*} [finite E] {M M₁ M₂ : matroid E}
  {I C X Y Z F F₁ F₂ : set E} {e f x y z : E}

open set

namespace matroid

lemma loop_def :
  M.loop e ↔ M.circuit {e} :=
iff.rfl

lemma loop.circuit (he : M.loop e) :
  M.circuit {e} :=
he

lemma loop.r (he : M.loop e) :
  M.r {e} = 0 :=
begin
 have h := he.circuit.card,
 rwa [ncard_singleton, self_eq_add_left] at h,
end

lemma loop_iff_r :
  M.loop e ↔ M.r {e} = 0 :=
begin
  refine ⟨loop.r, λ h, _⟩,
  rw [loop_def, circuit_def, ←r_lt_card_iff_dep, h, ncard_singleton],
  refine ⟨zero_lt_one, λ I hI, _⟩,
  rw [ssubset_singleton_iff.mp hI],
  apply empty_indep,
end

lemma loop_iff_not_mem_base_forall :
  M.loop e ↔ ∀ B, M.base B → e ∉ B :=
begin
  refine ⟨λ h B hB heB, h.circuit.dep (hB.indep.subset (singleton_subset_iff.mpr heB)),
    λ h, _⟩,
  refine ⟨λ h_ind, _,λ I hI, _⟩,
  { obtain ⟨B,hB⟩ := h_ind.exists_base_supset,
    exact h _ hB.1 (singleton_subset_iff.mp hB.2)},
  convert M.empty_indep,
  rwa ssubset_singleton_iff at hI,
end

lemma loop_iff_dep :
  M.loop e ↔ ¬M.indep {e} :=
⟨circuit.dep, λ h, loop_iff_not_mem_base_forall.mpr
  (λ B hB heB, h (hB.indep.subset (singleton_subset_iff.mpr heB)))⟩

lemma nonloop_iff_indep :
  (¬ M.loop e) ↔ M.indep {e} :=
by rw [not_iff_comm, loop_iff_dep]

lemma loop_iff_mem_cl_empty :
  M.loop e ↔ e ∈ M.cl ∅ :=
begin
  rw [loop_iff_dep, not_iff_comm, not_mem_cl_iff_forall_insert_basis_insert],
  split,
  { rintro ⟨-,h⟩, simpa using (h ∅ M.empty_basis_empty).indep},
  refine λ h, ⟨not_mem_empty _, λ I hI, _⟩,
  rw ←basis_self_iff_indep at h,
  rw basis_empty_iff at hI, subst hI,
  convert h;
  simp,
end

lemma cl_empty_eq_loops (M : matroid E) :
  M.cl ∅ = {e | M.loop e} :=
by {simp_rw loop_iff_mem_cl_empty, refl}

lemma loop.mem_cl (he : M.loop e) (X : set E) :
  e ∈ M.cl X :=
mem_of_mem_of_subset (loop_iff_mem_cl_empty.mp he) (M.cl_mono (empty_subset _))

lemma loop.dep_of_mem (he : M.loop e) (h : e ∈ X) :
  ¬M.indep X :=
λ hX, he.circuit.dep (hX.subset (singleton_subset_iff.mpr h))

lemma loop.not_mem_indep (he : M.loop e) (hI : M.indep I) :
  e ∉ I :=
λ h, he.dep_of_mem h hI

lemma indep.nonloop_of_mem (hI : M.indep I) (h : e ∈ I) :
  ¬ M.loop e :=
λ he, (he.not_mem_indep hI) h

lemma mem_nonloops_iff_not_loop :
  e ∈ M.nonloops ↔ ¬M.loop e :=
by rw [nonloops, mem_compl_iff, loop_iff_mem_cl_empty]

lemma indep.disjoint_loops (hI : M.indep I) :
  disjoint I (M.cl ∅) :=
begin
  rw [cl_empty_eq_loops],
  by_contra' h,
  obtain ⟨e,he⟩ := not_disjoint_iff.mp h,
  exact he.2.not_mem_indep hI he.1,
end

lemma nonloop_iff_r :
  ¬M.loop e ↔ M.r {e} = 1 :=
by rw [nonloop_iff_indep, indep_iff_r_eq_card, ncard_singleton]

lemma loop.eq_of_circuit_mem (he : M.loop e) (hC : M.circuit C) (h : e ∈ C) :
  C = {e} :=
by rw he.circuit.eq_of_subset_circuit hC (singleton_subset_iff.mpr h)

lemma coloop_def :
  M.coloop e ↔ ∀ B, M.base B → e ∈ B :=
iff.rfl

lemma coloop.r_compl_add_one (he : M.coloop e) :
  M.r {e}ᶜ + 1 = M.rk :=
begin
  obtain ⟨I,hI⟩ := M.exists_basis {e}ᶜ,
  obtain ⟨B, hIB, hB⟩ := hI.indep.subset_basis_of_subset (subset_univ I),
  rw [←base_iff_basis_univ] at hB,
  have heI : e ∉ I, from λ heI, by simpa using hI.subset heI,
  have hIB' : B = insert e I,
  { refine subset_antisymm _ _,
    { rw [←union_singleton, ←inter_union_diff B {e}, union_subset_iff],
      refine ⟨(inter_subset_right _ _).trans (subset_union_right _ _),
        subset_union_of_subset_left _ _⟩,
      rw hI.eq_of_subset_indep (hB.indep.diff {e}) (subset_diff_singleton hIB heI) _,
      rw [compl_eq_univ_diff],
      exact diff_subset_diff_left (subset_univ _)},
    exact insert_subset.mpr ⟨he B hB, hIB⟩},
  subst hIB',
  rw [←hI.r, hI.indep.r, ←hB.r, hB.indep.r, ncard_insert_of_not_mem heI],
end

lemma coloop_iff_r_compl_add_one_eq :
  M.coloop e ↔ M.r {e}ᶜ + 1 = M.rk :=
begin
  refine ⟨coloop.r_compl_add_one, λ h B hB, by_contra (λ h', _)⟩,
  rw ←subset_compl_singleton_iff at h',
  have hB' := M.r_mono h',
  rw [hB.r, ←h] at hB',
  simpa only [add_le_iff_nonpos_right, le_zero_iff, nat.one_ne_zero] using hB',
end

lemma coloop_iff_r_compl_lt :
  M.coloop e ↔ M.r {e}ᶜ < M.rk :=
begin
  refine ⟨λ h, _,λ h, _⟩,
  { rw ←h.r_compl_add_one, apply lt_add_one, },
  have he :insert e ({e}ᶜ : set E) = univ,
  {ext, simp [em]},
  rw [rk, ←he] at h,
  rw [coloop_iff_r_compl_add_one_eq, eq_comm, rk, ←he, r_insert_eq_add_one_of_r_ne h.ne.symm],
end

lemma coloop.coe_r_compl (he : M.coloop e) :
  (M.r {e}ᶜ : ℤ) = M.rk - 1 :=
by simp [←he.r_compl_add_one]

lemma coloop.not_mem_circuit (he : M.coloop e) (hC : M.circuit C) :
  e ∉ C :=
begin
  intro heC,
  obtain ⟨B,hB, hCB⟩ := (hC.diff_singleton_indep heC).exists_base_supset,
  have h := insert_subset.mpr ⟨he _ hB, hCB⟩,
  rw [insert_diff_singleton, insert_eq_of_mem heC] at h,
  exact hC.dep (hB.indep.subset h),
end

lemma cl_eq_loops_of_subset (h : X ⊆ M.cl ∅) :
  M.cl X = M.cl ∅ :=
(cl_subset_cl_of_subset_cl h).antisymm (M.cl_mono (empty_subset _))

lemma r_zero_iff_subset_loops :
  M.r X = 0 ↔ X ⊆ M.cl ∅ :=
begin
  obtain ⟨I, hI⟩ := M.exists_basis X,
  rw [←hI.r, hI.indep.r, ncard_eq_zero, ←cl_subset_cl_iff_subset_cl, ←hI.cl,
    cl_subset_cl_iff_subset_cl],
  refine ⟨λ h, _,λ h, _⟩,
  { rw h, exact empty_subset _},
  have := disjoint_iff_inter_eq_empty.mp hI.indep.disjoint_loops,
  rwa inter_eq_left_iff_subset.mpr h at this,
end

end matroid


/- LoVe Exercise 1: Definitions and Lemma Statements -/

/- Replace the placeholders (e.g., `:= sorry`) with your solutions. -/

import .love01_definitions_and_lemma_statements_demo

namespace LoVe

/- Question 1: Fibonacci Numbers -/

/- 1.1. Define the function `fib` that computes the Fibonacci numbers. -/

def fib : ℕ → ℕ
| 0 := 0
| 1 := 1
| (nat.succ (nat.succ n)) := fib n + fib (nat.succ n)
-- (n + 2) and (n + 1) would also work

/- 1.2. Check that your function works as expected. -/

#reduce fib 0  -- expected: 0
#reduce fib 1  -- expected: 1
#reduce fib 2  -- expected: 1
#reduce fib 3  -- expected: 2
#reduce fib 4  -- expected: 3
#reduce fib 5  -- expected: 5
#reduce fib 6  -- expected: 8
#reduce fib 7  -- expected: 13
#reduce fib 8  -- expected: 21

/- Question 2: Arithmetic Expressions -/

/- Consider the type `aexp` from the lecture. -/

#print aexp
#check eval

/- 2.1. Test that `eval` behaves as expected. Making sure to exercise each
constructor at least once. You can use the following environment in your
tests. What happens if you divide by zero? -/

def some_env : string → ℤ
| "x" := 3
| "y" := 17
| _   := 201

#eval eval some_env (aexp.add (aexp.var "x") (aexp.var "y"))
#eval eval some_env (aexp.sub (aexp.num 5) (aexp.var "y"))
#eval eval some_env (aexp.mul (aexp.num 11) (aexp.var "z"))
#eval eval some_env (aexp.div (aexp.num 2) (aexp.num 0))

/- 2.2. The following function simplifies arithmetic expressions involving
addition. It simplifies `0 + e` and `e + 0` to `e`. Complete the definition so
that it also simplifies expressions involving the other three binary
operators. -/

def simplify : aexp → aexp
| (aexp.add (aexp.num 0) e₂) := simplify e₂
| (aexp.add e₁ (aexp.num 0)) := simplify e₁
| (aexp.sub e₁ (aexp.num 0)) := simplify e₁
| (aexp.mul (aexp.num 0) e₂) := aexp.num 0
| (aexp.mul e₁ (aexp.num 0)) := aexp.num 0
| (aexp.mul (aexp.num 1) e₂) := simplify e₂
| (aexp.mul e₁ (aexp.num 1)) := simplify e₁
| (aexp.div (aexp.num 0) e₂) := aexp.num 0
| (aexp.div e₁ (aexp.num 0)) := aexp.num 0
| (aexp.div e₁ (aexp.num 1)) := simplify e₁
-- catch-all cases below
| (aexp.num i)               := aexp.num i
| (aexp.var x)               := aexp.var x
| (aexp.add e₁ e₂)           := aexp.add (simplify e₁) (simplify e₂)
| (aexp.sub e₁ e₂)           := aexp.sub (simplify e₁) (simplify e₂)
| (aexp.mul e₁ e₂)           := aexp.mul (simplify e₁) (simplify e₂)
| (aexp.div e₁ e₂)           := aexp.div (simplify e₁) (simplify e₂)

/- 2.3. State the correctness lemma for `simplify`, namely that the simplified
expression should have the same semantics, with respect to `eval`, as the
original expression. -/

lemma simplify_correct (env : string → ℤ) (e : aexp) :
  eval env (simplify e) = eval env e :=
sorry

/- Question 3: λ-Terms -/

/- We start by declaring three new opaque types. -/

constants α β γ : Type

/- 3.1. Complete the following definitions, by replacing the `sorry` markers by
terms of the expected type.

Hint: You can use `_` as a placeholder while constructing a term. By hovering
over `_`, you will see the current logical context. -/

def I : α → α :=
λa, a

def K : α → β → α :=
λa b, a

def C : (α → β → γ) → β → α → γ :=
λg b a, g a b

def proj_1st : α → α → α :=
λx y, x

-- please give a different answer than for `proj_1st`
def proj_2nd : α → α → α :=
λx y, y

def some_nonsense : (α → β → γ) → α → (α → γ) → β → γ :=
λg a f b, g a b

/- 3.2. Show the typing derivation for your definition of `C` above. -/

/- Let Γ := g : α → β → γ, b : β, a : α. We have

    –––––––––––––––––– Var    –––––––––– Var
    Γ ⊢ g : α → β → γ         Γ ⊢ a : α
    –––––––––––––––––––––––––––––––––––– App    –––––––––– Var
    Γ ⊢ g a : β → γ                             Γ ⊢ b : β
    –––––––––––––––––––––––––––––––––––––––––––––––––––––– App
    Γ ⊢ g a b : γ
    ––––––––––––––––––––––––––––––––––––––––––– Lam
    g : α → β → γ, b : β ⊢ (λa : α, g a b) : γ
    –––––––––––––––––––––––––––––––––––––––––––––– Lam
    g : α → β → γ ⊢ (λ(b : β) (a : α), g a b) : γ
    ––––––––––––––––––––––––––––––––––––––––––––––– Lam
    ⊢ (λ(g : α → β → γ) (b : β) (a : α), g a b) : γ
-/

end LoVe


/-
Copyright (c) 2021 Alena Gusakov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov
-/
import combinatorics.simple_graph.basic
import data.set.finite
/-!
# Strongly regular graphs

## Main definitions

* `G.is_SRG_with n k ℓ μ` (see `simple_graph.is_SRG_with`) is a structure for
  a `simple_graph` satisfying the following conditions:
  * The cardinality of the vertex set is `n`
  * `G` is a regular graph with degree `k`
  * The number of common neighbors between any two adjacent vertices in `G` is `ℓ`
  * The number of common neighbors between any two nonadjacent vertices in `G` is `μ`

## TODO
- Prove that the parameters of a strongly regular graph
  obey the relation `(n - k - 1) * μ = k * (k - ℓ - 1)`
- Prove that if `I` is the identity matrix and `J` is the all-one matrix,
  then the adj matrix `A` of SRG obeys relation `A^2 = kI + ℓA + μ(J - I - A)`
-/

open finset

universes u

namespace simple_graph
variables {V : Type u}
variables [fintype V] [decidable_eq V]
variables (G : simple_graph V) [decidable_rel G.adj]

/--
A graph is strongly regular with parameters `n k ℓ μ` if
 * its vertex set has cardinality `n`
 * it is regular with degree `k`
 * every pair of adjacent vertices has `ℓ` common neighbors
 * every pair of nonadjacent vertices has `μ` common neighbors
-/
structure is_SRG_with (n k ℓ μ : ℕ) : Prop :=
(card : fintype.card V = n)
(regular : G.is_regular_of_degree k)
(of_adj : ∀ (v w : V), G.adj v w → fintype.card (G.common_neighbors v w) = ℓ)
(of_not_adj : ∀ (v w : V), v ≠ w → ¬G.adj v w → fintype.card (G.common_neighbors v w) = μ)

variables {G} {n k ℓ μ : ℕ}

/-- Empty graphs are strongly regular. Note that `ℓ` can take any value
  for empty graphs, since there are no pairs of adjacent vertices. -/
lemma bot_strongly_regular :
  (⊥ : simple_graph V).is_SRG_with (fintype.card V) 0 ℓ 0 :=
{ card := rfl,
  regular := bot_degree,
  of_adj := λ v w h, h.elim,
  of_not_adj := λ v w h, begin
    simp only [card_eq_zero, filter_congr_decidable, fintype.card_of_finset, forall_true_left,
      not_false_iff, bot_adj],
    ext,
    simp [mem_common_neighbors],
  end }

/-- Complete graphs are strongly regular. Note that `μ` can take any value
  for complete graphs, since there are no distinct pairs of non-adjacent vertices. -/
lemma is_SRG_with.top :
  (⊤ : simple_graph V).is_SRG_with (fintype.card V) (fintype.card V - 1) (fintype.card V - 2) μ :=
{ card := rfl,
  regular := is_regular_of_degree.top,
  of_adj := λ v w h, begin
    rw card_common_neighbors_top,
    exact h,
  end,
  of_not_adj := λ v w h h', false.elim $ by simpa using h }

lemma is_SRG_with.card_neighbor_finset_union_eq {v w : V} (h : G.is_SRG_with n k ℓ μ) :
  (G.neighbor_finset v ∪ G.neighbor_finset w).card =
    2 * k - fintype.card (G.common_neighbors v w) :=
begin
  apply @nat.add_right_cancel _ (fintype.card (G.common_neighbors v w)),
  rw [nat.sub_add_cancel, ← set.to_finset_card],
  { simp [neighbor_finset, common_neighbors, set.to_finset_inter, finset.card_union_add_card_inter,
      h.regular.degree_eq, two_mul], },
  { apply le_trans (card_common_neighbors_le_degree_left _ _ _),
    simp [h.regular.degree_eq, two_mul], },
end

/-- Assuming `G` is strongly regular, `2*(k + 1) - m` in `G` is the number of vertices that are
  adjacent to either `v` or `w` when `¬G.adj v w`. So it's the cardinality of
  `G.neighbor_set v ∪ G.neighbor_set w`. -/
lemma is_SRG_with.card_neighbor_finset_union_of_not_adj {v w : V} (h : G.is_SRG_with n k ℓ μ)
  (hne : v ≠ w) (ha : ¬G.adj v w) :
  (G.neighbor_finset v ∪ G.neighbor_finset w).card = 2 * k - μ :=
begin
  rw ← h.of_not_adj v w hne ha,
  apply h.card_neighbor_finset_union_eq,
end

lemma is_SRG_with.card_neighbor_finset_union_of_adj {v w : V} (h : G.is_SRG_with n k ℓ μ)
  (ha : G.adj v w) :
  (G.neighbor_finset v ∪ G.neighbor_finset w).card = 2 * k - ℓ :=
begin
  rw ← h.of_adj v w ha,
  apply h.card_neighbor_finset_union_eq,
end

lemma compl_neighbor_finset_sdiff_inter_eq {v w : V} :
  (G.neighbor_finset v)ᶜ \ {v} ∩ ((G.neighbor_finset w)ᶜ \ {w}) =
    (G.neighbor_finset v)ᶜ ∩ (G.neighbor_finset w)ᶜ \ ({w} ∪ {v}) :=
by { ext, rw ← not_iff_not, simp [imp_iff_not_or, or_assoc, or_comm, or.left_comm], }

lemma sdiff_compl_neighbor_finset_inter_eq {v w : V} (h : G.adj v w) :
  (G.neighbor_finset v)ᶜ ∩ (G.neighbor_finset w)ᶜ \ ({w} ∪ {v}) =
    (G.neighbor_finset v)ᶜ ∩ (G.neighbor_finset w)ᶜ :=
begin
  ext,
  simp only [and_imp, mem_union, mem_sdiff, mem_compl, and_iff_left_iff_imp,
    mem_neighbor_finset, mem_inter, mem_singleton],
  rintros hnv hnw (rfl|rfl),
  { exact hnv h, },
  { apply hnw, rwa adj_comm, },
end

lemma is_SRG_with.compl_is_regular (h : G.is_SRG_with n k ℓ μ) :
  Gᶜ.is_regular_of_degree (n - k - 1) :=
begin
  rw [← h.card, nat.sub_sub, add_comm, ←nat.sub_sub],
  exact h.regular.compl,
end

lemma is_SRG_with.card_common_neighbors_eq_of_adj_compl (h : G.is_SRG_with n k ℓ μ)
  {v w : V} (ha : Gᶜ.adj v w) :
  fintype.card ↥(Gᶜ.common_neighbors v w) = n - (2 * k - μ) - 2 :=
begin
  simp only [←set.to_finset_card, common_neighbors, set.to_finset_inter, neighbor_set_compl,
    set.to_finset_sdiff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def],
  simp_rw compl_neighbor_finset_sdiff_inter_eq,
  have hne : v ≠ w := ne_of_adj _ ha,
  rw compl_adj at ha,
  rw [card_sdiff, ← insert_eq, card_insert_of_not_mem, card_singleton, ← finset.compl_union],
  { change (1 + 1) with 2,
    rw [card_compl, h.card_neighbor_finset_union_of_not_adj hne ha.2, ← h.card], },
  { simp only [hne.symm, not_false_iff, mem_singleton], },
  { intro u,
    simp only [mem_union, mem_compl, mem_neighbor_finset, mem_inter, mem_singleton],
    rintro (rfl|rfl);
    simpa [adj_comm] using ha.2, },
end

lemma is_SRG_with.card_common_neighbors_eq_of_not_adj_compl (h : G.is_SRG_with n k ℓ μ)
  {v w : V} (hn : v ≠ w) (hna : ¬Gᶜ.adj v w)  :
  fintype.card ↥(Gᶜ.common_neighbors v w) = n - (2 * k - ℓ) :=
begin
  simp only [←set.to_finset_card, common_neighbors, set.to_finset_inter, neighbor_set_compl,
    set.to_finset_sdiff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def],
  simp only [not_and, not_not, compl_adj] at hna,
  have h2' := hna hn,
  simp_rw [compl_neighbor_finset_sdiff_inter_eq, sdiff_compl_neighbor_finset_inter_eq h2'],
  rwa [← finset.compl_union, card_compl, h.card_neighbor_finset_union_of_adj, ← h.card],
end

/-- The complement of a strongly regular graph is strongly regular. -/
lemma is_SRG_with.compl (h : G.is_SRG_with n k ℓ μ) :
  Gᶜ.is_SRG_with n (n - k - 1) (n - (2 * k - μ) - 2) (n - (2 * k - ℓ)) :=
{ card := h.card,
  regular := h.compl_is_regular,
  of_adj := λ v w ha, h.card_common_neighbors_eq_of_adj_compl ha,
  of_not_adj := λ v w hn hna, h.card_common_neighbors_eq_of_not_adj_compl hn hna, }

end simple_graph


import Mathlib.Algebra.Order.Field.Basic
import Mathlib.Tactic.SolveByElim

open Nat

example {a b c d e : Nat} (h1 : a ≤ b) (h2 : c ≤ d) (h3 : 0 ≤ e) :
    a + c * e + a + c + 0 ≤ b + d * e + b + d + e :=
  Nat.add_le_add (Nat.add_le_add (Nat.add_le_add
    (Nat.add_le_add h1 (Nat.mul_le_mul_of_nonneg_right h2)) h1) h2) h3

example {a b c d e : Nat} (h1 : a ≤ b) (h2 : c ≤ d) (h3 : 0 ≤ e) :
    a + c * e + a + c + 0 ≤ b + d * e + b + d + e := by
  apply_rules [Nat.add_le_add, Nat.mul_le_mul_of_nonneg_right]

-- Check that when we supply an iteration bound,
-- `apply_rules` works up to that bound and returns the remaining goals.
example {a b c d e : Nat} (h1 : a ≤ b) (h2 : c ≤ d) (h3 : 0 ≤ e) :
    a + c * e + a + c + 0 ≤ b + d * e + b + d + e := by
  apply_rules (config := {maxDepth := 9}) [Nat.add_le_add, Nat.mul_le_mul_of_nonneg_right]
  guard_target = 0 ≤ e
  assumption

-- Check that `apply_rules only` works.
example {P Q : Prop} (p : P) (f : P → Q) : Q := by
  apply_rules only [f]
  exact p

-- Check that `apply_rules [-p]` works.
example {P Q : Prop} (p : P) (f : P → Q) : Q := by
  apply_rules [-p]
  exact p

-- Test that metavariables created for implicit arguments don't get stuck
-- This required extra work in Lean 3, but doesn't seem to be a problem in Lean 4.
example (P : Nat → Type) (f : {n : Nat} → P n → P (n + 1)) (g : P 0) : P 2 := by
  apply_rules only [f, g]

-- Check that `apply_rules` solves goals that come after goals that it can't solve
example (Q : Type) (f : Nat → Q) : Int × Q := by
  apply_rules only [Prod.mk, f]
  guard_target = Int
  exact 0
  guard_target = Nat
  exact 37

-- Test that with transparency set to `.reducible`, the tactic will not unfold `/` to the underlying
-- `*` to match the form of the lemma `mul_le_mul`
example [LinearOrderedField α] {a b : α} (hb : 0 ≤ b) (hab : a ≤ b) : a / 2 ≤ b / 2 := by
  apply_rules (config := { transparency := .reducible }) [mul_le_mul]
  guard_target = a / 2 ≤ b / 2
  exact div_le_div hb hab zero_lt_two le_rfl


/-
Copyright (c) 2022 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa, Junyan Xu

! This file was ported from Lean 3 source module data.dfinsupp.lex
! leanprover-community/mathlib commit dde670c9a3f503647fd5bfdf1037bad526d3397a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Dfinsupp.Order
import Mathlib.Data.Dfinsupp.NeLocus
import Mathlib.Order.WellFoundedSet

/-!
# Lexicographic order on finitely supported dependent functions

This file defines the lexicographic order on `Dfinsupp`.
-/

variable {ι : Type _} {α : ι → Type _}

namespace Dfinsupp

section Zero

variable [∀ i, Zero (α i)]

/-- `Dfinsupp.Lex r s` is the lexicographic relation on `Π₀ i, α i`, where `ι` is ordered by `r`,
and `α i` is ordered by `s i`.
The type synonym `Lex (Π₀ i, α i)` has an order given by `Dfinsupp.Lex (· < ·) (· < ·)`.
-/
protected def Lex (r : ι → ι → Prop) (s : ∀ i, α i → α i → Prop) (x y : Π₀ i, α i) : Prop :=
  Pi.Lex r (s _) x y
#align dfinsupp.lex Dfinsupp.Lex

-- Porting note: Added `_root_` to match more closely with Lean 3. Also updated `s`'s type.
theorem _root_.Pi.lex_eq_dfinsupp_lex {r : ι → ι → Prop} {s : ∀ i, α i → α i → Prop}
    (a b : Π₀ i, α i) : Pi.Lex r (s _) (a : ∀ i, α i) b = Dfinsupp.Lex r s a b :=
  rfl
#align pi.lex_eq_dfinsupp_lex Pi.lex_eq_dfinsupp_lex

-- Porting note: Updated `s`'s type.

instance [LT ι] [∀ i, LT (α i)] : LT (Lex (Π₀ i, α i)) :=
  ⟨fun f g ↦ Dfinsupp.Lex (· < ·) (fun _ ↦ (· < ·)) (ofLex f) (ofLex g)⟩

theorem lex_lt_of_lt_of_preorder [∀ i, Preorder (α i)] (r) [IsStrictOrder ι r] {x y : Π₀ i, α i}
    (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i := by
  obtain ⟨hle, j, hlt⟩ := Pi.lt_def.1 hlt
  classical
  have : (x.neLocus y : Set ι).WellFoundedOn r := (x.neLocus y).finite_toSet.wellFoundedOn
  obtain ⟨i, hi, hl⟩ := this.has_min { i | x i < y i } ⟨⟨j, mem_neLocus.2 hlt.ne⟩, hlt⟩
  refine' ⟨i, fun k hk ↦ ⟨hle k, _⟩, hi⟩
  exact of_not_not fun h ↦ hl ⟨k, mem_neLocus.2 (ne_of_not_le h).symm⟩ ((hle k).lt_of_not_le h) hk
#align dfinsupp.lex_lt_of_lt_of_preorder Dfinsupp.lex_lt_of_lt_of_preorder

theorem lex_lt_of_lt [∀ i, PartialOrder (α i)] (r) [IsStrictOrder ι r] {x y : Π₀ i, α i}
    (hlt : x < y) : Pi.Lex r (· < ·) x y := by
  simp_rw [Pi.Lex, le_antisymm_iff]
  exact lex_lt_of_lt_of_preorder r hlt
#align dfinsupp.lex_lt_of_lt Dfinsupp.lex_lt_of_lt

instance Lex.isStrictOrder [LinearOrder ι] [∀ i, PartialOrder (α i)] :
    IsStrictOrder (Lex (Π₀ i, α i)) (· < ·) :=
  let i : IsStrictOrder (Lex (∀ i, α i)) (· < ·) := Pi.Lex.isStrictOrder
  { irrefl := toLex.surjective.forall.2 fun _ ↦ @irrefl _ _ i.toIsIrrefl _
    trans := toLex.surjective.forall₃.2 fun _ _ _ ↦ @trans _ _ i.toIsTrans _ _ _ }
#align dfinsupp.lex.is_strict_order Dfinsupp.Lex.isStrictOrder

variable [LinearOrder ι]

/-- The partial order on `Dfinsupp`s obtained by the lexicographic ordering.
See `Dfinsupp.Lex.linearOrder` for a proof that this partial order is in fact linear. -/
instance Lex.partialOrder [∀ i, PartialOrder (α i)] : PartialOrder (Lex (Π₀ i, α i)) :=
  PartialOrder.lift (fun x ↦ toLex (⇑(ofLex x)))
    (FunLike.coe_injective (F := Dfinsupp fun i => α i))
#align dfinsupp.lex.partial_order Dfinsupp.Lex.partialOrder

section LinearOrder

variable [∀ i, LinearOrder (α i)]

/-- Auxiliary helper to case split computably. There is no need for this to be public, as it
can be written with `Or.by_cases` on `lt_trichotomy` once the instances below are constructed. -/
private def lt_trichotomy_rec {P : Lex (Π₀ i, α i) → Lex (Π₀ i, α i) → Sort _}
    (h_lt : ∀ {f g}, toLex f < toLex g → P (toLex f) (toLex g))
    (h_eq : ∀ {f g}, toLex f = toLex g → P (toLex f) (toLex g))
    (h_gt : ∀ {f g}, toLex g < toLex f → P (toLex f) (toLex g)) : ∀ f g, P f g :=
  Lex.rec fun f ↦ Lex.rec fun g ↦ match (motive := ∀ y, (f.neLocus g).min = y → _) _, rfl with
  | ⊤, h => h_eq (neLocus_eq_empty.mp <| Finset.min_eq_top.mp h)
  | (wit : ι), h => by
    apply (mem_neLocus.mp <| Finset.mem_of_min h).lt_or_lt.by_cases <;> intro hwit
    · exact h_lt ⟨wit, fun j hj ↦ not_mem_neLocus.mp (Finset.not_mem_of_lt_min hj h), hwit⟩
    · exact h_gt ⟨wit, fun j hj ↦
        not_mem_neLocus.mp (Finset.not_mem_of_lt_min hj <| by rwa [neLocus_comm]), hwit⟩

/-- The less-or-equal relation for the lexicographic ordering is decidable. -/
irreducible_def Lex.decidableLE : @DecidableRel (Lex (Π₀ i, α i)) (· ≤ ·) :=
  lt_trichotomy_rec (fun h ↦ isTrue <| Or.inr h)
    (fun h ↦ isTrue <| Or.inl <| congr_arg _ <| congr_arg _ h)
    fun h ↦ isFalse fun h' ↦ lt_irrefl _ (h.trans_le h')
#align dfinsupp.lex.decidable_le Dfinsupp.Lex.decidableLE

/-- The less-than relation for the lexicographic ordering is decidable. -/
irreducible_def Lex.decidableLT : @DecidableRel (Lex (Π₀ i, α i)) (· < ·) :=
  lt_trichotomy_rec (fun h ↦ isTrue h) (fun h ↦ isFalse h.not_lt) fun h ↦ isFalse h.asymm
#align dfinsupp.lex.decidable_lt Dfinsupp.Lex.decidableLT

-- Porting note: Added `DecidableEq` for `LinearOrder`.
instance : DecidableEq (Lex (Π₀ i, α i)) :=
  lt_trichotomy_rec (fun h ↦ isFalse fun h' => h'.not_lt h) (fun h ↦ isTrue h)
    fun h ↦ isFalse fun h' => h'.symm.not_lt h

/-- The linear order on `Dfinsupp`s obtained by the lexicographic ordering. -/
instance Lex.linearOrder : LinearOrder (Lex (Π₀ i, α i)) :=
  { Lex.partialOrder with
    le_total := lt_trichotomy_rec (fun h ↦ Or.inl h.le) (fun h ↦ Or.inl h.le) fun h ↦ Or.inr h.le
    decidable_lt := decidableLT
    decidable_le := decidableLE
    decidable_eq := inferInstance }
#align dfinsupp.lex.linear_order Dfinsupp.Lex.linearOrder

end LinearOrder

variable [∀ i, PartialOrder (α i)]

theorem toLex_monotone : Monotone (@toLex (Π₀ i, α i)) := by
  intro a b h
  refine' le_of_lt_or_eq (or_iff_not_imp_right.2 fun hne ↦ _)
  classical
  exact ⟨Finset.min' _ (nonempty_neLocus_iff.2 hne),
    fun j hj ↦ not_mem_neLocus.1 fun h ↦ (Finset.min'_le _ _ h).not_lt hj,
    (h _).lt_of_ne (mem_neLocus.1 <| Finset.min'_mem _ _)⟩
#align dfinsupp.to_lex_monotone Dfinsupp.toLex_monotone

theorem lt_of_forall_lt_of_lt (a b : Lex (Π₀ i, α i)) (i : ι) :
    (∀ j < i, ofLex a j = ofLex b j) → ofLex a i < ofLex b i → a < b :=
  fun h1 h2 ↦ ⟨i, h1, h2⟩
#align dfinsupp.lt_of_forall_lt_of_lt Dfinsupp.lt_of_forall_lt_of_lt

end Zero

section Covariants

variable [LinearOrder ι] [∀ i, AddMonoid (α i)] [∀ i, LinearOrder (α i)]

/-!  We are about to sneak in a hypothesis that might appear to be too strong.
We assume `CovariantClass` with *strict* inequality `<` also when proving the one with the
*weak* inequality `≤`. This is actually necessary: addition on `Lex (Π₀ i, α i)` may fail to be
monotone, when it is "just" monotone on `α i`. -/

section Left

variable [∀ i, CovariantClass (α i) (α i) (· + ·) (· < ·)]

instance Lex.covariantClass_lt_left :
    CovariantClass (Lex (Π₀ i, α i)) (Lex (Π₀ i, α i)) (· + ·) (· < ·) :=
  ⟨fun _ _ _ ⟨a, lta, ha⟩ ↦ ⟨a, fun j ja ↦ congr_arg _ (lta j ja), add_lt_add_left ha _⟩⟩
#align dfinsupp.lex.covariant_class_lt_left Dfinsupp.Lex.covariantClass_lt_left

instance Lex.covariantClass_le_left :
    CovariantClass (Lex (Π₀ i, α i)) (Lex (Π₀ i, α i)) (· + ·) (· ≤ ·) :=
  Add.to_covariantClass_left _
#align dfinsupp.lex.covariant_class_le_left Dfinsupp.Lex.covariantClass_le_left

end Left

section Right

variable [∀ i, CovariantClass (α i) (α i) (Function.swap (· + ·)) (· < ·)]

instance Lex.covariantClass_lt_right :
    CovariantClass (Lex (Π₀ i, α i)) (Lex (Π₀ i, α i)) (Function.swap (· + ·)) (· < ·) :=
  ⟨fun f _ _ ⟨a, lta, ha⟩ ↦
    ⟨a, fun j ja ↦ congr_arg (· + ofLex f j) (lta j ja), add_lt_add_right ha _⟩⟩
#align dfinsupp.lex.covariant_class_lt_right Dfinsupp.Lex.covariantClass_lt_right

instance Lex.covariantClass_le_right :
    CovariantClass (Lex (Π₀ i, α i)) (Lex (Π₀ i, α i)) (Function.swap (· + ·)) (· ≤ ·) :=
  Add.to_covariantClass_right _
#align dfinsupp.lex.covariant_class_le_right Dfinsupp.Lex.covariantClass_le_right

end Right

end Covariants

end Dfinsupp


import group_representation
import morphism
import Tools.to_sum
import Tools.sum_group
/-!
*    Let `ρ and π` two representations on `M` and `M'`. Let `f : M →ₗ[R] M'` a `linear_map`.
*    Let  `ℒ f := Σ_{g ∈ G} π g⁻¹ ∘ f ∘ ρ  g`,   then  `ℒ f` is a morphism `ρ ⟶ π`.
*    Proof :  `∀ t ∈ G,  ρ t ∘ ℒ f ∘ π t⁻¹  := ∑ ρ t g⁻¹  ∘ f ∘ π g t  = ∑  t'⁻¹  ∘  f ∘ π t'`

#    We start to define sum operator on `M →ₗ[R] M'`
*     Let `(X : Type u)[fintype X]` and ` φ : X → M→ₗ[R]M'`. We fix a notation for
*    `finset.sum finset.univ φ := Σ φ`.
-/
universes  u v w w'
open linear_map TEST
/-!
*   We illustrate in a first time the name of the function.
-/
namespace Illustration
notation `Σ` := finset.sum (finset.univ)
variables {G : Type u } [group G][fintype G]
          {R : Type v}[comm_ring R]
          {M : Type w}  [add_comm_group M] [module R M]
          {M' : Type w'} [add_comm_group M'] [module R M']
          (ρ : G → M →ₗ[R]M')
          (f : M' →ₗ[R]M')
          (g : M →ₗ[R]M)
          (x : M)
/-!
    Here ` * ` denote the composition of linear application. We have a structure of `add_comm_monoid`
    on ` M→ₗ[R]M' ` That ensure `Σ` is well define.
-/
example :  f * Σ ρ  = Σ  (λ s, f * ρ s)     := Sum_comp_left ρ f
example :  (Σ ρ) * g = Σ (λ s, (ρ s) * g )  := Sum_comp_right ρ g
example :  (Σ ρ ) x = Σ (λ g, ρ g x)        := Sum_apply ρ x

end Illustration

variables {G : Type u} [group G][fintype G]
          {R : Type v}[comm_ring R]   --- Commutative ring

namespace Reynold
open Illustration
variables {M : Type w}  [add_comm_group M] [module R M]
          {M' : Type w'} [add_comm_group M'] [module R M']
          (ρ : group_representation G R M)
          (π : group_representation G R M')

lemma coersion (s g : G) : (((ρ s * ρ g⁻¹) * ρ g) : M→ₗ[R]M) = linear_map.comp ((ρ s * ρ g⁻¹) : M→ₗ[R] M )  (ρ g : M→ₗ[R]M )  := rfl
/--
    We start to define `mixte_conj (f : M→ₗ[R]M')(s : G) : M→ₗ[R] M' := π s⁻¹ * f * ρ s`
-/
def mixte_conj (f : M→ₗ[R]M') : G →   M→ₗ[R] M' := λ s, ↑(π s⁻¹)  * f * ↑(ρ s)

lemma mixte_conj_ext (f : M→ₗ[R]M')(s : G) : mixte_conj ρ π f s = ↑(π s⁻¹)  * f * ↑(ρ s) := rfl
/--
        we have `∀ g : G, (π g) (π s⁻¹) * f * ρ s = π (s g⁻¹)⁻¹  * f * ρ (s g⁻¹) * ρ g`
        so `π  g * mixte_conj s = mixte_conj (s g⁻¹) ρ g`
-/
theorem mixte_conj_mul_left (f : M→ₗ[R]M') (g : G)(s : G):
 ↑(π g) * (mixte_conj ρ π f s) = (mixte_conj ρ π f (s * g⁻¹)) * ↑(ρ g ) :=
 begin
    rw mixte_conj_ext, rw mixte_conj_ext,
    erw mul_inv_rev, rw inv_inv, rw π.map_mul, rw ρ.map_mul,
    erw linear_map.comp_assoc ↑(ρ g),  rw ← coersion ρ s g,
    rw mul_assoc, rw ← ρ.map_mul , rw inv_mul_self, rw ρ.map_one, rw mul_one, exact rfl,
end
theorem mixte_conj_mul_left_fun (f : M→ₗ[R]M') (g : G) :
        (λ s : G, ↑(π g) * (mixte_conj ρ π f s)) = (λ s, (mixte_conj ρ π f (s * g⁻¹)) * ↑(ρ g )) :=
begin
    ext,rw mixte_conj_mul_left,
end
--- TO DO : i have to study more the operator.
---   For the organisation : perhaps just give the definition here and
---   To the work in other file ?
/--
    The operator `ℒ`
-/
def ℒ (f : M→ₗ[R]M') : M→ₗ[R] M' := finset.sum finset.univ (mixte_conj ρ π f)
/--
*
*
-/
theorem Per (f : M→ₗ[R]M') (g : G) : Σ (mixte_conj ρ π f) = Σ (λ s, mixte_conj ρ π f (s * g⁻¹)) :=
     @Sum_equiv G (M→ₗ[R]M') _ g (mixte_conj ρ π f) _ (to_equiv g)

theorem L_is_morphism (f : M→ₗ[R]M') (g : G) : (π g : M'→ₗ[R]M') * (ℒ ρ π  f) = (ℒ ρ π  f) * (ρ g : M→ₗ[R] M) :=  begin
    unfold ℒ,
    erw Sum_comp_left,
    rw  mixte_conj_mul_left_fun,
    rw ← Sum_comp_right,
    rw Per ρ π  f g,
end
/--
    The Reynold opérator.
-/
def ℛ : (M→ₗ[R]M') → (ρ ⟶  π) := λ f, { ℓ := ℒ ρ π f,
  commute := begin
        intros g, ext x, rw function.comp_apply,
        let theo := L_is_morphism ρ π f g,
        rw linear_map.ext_iff  at theo,
        specialize theo x,
        rw linear_map.comp_apply at theo,
        erw ← theo, exact rfl,
   end }
lemma reynold_ext(f : M →ₗ[R]M' ) : (ℛ ρ π f).ℓ = finset.sum finset.univ (mixte_conj ρ π f) := rfl
#check ℛ ρ ρ
end Reynold
namespace more_on_mixte_conj
open Reynold
end more_on_mixte_conj


import data.cpi.species.congruence data.cpi.species.prime

namespace cpi
namespace species
namespace equiv
variables {ℍ : Type} {ω : context}
open_locale congruence

section depth
  private def depth : ∀ {Γ}, species ℍ ω Γ → ℕ
  | _ nil := 0
  | _ (apply _ _) := 1
  | _ (Σ# _) := 1
  | _ (A |ₛ B) := depth A + depth B
  | Γ (ν(_) A) := depth A
  using_well_founded {
    rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, whole.sizeof ℍ ω kind.species x.fst x.snd ) ⟩ ],
    dec_tac := tactic.fst_dec_tac,
  }

  private lemma depth_rename : ∀ {Γ Δ} (ρ : name Γ → name Δ) (A : species ℍ ω Γ), depth (rename ρ A) = depth A
  | _ _ ρ nil := by simp only [rename.nil, depth]
  | _ _ ρ (apply _ _) := by simp only [rename.invoke, depth]
  | _ _ ρ (Σ# _) := by simp only [rename.choice, depth]
  | _ _ ρ (A |ₛ B) := begin
    simp only [rename.parallel, depth],
    rw [depth_rename ρ A, depth_rename ρ B],
  end
  | _ _ ρ (ν(_) A) := begin
    simp only [rename.restriction, depth],
    from depth_rename (name.ext ρ) A,
  end
  using_well_founded {
    rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, whole.sizeof ℍ ω kind.species x.1 x.2.2.2 ) ⟩ ],
    dec_tac := tactic.fst_dec_tac,
  }

  private lemma depth_eq : ∀ {Γ} {A B : species ℍ ω Γ}, A ≈ B → depth A = depth B
  | Γ A B ⟨ eq ⟩ := begin
    induction eq,
    case equivalent.refl { from rfl },
    case equivalent.trans : _ A' B' C' ab bc ihab ihbc { from trans ihab ihbc },
    case equivalent.ξ_parallel₁ : _ A' A'' B eq ih { unfold depth, rw ih },
    case equivalent.ξ_parallel₂ : _ A B' B' eq ih { unfold depth, rw ih },
    case equivalent.ξ_restriction : _ M A A' eq ih { unfold depth, rw ih },
    all_goals { repeat { unfold depth <|> simp only [add_zero, zero_add, add_comm, add_assoc, depth_rename] } },
  end

  private lemma depth_nil : ∀ {Γ} {A : species ℍ ω Γ}, A ≈ nil → depth A = 0
  | Γ A eq := by { have eq := depth_eq eq, unfold depth at eq, from eq }

  private lemma depth_nil_rev : ∀ {Γ} {A : species ℍ ω Γ}, depth A = 0 → A ≈ nil
  | _ nil eq := refl _
  | _ (apply _ _) eq := by { unfold depth at eq, contradiction }
  | _ (Σ# _) eq:= by { unfold depth at eq, contradiction }
  | _ (A |ₛ B) eq := begin
    unfold depth at eq,
    calc  (A |ₛ B)
        ≈ (A |ₛ nil) : equiv.ξ_parallel₂ (depth_nil_rev (nat.eq_zero_of_add_eq_zero_left eq))
    ... ≈ A : equiv.parallel_nil₁
    ... ≈ nil : depth_nil_rev (nat.eq_zero_of_add_eq_zero_right eq)
  end
  | _ (ν(M) A) eq := begin
    unfold depth at eq,
    calc  (ν(M) A)
        ≈ (ν(M) nil) : equiv.ξ_restriction M (depth_nil_rev eq)
    ... ≈ (ν(M) species.rename name.extend nil) : by simp only [rename.nil]
    ... ≈ nil : equiv.ν_drop₁ M
  end
  using_well_founded {
    rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, whole.sizeof ℍ ω kind.species x.1 x.2.1 ) ⟩ ],
    dec_tac := tactic.fst_dec_tac,
  }
end depth

open_locale classical

/-- A procecure to compute the prime decomposition of a species using classical
    logic. This is sound, but non-computable. -/
noncomputable def do_prime_decompose {Γ} :
  ∀ (A : species ℍ ω Γ)
  , Σ' (As : list (prime_species ℍ ω Γ))
    , A ≈ parallel.from_list (list.map subtype.val As)
| A :=
  if is_nil : A ≈ nil then
    ⟨ [], is_nil ⟩
  else if has_decomp : ∃ B C, ¬ B ≈ nil ∧ ¬ C ≈ nil ∧ A ≈ (B |ₛ C) then
    let B := classical.some has_decomp in
    let C := classical.some (classical.some_spec has_decomp) in
    have h : ¬B ≈ nil ∧ ¬C ≈ nil ∧ A ≈ (B |ₛ C) := classical.some_spec (classical.some_spec has_decomp),
    have lB : depth B < depth A := begin
        have : depth A = depth (B |ₛ C) := depth_eq h.2.2, rw this, unfold depth,
        from lt_add_of_pos_right _ (nat.pos_of_ne_zero (λ x, h.2.1 (depth_nil_rev x)))
      end,
    have lC : depth C < depth A := begin
        have : depth A = depth (B |ₛ C) := depth_eq h.2.2, rw this, unfold depth,
        from lt_add_of_pos_left _ (nat.pos_of_ne_zero (λ x, h.1 (depth_nil_rev x)))
      end,
    let Bs := do_prime_decompose B in
    let Cs := do_prime_decompose C in
    suffices this : A ≈ parallel.from_list (list.map subtype.val (Bs.1 ++ Cs.1)),
      from ⟨ Bs.1 ++ Cs.1, this ⟩,
    calc  A
        ≈ (B |ₛ C) : h.2.2
    ... ≈ (parallel.from_list (list.map subtype.val Bs.1) |ₛ parallel.from_list (list.map subtype.val Cs.1))
        : trans (equiv.ξ_parallel₁ Bs.2) (equiv.ξ_parallel₂ Cs.2)
    ... ≈ parallel.from_list (list.map subtype.val Bs.1 ++ list.map subtype.val Cs.1)
          : (parallel.from_append _ _).symm
    ... ≈ parallel.from_list (list.map subtype.val (Bs.1 ++ Cs.1)) : by rw list.map_append
  else
    suffices this : prime A, from ⟨ [ ⟨ A, this ⟩ ], refl _ ⟩,
    ⟨ is_nil, λ B C eq,
      if nilB : B ≈ nil then or.inl nilB else
      if nilC : C ≈ nil then or.inr nilC else
      false.elim (has_decomp ⟨ B, C, nilB, nilC, eq ⟩) ⟩
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf depth ⟩ ],
  dec_tac := tactic.fst_dec_tac',
}

/-- Decompose a species into its constituent primes. -/
noncomputable def prime_decompose {Γ} (A : species ℍ ω Γ) : multiset (prime_species ℍ ω Γ)
  := ⟦ (do_prime_decompose A).1 ⟧

lemma prime_decompose_nil {Γ} : prime_decompose (@nil ℍ ω Γ) = 0 := begin
  unfold prime_decompose do_prime_decompose,
  simpa only [dif_pos (refl nil)],
end

lemma prime_decompose_prime {Γ} : ∀ (A : prime_species ℍ ω Γ), prime_decompose A.val = [ A ]
| ⟨ A, ⟨ n_nil, n_decompose ⟩ ⟩ := begin
  have n_exist : ¬ ∃ (B C : whole ℍ ω kind.species Γ), ¬B ≈ nil ∧ ¬C ≈ nil ∧ A ≈ (B |ₛ C),
  { rintros ⟨ B, C, nB, nC, r ⟩, from or.elim (n_decompose B C r) nB nC },
  unfold prime_decompose do_prime_decompose,
  simpa only [dif_neg n_nil, dif_neg n_exist],
end

end equiv
end species
end cpi

#lint-


/-
Copyright (c) 2021 Noam Atar. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Noam Atar
-/
import order.ideal
import order.pfilter

/-!
# Prime ideals

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

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.

- `order.ideal.prime_pair`: A pair of an `ideal` and a `pfilter` which form a partition of `P`.
  This is useful as giving the data of a prime ideal is the same as giving the data of a prime
  filter.
- `order.ideal.is_prime`: a predicate for prime ideals. Dual to the notion of a prime filter.
- `order.pfilter.is_prime`: a predicate for prime filters. Dual to the notion of a prime ideal.

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>

## Tags

ideal, prime

-/

open order.pfilter

namespace order

variables {P : Type*}

namespace ideal

/-- A pair of an `ideal` and a `pfilter` which form a partition of `P`.
-/
@[nolint has_nonempty_instance]
structure prime_pair (P : Type*) [preorder P] :=
(I            : ideal P)
(F            : pfilter P)
(is_compl_I_F : is_compl (I : set P) F)

namespace prime_pair

variables [preorder P] (IF : prime_pair P)

lemma compl_I_eq_F : (IF.I : set P)ᶜ = IF.F := IF.is_compl_I_F.compl_eq
lemma compl_F_eq_I : (IF.F : set P)ᶜ = IF.I := IF.is_compl_I_F.eq_compl.symm

lemma I_is_proper : is_proper IF.I :=
begin
  cases IF.F.nonempty,
  apply is_proper_of_not_mem (_ : w ∉ IF.I),
  rwa ← IF.compl_I_eq_F at h,
end

lemma disjoint : disjoint (IF.I : set P) IF.F := IF.is_compl_I_F.disjoint

lemma I_union_F : (IF.I : set P) ∪ IF.F = set.univ := IF.is_compl_I_F.sup_eq_top
lemma F_union_I : (IF.F : set P) ∪ IF.I = set.univ := IF.is_compl_I_F.symm.sup_eq_top

end prime_pair

/-- An ideal `I` is prime if its complement is a filter.
-/
@[mk_iff] class is_prime [preorder P] (I : ideal P) extends is_proper I : Prop :=
(compl_filter : is_pfilter (I : set P)ᶜ)

section preorder

variable [preorder P]

/-- Create an element of type `order.ideal.prime_pair` from an ideal satisfying the predicate
`order.ideal.is_prime`. -/
def is_prime.to_prime_pair {I : ideal P} (h : is_prime I) : prime_pair P :=
{ I            := I,
  F            := h.compl_filter.to_pfilter,
  is_compl_I_F := is_compl_compl }

lemma prime_pair.I_is_prime (IF : prime_pair P) : is_prime IF.I :=
{ compl_filter := by { rw IF.compl_I_eq_F, exact IF.F.is_pfilter },
  ..IF.I_is_proper }

end preorder

section semilattice_inf

variables [semilattice_inf P] {x y : P} {I : ideal P}

lemma is_prime.mem_or_mem (hI : is_prime I) {x y : P} : x ⊓ y ∈ I → x ∈ I ∨ y ∈ I :=
begin
  contrapose!,
  let F := hI.compl_filter.to_pfilter,
  show x ∈ F ∧ y ∈ F → x ⊓ y ∈ F,
  exact λ h, inf_mem h.1 h.2,
end

lemma is_prime.of_mem_or_mem [is_proper I] (hI : ∀ {x y : P}, x ⊓ y ∈ I → x ∈ I ∨ y ∈ I) :
  is_prime I :=
begin
  rw is_prime_iff,
  use ‹_›,
  apply is_pfilter.of_def,
  { exact set.nonempty_compl.2 (I.is_proper_iff.1 ‹_›) },
  { intros x _ y _,
    refine ⟨x ⊓ y, _, inf_le_left, inf_le_right⟩,
    have := mt hI,
    tauto! },
  { exact @mem_compl_of_ge _ _ _ }
end

lemma is_prime_iff_mem_or_mem [is_proper I] : is_prime I ↔ ∀ {x y : P}, x ⊓ y ∈ I → x ∈ I ∨ y ∈ I :=
⟨is_prime.mem_or_mem, is_prime.of_mem_or_mem⟩

end semilattice_inf

section distrib_lattice

variables [distrib_lattice P] {I : ideal P}

@[priority 100]
instance is_maximal.is_prime [is_maximal I] : is_prime I :=
begin
  rw is_prime_iff_mem_or_mem,
  intros x y,
  contrapose!,
  rintro ⟨hx, hynI⟩ hxy,
  apply hynI,
  let J := I ⊔ principal x,
  have hJuniv : (J : set P) = set.univ :=
    is_maximal.maximal_proper (lt_sup_principal_of_not_mem ‹_›),
  have hyJ : y ∈ ↑J := set.eq_univ_iff_forall.mp hJuniv y,
  rw coe_sup_eq at hyJ,
  rcases hyJ with ⟨a, ha, b, hb, hy⟩,
  rw hy,
  refine sup_mem ha (I.lower (le_inf hb _) hxy),
  rw hy,
  exact le_sup_right
end

end distrib_lattice

section boolean_algebra

variables [boolean_algebra P] {x : P} {I : ideal P}

lemma is_prime.mem_or_compl_mem (hI : is_prime I) : x ∈ I ∨ xᶜ ∈ I :=
begin
  apply hI.mem_or_mem,
  rw inf_compl_eq_bot,
  exact I.bot_mem,
end

lemma is_prime.mem_compl_of_not_mem (hI : is_prime I) (hxnI : x ∉ I) : xᶜ ∈ I :=
hI.mem_or_compl_mem.resolve_left hxnI

lemma is_prime_of_mem_or_compl_mem [is_proper I] (h : ∀ {x : P}, x ∈ I ∨ xᶜ ∈ I) : is_prime I :=
begin
  simp only [is_prime_iff_mem_or_mem, or_iff_not_imp_left],
  intros x y hxy hxI,
  have hxcI : xᶜ ∈ I := h.resolve_left hxI,
  have ass : (x ⊓ y) ⊔ (y ⊓ xᶜ) ∈ I := sup_mem hxy (I.lower inf_le_right hxcI),
  rwa [inf_comm, sup_inf_inf_compl] at ass
end

@[priority 100]
instance is_prime.is_maximal [is_prime I] : is_maximal I :=
begin
  simp only [is_maximal_iff, set.eq_univ_iff_forall, is_prime.to_is_proper, true_and],
  intros J hIJ x,
  rcases set.exists_of_ssubset hIJ with ⟨y, hyJ, hyI⟩,
  suffices ass : (x ⊓ y) ⊔ (x ⊓ yᶜ) ∈ J,
  { rwa sup_inf_inf_compl at ass },
  exact sup_mem (J.lower inf_le_right hyJ)
    (hIJ.le $ I.lower inf_le_right $ is_prime.mem_compl_of_not_mem ‹_› hyI),
end

end boolean_algebra

end ideal

namespace pfilter

variable [preorder P]

/-- A filter `F` is prime if its complement is an ideal.
-/
@[mk_iff] class is_prime (F : pfilter P) : Prop :=
(compl_ideal : is_ideal (F : set P)ᶜ)

/-- Create an element of type `order.ideal.prime_pair` from a filter satisfying the predicate
`order.pfilter.is_prime`. -/
def is_prime.to_prime_pair {F : pfilter P} (h : is_prime F) : ideal.prime_pair P :=
{ I            := h.compl_ideal.to_ideal,
  F            := F,
  is_compl_I_F := is_compl_compl.symm }

lemma _root_.order.ideal.prime_pair.F_is_prime (IF : ideal.prime_pair P) : is_prime IF.F :=
{ compl_ideal := by { rw IF.compl_F_eq_I, exact IF.I.is_ideal } }

end pfilter

end order


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

! This file was ported from Lean 3 source module algebra.polynomial.group_ring_action
! leanprover-community/mathlib commit afad8e438d03f9d89da2914aa06cb4964ba87a18
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupRingAction.Basic
import Mathlib.Algebra.Hom.GroupAction
import Mathlib.Data.Polynomial.AlgebraMap
import Mathlib.Data.Polynomial.Monic
import Mathlib.GroupTheory.GroupAction.Quotient

/-!
# Group action on rings applied to polynomials

This file contains instances and definitions relating `MulSemiringAction` to `Polynomial`.
-/

variable (M : Type _) [Monoid M]

open Polynomial

namespace Polynomial

variable (R : Type _) [Semiring R]

variable {M}

-- porting note: changed `(· • ·) m` to `HSMul.hSMul m`
theorem smul_eq_map [MulSemiringAction M R] (m : M) :
    HSMul.hSMul m = map (MulSemiringAction.toRingHom M R m) := by
  suffices
    DistribMulAction.toAddMonoidHom R[X] m =
      (mapRingHom (MulSemiringAction.toRingHom M R m)).toAddMonoidHom
    by
    ext1 r
    exact FunLike.congr_fun this r
  ext (n r) : 2
  change m • monomial n r = map (MulSemiringAction.toRingHom M R m) (monomial n r)
  rw [Polynomial.map_monomial, Polynomial.smul_monomial, MulSemiringAction.toRingHom_apply]
#align polynomial.smul_eq_map Polynomial.smul_eq_map

variable (M)

noncomputable instance [MulSemiringAction M R] : MulSemiringAction M R[X] :=
  { Polynomial.distribMulAction with
    smul := (· • ·)
    smul_one := fun m ↦
      smul_eq_map R m ▸ Polynomial.map_one (MulSemiringAction.toRingHom M R m)
    smul_mul := fun m _ _ ↦
      smul_eq_map R m ▸ Polynomial.map_mul (MulSemiringAction.toRingHom M R m) }

variable {M R}

variable [MulSemiringAction M R]

@[simp]
theorem smul_X (m : M) : (m • X : R[X]) = X :=
  (smul_eq_map R m).symm ▸ map_X _
set_option linter.uppercaseLean3 false in
#align polynomial.smul_X Polynomial.smul_X

variable (S : Type _) [CommSemiring S] [MulSemiringAction M S]

theorem smul_eval_smul (m : M) (f : S[X]) (x : S) : (m • f).eval (m • x) = m • f.eval x :=
  Polynomial.induction_on f (fun r ↦ by rw [smul_C, eval_C, eval_C])
    (fun f g ihf ihg ↦ by rw [smul_add, eval_add, ihf, ihg, eval_add, smul_add]) fun n r _ ↦ by
    rw [smul_mul', smul_pow', smul_C, smul_X, eval_mul, eval_C, eval_pow, eval_X, eval_mul, eval_C,
      eval_pow, eval_X, smul_mul', smul_pow']
#align polynomial.smul_eval_smul Polynomial.smul_eval_smul

variable (G : Type _) [Group G]

theorem eval_smul' [MulSemiringAction G S] (g : G) (f : S[X]) (x : S) :
    f.eval (g • x) = g • (g⁻¹ • f).eval x := by
  rw [← smul_eval_smul, smul_inv_smul]
#align polynomial.eval_smul' Polynomial.eval_smul'

theorem smul_eval [MulSemiringAction G S] (g : G) (f : S[X]) (x : S) :
    (g • f).eval x = g • f.eval (g⁻¹ • x) := by
  rw [← smul_eval_smul, smul_inv_smul]
#align polynomial.smul_eval Polynomial.smul_eval

end Polynomial

section CommRing
set_option linter.uppercaseLean3 false  -- porting note: `prod_X_*`

variable (G : Type _) [Group G] [Fintype G]

variable (R : Type _) [CommRing R] [MulSemiringAction G R]

open MulAction

open Classical

/-- the product of `(X - g • x)` over distinct `g • x`. -/
noncomputable def prodXSubSmul (x : R) : R[X] :=
  (Finset.univ : Finset (G ⧸ MulAction.stabilizer G x)).prod fun g ↦
    Polynomial.X - Polynomial.C (ofQuotientStabilizer G x g)
#align prod_X_sub_smul prodXSubSmul

theorem prodXSubSmul.monic (x : R) : (prodXSubSmul G R x).Monic :=
  Polynomial.monic_prod_of_monic _ _ fun _ _ ↦ Polynomial.monic_X_sub_C _
#align prod_X_sub_smul.monic prodXSubSmul.monic

theorem prodXSubSmul.eval (x : R) : (prodXSubSmul G R x).eval x = 0 :=
  (map_prod ((Polynomial.aeval x).toRingHom.toMonoidHom : R[X] →* R) _ _).trans <|
    Finset.prod_eq_zero (Finset.mem_univ <| QuotientGroup.mk 1) <| by simp
#align prod_X_sub_smul.eval prodXSubSmul.eval

theorem prodXSubSmul.smul (x : R) (g : G) : g • prodXSubSmul G R x = prodXSubSmul G R x :=
  Finset.smul_prod.trans <|
    Fintype.prod_bijective _ (MulAction.bijective g) _ _ fun g' ↦ by
      rw [ofQuotientStabilizer_smul, smul_sub, Polynomial.smul_X, Polynomial.smul_C]
#align prod_X_sub_smul.smul prodXSubSmul.smul

theorem prodXSubSmul.coeff (x : R) (g : G) (n : ℕ) :
    g • (prodXSubSmul G R x).coeff n = (prodXSubSmul G R x).coeff n := by
  rw [← Polynomial.coeff_smul, prodXSubSmul.smul]
#align prod_X_sub_smul.coeff prodXSubSmul.coeff

end CommRing

namespace MulSemiringActionHom

variable {M}

variable {P : Type _} [CommSemiring P] [MulSemiringAction M P]

variable {Q : Type _} [CommSemiring Q] [MulSemiringAction M Q]

open Polynomial

/-- An equivariant map induces an equivariant map on polynomials. -/
protected noncomputable def polynomial (g : P →+*[M] Q) : P[X] →+*[M] Q[X] where
  toFun := map g
  map_smul' m p :=
    Polynomial.induction_on p
      (fun b ↦ by rw [smul_C, map_C, coe_fn_coe, g.map_smul, map_C, coe_fn_coe, smul_C])
      (fun p q ihp ihq ↦ by
        rw [smul_add, Polynomial.map_add, ihp, ihq, Polynomial.map_add, smul_add])
      fun n b _ ↦ by
      rw [smul_mul', smul_C, smul_pow', smul_X, Polynomial.map_mul, map_C, Polynomial.map_pow,
        map_X, coe_fn_coe, g.map_smul, Polynomial.map_mul, map_C, Polynomial.map_pow, map_X,
        smul_mul', smul_C, smul_pow', smul_X, coe_fn_coe]
  -- porting note: added `.toRingHom`
  map_zero' := Polynomial.map_zero g.toRingHom
  map_add' p q := Polynomial.map_add g.toRingHom
  map_one' := Polynomial.map_one g.toRingHom
  map_mul' p q := Polynomial.map_mul g.toRingHom
#align mul_semiring_action_hom.polynomial MulSemiringActionHom.polynomial

@[simp]
theorem coe_polynomial (g : P →+*[M] Q) : (g.polynomial : P[X] → Q[X]) = map g := rfl
#align mul_semiring_action_hom.coe_polynomial MulSemiringActionHom.coe_polynomial

end MulSemiringActionHom


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro
-/
import data.rat.init
import algebra.ring.defs

/-!
# Division (semi)rings and (semi)fields

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

This file introduces fields and division rings (also known as skewfields) and proves some basic
statements about them. For a more extensive theory of fields, see the `field_theory` folder.

## Main definitions

* `division_semiring`: Nontrivial semiring with multiplicative inverses for nonzero elements.
* `division_ring`: : Nontrivial ring with multiplicative inverses for nonzero elements.
* `semifield`: Commutative division semiring.
* `field`: Commutative division ring.
* `is_field`: Predicate on a (semi)ring that it is a (semi)field, i.e. that the multiplication is
  commutative, that it has more than one element and that all non-zero elements have a
  multiplicative inverse. In contrast to `field`, which contains the data of a function associating
  to an element of the field its multiplicative inverse, this predicate only assumes the existence
  and can therefore more easily be used to e.g. transfer along ring isomorphisms.

## Implementation details

By convention `0⁻¹ = 0` in a field or division ring. This is due to the fact that working with total
functions has the advantage of not constantly having to check that `x ≠ 0` when writing `x⁻¹`. With
this convention in place, some statements like `(a + b) * c⁻¹ = a * c⁻¹ + b * c⁻¹` still remain
true, while others like the defining property `a * a⁻¹ = 1` need the assumption `a ≠ 0`. If you are
a beginner in using Lean and are confused by that, you can read more about why this convention is
taken in Kevin Buzzard's
[blogpost](https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/)

A division ring or field is an example of a `group_with_zero`. If you cannot find
a division ring / field lemma that does not involve `+`, you can try looking for
a `group_with_zero` lemma instead.

## Tags

field, division ring, skew field, skew-field, skewfield
-/

open function set

set_option old_structure_cmd true

universe u
variables {α β K : Type*}

/-- The default definition of the coercion `(↑(a : ℚ) : K)` for a division ring `K`
is defined as `(a / b : K) = (a : K) * (b : K)⁻¹`.
Use `coe` instead of `rat.cast_rec` for better definitional behaviour.
-/
def rat.cast_rec [has_lift_t ℕ K] [has_lift_t ℤ K] [has_mul K] [has_inv K] : ℚ → K
| ⟨a, b, _, _⟩ := ↑a * (↑b)⁻¹

/--
Type class for the canonical homomorphism `ℚ → K`.
-/
@[protect_proj]
class has_rat_cast (K : Type u) :=
(rat_cast : ℚ → K)

/-- The default definition of the scalar multiplication `(a : ℚ) • (x : K)` for a division ring `K`
is given by `a • x = (↑ a) * x`.
Use `(a : ℚ) • (x : K)` instead of `qsmul_rec` for better definitional behaviour.
-/
def qsmul_rec (coe : ℚ → K) [has_mul K] (a : ℚ) (x : K) : K :=
coe a * x

/-- A `division_semiring` is a `semiring` with multiplicative inverses for nonzero elements. -/
@[protect_proj, ancestor semiring group_with_zero]
class division_semiring (α : Type*) extends semiring α, group_with_zero α

/-- A `division_ring` is a `ring` with multiplicative inverses for nonzero elements.

An instance of `division_ring K` includes maps `rat_cast : ℚ → K` and `qsmul : ℚ → K → K`.
If the division ring has positive characteristic p, we define `rat_cast (1 / p) = 1 / 0 = 0`
for consistency with our division by zero convention.
The fields `rat_cast` and `qsmul` are needed to implement the
`algebra_rat [division_ring K] : algebra ℚ K` instance, since we need to control the specific
definitions for some special cases of `K` (in particular `K = ℚ` itself).
See also Note [forgetful inheritance].
-/
@[protect_proj, ancestor ring div_inv_monoid nontrivial]
class division_ring (K : Type u) extends ring K, div_inv_monoid K, nontrivial K, has_rat_cast K :=
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)
(rat_cast := rat.cast_rec)
(rat_cast_mk : ∀ (a : ℤ) (b : ℕ) h1 h2, rat_cast ⟨a, b, h1, h2⟩ = a * b⁻¹ . try_refl_tac)
(qsmul : ℚ → K → K := qsmul_rec rat_cast)
(qsmul_eq_mul' : ∀ (a : ℚ) (x : K), qsmul a x = rat_cast a * x . try_refl_tac)

@[priority 100] -- see Note [lower instance priority]
instance division_ring.to_division_semiring [division_ring α] : division_semiring α :=
{ ..‹division_ring α›, ..(infer_instance : semiring α) }

/-- A `semifield` is a `comm_semiring` with multiplicative inverses for nonzero elements. -/
@[protect_proj, ancestor comm_semiring division_semiring comm_group_with_zero]
class semifield (α : Type*) extends comm_semiring α, division_semiring α, comm_group_with_zero α

/-- A `field` is a `comm_ring` with multiplicative inverses for nonzero elements.

An instance of `field K` includes maps `of_rat : ℚ → K` and `qsmul : ℚ → K → K`.
If the field has positive characteristic p, we define `of_rat (1 / p) = 1 / 0 = 0`
for consistency with our division by zero convention.
The fields `of_rat` and `qsmul are needed to implement the
`algebra_rat [division_ring K] : algebra ℚ K` instance, since we need to control the specific
definitions for some special cases of `K` (in particular `K = ℚ` itself).
See also Note [forgetful inheritance].
-/
@[protect_proj, ancestor comm_ring div_inv_monoid nontrivial]
class field (K : Type u) extends comm_ring K, division_ring K

section division_ring
variables [division_ring K] {a b : K}

namespace rat

/-- Construct the canonical injection from `ℚ` into an arbitrary
  division ring. If the field has positive characteristic `p`,
  we define `1 / p = 1 / 0 = 0` for consistency with our
  division by zero convention. -/
-- see Note [coercion into rings]
@[priority 900] instance cast_coe {K : Type*} [has_rat_cast K] : has_coe_t ℚ K :=
⟨has_rat_cast.rat_cast⟩

theorem cast_mk' (a b h1 h2) : ((⟨a, b, h1, h2⟩ : ℚ) : K) = a * b⁻¹ :=
division_ring.rat_cast_mk _ _ _ _

theorem cast_def : ∀ (r : ℚ), (r : K) = r.num / r.denom
| ⟨a, b, h1, h2⟩ := (cast_mk' _ _ _ _).trans (div_eq_mul_inv _ _).symm

@[priority 100]
instance smul_division_ring : has_smul ℚ K :=
⟨division_ring.qsmul⟩

lemma smul_def (a : ℚ) (x : K) : a • x = ↑a * x := division_ring.qsmul_eq_mul' a x

end rat

end division_ring

section field

variable [field K]

@[priority 100] -- see Note [lower instance priority]
instance field.to_semifield : semifield K :=
{ .. ‹field K›, .. (infer_instance : semiring K) }

end field

section is_field

/-- A predicate to express that a (semi)ring is a (semi)field.

This is mainly useful because such a predicate does not contain data,
and can therefore be easily transported along ring isomorphisms.
Additionaly, this is useful when trying to prove that
a particular ring structure extends to a (semi)field. -/
structure is_field (R : Type u) [semiring R] : Prop :=
(exists_pair_ne : ∃ (x y : R), x ≠ y)
(mul_comm : ∀ (x y : R), x * y = y * x)
(mul_inv_cancel : ∀ {a : R}, a ≠ 0 → ∃ b, a * b = 1)

/-- Transferring from `semifield` to `is_field`. -/
lemma semifield.to_is_field (R : Type u) [semifield R] : is_field R :=
{ mul_inv_cancel := λ a ha, ⟨a⁻¹, mul_inv_cancel ha⟩,
  ..‹semifield R› }

/-- Transferring from `field` to `is_field`. -/
lemma field.to_is_field (R : Type u) [field R] : is_field R := semifield.to_is_field _

@[simp] lemma is_field.nontrivial {R : Type u} [semiring R] (h : is_field R) : nontrivial R :=
⟨h.exists_pair_ne⟩

@[simp] lemma not_is_field_of_subsingleton (R : Type u) [semiring R] [subsingleton R] :
  ¬is_field R :=
λ h, let ⟨x, y, h⟩ := h.exists_pair_ne in h (subsingleton.elim _ _)

open_locale classical

/-- Transferring from `is_field` to `semifield`. -/
noncomputable def is_field.to_semifield {R : Type u} [semiring R] (h : is_field R) : semifield R :=
{ inv := λ a, if ha : a = 0 then 0 else classical.some (is_field.mul_inv_cancel h ha),
  inv_zero := dif_pos rfl,
  mul_inv_cancel := λ a ha,
    begin
      convert classical.some_spec (is_field.mul_inv_cancel h ha),
      exact dif_neg ha
    end,
  .. ‹semiring R›, ..h }

/-- Transferring from `is_field` to `field`. -/
noncomputable def is_field.to_field {R : Type u} [ring R] (h : is_field R) : field R :=
{ .. ‹ring R›, ..is_field.to_semifield h }

/-- For each field, and for each nonzero element of said field, there is a unique inverse.
Since `is_field` doesn't remember the data of an `inv` function and as such,
a lemma that there is a unique inverse could be useful.
-/
lemma uniq_inv_of_is_field (R : Type u) [ring R] (hf : is_field R) :
  ∀ (x : R), x ≠ 0 → ∃! (y : R), x * y = 1 :=
begin
  intros x hx,
  apply exists_unique_of_exists_of_unique,
  { exact hf.mul_inv_cancel hx },
  { intros y z hxy hxz,
    calc y = y * (x * z) : by rw [hxz, mul_one]
       ... = (x * y) * z : by rw [← mul_assoc, hf.mul_comm y x]
       ... = z           : by rw [hxy, one_mul] }
end

end is_field


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

/--
Suppose that $f(x+3)=3x^2 + 7x + 4$ and $f(x)=ax^2 + bx + c$. What is $a+b+c$?
Answer: $2$
--/
theorem amc12a_2009_p9
  (a b c : ℝ)
  (f : ℝ → ℝ)
  (h₀ : ∀ x, f (x + 3) = 3 * x^2 + 7 * x + 4)
  (h₁ : ∀ x, f x = a * x^2 + b * x + c) :
  a + b + c = 2 :=
begin
  simp [*, pow_succ'] at *,
  linarith [h₀ 0, h₀ 1, h₀ 2],
end