/-
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, Abhimanyu Pallavi Sudhir
-/
import order.filter.basic
import algebra.module.pi

/-!
# Germ of a function at a filter

The germ of a function `f : α → β` at a filter `l : filter α` is the equivalence class of `f`
with respect to the equivalence relation `eventually_eq l`: `f ≈ g` means `∀ᶠ x in l, f x = g x`.

## Main definitions

We define

* `germ l β` to be the space of germs of functions `α → β` at a filter `l : filter α`;
* coercion from `α → β` to `germ l β`: `(f : germ l β)` is the germ of `f : α → β`
  at `l : filter α`; this coercion is declared as `has_coe_t`, so it does not require an explicit
  up arrow `↑`;
* coercion from `β` to `germ l β`: `(↑c : germ l β)` is the germ of the constant function
  `λ x:α, c` at a filter `l`; this coercion is declared as `has_lift_t`, so it requires an explicit
  up arrow `↑`, see [TPiL][TPiL_coe] for details.
* `map (F : β → γ) (f : germ l β)` to be the composition of a function `F` and a germ `f`;
* `map₂ (F : β → γ → δ) (f : germ l β) (g : germ l γ)` to be the germ of `λ x, F (f x) (g x)`
  at `l`;
* `f.tendsto lb`: we say that a germ `f : germ l β` tends to a filter `lb` if its representatives
  tend to `lb` along `l`;
* `f.comp_tendsto g hg` and `f.comp_tendsto' g hg`: given `f : germ l β` and a function
  `g : γ → α` (resp., a germ `g : germ lc α`), if `g` tends to `l` along `lc`, then the composition
  `f ∘ g` is a well-defined germ at `lc`;
* `germ.lift_pred`, `germ.lift_rel`: lift a predicate or a relation to the space of germs:
  `(f : germ l β).lift_pred p` means `∀ᶠ x in l, p (f x)`, and similarly for a relation.
[TPiL_coe]: https://leanprover.github.io/theorem_proving_in_lean/type_classes.html#coercions-using-type-classes

We also define `map (F : β → γ) : germ l β → germ l γ` sending each germ `f` to `F ∘ f`.

For each of the following structures we prove that if `β` has this structure, then so does
`germ l β`:

* one-operation algebraic structures up to `comm_group`;
* `mul_zero_class`, `distrib`, `semiring`, `comm_semiring`, `ring`, `comm_ring`;
* `mul_action`, `distrib_mul_action`, `module`;
* `preorder`, `partial_order`, and `lattice` structures up to `bounded_lattice`;
* `ordered_cancel_comm_monoid` and `ordered_cancel_add_comm_monoid`.

## Tags

filter, germ
-/

namespace filter

variables {α β γ δ : Type*} {l : filter α} {f g h : α → β}

lemma const_eventually_eq' [ne_bot l] {a b : β} : (∀ᶠ x in l, a = b) ↔ a = b :=
eventually_const

lemma const_eventually_eq [ne_bot l] {a b : β} : ((λ _, a) =ᶠ[l] (λ _, b)) ↔ a = b :=
@const_eventually_eq' _ _ _ _ a b

lemma eventually_eq.comp_tendsto {f' : α → β} (H : f =ᶠ[l] f') {g : γ → α} {lc : filter γ}
  (hg : tendsto g lc l) :
  f ∘ g =ᶠ[lc] f' ∘ g :=
hg.eventually H

/-- Setoid used to define the space of germs. -/
def germ_setoid (l : filter α) (β : Type*) : setoid (α → β) :=
{ r := eventually_eq l,
  iseqv := ⟨eventually_eq.refl _, λ _ _, eventually_eq.symm, λ _ _ _, eventually_eq.trans⟩ }

/-- The space of germs of functions `α → β` at a filter `l`. -/
def germ (l : filter α) (β : Type*) : Type* := quotient (germ_setoid l β)

namespace germ

instance : has_coe_t (α → β) (germ l β) := ⟨quotient.mk'⟩

instance : has_lift_t β (germ l β) := ⟨λ c, ↑(λ (x : α), c)⟩

@[simp] lemma quot_mk_eq_coe (l : filter α) (f : α → β) : quot.mk _ f = (f : germ l β) := rfl

@[simp] lemma mk'_eq_coe (l : filter α) (f : α → β) : quotient.mk' f = (f : germ l β) := rfl

@[elab_as_eliminator]
lemma induction_on (f : germ l β) {p : germ l β → Prop} (h : ∀ f : α → β, p f) : p f :=
quotient.induction_on' f h

@[elab_as_eliminator]
lemma induction_on₂ (f : germ l β) (g : germ l γ) {p : germ l β → germ l γ → Prop}
  (h : ∀ (f : α → β) (g : α → γ), p f g) : p f g :=
quotient.induction_on₂' f g h

@[elab_as_eliminator]
lemma induction_on₃ (f : germ l β) (g : germ l γ) (h : germ l δ)
  {p : germ l β → germ l γ → germ l δ → Prop}
  (H : ∀ (f : α → β) (g : α → γ) (h : α → δ), p f g h) :
  p f g h :=
quotient.induction_on₃' f g h H

/-- Given a map `F : (α → β) → (γ → δ)` that sends functions eventually equal at `l` to functions
eventually equal at `lc`, returns a map from `germ l β` to `germ lc δ`. -/
def map' {lc : filter γ} (F : (α → β) → (γ → δ)) (hF : (l.eventually_eq ⇒ lc.eventually_eq) F F) :
  germ l β → germ lc δ :=
quotient.map' F hF

/-- Given a germ `f : germ l β` and a function `F : (α → β) → γ` sending eventually equal functions
to the same value, returns the value `F` takes on functions having germ `f` at `l`. -/
def lift_on {γ : Sort*} (f : germ l β) (F : (α → β) → γ) (hF : (l.eventually_eq ⇒ (=)) F F) : γ :=
quotient.lift_on' f F hF

@[simp] lemma map'_coe {lc : filter γ} (F : (α → β) → (γ → δ))
  (hF : (l.eventually_eq ⇒ lc.eventually_eq) F F) (f : α → β) :
  map' F hF f = F f :=
rfl

@[simp, norm_cast] lemma coe_eq : (f : germ l β) = g ↔ (f =ᶠ[l] g) := quotient.eq'

alias coe_eq ↔ _ filter.eventually_eq.germ_eq

/-- Lift a function `β → γ` to a function `germ l β → germ l γ`. -/
def map (op : β → γ) : germ l β → germ l γ :=
map' ((∘) op) $ λ f g H, H.mono $ λ x H, congr_arg op H

@[simp] lemma map_coe (op : β → γ) (f : α → β) : map op (f : germ l β) = op ∘ f := rfl

@[simp] lemma map_id : map id = (id : germ l β → germ l β) := by { ext ⟨f⟩, refl }

lemma map_map (op₁ : γ → δ) (op₂ : β → γ) (f : germ l β) :
  map op₁ (map op₂ f) = map (op₁ ∘ op₂) f :=
induction_on f $ λ f, rfl

/-- Lift a binary function `β → γ → δ` to a function `germ l β → germ l γ → germ l δ`. -/
def map₂ (op : β → γ → δ) : germ l β → germ l γ → germ l δ :=
quotient.map₂' (λ f g x, op (f x) (g x)) $ λ f f' Hf g g' Hg,
Hg.mp $ Hf.mono $ λ x Hf Hg, by simp only [Hf, Hg]

@[simp] lemma map₂_coe (op : β → γ → δ) (f : α → β) (g : α → γ) :
  map₂ op (f : germ l β) g = λ x, op (f x) (g x) :=
rfl

/-- A germ at `l` of maps from `α` to `β` tends to `lb : filter β` if it is represented by a map
which tends to `lb` along `l`. -/
protected def tendsto (f : germ l β) (lb : filter β) : Prop :=
lift_on f (λ f, tendsto f l lb) $ λ f g H, propext (tendsto_congr' H)

@[simp, norm_cast] lemma coe_tendsto {f : α → β} {lb : filter β} :
  (f : germ l β).tendsto lb ↔ tendsto f l lb :=
iff.rfl

alias coe_tendsto ↔ _ filter.tendsto.germ_tendsto

/-- Given two germs `f : germ l β`, and `g : germ lc α`, where `l : filter α`, if `g` tends to `l`,
then the composition `f ∘ g` is well-defined as a germ at `lc`. -/
def comp_tendsto' (f : germ l β) {lc : filter γ} (g : germ lc α) (hg : g.tendsto l) :
  germ lc β :=
lift_on f (λ f, g.map f) $ λ f₁ f₂ hF, (induction_on g $ λ g hg, coe_eq.2 $ hg.eventually hF) hg

@[simp] lemma coe_comp_tendsto' (f : α → β) {lc : filter γ} {g : germ lc α} (hg : g.tendsto l) :
  (f : germ l β).comp_tendsto' g hg = g.map f :=
rfl

/-- Given a germ `f : germ l β` and a function `g : γ → α`, where `l : filter α`, if `g` tends
to `l` along `lc : filter γ`, then the composition `f ∘ g` is well-defined as a germ at `lc`. -/
def comp_tendsto (f : germ l β) {lc : filter γ} (g : γ → α) (hg : tendsto g lc l) :
  germ lc β :=
f.comp_tendsto' _ hg.germ_tendsto

@[simp] lemma coe_comp_tendsto (f : α → β) {lc : filter γ} {g : γ → α} (hg : tendsto g lc l) :
  (f : germ l β).comp_tendsto g hg = f ∘ g :=
rfl

@[simp] lemma comp_tendsto'_coe (f : germ l β) {lc : filter γ} {g : γ → α} (hg : tendsto g lc l) :
  f.comp_tendsto' _ hg.germ_tendsto = f.comp_tendsto g hg :=
rfl

@[simp, norm_cast] lemma const_inj [ne_bot l] {a b : β} : (↑a : germ l β) = ↑b ↔ a = b :=
coe_eq.trans $ const_eventually_eq

@[simp] lemma map_const (l : filter α) (a : β) (f : β → γ) :
  (↑a : germ l β).map f = ↑(f a) :=
rfl

@[simp] lemma map₂_const (l : filter α) (b : β) (c : γ) (f : β → γ → δ) :
  map₂ f (↑b : germ l β) ↑c = ↑(f b c) :=
rfl

@[simp] lemma const_comp_tendsto {l : filter α} (b : β) {lc : filter γ} {g : γ → α}
  (hg : tendsto g lc l) :
  (↑b : germ l β).comp_tendsto g hg = ↑b :=
rfl

@[simp] lemma const_comp_tendsto' {l : filter α} (b : β) {lc : filter γ} {g : germ lc α}
  (hg : g.tendsto l) :
  (↑b : germ l β).comp_tendsto' g hg = ↑b :=
induction_on g (λ _ _, rfl) hg

/-- Lift a predicate on `β` to `germ l β`. -/
def lift_pred (p : β → Prop) (f : germ l β) : Prop :=
lift_on f (λ f, ∀ᶠ x in l, p (f x)) $
λ f g H, propext $ eventually_congr $ H.mono $ λ x hx, hx ▸ iff.rfl

@[simp] lemma lift_pred_coe {p : β → Prop} {f : α → β} :
  lift_pred p (f : germ l β) ↔ ∀ᶠ x in l, p (f x) :=
iff.rfl

lemma lift_pred_const {p : β → Prop} {x : β} (hx : p x) :
  lift_pred p (↑x : germ l β) :=
eventually_of_forall $ λ y, hx

@[simp] lemma lift_pred_const_iff [ne_bot l] {p : β → Prop} {x : β} :
  lift_pred p (↑x : germ l β) ↔ p x :=
@eventually_const _ _ _ (p x)

/-- Lift a relation `r : β → γ → Prop` to `germ l β → germ l γ → Prop`. -/
def lift_rel (r : β → γ → Prop) (f : germ l β) (g : germ l γ) : Prop :=
quotient.lift_on₂' f g (λ f g, ∀ᶠ x in l, r (f x) (g x)) $
λ f g f' g' Hf Hg, propext $ eventually_congr $ Hg.mp $ Hf.mono $ λ x hf hg, hf ▸ hg ▸ iff.rfl

@[simp] lemma lift_rel_coe {r : β → γ → Prop} {f : α → β} {g : α → γ} :
  lift_rel r (f : germ l β) g ↔ ∀ᶠ x in l, r (f x) (g x) :=
iff.rfl

lemma lift_rel_const {r : β → γ → Prop} {x : β} {y : γ} (h : r x y) :
  lift_rel r (↑x : germ l β) ↑y :=
eventually_of_forall $ λ _, h

@[simp] lemma lift_rel_const_iff [ne_bot l] {r : β → γ → Prop} {x : β} {y : γ} :
  lift_rel r (↑x : germ l β) ↑y ↔ r x y :=
@eventually_const _ _ _ (r x y)

instance [inhabited β] : inhabited (germ l β) := ⟨↑(default β)⟩

section monoid

variables {M : Type*} {G : Type*}

@[to_additive]
instance [has_mul M] : has_mul (germ l M) := ⟨map₂ (*)⟩

@[simp, to_additive]
lemma coe_mul [has_mul M] (f g : α → M) : ↑(f * g) = (f * g : germ l M) := rfl

attribute [norm_cast] coe_mul coe_add

@[to_additive]
instance [has_one M] : has_one (germ l M) := ⟨↑(1:M)⟩

@[simp, to_additive]
lemma coe_one [has_one M] : ↑(1 : α → M) = (1 : germ l M) := rfl

attribute [norm_cast] coe_one coe_zero

@[to_additive]
instance [semigroup M] : semigroup (germ l M) :=
{ mul := (*), mul_assoc := by { rintros ⟨f⟩ ⟨g⟩ ⟨h⟩,
    simp only [mul_assoc, quot_mk_eq_coe, ← coe_mul] } }

@[to_additive]
instance [comm_semigroup M] : comm_semigroup (germ l M) :=
{ mul := (*),
  mul_comm := by { rintros ⟨f⟩ ⟨g⟩, simp only [mul_comm, quot_mk_eq_coe, ← coe_mul] },
  .. germ.semigroup }

@[to_additive add_left_cancel_semigroup]
instance [left_cancel_semigroup M] : left_cancel_semigroup (germ l M) :=
{ mul := (*),
  mul_left_cancel := λ f₁ f₂ f₃, induction_on₃ f₁ f₂ f₃ $ λ f₁ f₂ f₃ H,
    coe_eq.2 ((coe_eq.1 H).mono $ λ x, mul_left_cancel),
  .. germ.semigroup }

@[to_additive add_right_cancel_semigroup]
instance [right_cancel_semigroup M] : right_cancel_semigroup (germ l M) :=
{ mul := (*),
  mul_right_cancel := λ f₁ f₂ f₃, induction_on₃ f₁ f₂ f₃ $ λ f₁ f₂ f₃ H,
    coe_eq.2 $ (coe_eq.1 H).mono $ λ x, mul_right_cancel,
  .. germ.semigroup }

@[to_additive]
instance [monoid M] : monoid (germ l M) :=
{ mul := (*),
  one := 1,
  one_mul := λ f, induction_on f $ λ f, by { norm_cast, rw [one_mul] },
  mul_one := λ f, induction_on f $ λ f, by { norm_cast, rw [mul_one] },
  .. germ.semigroup }

/-- coercion from functions to germs as a monoid homomorphism. -/
@[to_additive]
def coe_mul_hom [monoid M] (l : filter α) : (α → M) →* germ l M := ⟨coe, rfl, λ f g, rfl⟩

/-- coercion from functions to germs as an additive monoid homomorphism. -/
add_decl_doc coe_add_hom

@[simp, to_additive]
lemma coe_coe_mul_hom [monoid M] : (coe_mul_hom l : (α → M) → germ l M) = coe := rfl

@[to_additive]
instance [comm_monoid M] : comm_monoid (germ l M) :=
{ mul := (*),
  one := 1,
  .. germ.comm_semigroup, .. germ.monoid }

@[to_additive]
instance [has_inv G] : has_inv (germ l G) := ⟨map has_inv.inv⟩

@[simp, to_additive]
lemma coe_inv [has_inv G] (f : α → G) : ↑f⁻¹ = (f⁻¹ : germ l G) := rfl

attribute [norm_cast] coe_inv coe_neg

@[to_additive]
instance [has_div M] : has_div (germ l M) := ⟨map₂ (/)⟩

@[simp, norm_cast, to_additive]
lemma coe_div [has_div M] (f g : α → M) : ↑(f / g) = (f / g : germ l M) := rfl

@[to_additive]
instance [div_inv_monoid G] : div_inv_monoid (germ l G) :=
{ inv := has_inv.inv,
  div := has_div.div,
  div_eq_mul_inv := by { rintros ⟨f⟩ ⟨g⟩, exact congr_arg (quot.mk _) (div_eq_mul_inv f g) },
  .. germ.monoid }

@[to_additive]
instance [group G] : group (germ l G) :=
{ mul := (*),
  one := 1,
  mul_left_inv := by { rintros ⟨f⟩, exact congr_arg (quot.mk _) (mul_left_inv f) },
  .. germ.div_inv_monoid }

@[to_additive]
instance [comm_group G] : comm_group (germ l G) :=
{ mul := (*),
  one := 1,
  inv := has_inv.inv,
  .. germ.group, .. germ.comm_monoid }

end monoid

section ring

variables {R : Type*}

instance nontrivial [nontrivial R] [ne_bot l] : nontrivial (germ l R) :=
let ⟨x, y, h⟩ := exists_pair_ne R in ⟨⟨↑x, ↑y, mt const_inj.1 h⟩⟩

instance [mul_zero_class R] : mul_zero_class (germ l R) :=
{ zero := 0,
  mul := (*),
  mul_zero := λ f, induction_on f $ λ f, by { norm_cast, rw [mul_zero] },
  zero_mul := λ f, induction_on f $ λ f, by { norm_cast, rw [zero_mul] } }

instance [distrib R] : distrib (germ l R) :=
{ mul := (*),
  add := (+),
  left_distrib := λ f g h, induction_on₃ f g h $ λ f g h, by { norm_cast, rw [left_distrib] },
  right_distrib := λ f g h, induction_on₃ f g h $ λ f g h, by { norm_cast, rw [right_distrib] } }

instance [semiring R] : semiring (germ l R) :=
{ .. germ.add_comm_monoid, .. germ.monoid, .. germ.distrib, .. germ.mul_zero_class }

/-- Coercion `(α → R) → germ l R` as a `ring_hom`. -/
def coe_ring_hom [semiring R] (l : filter α) : (α → R) →+* germ l R :=
{ to_fun := coe, .. (coe_mul_hom l : _ →* germ l R), .. (coe_add_hom l : _ →+ germ l R) }

@[simp] lemma coe_coe_ring_hom [semiring R] : (coe_ring_hom l : (α → R) → germ l R) = coe := rfl

instance [ring R] : ring (germ l R) :=
{ .. germ.add_comm_group, .. germ.monoid, .. germ.distrib, .. germ.mul_zero_class }

instance [comm_semiring R] : comm_semiring (germ l R) :=
{ .. germ.semiring, .. germ.comm_monoid }

instance [comm_ring R] : comm_ring (germ l R) :=
{ .. germ.ring, .. germ.comm_monoid }

end ring

section module

variables {M N R : Type*}

instance [has_scalar M β]  : has_scalar M (germ l β) :=
⟨λ c, map ((•) c)⟩

instance has_scalar' [has_scalar M β] : has_scalar (germ l M) (germ l β) :=
⟨map₂ (•)⟩

@[simp, norm_cast] lemma coe_smul [has_scalar M β] (c : M) (f : α → β) :
  ↑(c • f) = (c • f : germ l β) :=
rfl

@[simp, norm_cast] lemma coe_smul' [has_scalar M β] (c : α → M) (f : α → β) :
  ↑(c • f) = (c : germ l M) • (f : germ l β) :=
rfl

instance [monoid M] [mul_action M β]  : mul_action M (germ l β) :=
{ one_smul := λ f, induction_on f $ λ f, by { norm_cast, simp only [one_smul] },
  mul_smul := λ c₁ c₂ f, induction_on f $ λ f, by { norm_cast, simp only [mul_smul] } }

instance mul_action' [monoid M] [mul_action M β]  : mul_action (germ l M) (germ l β) :=
{ one_smul := λ f, induction_on f $ λ f, by simp only [← coe_one, ← coe_smul', one_smul],
  mul_smul := λ c₁ c₂ f, induction_on₃ c₁ c₂ f $ λ c₁ c₂ f, by { norm_cast, simp only [mul_smul] } }

instance [monoid M] [add_monoid N] [distrib_mul_action M N] :
  distrib_mul_action M (germ l N) :=
{ smul_add := λ c f g, induction_on₂ f g $ λ f g, by { norm_cast, simp only [smul_add] },
  smul_zero := λ c, by simp only [← coe_zero, ← coe_smul, smul_zero] }

instance distrib_mul_action' [monoid M] [add_monoid N] [distrib_mul_action M N] :
  distrib_mul_action (germ l M) (germ l N) :=
{ smul_add := λ c f g, induction_on₃ c f g $ λ c f g, by { norm_cast, simp only [smul_add] },
  smul_zero := λ c, induction_on c $ λ c, by simp only [← coe_zero, ← coe_smul', smul_zero] }

instance [semiring R] [add_comm_monoid M] [module R M] :
  module R (germ l M) :=
{ add_smul := λ c₁ c₂ f, induction_on f $ λ f, by { norm_cast, simp only [add_smul] },
  zero_smul := λ f, induction_on f $ λ f, by { norm_cast, simp only [zero_smul, coe_zero] } }

instance module' [semiring R] [add_comm_monoid M] [module R M] :
  module (germ l R) (germ l M) :=
{ add_smul := λ c₁ c₂ f, induction_on₃ c₁ c₂ f $ λ c₁ c₂ f, by { norm_cast, simp only [add_smul] },
  zero_smul := λ f, induction_on f $ λ f, by simp only [← coe_zero, ← coe_smul', zero_smul] }

end module

instance [has_le β] : has_le (germ l β) :=
⟨lift_rel (≤)⟩

@[simp] lemma coe_le [has_le β] : (f : germ l β) ≤ g ↔ (f ≤ᶠ[l] g) := iff.rfl

lemma le_def [has_le β] : ((≤) : germ l β → germ l β → Prop) = lift_rel (≤) := rfl

lemma const_le [has_le β] {x y : β} (h : x ≤ y) : (↑x : germ l β) ≤ ↑y :=
lift_rel_const h

@[simp, norm_cast]
lemma const_le_iff [has_le β] [ne_bot l] {x y : β} : (↑x : germ l β) ≤ ↑y ↔ x ≤ y :=
lift_rel_const_iff

instance [preorder β] : preorder (germ l β) :=
{ le := (≤),
  le_refl := λ f, induction_on f $ eventually_le.refl l,
  le_trans := λ f₁ f₂ f₃, induction_on₃ f₁ f₂ f₃ $ λ f₁ f₂ f₃, eventually_le.trans }

instance [partial_order β] : partial_order (germ l β) :=
{ le := (≤),
  le_antisymm := λ f g, induction_on₂ f g $ λ f g h₁ h₂, (eventually_le.antisymm h₁ h₂).germ_eq,
  .. germ.preorder }

instance [has_bot β] : has_bot (germ l β) := ⟨↑(⊥:β)⟩

@[simp, norm_cast] lemma const_bot [has_bot β] : (↑(⊥:β) : germ l β) = ⊥ := rfl

instance [order_bot β] : order_bot (germ l β) :=
{ bot := ⊥,
  le := (≤),
  bot_le := λ f, induction_on f $ λ f, eventually_of_forall $ λ x, bot_le,
  .. germ.partial_order }

instance [has_top β] : has_top (germ l β) := ⟨↑(⊤:β)⟩

@[simp, norm_cast] lemma const_top [has_top β] : (↑(⊤:β) : germ l β) = ⊤ := rfl

instance [order_top β] : order_top (germ l β) :=
{ top := ⊤,
  le := (≤),
  le_top := λ f, induction_on f $ λ f, eventually_of_forall $ λ x, le_top,
  .. germ.partial_order }

instance [has_sup β] : has_sup (germ l β) := ⟨map₂ (⊔)⟩

@[simp, norm_cast] lemma const_sup [has_sup β] (a b : β) : ↑(a ⊔ b) = (↑a ⊔ ↑b : germ l β) := rfl

instance [has_inf β] : has_inf (germ l β) := ⟨map₂ (⊓)⟩

@[simp, norm_cast] lemma const_inf [has_inf β] (a b : β) : ↑(a ⊓ b) = (↑a ⊓ ↑b : germ l β) := rfl

instance [semilattice_sup β] : semilattice_sup (germ l β) :=
{ sup := (⊔),
  le_sup_left := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, le_sup_left,
  le_sup_right := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, le_sup_right,
  sup_le := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
    h₂.mp $ h₁.mono $ λ x, sup_le,
  .. germ.partial_order }

instance [semilattice_inf β] : semilattice_inf (germ l β) :=
{ inf := (⊓),
  inf_le_left := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, inf_le_left,
  inf_le_right := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, inf_le_right,
  le_inf := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
    h₂.mp $ h₁.mono $ λ x, le_inf,
  .. germ.partial_order }

instance [semilattice_inf_bot β] : semilattice_inf_bot (germ l β) :=
{ .. germ.semilattice_inf, .. germ.order_bot }

instance [semilattice_sup_bot β] : semilattice_sup_bot (germ l β) :=
{ .. germ.semilattice_sup, .. germ.order_bot }

instance [semilattice_inf_top β] : semilattice_inf_top (germ l β) :=
{ .. germ.semilattice_inf, .. germ.order_top }

instance [semilattice_sup_top β] : semilattice_sup_top (germ l β) :=
{ .. germ.semilattice_sup, .. germ.order_top }

instance [lattice β] : lattice (germ l β) :=
{ .. germ.semilattice_sup, .. germ.semilattice_inf }

instance [bounded_lattice β] : bounded_lattice (germ l β) :=
{ .. germ.lattice, .. germ.order_bot, .. germ.order_top }

@[to_additive]
instance [ordered_cancel_comm_monoid β] : ordered_cancel_comm_monoid (germ l β) :=
{ mul_le_mul_left := λ f g, induction_on₂ f g $ λ f g H h, induction_on h $ λ h,
    H.mono $ λ x H, mul_le_mul_left' H _,
  le_of_mul_le_mul_left := λ f g h, induction_on₃ f g h $ λ f g h H,
    H.mono $ λ x, le_of_mul_le_mul_left',
  .. germ.partial_order, .. germ.comm_monoid, .. germ.left_cancel_semigroup }

@[to_additive]
instance ordered_comm_group [ordered_comm_group β] : ordered_comm_group (germ l β) :=
{ mul_le_mul_left := λ f g, induction_on₂ f g $ λ f g H h, induction_on h $ λ h,
    H.mono $ λ x H, mul_le_mul_left' H _,
  .. germ.partial_order, .. germ.comm_group }

end germ

end filter


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.category.PartOrd
import order.hom.lattice

/-!
# The category of lattices

This defines `Lat`, the category of lattices.

Note that `Lat` doesn't correspond to the literature definition of [`Lat`]
(https://ncatlab.org/nlab/show/Lat) as we don't require bottom or top elements. Instead, `Lat`
corresponds to `BddLat`.

## TODO

The free functor from `Lat` to `BddLat` is `X → with_top (with_bot X)`.
-/

universes u

open category_theory

/-- The category of lattices. -/
def Lat := bundled lattice

namespace Lat

instance : has_coe_to_sort Lat Type* := bundled.has_coe_to_sort
instance (X : Lat) : lattice X := X.str

/-- Construct a bundled `Lat` from a `lattice`. -/
def of (α : Type*) [lattice α] : Lat := bundled.of α

@[simp] lemma coe_of (α : Type*) [lattice α] : ↥(of α) = α := rfl

instance : inhabited Lat := ⟨of bool⟩

instance : bundled_hom @lattice_hom :=
{ to_fun := λ _ _ _ _, coe_fn,
  id := @lattice_hom.id,
  comp := @lattice_hom.comp,
  hom_ext := λ X Y _ _, by exactI fun_like.coe_injective }

instance : large_category.{u} Lat := bundled_hom.category lattice_hom
instance : concrete_category Lat := bundled_hom.concrete_category lattice_hom

instance has_forget_to_PartOrd : has_forget₂ Lat PartOrd :=
{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f },
  forget_comp := rfl }

/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
@[simps] def iso.mk {α β : Lat.{u}} (e : α ≃o β) : α ≅ β :=
{ hom := e,
  inv := e.symm,
  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }

/-- `order_dual` as a functor. -/
@[simps] def dual : Lat ⥤ Lat := { obj := λ X, of Xᵒᵈ, map := λ X Y, lattice_hom.dual }

/-- The equivalence between `Lat` and itself induced by `order_dual` both ways. -/
@[simps functor inverse] def dual_equiv : Lat ≌ Lat :=
equivalence.mk dual dual
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)

end Lat

lemma Lat_dual_comp_forget_to_PartOrd :
  Lat.dual ⋙ forget₂ Lat PartOrd =
    forget₂ Lat PartOrd ⋙ PartOrd.dual := rfl


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

import data.nat.factorization.basic
import data.set_like.fintype
import group_theory.group_action.conj_act
import group_theory.p_group
import group_theory.noncomm_pi_coprod

/-!
# Sylow theorems

The Sylow theorems are the following results for every finite group `G` and every prime number `p`.

* There exists a Sylow `p`-subgroup of `G`.
* All Sylow `p`-subgroups of `G` are conjugate to each other.
* Let `nₚ` be the number of Sylow `p`-subgroups of `G`, then `nₚ` divides the index of the Sylow
  `p`-subgroup, `nₚ ≡ 1 [MOD p]`, and `nₚ` is equal to the index of the normalizer of the Sylow
  `p`-subgroup in `G`.

## Main definitions

* `sylow p G` : The type of Sylow `p`-subgroups of `G`.

## Main statements

* `exists_subgroup_card_pow_prime`: A generalization of Sylow's first theorem:
  For every prime power `pⁿ` dividing the cardinality of `G`,
  there exists a subgroup of `G` of order `pⁿ`.
* `is_p_group.exists_le_sylow`: A generalization of Sylow's first theorem:
  Every `p`-subgroup is contained in a Sylow `p`-subgroup.
* `sylow_conjugate`: A generalization of Sylow's second theorem:
  If the number of Sylow `p`-subgroups is finite, then all Sylow `p`-subgroups are conjugate.
* `card_sylow_modeq_one`: A generalization of Sylow's third theorem:
  If the number of Sylow `p`-subgroups is finite, then it is congruent to `1` modulo `p`.
-/

open fintype mul_action subgroup

section infinite_sylow

variables (p : ℕ) (G : Type*) [group G]

/-- A Sylow `p`-subgroup is a maximal `p`-subgroup. -/
structure sylow extends subgroup G :=
(is_p_group' : is_p_group p to_subgroup)
(is_maximal' : ∀ {Q : subgroup G}, is_p_group p Q → to_subgroup ≤ Q → Q = to_subgroup)

variables {p} {G}

namespace sylow

instance : has_coe (sylow p G) (subgroup G) := ⟨sylow.to_subgroup⟩

@[simp] lemma to_subgroup_eq_coe {P : sylow p G} : P.to_subgroup = ↑P := rfl

@[ext] lemma ext {P Q : sylow p G} (h : (P : subgroup G) = Q) : P = Q :=
by cases P; cases Q; congr'

lemma ext_iff {P Q : sylow p G} : P = Q ↔ (P : subgroup G) = Q :=
⟨congr_arg coe, ext⟩

instance : set_like (sylow p G) G :=
{ coe := coe,
  coe_injective' := λ P Q h, ext (set_like.coe_injective h) }

instance : subgroup_class (sylow p G) G :=
{ mul_mem := λ s, s.mul_mem',
  one_mem := λ s, s.one_mem',
  inv_mem := λ s, s.inv_mem' }

variables (P : sylow p G) {K : Type*} [group K] (ϕ : K →* G) {N : subgroup G}

/-- The preimage of a Sylow subgroup under a p-group-kernel homomorphism is a Sylow subgroup. -/
def comap_of_ker_is_p_group (hϕ : is_p_group p ϕ.ker) (h : ↑P ≤ ϕ.range) : sylow p K :=
{ P.1.comap ϕ with
  is_p_group' := P.2.comap_of_ker_is_p_group ϕ hϕ,
  is_maximal' := λ Q hQ hle, by
  { rw ← P.3 (hQ.map ϕ) (le_trans (ge_of_eq (map_comap_eq_self h)) (map_mono hle)),
    exact (comap_map_eq_self ((P.1.ker_le_comap ϕ).trans hle)).symm }, }

@[simp] lemma coe_comap_of_ker_is_p_group (hϕ : is_p_group p ϕ.ker) (h : ↑P ≤ ϕ.range) :
  ↑(P.comap_of_ker_is_p_group ϕ hϕ h) = subgroup.comap ϕ ↑P := rfl

/-- The preimage of a Sylow subgroup under an injective homomorphism is a Sylow subgroup. -/
def comap_of_injective (hϕ : function.injective ϕ) (h : ↑P ≤ ϕ.range) : sylow p K :=
P.comap_of_ker_is_p_group ϕ (is_p_group.ker_is_p_group_of_injective hϕ) h

@[simp] lemma coe_comap_of_injective (hϕ : function.injective ϕ) (h : ↑P ≤ ϕ.range) :
  ↑(P.comap_of_injective ϕ hϕ h) = subgroup.comap ϕ ↑P := rfl

/-- A sylow subgroup of G is also a sylow subgroup of a subgroup of G. -/
def subtype (h : ↑P ≤ N) : sylow p N :=
P.comap_of_injective N.subtype subtype.coe_injective (by simp [h])

@[simp] lemma coe_subtype (h : ↑P ≤ N) : ↑(P.subtype h) = subgroup.comap N.subtype ↑P := rfl

end sylow

/-- A generalization of **Sylow's first theorem**.
  Every `p`-subgroup is contained in a Sylow `p`-subgroup. -/
lemma is_p_group.exists_le_sylow {P : subgroup G} (hP : is_p_group p P) :
  ∃ Q : sylow p G, P ≤ Q :=
exists.elim (zorn_nonempty_partial_order₀ {Q : subgroup G | is_p_group p Q} (λ c hc1 hc2 Q hQ,
⟨ { carrier := ⋃ (R : c), R,
    one_mem' := ⟨Q, ⟨⟨Q, hQ⟩, rfl⟩, Q.one_mem⟩,
    inv_mem' := λ g ⟨_, ⟨R, rfl⟩, hg⟩, ⟨R, ⟨R, rfl⟩, R.1.inv_mem hg⟩,
    mul_mem' := λ g h ⟨_, ⟨R, rfl⟩, hg⟩ ⟨_, ⟨S, rfl⟩, hh⟩, (hc2.total R.2 S.2).elim
      (λ T, ⟨S, ⟨S, rfl⟩, S.1.mul_mem (T hg) hh⟩) (λ T, ⟨R, ⟨R, rfl⟩, R.1.mul_mem hg (T hh)⟩) },
  λ ⟨g, _, ⟨S, rfl⟩, hg⟩, by
  { refine exists_imp_exists (λ k hk, _) (hc1 S.2 ⟨g, hg⟩),
    rwa [subtype.ext_iff, coe_pow] at hk ⊢ },
  λ M hM g hg, ⟨M, ⟨⟨M, hM⟩, rfl⟩, hg⟩⟩) P hP) (λ Q ⟨hQ1, hQ2, hQ3⟩, ⟨⟨Q, hQ1, hQ3⟩, hQ2⟩)

instance sylow.nonempty : nonempty (sylow p G) :=
nonempty_of_exists is_p_group.of_bot.exists_le_sylow

noncomputable instance sylow.inhabited : inhabited (sylow p G) :=
classical.inhabited_of_nonempty sylow.nonempty

lemma sylow.exists_comap_eq_of_ker_is_p_group {H : Type*} [group H] (P : sylow p H)
  {f : H →* G} (hf : is_p_group p f.ker) : ∃ Q : sylow p G, (Q : subgroup G).comap f = P :=
exists_imp_exists (λ Q hQ, P.3 (Q.2.comap_of_ker_is_p_group f hf) (map_le_iff_le_comap.mp hQ))
  (P.2.map f).exists_le_sylow

lemma sylow.exists_comap_eq_of_injective {H : Type*} [group H] (P : sylow p H)
  {f : H →* G} (hf : function.injective f) : ∃ Q : sylow p G, (Q : subgroup G).comap f = P :=
P.exists_comap_eq_of_ker_is_p_group (is_p_group.ker_is_p_group_of_injective hf)

lemma sylow.exists_comap_subtype_eq {H : subgroup G} (P : sylow p H) :
  ∃ Q : sylow p G, (Q : subgroup G).comap H.subtype = P :=
P.exists_comap_eq_of_injective subtype.coe_injective

/-- If the kernel of `f : H →* G` is a `p`-group,
  then `fintype (sylow p G)` implies `fintype (sylow p H)`. -/
noncomputable def sylow.fintype_of_ker_is_p_group {H : Type*} [group H]
  {f : H →* G} (hf : is_p_group p f.ker) [fintype (sylow p G)] : fintype (sylow p H) :=
let h_exists := λ P : sylow p H, P.exists_comap_eq_of_ker_is_p_group hf,
  g : sylow p H → sylow p G := λ P, classical.some (h_exists P),
  hg : ∀ P : sylow p H, (g P).1.comap f = P := λ P, classical.some_spec (h_exists P) in
fintype.of_injective g (λ P Q h, sylow.ext (by simp only [←hg, h]))

/-- If `f : H →* G` is injective, then `fintype (sylow p G)` implies `fintype (sylow p H)`. -/
noncomputable def sylow.fintype_of_injective {H : Type*} [group H]
  {f : H →* G} (hf : function.injective f) [fintype (sylow p G)] : fintype (sylow p H) :=
sylow.fintype_of_ker_is_p_group (is_p_group.ker_is_p_group_of_injective hf)

/-- If `H` is a subgroup of `G`, then `fintype (sylow p G)` implies `fintype (sylow p H)`. -/
noncomputable instance (H : subgroup G) [fintype (sylow p G)] : fintype (sylow p H) :=
sylow.fintype_of_injective (show function.injective H.subtype, from subtype.coe_injective)

open_locale pointwise

/-- `subgroup.pointwise_mul_action` preserves Sylow subgroups. -/
instance sylow.pointwise_mul_action {α : Type*} [group α] [mul_distrib_mul_action α G] :
  mul_action α (sylow p G) :=
{ smul := λ g P, ⟨g • P, P.2.map _, λ Q hQ hS, inv_smul_eq_iff.mp (P.3 (hQ.map _)
    (λ s hs, (congr_arg (∈ g⁻¹ • Q) (inv_smul_smul g s)).mp
      (smul_mem_pointwise_smul (g • s) g⁻¹ Q (hS (smul_mem_pointwise_smul s g P hs)))))⟩,
  one_smul := λ P, sylow.ext (one_smul α P),
  mul_smul := λ g h P, sylow.ext (mul_smul g h P) }

lemma sylow.pointwise_smul_def {α : Type*} [group α] [mul_distrib_mul_action α G]
  {g : α} {P : sylow p G} : ↑(g • P) = g • (P : subgroup G) := rfl

instance sylow.mul_action : mul_action G (sylow p G) :=
comp_hom _ mul_aut.conj

lemma sylow.smul_def {g : G} {P : sylow p G} : g • P = mul_aut.conj g • P := rfl

lemma sylow.coe_subgroup_smul {g : G} {P : sylow p G} :
  ↑(g • P) = mul_aut.conj g • (P : subgroup G) := rfl

lemma sylow.coe_smul {g : G} {P : sylow p G} :
  ↑(g • P) = mul_aut.conj g • (P : set G) := rfl

lemma sylow.smul_le {P : sylow p G} {H : subgroup G} (hP : ↑P ≤ H) (h : H) : ↑(h • P) ≤ H :=
subgroup.conj_smul_le_of_le hP h

lemma sylow.smul_subtype {P : sylow p G} {H : subgroup G} (hP : ↑P ≤ H) (h : H) :
  h • P.subtype hP = (h • P).subtype (sylow.smul_le hP h) :=
sylow.ext (subgroup.conj_smul_subgroup_of hP h)

lemma sylow.smul_eq_iff_mem_normalizer {g : G} {P : sylow p G} :
  g • P = P ↔ g ∈ (P : subgroup G).normalizer :=
begin
  rw [eq_comm, set_like.ext_iff, ←inv_mem_iff, mem_normalizer_iff, inv_inv],
  exact forall_congr (λ h, iff_congr iff.rfl ⟨λ ⟨a, b, c⟩, (congr_arg _ c).mp
    ((congr_arg (∈ P.1) (mul_aut.inv_apply_self G (mul_aut.conj g) a)).mpr b),
    λ hh, ⟨(mul_aut.conj g)⁻¹ h, hh, mul_aut.apply_inv_self G (mul_aut.conj g) h⟩⟩),
end

lemma sylow.smul_eq_of_normal {g : G} {P : sylow p G} [h : (P : subgroup G).normal] :
  g • P = P :=
by simp only [sylow.smul_eq_iff_mem_normalizer, normalizer_eq_top.mpr h, mem_top]

lemma subgroup.sylow_mem_fixed_points_iff (H : subgroup G) {P : sylow p G} :
  P ∈ fixed_points H (sylow p G) ↔ H ≤ (P : subgroup G).normalizer :=
by simp_rw [set_like.le_def, ←sylow.smul_eq_iff_mem_normalizer]; exact subtype.forall

lemma is_p_group.inf_normalizer_sylow {P : subgroup G} (hP : is_p_group p P) (Q : sylow p G) :
  P ⊓ (Q : subgroup G).normalizer = P ⊓ Q :=
le_antisymm (le_inf inf_le_left (sup_eq_right.mp (Q.3 (hP.to_inf_left.to_sup_of_normal_right'
  Q.2 inf_le_right) le_sup_right))) (inf_le_inf_left P le_normalizer)

lemma is_p_group.sylow_mem_fixed_points_iff
  {P : subgroup G} (hP : is_p_group p P) {Q : sylow p G} :
  Q ∈ fixed_points P (sylow p G) ↔ P ≤ Q :=
by rw [P.sylow_mem_fixed_points_iff, ←inf_eq_left, hP.inf_normalizer_sylow, inf_eq_left]

/-- A generalization of **Sylow's second theorem**.
  If the number of Sylow `p`-subgroups is finite, then all Sylow `p`-subgroups are conjugate. -/
instance [hp : fact p.prime] [fintype (sylow p G)] : is_pretransitive G (sylow p G) :=
⟨λ P Q, by
{ classical,
  have H := λ {R : sylow p G} {S : orbit G P},
  calc S ∈ fixed_points R (orbit G P)
      ↔ S.1 ∈ fixed_points R (sylow p G) : forall_congr (λ a, subtype.ext_iff)
  ... ↔ R.1 ≤ S : R.2.sylow_mem_fixed_points_iff
  ... ↔ S.1.1 = R : ⟨λ h, R.3 S.1.2 h, ge_of_eq⟩,
  suffices : set.nonempty (fixed_points Q (orbit G P)),
  { exact exists.elim this (λ R hR, (congr_arg _ (sylow.ext (H.mp hR))).mp R.2) },
  apply Q.2.nonempty_fixed_point_of_prime_not_dvd_card,
  refine λ h, hp.out.not_dvd_one (nat.modeq_zero_iff_dvd.mp _),
  calc 1 = card (fixed_points P (orbit G P)) : _
     ... ≡ card (orbit G P) [MOD p] : (P.2.card_modeq_card_fixed_points (orbit G P)).symm
     ... ≡ 0 [MOD p] : nat.modeq_zero_iff_dvd.mpr h,
  rw ← set.card_singleton (⟨P, mem_orbit_self P⟩ : orbit G P),
  refine card_congr' (congr_arg _ (eq.symm _)),
  rw set.eq_singleton_iff_unique_mem,
  exact ⟨H.mpr rfl, λ R h, subtype.ext (sylow.ext (H.mp h))⟩ }⟩

variables (p) (G)

/-- A generalization of **Sylow's third theorem**.
  If the number of Sylow `p`-subgroups is finite, then it is congruent to `1` modulo `p`. -/
lemma card_sylow_modeq_one [fact p.prime] [fintype (sylow p G)] : card (sylow p G) ≡ 1 [MOD p] :=
begin
  refine sylow.nonempty.elim (λ P : sylow p G, _),
  have : fixed_points P.1 (sylow p G) = {P} :=
  set.ext (λ Q : sylow p G, calc Q ∈ fixed_points P (sylow p G)
      ↔ P.1 ≤ Q : P.2.sylow_mem_fixed_points_iff
  ... ↔ Q.1 = P.1 : ⟨P.3 Q.2, ge_of_eq⟩
  ... ↔ Q ∈ {P} : sylow.ext_iff.symm.trans set.mem_singleton_iff.symm),
  haveI : fintype (fixed_points P.1 (sylow p G)), { rw this, apply_instance },
  have : card (fixed_points P.1 (sylow p G)) = 1, { simp [this] },
  exact (P.2.card_modeq_card_fixed_points (sylow p G)).trans (by rw this),
end

lemma not_dvd_card_sylow [hp : fact p.prime] [fintype (sylow p G)] : ¬ p ∣ card (sylow p G) :=
λ h, hp.1.ne_one (nat.dvd_one.mp ((nat.modeq_iff_dvd' zero_le_one).mp
  ((nat.modeq_zero_iff_dvd.mpr h).symm.trans (card_sylow_modeq_one p G))))

variables {p} {G}

/-- Sylow subgroups are isomorphic -/
def sylow.equiv_smul (P : sylow p G) (g : G) : P ≃* (g • P : sylow p G) :=
equiv_smul (mul_aut.conj g) ↑P

/-- Sylow subgroups are isomorphic -/
noncomputable def sylow.equiv [fact p.prime] [fintype (sylow p G)] (P Q : sylow p G) :
  P ≃* Q :=
begin
  rw ← classical.some_spec (exists_smul_eq G P Q),
  exact P.equiv_smul (classical.some (exists_smul_eq G P Q)),
end

@[simp] lemma sylow.orbit_eq_top [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
  orbit G P = ⊤ :=
top_le_iff.mp (λ Q hQ, exists_smul_eq G P Q)

lemma sylow.stabilizer_eq_normalizer (P : sylow p G) :
  stabilizer G P = (P : subgroup G).normalizer :=
ext (λ g, sylow.smul_eq_iff_mem_normalizer)

/-- Sylow `p`-subgroups are in bijection with cosets of the normalizer of a Sylow `p`-subgroup -/
noncomputable def sylow.equiv_quotient_normalizer [fact p.prime] [fintype (sylow p G)]
  (P : sylow p G) : sylow p G ≃ G ⧸ (P : subgroup G).normalizer :=
calc sylow p G ≃ (⊤ : set (sylow p G)) : (equiv.set.univ (sylow p G)).symm
... ≃ orbit G P : by rw P.orbit_eq_top
... ≃ G ⧸ (stabilizer G P) : orbit_equiv_quotient_stabilizer G P
... ≃ G ⧸ (P : subgroup G).normalizer : by rw P.stabilizer_eq_normalizer

noncomputable instance [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
  fintype (G ⧸ (P : subgroup G).normalizer) :=
of_equiv (sylow p G) P.equiv_quotient_normalizer

lemma card_sylow_eq_card_quotient_normalizer [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
  card (sylow p G) = card (G ⧸ (P : subgroup G).normalizer) :=
card_congr P.equiv_quotient_normalizer

lemma card_sylow_eq_index_normalizer [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
  card (sylow p G) = (P : subgroup G).normalizer.index :=
(card_sylow_eq_card_quotient_normalizer P).trans (P : subgroup G).normalizer.index_eq_card.symm

lemma card_sylow_dvd_index [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
  card (sylow p G) ∣ (P : subgroup G).index :=
((congr_arg _ (card_sylow_eq_index_normalizer P)).mp dvd_rfl).trans (index_dvd_of_le le_normalizer)

lemma not_dvd_index_sylow' [hp : fact p.prime] (P : sylow p G) [(P : subgroup G).normal]
  (hP : (P : subgroup G).index ≠ 0) : ¬ p ∣ (P : subgroup G).index :=
begin
  intro h,
  haveI : fintype (G ⧸ (P : subgroup G)) := fintype_of_index_ne_zero hP,
  rw index_eq_card at h,
  obtain ⟨x, hx⟩ := exists_prime_order_of_dvd_card p h,
  have h := is_p_group.of_card ((order_eq_card_zpowers.symm.trans hx).trans (pow_one p).symm),
  let Q := (zpowers x).comap (quotient_group.mk' (P : subgroup G)),
  have hQ : is_p_group p Q,
  { apply h.comap_of_ker_is_p_group,
    rw [quotient_group.ker_mk],
    exact P.2 },
  replace hp := mt order_of_eq_one_iff.mpr (ne_of_eq_of_ne hx hp.1.ne_one),
  rw [←zpowers_eq_bot, ←ne, ←bot_lt_iff_ne_bot, ←comap_lt_comap_of_surjective
    (quotient_group.mk'_surjective _), monoid_hom.comap_bot, quotient_group.ker_mk] at hp,
  exact hp.ne' (P.3 hQ hp.le),
end

lemma not_dvd_index_sylow [hp : fact p.prime] [fintype (sylow p G)] (P : sylow p G)
  (hP : relindex ↑P (P : subgroup G).normalizer ≠ 0) : ¬ p ∣ (P : subgroup G).index :=
begin
  rw [←relindex_mul_index le_normalizer, ←card_sylow_eq_index_normalizer],
  haveI : (P.subtype le_normalizer : subgroup (P : subgroup G).normalizer).normal :=
  subgroup.normal_in_normalizer,
  replace hP := not_dvd_index_sylow' (P.subtype le_normalizer) hP,
  exact hp.1.not_dvd_mul hP (not_dvd_card_sylow p G),
end

/-- Frattini's Argument: If `N` is a normal subgroup of `G`, and if `P` is a Sylow `p`-subgroup
  of `N`, then `N_G(P) ⊔ N = G`. -/
lemma sylow.normalizer_sup_eq_top {p : ℕ} [fact p.prime] {N : subgroup G} [N.normal]
  [fintype (sylow p N)] (P : sylow p N) : ((↑P : subgroup N).map N.subtype).normalizer ⊔ N = ⊤ :=
begin
  refine top_le_iff.mp (λ g hg, _),
  obtain ⟨n, hn⟩ := exists_smul_eq N ((mul_aut.conj_normal g : mul_aut N) • P) P,
  rw [←inv_mul_cancel_left ↑n g, sup_comm],
  apply mul_mem_sup (N.inv_mem n.2),
  rw [sylow.smul_def, ←mul_smul, ←mul_aut.conj_normal_coe, ←mul_aut.conj_normal.map_mul,
      sylow.ext_iff, sylow.pointwise_smul_def, pointwise_smul_def] at hn,
  refine λ x, (mem_map_iff_mem (show function.injective (mul_aut.conj (↑n * g)).to_monoid_hom,
    from (mul_aut.conj (↑n * g)).injective)).symm.trans _,
  rw [map_map, ←(congr_arg (map N.subtype) hn), map_map],
  refl,
end

end infinite_sylow

open equiv equiv.perm finset function list quotient_group
open_locale big_operators
universes u v w
variables {G : Type u} {α : Type v} {β : Type w} [group G]

local attribute [instance, priority 10] subtype.fintype set_fintype classical.prop_decidable

lemma quotient_group.card_preimage_mk [fintype G] (s : subgroup G)
  (t : set (G ⧸ s)) : fintype.card (quotient_group.mk ⁻¹' t) =
  fintype.card s * fintype.card t :=
by rw [← fintype.card_prod, fintype.card_congr
  (preimage_mk_equiv_subgroup_times_set _ _)]

namespace sylow

open subgroup submonoid mul_action

lemma mem_fixed_points_mul_left_cosets_iff_mem_normalizer {H : subgroup G}
  [fintype ((H : set G) : Type u)] {x : G} :
  (x : G ⧸ H) ∈ fixed_points H (G ⧸ H) ↔ x ∈ normalizer H :=
⟨λ hx, have ha : ∀ {y : G ⧸ H}, y ∈ orbit H (x : G ⧸ H) → y = x,
  from λ _, ((mem_fixed_points' _).1 hx _),
  inv_mem_iff.1 (@mem_normalizer_fintype _ _ _ _inst_2 _ (λ n (hn : n ∈ H),
    have (n⁻¹ * x)⁻¹ * x ∈ H := quotient_group.eq.1 (ha (mem_orbit _ ⟨n⁻¹, H.inv_mem hn⟩)),
    show _ ∈ H, by {rw [mul_inv_rev, inv_inv] at this, convert this, rw inv_inv}
    )),
λ (hx : ∀ (n : G), n ∈ H ↔ x * n * x⁻¹ ∈ H),
(mem_fixed_points' _).2 $ λ y, quotient.induction_on' y $ λ y hy, quotient_group.eq.2
  (let ⟨⟨b, hb₁⟩, hb₂⟩ := hy in
  have hb₂ : (b * x)⁻¹ * y ∈ H := quotient_group.eq.1 hb₂,
  inv_mem_iff.1 $ (hx _).2 $ (mul_mem_cancel_left (inv_mem hb₁)).1
  $ by rw hx at hb₂;
    simpa [mul_inv_rev, mul_assoc] using hb₂)⟩

def fixed_points_mul_left_cosets_equiv_quotient (H : subgroup G) [fintype (H : set G)] :
  mul_action.fixed_points H (G ⧸ H) ≃
  normalizer H ⧸ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H) :=
@subtype_quotient_equiv_quotient_subtype G (normalizer H : set G) (id _) (id _) (fixed_points _ _)
  (λ a, (@mem_fixed_points_mul_left_cosets_iff_mem_normalizer _ _ _ _inst_2 _).symm)
  (by intros; refl)

/-- If `H` is a `p`-subgroup of `G`, then the index of `H` inside its normalizer is congruent
  mod `p` to the index of `H`.  -/
lemma card_quotient_normalizer_modeq_card_quotient [fintype G] {p : ℕ} {n : ℕ} [hp : fact p.prime]
  {H : subgroup G} (hH : fintype.card H = p ^ n) :
  card (normalizer H ⧸ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H))
  ≡ card (G ⧸ H) [MOD p] :=
begin
  rw [← fintype.card_congr (fixed_points_mul_left_cosets_equiv_quotient H)],
  exact ((is_p_group.of_card hH).card_modeq_card_fixed_points _).symm
end

/-- If `H` is a subgroup of `G` of cardinality `p ^ n`, then the cardinality of the
  normalizer of `H` is congruent mod `p ^ (n + 1)` to the cardinality of `G`.  -/
lemma card_normalizer_modeq_card [fintype G] {p : ℕ} {n : ℕ} [hp : fact p.prime]
  {H : subgroup G} (hH : fintype.card H = p ^ n) :
  card (normalizer H) ≡ card G [MOD p ^ (n + 1)] :=
have subgroup.comap ((normalizer H).subtype : normalizer H →* G) H ≃ H,
  from set.bij_on.equiv (normalizer H).subtype
    ⟨λ _, id, λ _ _ _ _ h, subtype.val_injective h,
      λ x hx, ⟨⟨x, le_normalizer hx⟩, hx, rfl⟩⟩,
begin
  rw [card_eq_card_quotient_mul_card_subgroup H,
      card_eq_card_quotient_mul_card_subgroup
        (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H),
      fintype.card_congr this, hH, pow_succ],
  exact (card_quotient_normalizer_modeq_card_quotient hH).mul_right' _
end

/-- If `H` is a `p`-subgroup but not a Sylow `p`-subgroup, then `p` divides the
  index of `H` inside its normalizer. -/
lemma prime_dvd_card_quotient_normalizer [fintype G] {p : ℕ} {n : ℕ} [hp : fact p.prime]
  (hdvd : p ^ (n + 1) ∣ card G) {H : subgroup G} (hH : fintype.card H = p ^ n) :
  p ∣ card (normalizer H ⧸ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H)) :=
let ⟨s, hs⟩ := exists_eq_mul_left_of_dvd hdvd in
have hcard : card (G ⧸ H) = s * p :=
  (nat.mul_left_inj (show card H > 0, from fintype.card_pos_iff.2
      ⟨⟨1, H.one_mem⟩⟩)).1
    (by rwa [← card_eq_card_quotient_mul_card_subgroup H, hH, hs,
      pow_succ', mul_assoc, mul_comm p]),
have hm : s * p % p =
  card (normalizer H ⧸ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H)) % p :=
  hcard ▸ (card_quotient_normalizer_modeq_card_quotient hH).symm,
nat.dvd_of_mod_eq_zero
  (by rwa [nat.mod_eq_zero_of_dvd (dvd_mul_left _ _), eq_comm] at hm)

/-- If `H` is a `p`-subgroup but not a Sylow `p`-subgroup of cardinality `p ^ n`,
  then `p ^ (n + 1)` divides the cardinality of the normalizer of `H`. -/
lemma prime_pow_dvd_card_normalizer [fintype G] {p : ℕ} {n : ℕ} [hp : fact p.prime]
  (hdvd : p ^ (n + 1) ∣ card G) {H : subgroup G} (hH : fintype.card H = p ^ n) :
  p ^ (n + 1) ∣ card (normalizer H) :=
nat.modeq_zero_iff_dvd.1 ((card_normalizer_modeq_card hH).trans
  hdvd.modeq_zero_nat)

/-- If `H` is a subgroup of `G` of cardinality `p ^ n`,
  then `H` is contained in a subgroup of cardinality `p ^ (n + 1)`
  if `p ^ (n + 1)` divides the cardinality of `G` -/
theorem exists_subgroup_card_pow_succ [fintype G] {p : ℕ} {n : ℕ} [hp : fact p.prime]
  (hdvd : p ^ (n + 1) ∣ card G) {H : subgroup G} (hH : fintype.card H = p ^ n) :
  ∃ K : subgroup G, fintype.card K = p ^ (n + 1) ∧ H ≤ K :=
let ⟨s, hs⟩ := exists_eq_mul_left_of_dvd hdvd in
have hcard : card (G ⧸ H) = s * p :=
  (nat.mul_left_inj (show card H > 0, from fintype.card_pos_iff.2
      ⟨⟨1, H.one_mem⟩⟩)).1
    (by rwa [← card_eq_card_quotient_mul_card_subgroup H, hH, hs,
      pow_succ', mul_assoc, mul_comm p]),
have hm : s * p % p =
  card (normalizer H ⧸ (subgroup.comap (normalizer H).subtype H)) % p :=
  card_congr (fixed_points_mul_left_cosets_equiv_quotient H) ▸ hcard ▸
    (is_p_group.of_card hH).card_modeq_card_fixed_points _,
have hm' : p ∣ card (normalizer H ⧸ (subgroup.comap (normalizer H).subtype H)) :=
  nat.dvd_of_mod_eq_zero
    (by rwa [nat.mod_eq_zero_of_dvd (dvd_mul_left _ _), eq_comm] at hm),
let ⟨x, hx⟩ := @exists_prime_order_of_dvd_card _ (quotient_group.quotient.group _) _ _ hp hm' in
have hequiv : H ≃ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H) :=
  ⟨λ a, ⟨⟨a.1, le_normalizer a.2⟩, a.2⟩, λ a, ⟨a.1.1, a.2⟩,
    λ ⟨_, _⟩, rfl, λ ⟨⟨_, _⟩, _⟩, rfl⟩,
⟨subgroup.map ((normalizer H).subtype) (subgroup.comap
  (quotient_group.mk' (comap H.normalizer.subtype H)) (zpowers x)),
begin
  show card ↥(map H.normalizer.subtype
    (comap (mk' (comap H.normalizer.subtype H)) (subgroup.zpowers x))) = p ^ (n + 1),
  suffices : card ↥(subtype.val '' ((subgroup.comap (mk' (comap H.normalizer.subtype H))
    (zpowers x)) : set (↥(H.normalizer)))) = p^(n+1),
  { convert this using 2 },
  rw [set.card_image_of_injective
        (subgroup.comap (mk' (comap H.normalizer.subtype H)) (zpowers x) : set (H.normalizer))
        subtype.val_injective,
      pow_succ', ← hH, fintype.card_congr hequiv, ← hx, order_eq_card_zpowers,
      ← fintype.card_prod],
  exact @fintype.card_congr _ _ (id _) (id _) (preimage_mk_equiv_subgroup_times_set _ _)
end,
begin
  assume y hy,
  simp only [exists_prop, subgroup.coe_subtype, mk'_apply, subgroup.mem_map, subgroup.mem_comap],
  refine ⟨⟨y, le_normalizer hy⟩, ⟨0, _⟩, rfl⟩,
  rw [zpow_zero, eq_comm, quotient_group.eq_one_iff],
  simpa using hy
end⟩

/-- If `H` is a subgroup of `G` of cardinality `p ^ n`,
  then `H` is contained in a subgroup of cardinality `p ^ m`
  if `n ≤ m` and `p ^ m` divides the cardinality of `G` -/
theorem exists_subgroup_card_pow_prime_le [fintype G] (p : ℕ) : ∀ {n m : ℕ} [hp : fact p.prime]
  (hdvd : p ^ m ∣ card G) (H : subgroup G) (hH : card H = p ^ n) (hnm : n ≤ m),
  ∃ K : subgroup G, card K = p ^ m ∧ H ≤ K
| n m := λ hp hdvd H hH hnm,
  (lt_or_eq_of_le hnm).elim
    (λ hnm : n < m,
      have h0m : 0 < m, from (lt_of_le_of_lt n.zero_le hnm),
      have wf : m - 1 < m,  from nat.sub_lt h0m zero_lt_one,
      have hnm1 : n ≤ m - 1, from le_tsub_of_add_le_right hnm,
      let ⟨K, hK⟩ := @exists_subgroup_card_pow_prime_le n (m - 1) hp
        (nat.pow_dvd_of_le_of_pow_dvd tsub_le_self hdvd) H hH hnm1 in
      have hdvd' : p ^ ((m - 1) + 1) ∣ card G, by rwa [tsub_add_cancel_of_le h0m.nat_succ_le],
      let ⟨K', hK'⟩ := @exists_subgroup_card_pow_succ _ _ _ _ _ hp hdvd' K hK.1 in
      ⟨K', by rw [hK'.1, tsub_add_cancel_of_le h0m.nat_succ_le], le_trans hK.2 hK'.2⟩)
    (λ hnm : n = m, ⟨H, by simp [hH, hnm]⟩)

/-- A generalisation of **Sylow's first theorem**. If `p ^ n` divides
  the cardinality of `G`, then there is a subgroup of cardinality `p ^ n` -/
theorem exists_subgroup_card_pow_prime [fintype G] (p : ℕ) {n : ℕ} [fact p.prime]
  (hdvd : p ^ n ∣ card G) : ∃ K : subgroup G, fintype.card K = p ^ n :=
let ⟨K, hK⟩ := exists_subgroup_card_pow_prime_le p hdvd ⊥ (by simp) n.zero_le in
⟨K, hK.1⟩

lemma pow_dvd_card_of_pow_dvd_card [fintype G] {p n : ℕ} [hp : fact p.prime] (P : sylow p G)
  (hdvd : p ^ n ∣ card G) : p ^ n ∣ card P :=
(hp.1.coprime_pow_of_not_dvd (not_dvd_index_sylow P
  index_ne_zero_of_fintype)).symm.dvd_of_dvd_mul_left ((index_mul_card P.1).symm ▸ hdvd)

lemma dvd_card_of_dvd_card [fintype G] {p : ℕ} [fact p.prime] (P : sylow p G)
  (hdvd : p ∣ card G) : p ∣ card P :=
begin
  rw ← pow_one p at hdvd,
  have key := P.pow_dvd_card_of_pow_dvd_card hdvd,
  rwa pow_one at key,
end

/-- Sylow subgroups are Hall subgroups. -/
lemma card_coprime_index [fintype G] {p : ℕ} [hp : fact p.prime] (P : sylow p G) :
  (card P).coprime (index (P : subgroup G)) :=
let ⟨n, hn⟩ := is_p_group.iff_card.mp P.2 in
hn.symm ▸ (hp.1.coprime_pow_of_not_dvd (not_dvd_index_sylow P index_ne_zero_of_fintype)).symm

lemma ne_bot_of_dvd_card [fintype G] {p : ℕ} [hp : fact p.prime] (P : sylow p G)
  (hdvd : p ∣ card G) : (P : subgroup G) ≠ ⊥ :=
begin
  refine λ h, hp.out.not_dvd_one _,
  have key : p ∣ card (P : subgroup G) := P.dvd_card_of_dvd_card hdvd,
  rwa [h, card_bot] at key,
end

/-- The cardinality of a Sylow group is `p ^ n`
 where `n` is the multiplicity of `p` in the group order. -/
lemma card_eq_multiplicity [fintype G] {p : ℕ} [hp : fact p.prime] (P : sylow p G) :
  card P = p ^ nat.factorization (card G) p :=
begin
  obtain ⟨n, heq : card P = _⟩ := is_p_group.iff_card.mp (P.is_p_group'),
  refine nat.dvd_antisymm _ (P.pow_dvd_card_of_pow_dvd_card (nat.pow_factorization_dvd _ p)),
  rw [heq, ←hp.out.pow_dvd_iff_dvd_pow_factorization (show card G ≠ 0, from card_ne_zero), ←heq],
  exact P.1.card_subgroup_dvd_card,
end

lemma subsingleton_of_normal {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G)
  (h : (P : subgroup G).normal) : subsingleton (sylow p G) :=
begin
  apply subsingleton.intro,
  intros Q R,
  obtain ⟨x, h1⟩ := exists_smul_eq G P Q,
  obtain ⟨x, h2⟩ := exists_smul_eq G P R,
  rw sylow.smul_eq_of_normal at h1 h2,
  rw [← h1, ← h2],
end

section pointwise

open_locale pointwise

lemma characteristic_of_normal {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G)
  (h : (P : subgroup G).normal) :
  (P : subgroup G).characteristic :=
begin
  haveI := sylow.subsingleton_of_normal P h,
  rw characteristic_iff_map_eq,
  intros Φ,
  show (Φ • P).to_subgroup = P.to_subgroup,
  congr,
end

end pointwise

lemma normal_of_normalizer_normal {p : ℕ} [fact p.prime] [fintype (sylow p G)]
  (P : sylow p G) (hn : (↑P : subgroup G).normalizer.normal) :
  (↑P : subgroup G).normal :=
by rw [←normalizer_eq_top, ←normalizer_sup_eq_top (P.subtype le_normalizer), coe_subtype,
  map_comap_eq_self (le_normalizer.trans (ge_of_eq (subtype_range _))), sup_idem]

@[simp] lemma normalizer_normalizer {p : ℕ} [fact p.prime] [fintype (sylow p G)]
 (P : sylow p G) :
 (↑P : subgroup G).normalizer.normalizer = (↑P : subgroup G).normalizer :=
begin
  have := normal_of_normalizer_normal (P.subtype (le_normalizer.trans le_normalizer)),
  simp_rw [←normalizer_eq_top, coe_subtype, ←comap_subtype_normalizer_eq le_normalizer,
    ←comap_subtype_normalizer_eq le_rfl, comap_subtype_self_eq_top] at this,
  rw [←subtype_range (P : subgroup G).normalizer.normalizer, monoid_hom.range_eq_map, ←this rfl],
  exact map_comap_eq_self (le_normalizer.trans (ge_of_eq (subtype_range _))),
end

lemma normal_of_all_max_subgroups_normal [fintype G]
  (hnc : ∀ (H : subgroup G), is_coatom H → H.normal)
  {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
  (↑P : subgroup G).normal :=
normalizer_eq_top.mp begin
  rcases eq_top_or_exists_le_coatom ((↑P : subgroup G).normalizer) with heq | ⟨K, hK, hNK⟩,
  { exact heq },
  { haveI := hnc _ hK,
    have hPK := le_trans le_normalizer hNK,
    let P' := P.subtype hPK,
    exfalso,
    apply hK.1,
    calc K = (↑P : subgroup G).normalizer ⊔ K : by { rw sup_eq_right.mpr, exact hNK }
    ... = (map K.subtype (↑P' : subgroup K)).normalizer ⊔ K : by simp [map_comap_eq_self, hPK]
    ... = ⊤ : normalizer_sup_eq_top P' },
end

lemma normal_of_normalizer_condition (hnc : normalizer_condition G)
 {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
 (↑P : subgroup G).normal :=
normalizer_eq_top.mp $ normalizer_condition_iff_only_full_group_self_normalizing.mp hnc _ $
  normalizer_normalizer _

open_locale big_operators

/-- If all its sylow groups are normal, then a finite group is isomorphic to the direct product
of these sylow groups.
-/
noncomputable
def direct_product_of_normal [fintype G]
  (hn : ∀ {p : ℕ} [fact p.prime] (P : sylow p G), (↑P : subgroup G).normal) :
  (Π p : (card G).factorization.support, Π P : sylow p G, (↑P : subgroup G)) ≃* G :=
begin
  set ps := (fintype.card G).factorization.support,

  -- “The” sylow group for p
  let P : Π p, sylow p G := default,

  have hcomm : pairwise (λ (p₁ p₂ : ps), ∀ (x y : G), x ∈ P p₁ → y ∈ P p₂ → commute x y),
  { rintros ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ hne,
    haveI hp₁' := fact.mk (nat.prime_of_mem_factorization hp₁),
    haveI hp₂' := fact.mk (nat.prime_of_mem_factorization hp₂),
    have hne' : p₁ ≠ p₂, by simpa using hne,
    apply subgroup.commute_of_normal_of_disjoint _ _ (hn (P p₁)) (hn (P p₂)),
    apply is_p_group.disjoint_of_ne p₁ p₂ hne' _ _ (P p₁).is_p_group' (P p₂).is_p_group', },

  refine mul_equiv.trans _ _,
  -- There is only one sylow group for each p, so the inner product is trivial
  show (Π p : ps, Π P : sylow p G, P) ≃* (Π p : ps, P p),
  { -- here we need to help the elaborator with an explicit instantiation
    apply @mul_equiv.Pi_congr_right ps (λ p, (Π P : sylow p G, P)) (λ p, P p) _ _ ,
    rintro ⟨p, hp⟩,
    haveI hp' := fact.mk (nat.prime_of_mem_factorization hp),
    haveI := subsingleton_of_normal _ (hn (P p)),
    change (Π (P : sylow p G), P) ≃* P p,
    exact mul_equiv.Pi_subsingleton _ _, },

  show (Π p : ps, P p) ≃* G,
  apply mul_equiv.of_bijective (subgroup.noncomm_pi_coprod hcomm),
  apply (bijective_iff_injective_and_card _).mpr,
  split,

  show injective _,
  { apply subgroup.injective_noncomm_pi_coprod_of_independent,
    apply independent_of_coprime_order hcomm,
    rintros ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ hne,
    haveI hp₁' := fact.mk (nat.prime_of_mem_factorization hp₁),
    haveI hp₂' := fact.mk (nat.prime_of_mem_factorization hp₂),
    have hne' : p₁ ≠ p₂, by simpa using hne,
    apply is_p_group.coprime_card_of_ne p₁ p₂ hne' _ _ (P p₁).is_p_group' (P p₂).is_p_group', },

  show card (Π (p : ps), P p) = card G,
  { calc card (Π (p : ps), P p)
        = ∏ (p : ps), card ↥(P p) : fintype.card_pi
    ... = ∏ (p : ps), p.1 ^ (card G).factorization p.1 :
      begin
        congr' 1 with ⟨p, hp⟩,
        exact @card_eq_multiplicity _ _ _ p ⟨nat.prime_of_mem_factorization hp⟩ (P p)
      end
    ... = ∏ p in ps, p ^ (card G).factorization p :
      finset.prod_finset_coe (λ p, p ^ (card G).factorization p) _
    ... = (card G).factorization.prod pow : rfl
    ... = card G : nat.factorization_prod_pow_eq_self fintype.card_ne_zero }
end

end sylow


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module data.sum.order
! leanprover-community/mathlib commit f1a2caaf51ef593799107fe9a8d5e411599f3996
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Hom.Basic

/-!
# Orders on a sum type

This file defines the disjoint sum and the linear (aka lexicographic) sum of two orders and
provides relation instances for `Sum.LiftRel` and `Sum.Lex`.

We declare the disjoint sum of orders as the default set of instances. The linear order goes on a
type synonym.

## Main declarations

* `Sum.LE`, `Sum.LT`: Disjoint sum of orders.
* `Sum.Lex.LE`, `Sum.Lex.LT`: Lexicographic/linear sum of orders.

## Notation

* `α ⊕ₗ β`:  The linear sum of `α` and `β`.
-/

variable {α β γ δ : Type _}

namespace Sum

/-! ### Unbundled relation classes -/

section LiftRel

variable (r : α → α → Prop) (s : β → β → Prop)

@[refl]
theorem LiftRel.refl [IsRefl α r] [IsRefl β s] : ∀ x, LiftRel r s x x
  | inl a => LiftRel.inl (_root_.refl a)
  | inr a => LiftRel.inr (_root_.refl a)
#align sum.lift_rel.refl Sum.LiftRel.refl

instance [IsRefl α r] [IsRefl β s] : IsRefl (Sum α β) (LiftRel r s) :=
  ⟨LiftRel.refl _ _⟩

instance [IsIrrefl α r] [IsIrrefl β s] : IsIrrefl (Sum α β) (LiftRel r s) :=
  ⟨by rintro _ (⟨h⟩ | ⟨h⟩) <;> exact irrefl _ h⟩

@[trans]
theorem LiftRel.trans [IsTrans α r] [IsTrans β s] :
    ∀ {a b c}, LiftRel r s a b → LiftRel r s b c → LiftRel r s a c
  | _, _, _, LiftRel.inl hab, LiftRel.inl hbc => LiftRel.inl <| _root_.trans hab hbc
  | _, _, _, LiftRel.inr hab, LiftRel.inr hbc => LiftRel.inr <| _root_.trans hab hbc
#align sum.lift_rel.trans Sum.LiftRel.trans

instance [IsTrans α r] [IsTrans β s] : IsTrans (Sum α β) (LiftRel r s) :=
  ⟨fun _ _ _ => LiftRel.trans _ _⟩

instance [IsAntisymm α r] [IsAntisymm β s] : IsAntisymm (Sum α β) (LiftRel r s) :=
  ⟨by rintro _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hba⟩ | ⟨hba⟩) <;> rw [antisymm hab hba]⟩

end LiftRel

section Lex

variable (r : α → α → Prop) (s : β → β → Prop)

instance [IsRefl α r] [IsRefl β s] : IsRefl (Sum α β) (Lex r s) :=
  ⟨by
    rintro (a | a)
    exacts[Lex.inl (refl _), Lex.inr (refl _)]⟩

instance [IsIrrefl α r] [IsIrrefl β s] : IsIrrefl (Sum α β) (Lex r s) :=
  ⟨by rintro _ (⟨h⟩ | ⟨h⟩) <;> exact irrefl _ h⟩

instance [IsTrans α r] [IsTrans β s] : IsTrans (Sum α β) (Lex r s) :=
  ⟨by
    rintro _ _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hbc⟩ | ⟨hbc⟩)
    exacts[.inl (_root_.trans hab hbc), .sep _ _, .inr (_root_.trans hab hbc), .sep _ _]⟩

instance [IsAntisymm α r] [IsAntisymm β s] : IsAntisymm (Sum α β) (Lex r s) :=
  ⟨by rintro _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hba⟩ | ⟨hba⟩) <;> rw [antisymm hab hba]⟩

instance [IsTotal α r] [IsTotal β s] : IsTotal (Sum α β) (Lex r s) :=
  ⟨fun a b =>
    match a, b with
    | inl a, inl b => (total_of r a b).imp Lex.inl Lex.inl
    | inl _, inr _ => Or.inl (Lex.sep _ _)
    | inr _, inl _ => Or.inr (Lex.sep _ _)
    | inr a, inr b => (total_of s a b).imp Lex.inr Lex.inr⟩

instance [IsTrichotomous α r] [IsTrichotomous β s] : IsTrichotomous (Sum α β) (Lex r s) :=
  ⟨fun a b =>
    match a, b with
    | inl a, inl b => (trichotomous_of r a b).imp3 Lex.inl (congr_arg _) Lex.inl
    | inl _, inr _ => Or.inl (Lex.sep _ _)
    | inr _, inl _ => Or.inr (Or.inr <| Lex.sep _ _)
    | inr a, inr b => (trichotomous_of s a b).imp3 Lex.inr (congr_arg _) Lex.inr⟩

instance [IsWellOrder α r] [IsWellOrder β s] :
    IsWellOrder (Sum α β) (Sum.Lex r s) where wf := Sum.lex_wf IsWellFounded.wf IsWellFounded.wf

end Lex

/-! ### Disjoint sum of two orders -/

section Disjoint

instance [LE α] [LE β] : LE (Sum α β) :=
  ⟨LiftRel (· ≤ ·) (· ≤ ·)⟩

instance [LT α] [LT β] : LT (Sum α β) :=
  ⟨LiftRel (· < ·) (· < ·)⟩

theorem le_def [LE α] [LE β] {a b : Sum α β} : a ≤ b ↔ LiftRel (· ≤ ·) (· ≤ ·) a b :=
  Iff.rfl
#align sum.le_def Sum.le_def

theorem lt_def [LT α] [LT β] {a b : Sum α β} : a < b ↔ LiftRel (· < ·) (· < ·) a b :=
  Iff.rfl
#align sum.lt_def Sum.lt_def

@[simp]
theorem inl_le_inl_iff [LE α] [LE β] {a b : α} : (inl a : Sum α β) ≤ inl b ↔ a ≤ b :=
  liftRel_inl_inl
#align sum.inl_le_inl_iff Sum.inl_le_inl_iff

@[simp]
theorem inr_le_inr_iff [LE α] [LE β] {a b : β} : (inr a : Sum α β) ≤ inr b ↔ a ≤ b :=
  liftRel_inr_inr
#align sum.inr_le_inr_iff Sum.inr_le_inr_iff

@[simp]
theorem inl_lt_inl_iff [LT α] [LT β] {a b : α} : (inl a : Sum α β) < inl b ↔ a < b :=
  liftRel_inl_inl
#align sum.inl_lt_inl_iff Sum.inl_lt_inl_iff

@[simp]

@[simp]
theorem not_inl_le_inr [LE α] [LE β] {a : α} {b : β} : ¬inl b ≤ inr a :=
  not_liftRel_inl_inr
#align sum.not_inl_le_inr Sum.not_inl_le_inr

@[simp]
theorem not_inl_lt_inr [LT α] [LT β] {a : α} {b : β} : ¬inl b < inr a :=
  not_liftRel_inl_inr
#align sum.not_inl_lt_inr Sum.not_inl_lt_inr

@[simp]
theorem not_inr_le_inl [LE α] [LE β] {a : α} {b : β} : ¬inr b ≤ inl a :=
  not_liftRel_inr_inl
#align sum.not_inr_le_inl Sum.not_inr_le_inl

@[simp]
theorem not_inr_lt_inl [LT α] [LT β] {a : α} {b : β} : ¬inr b < inl a :=
  not_liftRel_inr_inl
#align sum.not_inr_lt_inl Sum.not_inr_lt_inl

section Preorder

variable [Preorder α] [Preorder β]

instance : Preorder (Sum α β) :=
  { instLESum, instLTSum with
    le_refl := fun x => LiftRel.refl _ _ _,
    le_trans := fun _ _ _ => LiftRel.trans _ _,
    lt_iff_le_not_le := fun a b => by
      refine' ⟨fun hab => ⟨hab.mono (fun _ _ => le_of_lt) fun _ _ => le_of_lt, _⟩, _⟩
      · rintro (⟨hba⟩ | ⟨hba⟩)
        · exact hba.not_lt (inl_lt_inl_iff.1 hab)
        · exact hba.not_lt (inr_lt_inr_iff.1 hab)
      · rintro ⟨⟨hab⟩ | ⟨hab⟩, hba⟩
        · exact LiftRel.inl (hab.lt_of_not_le fun h => hba <| LiftRel.inl h)
        · exact LiftRel.inr (hab.lt_of_not_le fun h => hba <| LiftRel.inr h) }

theorem inl_mono : Monotone (inl : α → Sum α β) := fun _ _ => LiftRel.inl
#align sum.inl_mono Sum.inl_mono

theorem inr_mono : Monotone (inr : β → Sum α β) := fun _ _ => LiftRel.inr
#align sum.inr_mono Sum.inr_mono

theorem inl_strictMono : StrictMono (inl : α → Sum α β) := fun _ _ => LiftRel.inl
#align sum.inl_strict_mono Sum.inl_strictMono

theorem inr_strictMono : StrictMono (inr : β → Sum α β) := fun _ _ => LiftRel.inr
#align sum.inr_strict_mono Sum.inr_strictMono

end Preorder

instance [PartialOrder α] [PartialOrder β] : PartialOrder (Sum α β) :=
  { instPreorderSum with
    le_antisymm := fun _ _ => show LiftRel _ _ _ _ → _ from antisymm  }

instance noMinOrder [LT α] [LT β] [NoMinOrder α] [NoMinOrder β] : NoMinOrder (Sum α β) :=
  ⟨fun a =>
    match a with
    | inl a =>
      let ⟨b, h⟩ := exists_lt a
      ⟨inl b, inl_lt_inl_iff.2 h⟩
    | inr a =>
      let ⟨b, h⟩ := exists_lt a
      ⟨inr b, inr_lt_inr_iff.2 h⟩⟩
#align sum.no_min_order Sum.noMinOrder

instance noMaxOrder [LT α] [LT β] [NoMaxOrder α] [NoMaxOrder β] : NoMaxOrder (Sum α β) :=
  ⟨fun a =>
    match a with
    | inl a =>
      let ⟨b, h⟩ := exists_gt a
      ⟨inl b, inl_lt_inl_iff.2 h⟩
    | inr a =>
      let ⟨b, h⟩ := exists_gt a
      ⟨inr b, inr_lt_inr_iff.2 h⟩⟩
#align sum.no_max_order Sum.noMaxOrder

@[simp]
theorem noMinOrder_iff [LT α] [LT β] : NoMinOrder (Sum α β) ↔ NoMinOrder α ∧ NoMinOrder β :=
  ⟨fun _ =>
    ⟨⟨fun a => by
        obtain ⟨b | b, h⟩ := exists_lt (inl a : Sum α β)
        · exact ⟨b, inl_lt_inl_iff.1 h⟩
        · exact (not_inr_lt_inl h).elim⟩,
      ⟨fun a => by
        obtain ⟨b | b, h⟩ := exists_lt (inr a : Sum α β)
        · exact (not_inl_lt_inr h).elim
        · exact ⟨b, inr_lt_inr_iff.1 h⟩⟩⟩,
    fun h => @Sum.noMinOrder _ _ _ _ h.1 h.2⟩
#align sum.no_min_order_iff Sum.noMinOrder_iff

@[simp]
theorem noMaxOrder_iff [LT α] [LT β] : NoMaxOrder (Sum α β) ↔ NoMaxOrder α ∧ NoMaxOrder β :=
  ⟨fun _ =>
    ⟨⟨fun a => by
        obtain ⟨b | b, h⟩ := exists_gt (inl a : Sum α β)
        · exact ⟨b, inl_lt_inl_iff.1 h⟩
        · exact (not_inl_lt_inr h).elim⟩,
      ⟨fun a => by
        obtain ⟨b | b, h⟩ := exists_gt (inr a : Sum α β)
        · exact (not_inr_lt_inl h).elim
        · exact ⟨b, inr_lt_inr_iff.1 h⟩⟩⟩,
    fun h => @Sum.noMaxOrder _ _ _ _ h.1 h.2⟩
#align sum.no_max_order_iff Sum.noMaxOrder_iff

instance denselyOrdered [LT α] [LT β] [DenselyOrdered α] [DenselyOrdered β] :
    DenselyOrdered (Sum α β) :=
  ⟨fun a b h =>
    match a, b, h with
    | inl _, inl _, LiftRel.inl h =>
      let ⟨c, ha, hb⟩ := exists_between h
      ⟨toLex (inl c), LiftRel.inl ha, LiftRel.inl hb⟩
    | inr _, inr _, LiftRel.inr h =>
      let ⟨c, ha, hb⟩ := exists_between h
      ⟨toLex (inr c), LiftRel.inr ha, LiftRel.inr hb⟩⟩
#align sum.densely_ordered Sum.denselyOrdered

@[simp]
theorem denselyOrdered_iff [LT α] [LT β] :
    DenselyOrdered (Sum α β) ↔ DenselyOrdered α ∧ DenselyOrdered β :=
  ⟨fun _ =>
    ⟨⟨fun a b h => by
        obtain ⟨c | c, ha, hb⟩ := @exists_between (Sum α β) _ _ _ _ (inl_lt_inl_iff.2 h)
        · exact ⟨c, inl_lt_inl_iff.1 ha, inl_lt_inl_iff.1 hb⟩
        · exact (not_inl_lt_inr ha).elim⟩,
      ⟨fun a b h => by
        obtain ⟨c | c, ha, hb⟩ := @exists_between (Sum α β) _ _ _ _ (inr_lt_inr_iff.2 h)
        · exact (not_inl_lt_inr hb).elim
        · exact ⟨c, inr_lt_inr_iff.1 ha, inr_lt_inr_iff.1 hb⟩⟩⟩,
    fun h => @Sum.denselyOrdered _ _ _ _ h.1 h.2⟩
#align sum.densely_ordered_iff Sum.denselyOrdered_iff

@[simp]
theorem swap_le_swap_iff [LE α] [LE β] {a b : Sum α β} : a.swap ≤ b.swap ↔ a ≤ b :=
  liftRel_swap_iff
#align sum.swap_le_swap_iff Sum.swap_le_swap_iff

@[simp]
theorem swap_lt_swap_iff [LT α] [LT β] {a b : Sum α β} : a.swap < b.swap ↔ a < b :=
  liftRel_swap_iff
#align sum.swap_lt_swap_iff Sum.swap_lt_swap_iff

end Disjoint

/-! ### Linear sum of two orders -/

namespace Lex

/-- The linear sum of two orders -/
notation:30 α " ⊕ₗ " β:29 => _root_.Lex (Sum α β)

--TODO: Can we make `inlₗ`, `inrₗ` `local notation`?
/-- Lexicographical `sum.inl`. Only used for pattern matching. -/
@[match_pattern]
abbrev _root_.Sum.inlₗ (x : α) : α ⊕ₗ β :=
  toLex (Sum.inl x)
#align sum.inlₗ Sum.inlₗ

/-- Lexicographical `sum.inr`. Only used for pattern matching. -/
@[match_pattern]
abbrev _root_.Sum.inrₗ (x : β) : α ⊕ₗ β :=
  toLex (Sum.inr x)
#align sum.inrₗ Sum.inrₗ

/-- The linear/lexicographical `≤` on a sum. -/
protected instance LE [LE α] [LE β] : LE (α ⊕ₗ β) :=
  ⟨Lex (· ≤ ·) (· ≤ ·)⟩
#align sum.lex.has_le Sum.Lex.LE

/-- The linear/lexicographical `<` on a sum. -/
protected instance LT [LT α] [LT β] : LT (α ⊕ₗ β) :=
  ⟨Lex (· < ·) (· < ·)⟩
#align sum.lex.has_lt Sum.Lex.LT

@[simp]
theorem toLex_le_toLex [LE α] [LE β] {a b : Sum α β} :
    toLex a ≤ toLex b ↔ Lex (· ≤ ·) (· ≤ ·) a b :=
  Iff.rfl
#align sum.lex.to_lex_le_to_lex Sum.Lex.toLex_le_toLex

@[simp]
theorem toLex_lt_toLex [LT α] [LT β] {a b : Sum α β} :
    toLex a < toLex b ↔ Lex (· < ·) (· < ·) a b :=
  Iff.rfl
#align sum.lex.to_lex_lt_to_lex Sum.Lex.toLex_lt_toLex

theorem le_def [LE α] [LE β] {a b : α ⊕ₗ β} : a ≤ b ↔ Lex (· ≤ ·) (· ≤ ·) (ofLex a) (ofLex b) :=
  Iff.rfl
#align sum.lex.le_def Sum.Lex.le_def

theorem lt_def [LT α] [LT β] {a b : α ⊕ₗ β} : a < b ↔ Lex (· < ·) (· < ·) (ofLex a) (ofLex b) :=
  Iff.rfl
#align sum.lex.lt_def Sum.Lex.lt_def

theorem inl_le_inl_iff [LE α] [LE β] {a b : α} : toLex (inl a : Sum α β) ≤ toLex (inl b) ↔ a ≤ b :=
  lex_inl_inl
#align sum.lex.inl_le_inl_iff Sum.Lex.inl_le_inl_iff

theorem inr_le_inr_iff [LE α] [LE β] {a b : β} : toLex (inr a : Sum α β) ≤ toLex (inr b) ↔ a ≤ b :=
  lex_inr_inr
#align sum.lex.inr_le_inr_iff Sum.Lex.inr_le_inr_iff

theorem inl_lt_inl_iff [LT α] [LT β] {a b : α} : toLex (inl a : Sum α β) < toLex (inl b) ↔ a < b :=
  lex_inl_inl
#align sum.lex.inl_lt_inl_iff Sum.Lex.inl_lt_inl_iff

theorem inr_lt_inr_iff [LT α] [LT β] {a b : β} : toLex (inr a : α ⊕ₗ β) < toLex (inr b) ↔ a < b :=
  lex_inr_inr
#align sum.lex.inr_lt_inr_iff Sum.Lex.inr_lt_inr_iff

theorem inl_le_inr [LE α] [LE β] (a : α) (b : β) : toLex (inl a) ≤ toLex (inr b) :=
  Lex.sep _ _
#align sum.lex.inl_le_inr Sum.Lex.inl_le_inr

theorem inl_lt_inr [LT α] [LT β] (a : α) (b : β) : toLex (inl a) < toLex (inr b) :=
  Lex.sep _ _
#align sum.lex.inl_lt_inr Sum.Lex.inl_lt_inr

theorem not_inr_le_inl [LE α] [LE β] {a : α} {b : β} : ¬toLex (inr b) ≤ toLex (inl a) :=
  lex_inr_inl
#align sum.lex.not_inr_le_inl Sum.Lex.not_inr_le_inl

theorem not_inr_lt_inl [LT α] [LT β] {a : α} {b : β} : ¬toLex (inr b) < toLex (inl a) :=
  lex_inr_inl
#align sum.lex.not_inr_lt_inl Sum.Lex.not_inr_lt_inl

section Preorder

variable [Preorder α] [Preorder β]

instance preorder : Preorder (α ⊕ₗ β) :=
  { Lex.LE, Lex.LT with
    le_refl := refl_of (Lex (· ≤ ·) (· ≤ ·)),
    le_trans := fun _ _ _ => trans_of (Lex (· ≤ ·) (· ≤ ·)),
    lt_iff_le_not_le := fun a b => by
      refine' ⟨fun hab => ⟨hab.mono (fun _ _ => le_of_lt) fun _ _ => le_of_lt, _⟩, _⟩
      · rintro (⟨hba⟩ | ⟨hba⟩ | ⟨b, a⟩)
        · exact hba.not_lt (inl_lt_inl_iff.1 hab)
        · exact hba.not_lt (inr_lt_inr_iff.1 hab)
        · exact not_inr_lt_inl hab
      · rintro ⟨⟨hab⟩ | ⟨hab⟩ | ⟨a, b⟩, hba⟩
        · exact Lex.inl (hab.lt_of_not_le fun h => hba <| Lex.inl h)
        · exact Lex.inr (hab.lt_of_not_le fun h => hba <| Lex.inr h)
        · exact Lex.sep _ _ }
#align sum.lex.preorder Sum.Lex.preorder

theorem toLex_mono : Monotone (@toLex (Sum α β)) := fun _ _ h => h.lex
#align sum.lex.to_lex_mono Sum.Lex.toLex_mono

theorem toLex_strictMono : StrictMono (@toLex (Sum α β)) := fun _ _ h => h.lex
#align sum.lex.to_lex_strict_mono Sum.Lex.toLex_strictMono

theorem inl_mono : Monotone (toLex ∘ inl : α → α ⊕ₗ β) :=
  toLex_mono.comp Sum.inl_mono
#align sum.lex.inl_mono Sum.Lex.inl_mono

theorem inr_mono : Monotone (toLex ∘ inr : β → α ⊕ₗ β) :=
  toLex_mono.comp Sum.inr_mono
#align sum.lex.inr_mono Sum.Lex.inr_mono

theorem inl_strictMono : StrictMono (toLex ∘ inl : α → α ⊕ₗ β) :=
  toLex_strictMono.comp Sum.inl_strictMono
#align sum.lex.inl_strict_mono Sum.Lex.inl_strictMono

theorem inr_strictMono : StrictMono (toLex ∘ inr : β → α ⊕ₗ β) :=
  toLex_strictMono.comp Sum.inr_strictMono
#align sum.lex.inr_strict_mono Sum.Lex.inr_strictMono

end Preorder

instance partialOrder [PartialOrder α] [PartialOrder β] : PartialOrder (α ⊕ₗ β) :=
  { Lex.preorder with le_antisymm := fun _ _ => antisymm_of (Lex (· ≤ ·) (· ≤ ·)) }
#align sum.lex.partial_order Sum.Lex.partialOrder

instance linearOrder [LinearOrder α] [LinearOrder β] : LinearOrder (α ⊕ₗ β) :=
  { Lex.partialOrder with
    le_total := total_of (Lex (· ≤ ·) (· ≤ ·)),
    decidable_le := instDecidableRelSumLex,
    decidable_eq := instDecidableEqSum }
#align sum.lex.linear_order Sum.Lex.linearOrder

/-- The lexicographical bottom of a sum is the bottom of the left component. -/
instance orderBot [LE α] [OrderBot α] [LE β] :
    OrderBot (α ⊕ₗ β) where
  bot := inl ⊥
  bot_le := by
    rintro (a | b)
    · exact Lex.inl bot_le
    · exact Lex.sep _ _
#align sum.lex.order_bot Sum.Lex.orderBot

@[simp]
theorem inl_bot [LE α] [OrderBot α] [LE β] : toLex (inl ⊥ : Sum α β) = ⊥ :=
  rfl
#align sum.lex.inl_bot Sum.Lex.inl_bot

/-- The lexicographical top of a sum is the top of the right component. -/
instance orderTop [LE α] [LE β] [OrderTop β] :
    OrderTop (α ⊕ₗ β) where
  top := inr ⊤
  le_top := by
    rintro (a | b)
    · exact Lex.sep _ _
    · exact Lex.inr le_top
#align sum.lex.order_top Sum.Lex.orderTop

@[simp]
theorem inr_top [LE α] [LE β] [OrderTop β] : toLex (inr ⊤ : Sum α β) = ⊤ :=
  rfl
#align sum.lex.inr_top Sum.Lex.inr_top

instance boundedOrder [LE α] [LE β] [OrderBot α] [OrderTop β] : BoundedOrder (α ⊕ₗ β) :=
  { Lex.orderBot, Lex.orderTop with }
#align sum.lex.bounded_order Sum.Lex.boundedOrder

instance noMinOrder [LT α] [LT β] [NoMinOrder α] [NoMinOrder β] : NoMinOrder (α ⊕ₗ β) :=
  ⟨fun a =>
    match a with
    | inl a =>
      let ⟨b, h⟩ := exists_lt a
      ⟨toLex (inl b), inl_lt_inl_iff.2 h⟩
    | inr a =>
      let ⟨b, h⟩ := exists_lt a
      ⟨toLex (inr b), inr_lt_inr_iff.2 h⟩⟩
#align sum.lex.no_min_order Sum.Lex.noMinOrder

instance noMaxOrder [LT α] [LT β] [NoMaxOrder α] [NoMaxOrder β] : NoMaxOrder (α ⊕ₗ β) :=
  ⟨fun a =>
    match a with
    | inl a =>
      let ⟨b, h⟩ := exists_gt a
      ⟨toLex (inl b), inl_lt_inl_iff.2 h⟩
    | inr a =>
      let ⟨b, h⟩ := exists_gt a
      ⟨toLex (inr b), inr_lt_inr_iff.2 h⟩⟩
#align sum.lex.no_max_order Sum.Lex.noMaxOrder

instance noMinOrder_of_nonempty [LT α] [LT β] [NoMinOrder α] [Nonempty α] : NoMinOrder (α ⊕ₗ β) :=
  ⟨fun a =>
    match a with
    | inl a =>
      let ⟨b, h⟩ := exists_lt a
      ⟨toLex (inl b), inl_lt_inl_iff.2 h⟩
    | inr _ => ⟨toLex (inl <| Classical.arbitrary α), inl_lt_inr _ _⟩⟩
#align sum.lex.no_min_order_of_nonempty Sum.Lex.noMinOrder_of_nonempty

instance noMaxOrder_of_nonempty [LT α] [LT β] [NoMaxOrder β] [Nonempty β] : NoMaxOrder (α ⊕ₗ β) :=
  ⟨fun a =>
    match a with
    | inl _ => ⟨toLex (inr <| Classical.arbitrary β), inl_lt_inr _ _⟩
    | inr a =>
      let ⟨b, h⟩ := exists_gt a
      ⟨toLex (inr b), inr_lt_inr_iff.2 h⟩⟩
#align sum.lex.no_max_order_of_nonempty Sum.Lex.noMaxOrder_of_nonempty

instance denselyOrdered_of_noMaxOrder [LT α] [LT β] [DenselyOrdered α] [DenselyOrdered β]
    [NoMaxOrder α] : DenselyOrdered (α ⊕ₗ β) :=
  ⟨fun a b h =>
    match a, b, h with
    | inl _, inl _, Lex.inl h =>
      let ⟨c, ha, hb⟩ := exists_between h
      ⟨toLex (inl c), inl_lt_inl_iff.2 ha, inl_lt_inl_iff.2 hb⟩
    | inl a, inr _, Lex.sep _ _ =>
      let ⟨c, h⟩ := exists_gt a
      ⟨toLex (inl c), inl_lt_inl_iff.2 h, inl_lt_inr _ _⟩
    | inr _, inr _, Lex.inr h =>
      let ⟨c, ha, hb⟩ := exists_between h
      ⟨toLex (inr c), inr_lt_inr_iff.2 ha, inr_lt_inr_iff.2 hb⟩⟩
#align sum.lex.densely_ordered_of_no_max_order Sum.Lex.denselyOrdered_of_noMaxOrder

instance denselyOrdered_of_noMinOrder [LT α] [LT β] [DenselyOrdered α] [DenselyOrdered β]
    [NoMinOrder β] : DenselyOrdered (α ⊕ₗ β) :=
  ⟨fun a b h =>
    match a, b, h with
    | inl _, inl _, Lex.inl h =>
      let ⟨c, ha, hb⟩ := exists_between h
      ⟨toLex (inl c), inl_lt_inl_iff.2 ha, inl_lt_inl_iff.2 hb⟩
    | inl _, inr b, Lex.sep _ _ =>
      let ⟨c, h⟩ := exists_lt b
      ⟨toLex (inr c), inl_lt_inr _ _, inr_lt_inr_iff.2 h⟩
    | inr _, inr _, Lex.inr h =>
      let ⟨c, ha, hb⟩ := exists_between h
      ⟨toLex (inr c), inr_lt_inr_iff.2 ha, inr_lt_inr_iff.2 hb⟩⟩
#align sum.lex.densely_ordered_of_no_min_order Sum.Lex.denselyOrdered_of_noMinOrder

end Lex

end Sum

/-! ### Order isomorphisms -/

open OrderDual Sum

namespace OrderIso

variable [LE α] [LE β] [LE γ] (a : α) (b : β) (c : γ)

/-- `Equiv.sumComm` promoted to an order isomorphism. -/
@[simps! apply]
def sumComm (α β : Type _) [LE α] [LE β] : Sum α β ≃o Sum β α :=
  { Equiv.sumComm α β with map_rel_iff' := swap_le_swap_iff }
#align order_iso.sum_comm OrderIso.sumComm
#align order_iso.sum_comm_apply OrderIso.sumComm_apply

@[simp]
theorem sumComm_symm (α β : Type _) [LE α] [LE β] :
    (OrderIso.sumComm α β).symm = OrderIso.sumComm β α :=
  rfl
#align order_iso.sum_comm_symm OrderIso.sumComm_symm

/-- `Equiv.sumAssoc` promoted to an order isomorphism. -/
def sumAssoc (α β γ : Type _) [LE α] [LE β] [LE γ] : Sum (Sum α β) γ ≃o Sum α (Sum β γ) :=
  { Equiv.sumAssoc α β γ with
    map_rel_iff' := @fun a b => by
      rcases a with ((_ | _) | _) <;> rcases b with ((_ | _) | _) <;>
      simp [Equiv.sumAssoc] }
#align order_iso.sum_assoc OrderIso.sumAssoc

@[simp]
theorem sumAssoc_apply_inl_inl : sumAssoc α β γ (inl (inl a)) = inl a :=
  rfl
#align order_iso.sum_assoc_apply_inl_inl OrderIso.sumAssoc_apply_inl_inl

@[simp]
theorem sumAssoc_apply_inl_inr : sumAssoc α β γ (inl (inr b)) = inr (inl b) :=
  rfl
#align order_iso.sum_assoc_apply_inl_inr OrderIso.sumAssoc_apply_inl_inr

@[simp]
theorem sumAssoc_apply_inr : sumAssoc α β γ (inr c) = inr (inr c) :=
  rfl
#align order_iso.sum_assoc_apply_inr OrderIso.sumAssoc_apply_inr

@[simp]
theorem sumAssoc_symm_apply_inl : (sumAssoc α β γ).symm (inl a) = inl (inl a) :=
  rfl
#align order_iso.sum_assoc_symm_apply_inl OrderIso.sumAssoc_symm_apply_inl

@[simp]
theorem sumAssoc_symm_apply_inr_inl : (sumAssoc α β γ).symm (inr (inl b)) = inl (inr b) :=
  rfl
#align order_iso.sum_assoc_symm_apply_inr_inl OrderIso.sumAssoc_symm_apply_inr_inl

@[simp]
theorem sumAssoc_symm_apply_inr_inr : (sumAssoc α β γ).symm (inr (inr c)) = inr c :=
  rfl
#align order_iso.sum_assoc_symm_apply_inr_inr OrderIso.sumAssoc_symm_apply_inr_inr

/-- `orderDual` is distributive over `⊕` up to an order isomorphism. -/
def sumDualDistrib (α β : Type _) [LE α] [LE β] : (Sum α β)ᵒᵈ ≃o Sum αᵒᵈ βᵒᵈ :=
  { Equiv.refl _ with
    map_rel_iff' := by
      rintro (a | a) (b | b)
      · change inl (toDual a) ≤ inl (toDual b) ↔ toDual (inl a) ≤ toDual (inl b)
        simp [toDual_le_toDual, inl_le_inl_iff]
      · exact iff_of_false (@not_inl_le_inr (OrderDual β) (OrderDual α) _ _ _ _) not_inr_le_inl
      · exact iff_of_false (@not_inr_le_inl (OrderDual α) (OrderDual β) _ _ _ _) not_inl_le_inr
      · change inr (toDual a) ≤ inr (toDual b) ↔ toDual (inr a) ≤ toDual (inr b)
        simp [toDual_le_toDual, inr_le_inr_iff] }
#align order_iso.sum_dual_distrib OrderIso.sumDualDistrib

@[simp]
theorem sumDualDistrib_inl : sumDualDistrib α β (toDual (inl a)) = inl (toDual a) :=
  rfl
#align order_iso.sum_dual_distrib_inl OrderIso.sumDualDistrib_inl

@[simp]
theorem sumDualDistrib_inr : sumDualDistrib α β (toDual (inr b)) = inr (toDual b) :=
  rfl
#align order_iso.sum_dual_distrib_inr OrderIso.sumDualDistrib_inr

@[simp]
theorem sumDualDistrib_symm_inl : (sumDualDistrib α β).symm (inl (toDual a)) = toDual (inl a) :=
  rfl
#align order_iso.sum_dual_distrib_symm_inl OrderIso.sumDualDistrib_symm_inl

@[simp]
theorem sumDualDistrib_symm_inr : (sumDualDistrib α β).symm (inr (toDual b)) = toDual (inr b) :=
  rfl
#align order_iso.sum_dual_distrib_symm_inr OrderIso.sumDualDistrib_symm_inr

/-- `Equiv.SumAssoc` promoted to an order isomorphism. -/
def sumLexAssoc (α β γ : Type _) [LE α] [LE β] [LE γ] : (α ⊕ₗ β) ⊕ₗ γ ≃o α ⊕ₗ β ⊕ₗ γ :=
  { Equiv.sumAssoc α β γ with
    map_rel_iff' := @fun a b =>
      ⟨fun h =>
        match a, b, h with
        | inlₗ (inlₗ _), inlₗ (inlₗ _), Lex.inl h => Lex.inl <| Lex.inl h
        | inlₗ (inlₗ _), inlₗ (inrₗ _), Lex.sep _ _ => Lex.inl <| Lex.sep _ _
        | inlₗ (inlₗ _), inrₗ _, Lex.sep _ _ => Lex.sep _ _
        | inlₗ (inrₗ _), inlₗ (inrₗ _), Lex.inr (Lex.inl h) => Lex.inl <| Lex.inr h
        | inlₗ (inrₗ _), inrₗ _, Lex.inr (Lex.sep _ _) => Lex.sep _ _
        | inrₗ _, inrₗ _, Lex.inr (Lex.inr h) => Lex.inr h,
        fun h =>
        match a, b, h with
        | inlₗ (inlₗ _), inlₗ (inlₗ _), Lex.inl (Lex.inl h) => Lex.inl h
        | inlₗ (inlₗ _), inlₗ (inrₗ _), Lex.inl (Lex.sep _ _) => Lex.sep _ _
        | inlₗ (inlₗ _), inrₗ _, Lex.sep _ _ => Lex.sep _ _
        | inlₗ (inrₗ _), inlₗ (inrₗ _), Lex.inl (Lex.inr h) => Lex.inr <| Lex.inl h
        | inlₗ (inrₗ _), inrₗ _, Lex.sep _ _ => Lex.inr <| Lex.sep _ _
        | inrₗ _, inrₗ _, Lex.inr h => Lex.inr <| Lex.inr h⟩ }
#align order_iso.sum_lex_assoc OrderIso.sumLexAssoc

@[simp]
theorem sumLexAssoc_apply_inl_inl :
    sumLexAssoc α β γ (toLex <| inl <| toLex <| inl a) = toLex (inl a) :=
  rfl
#align order_iso.sum_lex_assoc_apply_inl_inl OrderIso.sumLexAssoc_apply_inl_inl

@[simp]
theorem sumLexAssoc_apply_inl_inr :
    sumLexAssoc α β γ (toLex <| inl <| toLex <| inr b) = toLex (inr <| toLex <| inl b) :=
  rfl
#align order_iso.sum_lex_assoc_apply_inl_inr OrderIso.sumLexAssoc_apply_inl_inr

@[simp]
theorem sumLexAssoc_apply_inr :
    sumLexAssoc α β γ (toLex <| inr c) = toLex (inr <| toLex <| inr c) :=
  rfl
#align order_iso.sum_lex_assoc_apply_inr OrderIso.sumLexAssoc_apply_inr

@[simp]
theorem sumLexAssoc_symm_apply_inl : (sumLexAssoc α β γ).symm (inl a) = inl (inl a) :=
  rfl
#align order_iso.sum_lex_assoc_symm_apply_inl OrderIso.sumLexAssoc_symm_apply_inl

@[simp]
theorem sumLexAssoc_symm_apply_inr_inl : (sumLexAssoc α β γ).symm (inr (inl b)) = inl (inr b) :=
  rfl
#align order_iso.sum_lex_assoc_symm_apply_inr_inl OrderIso.sumLexAssoc_symm_apply_inr_inl

@[simp]
theorem sumLexAssoc_symm_apply_inr_inr : (sumLexAssoc α β γ).symm (inr (inr c)) = inr c :=
  rfl
#align order_iso.sum_lex_assoc_symm_apply_inr_inr OrderIso.sumLexAssoc_symm_apply_inr_inr

/-- `OrderDual` is antidistributive over `⊕ₗ` up to an order isomorphism. -/
def sumLexDualAntidistrib (α β : Type _) [LE α] [LE β] : (α ⊕ₗ β)ᵒᵈ ≃o βᵒᵈ ⊕ₗ αᵒᵈ :=
  { Equiv.sumComm α β with
    map_rel_iff' := @fun a b => by
      rcases a with (a | a) <;> rcases b with (b | b); simp
      · change
          toLex (inr <| toDual a) ≤ toLex (inr <| toDual b) ↔
            toDual (toLex <| inl a) ≤ toDual (toLex <| inl b)
        simp [toDual_le_toDual, Lex.inl_le_inl_iff, Lex.inr_le_inr_iff]
      · exact iff_of_false (@Lex.not_inr_le_inl (OrderDual β) (OrderDual α) _ _ _ _)
          Lex.not_inr_le_inl
      · exact iff_of_true (@Lex.inl_le_inr (OrderDual β) (OrderDual α) _ _ _ _)
          (Lex.inl_le_inr _ _)
      · change
          toLex (inl <| toDual a) ≤ toLex (inl <| toDual b) ↔
            toDual (toLex <| inr a) ≤ toDual (toLex <| inr b)
        simp [toDual_le_toDual, Lex.inl_le_inl_iff, Lex.inr_le_inr_iff] }
#align order_iso.sum_lex_dual_antidistrib OrderIso.sumLexDualAntidistrib

@[simp]
theorem sumLexDualAntidistrib_inl :
    sumLexDualAntidistrib α β (toDual (inl a)) = inr (toDual a) :=
  rfl
#align order_iso.sum_lex_dual_antidistrib_inl OrderIso.sumLexDualAntidistrib_inl

@[simp]
theorem sumLexDualAntidistrib_inr :
    sumLexDualAntidistrib α β (toDual (inr b)) = inl (toDual b) :=
  rfl
#align order_iso.sum_lex_dual_antidistrib_inr OrderIso.sumLexDualAntidistrib_inr

@[simp]
theorem sumLexDualAntidistrib_symm_inl :
    (sumLexDualAntidistrib α β).symm (inl (toDual b)) = toDual (inr b) :=
  rfl
#align order_iso.sum_lex_dual_antidistrib_symm_inl OrderIso.sumLexDualAntidistrib_symm_inl

@[simp]
theorem sumLexDualAntidistrib_symm_inr :
    (sumLexDualAntidistrib α β).symm (inr (toDual a)) = toDual (inl a) :=
  rfl
#align order_iso.sum_lex_dual_antidistrib_symm_inr OrderIso.sumLexDualAntidistrib_symm_inr

end OrderIso

variable [LE α]

namespace WithBot

/-- `WithBot α` is order-isomorphic to `PUnit ⊕ₗ α`, by sending `⊥` to `unit` and `↑a` to
`a`. -/
def orderIsoPUnitSumLex : WithBot α ≃o PUnit ⊕ₗ α :=
  ⟨(Equiv.optionEquivSumPUnit α).trans <| (Equiv.sumComm _ _).trans toLex, @fun a b => by
    rcases a with (a | _) <;> rcases b with (b | _) <;>
    simp [swap, Equiv.optionEquivSumPUnit]
    exact not_coe_le_bot _⟩
#align with_bot.order_iso_punit_sum_lex WithBot.orderIsoPUnitSumLex

@[simp]
theorem orderIsoPUnitSumLex_bot : @orderIsoPUnitSumLex α _ ⊥ = toLex (inl PUnit.unit) :=
  rfl
#align with_bot.order_iso_punit_sum_lex_bot WithBot.orderIsoPUnitSumLex_bot

@[simp]
theorem orderIsoPUnitSumLex_toLex (a : α) : orderIsoPUnitSumLex ↑a = toLex (inr a) :=
  rfl
#align with_bot.order_iso_punit_sum_lex_coe WithBot.orderIsoPUnitSumLex_toLex

@[simp]
theorem orderIsoPUnitSumLex_symm_inl (x : PUnit) :
    (@orderIsoPUnitSumLex α _).symm (toLex <| inl x) = ⊥ :=
  rfl
#align with_bot.order_iso_punit_sum_lex_symm_inl WithBot.orderIsoPUnitSumLex_symm_inl

@[simp]
theorem orderIsoPUnitSumLex_symm_inr (a : α) : orderIsoPUnitSumLex.symm (toLex <| inr a) = a :=
  rfl
#align with_bot.order_iso_punit_sum_lex_symm_inr WithBot.orderIsoPUnitSumLex_symm_inr

end WithBot

namespace WithTop

/-- `WithTop α` is order-isomorphic to `α ⊕ₗ PUnit`, by sending `⊤` to `unit` and `↑a` to
`a`. -/
def orderIsoSumLexPUnit : WithTop α ≃o α ⊕ₗ PUnit :=
  ⟨(Equiv.optionEquivSumPUnit α).trans toLex, @fun a b => by
    rcases a with (a | _) <;> rcases b with (b | _) <;>
    simp [swap, Equiv.optionEquivSumPUnit]
    exact not_top_le_coe _⟩
#align with_top.order_iso_sum_lex_punit WithTop.orderIsoSumLexPUnit

@[simp]
theorem orderIsoSumLexPUnit_top : @orderIsoSumLexPUnit α _ ⊤ = toLex (inr PUnit.unit) :=
  rfl
#align with_top.order_iso_sum_lex_punit_top WithTop.orderIsoSumLexPUnit_top

@[simp]
theorem orderIsoSumLexPUnit_toLex (a : α) : orderIsoSumLexPUnit ↑a = toLex (inl a) :=
  rfl
#align with_top.order_iso_sum_lex_punit_coe WithTop.orderIsoSumLexPUnit_toLex

@[simp]
theorem orderIsoSumLexPUnit_symm_inr (x : PUnit) :
    (@orderIsoSumLexPUnit α _).symm (toLex <| inr x) = ⊤ :=
  rfl
#align with_top.order_iso_sum_lex_punit_symm_inr WithTop.orderIsoSumLexPUnit_symm_inr

@[simp]
theorem orderIsoSumLexPUnit_symm_inl (a : α) : orderIsoSumLexPUnit.symm (toLex <| inl a) = a :=
  rfl
#align with_top.order_iso_sum_lex_punit_symm_inl WithTop.orderIsoSumLexPUnit_symm_inl

end WithTop


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

/-!
# Quadratic characters on ℤ/nℤ

This file defines some quadratic characters on the rings ℤ/4ℤ and ℤ/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 χ₄ : (zmod 4) →*₀ ℤ :=
{ to_fun := (![0,1,0,-1] : (zmod 4 → ℤ)),
  map_zero' := rfl, map_one' := rfl, map_mul' := dec_trivial }

/-- `χ₄` takes values in `{0, 1, -1}` -/
lemma χ₄_trichotomy (a : zmod 4) : χ₄ a = 0 ∨ χ₄ a = 1 ∨ χ₄ a = -1 := by dec_trivial!

/-- 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 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

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

/-- `χ₈` takes values in `{0, 1, -1}` -/
lemma χ₈_trichotomy (a : zmod 8) : χ₈ a = 0 ∨ χ₈ a = 1 ∨ χ₈ a = -1 := by 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 = 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 χ₈' : (zmod 8) →*₀ ℤ :=
{ to_fun := (![0,1,0,1,0,-1,0,-1] : (zmod 8 → ℤ)),
  map_zero' := rfl, map_one' := rfl, map_mul' := dec_trivial }

/-- `χ₈'` takes values in `{0, 1, -1}` -/
lemma χ₈'_trichotomy (a : zmod 8) : χ₈' a = 0 ∨ χ₈' a = 1 ∨ χ₈' a = -1 := by 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
  have h : (a : zmod 4) = (a : zmod 8),
  { have help : ∀ m : ℤ, 0 ≤ m → m < 8 → ((m % 4 : ℤ) : zmod 4) = (m : zmod 8) := dec_trivial,
    rw [← zmod.int_cast_mod a 8, ← zmod.int_cast_mod a 4,
        (by norm_cast : ((8 : ℕ) : ℤ) = 8), (by norm_cast : ((4 : ℕ) : ℤ) = 4),
        ← int.mod_mod_of_dvd a (by norm_num : (4 : ℤ) ∣ 8)],
    exact help (a % 8) (int.mod_nonneg a (by norm_num)) (int.mod_lt a (by norm_num)), },
  rw h,
  exact χ₈'_eq_χ₄_mul_χ₈ a,
end

end quad_char_mod_p

end zmod


import data.real.basic
import data.polynomial.derivative
import linear_algebra.basic
import linear_algebra.finite_dimensional

-- On se place dans le R -espace vectoriel E = R[X] .
-- (a) Soit H un sous-espace vectoriel de dimension finie et f un endomorphisme de H. Montrer qu'il existe p ∈ N tel que
--    ∀k ≥ p, Ker f k+1 = Ker f k.
--
-- Soit F un sous-espace vectoriel de E stable par l'opérateur D de dérivation.
-- (b) On suppose que F est de dimension finie non nulle. Montrer que l'endomorphisme induit par D sur R n [X] est nilpotent pour tout n ∈ N .
-- Montrer qu'il existe m ∈ N tel que F = R m [X] .
-- (c) Montrer que si F est de dimension innie alors F = R[X] .
-- (d) Soit g ∈ L(E) tel que g^2 = kId + D avec k ∈ R . Quel est le signe de k ?

variable F: submodule real (polynomial real)
variable HF: forall p: polynomial real, p ∈ F.carrier -> polynomial.derivative p ∈ F.carrier

theorem c: (finite_dimensional real F) \/ (exists _: F ≃ₗ[real] polynomial real, true) := sorry


import tactic.linear_combination
import data.real.basic

/-! ### Simple Cases with ℤ and two or less equations -/

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by linear_combination (h1, 1)

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by linear_combination h1

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  2*x + 4 = -6 :=
by linear_combination (h1, 2)

example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by linear_combination (h1, 1) (h2, -2)

example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by linear_combination (h2, -2) h1

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  2*x + 4 - y = -16 :=
by linear_combination (h1, 2) (h2, -1)

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by linear_combination (h2, -1) (h1, 2)

example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  11*y = -11 :=
by linear_combination (h1, -2) (h2, 3)

example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y = 11 :=
by linear_combination (h1, 2) (h2, -3)

example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y = 11 + 1 - 1 :=
by linear_combination (h1, 2) (h2, -3)

example (x y : ℤ) (h1 : 10 = 3*x + 2*y) (h2 : 3 = 2*x + 5*y) :
  11 + 1 - 1 = -11*y :=
by linear_combination (h1, 2) (h2, -3)

/-! ### More complicated cases with two equations -/

example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by linear_combination (h1, 2) (h2, -1)

example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y + 1 = 11 + 1 :=
by linear_combination (h1, 2) (h2, -3)

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
  b = 2 / 3 :=
by linear_combination (ha, 1/6) (hab, 1/3)

/-! ### Cases with more than 2 equations -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
  b = 2 / 3 :=
by linear_combination (ha, 1/6) (hab, 1/3) (hignore, 0)

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by linear_combination (ha, 1) (hb, -1) (hc, -2)

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  6*x = -10 :=
by linear_combination (ha, 1) (hb, 4) (hc, -3)

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  10 = 6*-x :=
by linear_combination (ha, 1) (hb, 4) (hc, -3)

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by linear_combination (h1, 2) (h2, 1) (h3, -2)

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by linear_combination (h1, 2) h2 (h3, -2)

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
by linear_combination (h1, 2) (h2, -1) (h3, 3) (h4, -3)

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  6 - 3*c + 3*a + 3*d = 2*b - d + 12 - 3*a :=
by linear_combination (h2, 2) (h3, -1) (h1, 3) (h4, -3)

/-! ### Cases with arbitrary coefficients -/

example (a b : ℤ) (h : a = b) :
  a * a = a * b :=
by linear_combination (h, a)

example (a b c : ℤ) (h : a = b) :
  a * c = b * c :=
by linear_combination (h, c)

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by linear_combination (h1, c) (h2, 1)

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by linear_combination (h1, x*y) (h2, 2)

example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
  c * (a*f - b*e) = 0 :=
by linear_combination (h1, e) (h2, a)

/-! ### Cases that explicitly use a linear_combination_config -/

example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y + 1 = 11 + 1 :=
by linear_combination (h1, 2) (h2, -3) {normalization_tactic := `[ring]}

example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  -11*y + 1 = 11 + 1 :=
by linear_combination (h1, 2) (h2, -3) {normalization_tactic := `[ring1]}

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
  b = 2 / 3 :=
by linear_combination (ha, 1/6) (hab, 1/3) {normalization_tactic := `[ring_nf]}

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by linear_combination (h1, 1) {normalization_tactic := `[simp]}

/-! ### Cases that have linear_combination skip normalization -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
  b = 2 / 3 :=
begin
  linear_combination (ha, 1/6) (hab, 1/3) {normalize := ff},
  linarith
end

example (x y : ℤ) (h1 : x = -3) (h2 : y = 10) :
  2*x = -6 :=
begin
  linear_combination (h1, 2) {normalize := ff},
  simp,
  norm_cast
end

/-! ### Cases that should fail -/

-- This should fail because there are no hypotheses given
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
begin
  success_if_fail {linear_combination},
  linear_combination (h1, 1) (h2, -2)
end

-- This should fail because the second coefficient has a different type than
--   the equations it is being combined with.  This was a design choice for the
--   sake of simplicity, but the tactic could potentially be modified to allow
--   this behavior.
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y + 2*x = 1 :=
begin
  success_if_fail {linear_combination (h1, 1) (h2, (0 : ℝ))},
  linear_combination (h1, 1)
end

-- This should fail because the second coefficient has a different type than
--   the equations it is being combined with.  This was a design choice for the
--   sake of simplicity, but the tactic could potentially be modified to allow
--   this behavior.
example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y + 2*x = 1 :=
begin
  success_if_fail {linear_combination (h1, 1) (h2, (0 : ℕ))},
  linear_combination (h1, 1)
end

-- This should fail because the coefficients are incorrect.  They should instead
--   be -2 and 3, respectively.
example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
  11*y = -11 :=
begin
  success_if_fail {linear_combination (h1, 2) (h2, -3)},
  linear_combination (h1, -2) (h2, 3)
end

-- This fails because the linear_combination tactic requires the equations
--   and coefficients to use a type that fulfills the add_group condition,
--   and ℕ does not.
example (a b : ℕ) (h1 : a = 3) :
  a = 3 :=
begin
  success_if_fail {linear_combination (h1, (1 : ℕ))},
  exact h1
end


example : ∃ x : Nat, x = x := by
  exists 0

example : ∃ x : Nat, ∃ y : Nat, x > y := by
  exists 1, 0

example : (x : Nat) ×' (y : Nat) ×' x > y := by
  exists 1, 0

example : { x : Nat // x > 2 } := by
  exists 3