/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn
-/
import algebra.group data.set.basic

universes u v
variable {α : Type u}

section
variable [semiring α]

theorem mul_two (n : α) : n * 2 = n + n :=
(left_distrib n 1 1).trans (by simp)

theorem bit0_eq_two_mul (n : α) : bit0 n = 2 * n :=
(two_mul _).symm

variable (α)
lemma zero_ne_one_or_forall_eq_0 : (0 : α) ≠ 1 ∨ (∀a:α, a = 0) :=
by haveI := classical.dec;
   refine not_or_of_imp (λ h a, _); simpa using congr_arg ((*) a) h.symm

lemma eq_zero_of_zero_eq_one (h : (0 : α) = 1) : (∀a:α, a = 0) :=
(zero_ne_one_or_forall_eq_0 α).neg_resolve_left h

theorem subsingleton_of_zero_eq_one (h : (0 : α) = 1) : subsingleton α :=
⟨λa b, by rw [eq_zero_of_zero_eq_one α h a, eq_zero_of_zero_eq_one α h b]⟩

end

namespace units
variables [ring α] {a b : α}

instance : has_neg (units α) := ⟨λu, ⟨-↑u, -↑u⁻¹, by simp, by simp⟩ ⟩

@[simp] protected theorem coe_neg (u : units α) : (↑-u : α) = -u := rfl

@[simp] protected theorem neg_inv (u : units α) : (-u)⁻¹ = -u⁻¹ := rfl

@[simp] protected theorem neg_neg (u : units α) : - -u = u :=
units.ext $ neg_neg _

@[simp] protected theorem neg_mul (u₁ u₂ : units α) : -u₁ * u₂ = -(u₁ * u₂) :=
units.ext $ neg_mul_eq_neg_mul_symm _ _

@[simp] protected theorem mul_neg (u₁ u₂ : units α) : u₁ * -u₂ = -(u₁ * u₂) :=
units.ext $ (neg_mul_eq_mul_neg _ _).symm

@[simp] protected theorem neg_mul_neg (u₁ u₂ : units α) : -u₁ * -u₂ = u₁ * u₂ := by simp

protected theorem neg_eq_neg_one_mul (u : units α) : -u = -1 * u := by simp

end units

instance [semiring α] : semiring (with_zero α) :=
{ left_distrib := λ a b c, begin
    cases a with a, {refl},
    cases b with b; cases c with c; try {refl},
    exact congr_arg some (left_distrib _ _ _)
  end,
  right_distrib := λ a b c, begin
    cases c with c,
    { change (a + b) * 0 = a * 0 + b * 0, simp },
    cases a with a; cases b with b; try {refl},
    exact congr_arg some (right_distrib _ _ _)
  end,
  ..with_zero.add_comm_monoid,
  ..with_zero.mul_zero_class,
  ..with_zero.monoid }

attribute [refl] dvd_refl
attribute [trans] dvd.trans

class is_semiring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α → β) : Prop :=
(map_zero : f 0 = 0)
(map_one : f 1 = 1)
(map_add : ∀ {x y}, f (x + y) = f x + f y)
(map_mul : ∀ {x y}, f (x * y) = f x * f y)

namespace is_semiring_hom

variables {β : Type v} [semiring α] [semiring β]
variables (f : α → β) [is_semiring_hom f] {x y : α}

instance id : is_semiring_hom (@id α) := by refine {..}; intros; refl

instance comp {γ} [semiring γ] (g : β → γ) [is_semiring_hom g] :
  is_semiring_hom (g ∘ f) :=
{ map_zero := by simp [map_zero f]; exact map_zero g,
  map_one := by simp [map_one f]; exact map_one g,
  map_add := λ x y, by simp [map_add f]; rw map_add g; refl,
  map_mul := λ x y, by simp [map_mul f]; rw map_mul g; refl }

instance : is_add_monoid_hom f :=
{ ..‹is_semiring_hom f› }

instance : is_monoid_hom f :=
{ ..‹is_semiring_hom f› }

end is_semiring_hom

section
  variables [ring α] (a b c d e : α)

  lemma mul_neg_one (a : α) : a * -1 = -a := by simp

  lemma neg_one_mul (a : α) : -1 * a = -a := by simp

  theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
  calc
    a * e + c = b * e + d ↔ a * e + c = d + b * e : by simp
      ... ↔ a * e + c - b * e = d : iff.intro (λ h, begin simp [h] end) (λ h,
                                                    begin simp [h.symm] end)
      ... ↔ (a - b) * e + c = d   : begin simp [@sub_eq_add_neg α, @right_distrib α] end

  theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d :=
  assume h,
  calc
    (a - b) * e + c = (a * e + c) - b * e : begin simp [@sub_eq_add_neg α, @right_distrib α] end
                ... = d                   : begin rw h, simp [@add_sub_cancel α] end

  theorem ne_zero_and_ne_zero_of_mul_ne_zero {a b : α} (h : a * b ≠ 0) : a ≠ 0 ∧ b ≠ 0 :=
  begin
    split,
    { intro ha, apply h, simp [ha] },
    { intro hb, apply h, simp [hb] }
  end

end

@[simp] lemma zero_dvd_iff [comm_semiring α] {a : α} : 0 ∣ a ↔ a = 0 :=
⟨eq_zero_of_zero_dvd, λ h, by rw h⟩

section comm_ring
  variable [comm_ring α]

  @[simp] lemma dvd_neg (a b : α) : (a ∣ -b) ↔ (a ∣ b) :=
  ⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩

  @[simp] lemma neg_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) :=
  ⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩

  theorem dvd_add_left {a b c : α} (h : a ∣ c) : a ∣ b + c ↔ a ∣ b :=
  (dvd_add_iff_left h).symm

  theorem dvd_add_right {a b c : α} (h : a ∣ b) : a ∣ b + c ↔ a ∣ c :=
  (dvd_add_iff_right h).symm

end comm_ring

class is_ring_hom {α : Type u} {β : Type v} [ring α] [ring β] (f : α → β) : Prop :=
(map_one : f 1 = 1)
(map_mul : ∀ {x y}, f (x * y) = f x * f y)
(map_add : ∀ {x y}, f (x + y) = f x + f y)

namespace is_ring_hom

variables {β : Type v} [ring α] [ring β]

def of_semiring (f : α → β) [H : is_semiring_hom f] : is_ring_hom f := {..H}

variables (f : α → β) [is_ring_hom f] {x y : α}

lemma map_zero : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [map_add f]; simp
     ... = 0 : by simp

lemma map_neg : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [map_add f]; simp
        ... = -f x : by simp [map_zero f]

lemma map_sub : f (x - y) = f x - f y :=
by simp [map_add f, map_neg f]

instance id : is_ring_hom (@id α) := by refine {..}; intros; refl

instance comp {γ} [ring γ] (g : β → γ) [is_ring_hom g] :
  is_ring_hom (g ∘ f) :=
{ map_add := λ x y, by simp [map_add f]; rw map_add g; refl,
  map_mul := λ x y, by simp [map_mul f]; rw map_mul g; refl,
  map_one := by simp [map_one f]; exact map_one g }

instance : is_semiring_hom f :=
{ map_zero := map_zero f, ..‹is_ring_hom f› }

instance : is_add_group_hom f :=
⟨λ _ _, map_add f⟩

end is_ring_hom

set_option old_structure_cmd true

class nonzero_comm_semiring (α : Type*) extends comm_semiring α, zero_ne_one_class α

class nonzero_comm_ring (α : Type*) extends comm_ring α, zero_ne_one_class α

instance nonzero_comm_ring.to_nonzero_comm_semiring {α : Type*} [I : nonzero_comm_ring α] :
  nonzero_comm_semiring α :=
{ zero_ne_one := by convert zero_ne_one,
  ..show comm_semiring α, by apply_instance }

instance integral_domain.to_nonzero_comm_ring (α : Type*) [id : integral_domain α] :
  nonzero_comm_ring α :=
{ ..id }

lemma units.coe_ne_zero [nonzero_comm_semiring α] (u : units α) : (u : α) ≠ 0 :=
λ h : u.1 = 0, by simpa [h, zero_ne_one] using u.3

def nonzero_comm_ring.of_ne [comm_ring α] {x y : α} (h : x ≠ y) : nonzero_comm_ring α :=
{ one := 1,
  zero := 0,
  zero_ne_one := λ h01, h $ by rw [← one_mul x, ← one_mul y, ← h01, zero_mul, zero_mul],
  ..show comm_ring α, by apply_instance }

def nonzero_comm_semiring.of_ne [comm_semiring α] {x y : α} (h : x ≠ y) : nonzero_comm_semiring α :=
{ one := 1,
  zero := 0,
  zero_ne_one := λ h01, h $ by rw [← one_mul x, ← one_mul y, ← h01, zero_mul, zero_mul],
  ..show comm_semiring α, by apply_instance }

/-- A domain is a ring with no zero divisors, i.e. satisfying
  the condition `a * b = 0 ↔ a = 0 ∨ b = 0`. Alternatively, a domain
  is an integral domain without assuming commutativity of multiplication. -/
class domain (α : Type u) extends ring α, no_zero_divisors α, zero_ne_one_class α

section domain
  variable [domain α]

  @[simp] theorem mul_eq_zero {a b : α} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
  ⟨eq_zero_or_eq_zero_of_mul_eq_zero, λo,
    or.elim o (λh, by rw h; apply zero_mul) (λh, by rw h; apply mul_zero)⟩

  @[simp] theorem zero_eq_mul {a b : α} : 0 = a * b ↔ a = 0 ∨ b = 0 :=
  by rw [eq_comm, mul_eq_zero]

  theorem mul_ne_zero' {a b : α} (h₁ : a ≠ 0) (h₂ : b ≠ 0) : a * b ≠ 0 :=
  λ h, or.elim (eq_zero_or_eq_zero_of_mul_eq_zero h) h₁ h₂

  theorem domain.mul_right_inj {a b c : α} (ha : a ≠ 0) : b * a = c * a ↔ b = c :=
  by rw [← sub_eq_zero, ← mul_sub_right_distrib, mul_eq_zero];
     simp [ha]; exact sub_eq_zero

  theorem domain.mul_left_inj {a b c : α} (ha : a ≠ 0) : a * b = a * c ↔ b = c :=
  by rw [← sub_eq_zero, ← mul_sub_left_distrib, mul_eq_zero];
     simp [ha]; exact sub_eq_zero

  theorem eq_zero_of_mul_eq_self_right' {a b : α} (h₁ : b ≠ 1) (h₂ : a * b = a) : a = 0 :=
  by apply (mul_eq_zero.1 _).resolve_right (sub_ne_zero.2 h₁);
     rw [mul_sub_left_distrib, mul_one, sub_eq_zero, h₂]

  theorem eq_zero_of_mul_eq_self_left' {a b : α} (h₁ : b ≠ 1) (h₂ : b * a = a) : a = 0 :=
  by apply (mul_eq_zero.1 _).resolve_left (sub_ne_zero.2 h₁);
     rw [mul_sub_right_distrib, one_mul, sub_eq_zero, h₂]

  theorem mul_ne_zero_comm' {a b : α} (h : a * b ≠ 0) : b * a ≠ 0 :=
  mul_ne_zero' (ne_zero_of_mul_ne_zero_left h) (ne_zero_of_mul_ne_zero_right h)

end domain

/- integral domains -/

section
  variables [s : integral_domain α] (a b c d e : α)
  include s

  instance integral_domain.to_domain : domain α := {..s}

  theorem eq_of_mul_eq_mul_right_of_ne_zero {a b c : α} (ha : a ≠ 0) (h : b * a = c * a) : b = c :=
  have b * a - c * a = 0, by simp [h],
  have (b - c) * a = 0, by rw [mul_sub_right_distrib, this],
  have b - c = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right ha,
  eq_of_sub_eq_zero this

  theorem eq_of_mul_eq_mul_left_of_ne_zero {a b c : α} (ha : a ≠ 0) (h : a * b = a * c) : b = c :=
  have a * b - a * c = 0, by simp [h],
  have a * (b - c) = 0, by rw [mul_sub_left_distrib, this],
  have b - c = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_left ha,
  eq_of_sub_eq_zero this

  theorem mul_dvd_mul_iff_left {a b c : α} (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c :=
  exists_congr $ λ d, by rw [mul_assoc, domain.mul_left_inj ha]

  theorem mul_dvd_mul_iff_right {a b c : α} (hc : c ≠ 0) : a * c ∣ b * c ↔ a ∣ b :=
  exists_congr $ λ d, by rw [mul_right_comm, domain.mul_right_inj hc]

  lemma units.inv_eq_self_iff (u : units α) : u⁻¹ = u ↔ u = 1 ∨ u = -1 :=
  by conv {to_lhs, rw [inv_eq_iff_mul_eq_one, ← mul_one (1 : units α), units.ext_iff, units.coe_mul,
    units.coe_mul, mul_self_eq_mul_self_iff, ← units.ext_iff, ← units.coe_neg, ← units.ext_iff] }

end

/- units in various rings -/

namespace units

section comm_semiring
variables [comm_semiring α] (a b : α) (u : units α)

@[simp] lemma coe_dvd : ↑u ∣ a := ⟨↑u⁻¹ * a, by simp⟩

@[simp] lemma dvd_coe_mul : a ∣ b * u ↔ a ∣ b :=
iff.intro
  (assume ⟨c, eq⟩, ⟨c * ↑u⁻¹, by rw [← mul_assoc, ← eq, units.mul_inv_cancel_right]⟩)
  (assume ⟨c, eq⟩, eq.symm ▸ dvd_mul_of_dvd_left (dvd_mul_right _ _) _)

@[simp] lemma dvd_coe : a ∣ ↑u ↔ a ∣ 1 :=
suffices a ∣ 1 * ↑u ↔ a ∣ 1, by simpa,
dvd_coe_mul _ _ _

@[simp] lemma coe_mul_dvd : a * u ∣ b ↔ a ∣ b :=
iff.intro
  (assume ⟨c, eq⟩, ⟨c * ↑u, eq.symm ▸ by ac_refl⟩)
  (assume h, suffices a * ↑u ∣ b * 1, by simpa, mul_dvd_mul h (coe_dvd _ _))

end comm_semiring

section domain
variables [domain α]

@[simp] theorem ne_zero : ∀(u : units α), (↑u : α) ≠ 0
| ⟨u, v, (huv : 0 * v = 1), hvu⟩ rfl := by simpa using huv

end domain

end units


import Lean
import Qpf.Util.Vec

/-
  # Type Classes on Vecs
  Since a `Vec` contains finitely many elements, statements of the form `∀i, Class (v i)`
  can be inferred using induction on the length of `Vec`s.

  A reasonable first attempt could be as follows
  ```lean4
  instance VecClass_nil' (v : Vec α 0) : VecClass' Class v
    := by intro i; cases i

  -- We have to set this option because `Class` might not be a type class
  set_option checkBinderAnnotations false in
  instance VecClass_succ'  (v : Vec α (.succ n))
                              [zero : Class (v .fz)]
                              [succ : VecClass' Class (fun i => v i.fs)] :
                          VecClass' Class v :=
  by intro i;
      cases i;
      exact zero;
      apply succ
  ```

  And this is accepted by lean, but fails to correctly infer for vectors with more than one element
  ```lean4

  /-- The vector `![Nat]` -/
  abbrev v₁ : Vec Type 1 := fun i => Nat

  /-- The vector `![Nat, Int]` -/
  abbrev v₂ : Vec Type 2
    | .fz     => Nat
    | .fs .fz => Int

  /-- Works! -/
  example : ∀i, Inhabited (v₁ i) :=
    by infer_instance

  /-- Failed to syntesize instance -/
  example : ∀i, Inhabited (v₂ i) :=
    by infer_instance
  ```

  Instead, we "box" these universally quantified statements in a new type class `VecClass`
  -/

-- `Class` is intended to range over (unary) typeclasses, but there is nothing preventing
    -- users to instantiate it with non-typeclass functions
    variable {α : Type _} {n : Nat}

namespace Vec

open Lean Meta in
/-- Derive a quantified version of the provided typeclass, so that statements of the form
    `∀i, Class (v i)` can be synthesized
 -/
macro "derive_vec_class" Class:ident type:term : command =>
  let VecClass := mkIdent <| Class.getId ++ "VecClass"
  `(
    class $VecClass {n : Nat} (v : Vec $type n) where
      prop : ∀ i, $Class (v i)

    namespace $VecClass
      /-- In case of an empty `Vec`, the statement is vacuous -/
      instance instNil (G : Vec $type 0) : $VecClass G
        := ⟨by intro i; cases i⟩

      /--
        The recursive step, if the head and all elements in the tail of a vector implement `Class`,
        then all elements implement `Class`.
        Requires that `v` is reducible by type class inference.
      -/
      instance instSucc {n : Nat} (G : Vec $type (.succ n))
                                  [zero : $Class (G .fz)]
                                  /-  It is important that the vector used in the recursive step remains
                                      reducible, or the inference system will not find the appropriate
                                      instance. That is why we spell out the composition, rather than
                                      use the more concise `v ∘ .fs`
                                  -/
                                  [succ : $VecClass (fun i => G i.fs)] :
                              $VecClass G :=
      ⟨by intro i;
          cases i;
          exact zero;
          apply succ.prop
        ⟩

      /--
        Alternative recursive step. Since `Vec.append1` is not reducible, we explicitly provide an
        instance
      -/
      instance instAppend1 {n : Nat} (tl : Vec $type n) (hd : $type)
                                  [zero : $Class hd]
                                  [succ : $VecClass tl] :
                              $VecClass (tl.append1 hd) :=
      ⟨by intro i;
          cases i;
          exact zero;
          apply succ.prop
        ⟩

      /-- Users need not be aware of `VecClass`, they can simply write universally quantified type class
          constraints  -/
      instance instUnbox {n : Nat} {G : Vec $type n} [inst : $VecClass G] :
        ∀i, $Class (G i) :=
      inst.prop

      instance instBox {n : Nat} {G : Vec $type n} [inst : ∀i, $Class (G i)] :
        $VecClass G :=
      ⟨inst⟩
    end $VecClass
  )
end Vec


/-
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 data.fintype.card
import order.upper_lower.basic

/-!
# Intersecting families

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

This file defines intersecting families and proves their basic properties.

## Main declarations

* `set.intersecting`: Predicate for a set of elements in a generalized boolean algebra to be an
  intersecting family.
* `set.intersecting.card_le`: An intersecting family can only take up to half the elements, because
  `a` and `aᶜ` cannot simultaneously be in it.
* `set.intersecting.is_max_iff_card_eq`: Any maximal intersecting family takes up half the elements.

## References

* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966]
-/

open finset

variables {α : Type*}

namespace set
section semilattice_inf
variables [semilattice_inf α] [order_bot α] {s t : set α} {a b c : α}

/-- A set family is intersecting if every pair of elements is non-disjoint. -/
def intersecting (s : set α) : Prop := ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → ¬ disjoint a b

@[mono] lemma intersecting.mono (h : t ⊆ s) (hs : s.intersecting) : t.intersecting :=
λ a ha b hb, hs (h ha) (h hb)

lemma intersecting.not_bot_mem (hs : s.intersecting) : ⊥ ∉ s := λ h, hs h h disjoint_bot_left

lemma intersecting.ne_bot (hs : s.intersecting) (ha : a ∈ s) : a ≠ ⊥ :=
ne_of_mem_of_not_mem ha hs.not_bot_mem

lemma intersecting_empty : (∅ : set α).intersecting := λ _, false.elim

@[simp] lemma intersecting_singleton : ({a} : set α).intersecting ↔ a ≠ ⊥ := by simp [intersecting]

lemma intersecting.insert (hs : s.intersecting) (ha : a ≠ ⊥) (h : ∀ b ∈ s, ¬ disjoint a b) :
  (insert a s).intersecting :=
begin
  rintro b (rfl | hb) c (rfl | hc),
  { rwa disjoint_self },
  { exact h _ hc },
  { exact λ H, h _ hb H.symm },
  { exact hs hb hc }
end

lemma intersecting_insert :
  (insert a s).intersecting ↔ s.intersecting ∧ a ≠ ⊥ ∧ ∀ b ∈ s, ¬ disjoint a b :=
⟨λ h, ⟨h.mono $ subset_insert _ _, h.ne_bot $ mem_insert _ _,
  λ b hb, h (mem_insert _ _) $ mem_insert_of_mem _ hb⟩, λ h, h.1.insert h.2.1 h.2.2⟩

lemma intersecting_iff_pairwise_not_disjoint :
  s.intersecting ↔ s.pairwise (λ a b, ¬ disjoint a b) ∧ s ≠ {⊥} :=
begin
  refine ⟨λ h, ⟨λ a ha b hb _, h ha hb, _⟩, λ h a ha b hb hab, _⟩,
  { rintro rfl,
    exact intersecting_singleton.1 h rfl },
  { have := h.1.eq ha hb (not_not.2 hab),
    rw [this, disjoint_self] at hab,
    rw hab at hb,
    exact h.2 (eq_singleton_iff_unique_mem.2
      ⟨hb, λ c hc, not_ne_iff.1 $ λ H, h.1 hb hc H.symm disjoint_bot_left⟩) }
end

protected lemma subsingleton.intersecting (hs : s.subsingleton) : s.intersecting ↔ s ≠ {⊥} :=
intersecting_iff_pairwise_not_disjoint.trans $ and_iff_right $ hs.pairwise _

lemma intersecting_iff_eq_empty_of_subsingleton [subsingleton α] (s : set α) :
  s.intersecting ↔ s = ∅ :=
begin
  refine subsingleton_of_subsingleton.intersecting.trans
    ⟨not_imp_comm.2 $ λ h, subsingleton_of_subsingleton.eq_singleton_of_mem _, _⟩,
  { obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h,
    rwa subsingleton.elim ⊥ a },
  { rintro rfl,
    exact (set.singleton_nonempty _).ne_empty.symm }
end

/-- Maximal intersecting families are upper sets. -/
protected lemma intersecting.is_upper_set (hs : s.intersecting)
  (h : ∀ t : set α, t.intersecting → s ⊆ t → s = t) :
  is_upper_set s :=
begin
  classical,
  rintro a b hab ha,
  rw h (insert b s) _ (subset_insert _ _),
  { exact mem_insert _ _ },
  exact hs.insert (mt (eq_bot_mono hab) $ hs.ne_bot ha)
    (λ c hc hbc, hs ha hc $ hbc.mono_left hab),
end

/-- Maximal intersecting families are upper sets. Finset version. -/
lemma intersecting.is_upper_set' {s : finset α} (hs : (s : set α).intersecting)
  (h : ∀ t : finset α, (t : set α).intersecting → s ⊆ t → s = t) :
  is_upper_set (s : set α) :=
begin
  classical,
  rintro a b hab ha,
  rw h (insert b s) _ (finset.subset_insert _ _),
  { exact mem_insert_self _ _ },
  rw coe_insert,
  exact hs.insert (mt (eq_bot_mono hab) $ hs.ne_bot ha)
    (λ c hc hbc, hs ha hc $ hbc.mono_left hab),
end

end semilattice_inf

lemma intersecting.exists_mem_set {𝒜 : set (set α)} (h𝒜 : 𝒜.intersecting) {s t : set α}
  (hs : s ∈ 𝒜) (ht : t ∈ 𝒜) : ∃ a, a ∈ s ∧ a ∈ t :=
not_disjoint_iff.1 $ h𝒜 hs ht

lemma intersecting.exists_mem_finset [decidable_eq α] {𝒜 : set (finset α)} (h𝒜 : 𝒜.intersecting)
  {s t : finset α} (hs : s ∈ 𝒜) (ht : t ∈ 𝒜) : ∃ a, a ∈ s ∧ a ∈ t :=
not_disjoint_iff.1 $ disjoint_coe.not.2 $ h𝒜 hs ht

variables [boolean_algebra α]

lemma intersecting.not_compl_mem {s : set α} (hs : s.intersecting) {a : α} (ha : a ∈ s) : aᶜ ∉ s :=
λ h, hs ha h disjoint_compl_right

lemma intersecting.disjoint_map_compl {s : finset α}
  (hs : (s : set α).intersecting) :
  disjoint s (s.map ⟨compl, compl_injective⟩) :=
begin
  rw finset.disjoint_left,
  rintro x hx hxc,
  obtain ⟨x, hx', rfl⟩ := mem_map.mp hxc,
  exact hs.not_compl_mem hx' hx,
end

lemma intersecting.card_le [fintype α] {s : finset α}
  (hs : (s : set α).intersecting) : 2 * s.card ≤ fintype.card α :=
begin
  classical,
  refine (s.disj_union _ hs.disjoint_map_compl).card_le_univ.trans_eq' _,
  rw [two_mul, card_disj_union, card_map],
end

variables [nontrivial α] [fintype α] {s : finset α}

-- Note, this lemma is false when `α` has exactly one element and boring when `α` is empty.
lemma intersecting.is_max_iff_card_eq (hs : (s : set α).intersecting) :
  (∀ t : finset α, (t : set α).intersecting → s ⊆ t → s = t) ↔ 2 * s.card = fintype.card α :=
begin
  classical,
  refine ⟨λ h, _, λ h t ht hst, finset.eq_of_subset_of_card_le hst $
    le_of_mul_le_mul_left (ht.card_le.trans_eq h.symm) two_pos⟩,
  suffices : s.disj_union (s.map ⟨compl, compl_injective⟩) (hs.disjoint_map_compl) = finset.univ,
  { rw [fintype.card, ←this, two_mul, card_disj_union, card_map] },
  rw [←coe_eq_univ, disj_union_eq_union, coe_union, coe_map, function.embedding.coe_fn_mk,
    image_eq_preimage_of_inverse compl_compl compl_compl],
  refine eq_univ_of_forall (λ a, _),
  simp_rw [mem_union, mem_preimage],
  by_contra' ha,
  refine s.ne_insert_of_not_mem _ ha.1 (h _ _ $ s.subset_insert _),
  rw coe_insert,
  refine hs.insert _ (λ b hb hab, ha.2 $ (hs.is_upper_set' h) hab.le_compl_left hb),
  rintro rfl,
  have := h {⊤} (by { rw coe_singleton, exact intersecting_singleton.2 top_ne_bot }),
  rw compl_bot at ha,
  rw coe_eq_empty.1 ((hs.is_upper_set' h).not_top_mem.1 ha.2) at this,
  exact finset.singleton_ne_empty _ (this $ empty_subset _).symm,
end

lemma intersecting.exists_card_eq (hs : (s : set α).intersecting) :
  ∃ t, s ⊆ t ∧ 2 * t.card = fintype.card α ∧ (t : set α).intersecting :=
begin
  have := hs.card_le,
  rw [mul_comm, ←nat.le_div_iff_mul_le' two_pos] at this,
  revert hs,
  refine s.strong_downward_induction_on _ this,
  rintro s ih hcard hs,
  by_cases ∀ t : finset α, (t : set α).intersecting → s ⊆ t → s = t,
  { exact ⟨s, subset.rfl, hs.is_max_iff_card_eq.1 h, hs⟩ },
  push_neg at h,
  obtain ⟨t, ht, hst⟩ := h,
  refine (ih _ (_root_.ssubset_iff_subset_ne.2 hst) ht).imp (λ u, and.imp_left hst.1.trans),
  rw [nat.le_div_iff_mul_le' two_pos, mul_comm],
  exact ht.card_le,
end

end set


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.complex.isometry
import analysis.normed_space.conformal_linear_map

/-!
# Conformal maps between complex vector spaces

We prove the sufficient and necessary conditions for a real-linear map between complex vector spaces
to be conformal.

## Main results

* `is_conformal_map_complex_linear`: a nonzero complex linear map into an arbitrary complex
                                     normed space is conformal.
* `is_conformal_map_complex_linear_conj`: the composition of a nonzero complex linear map with
                                          `conj` is complex linear.
* `is_conformal_map_iff_is_complex_or_conj_linear`: a real linear map between the complex
                                                            plane is conformal iff it's complex
                                                            linear or the composition of
                                                            some complex linear map and `conj`.

## Warning

Antiholomorphic functions such as the complex conjugate are considered as conformal functions in
this file.
-/

noncomputable theory

open complex continuous_linear_map
open_locale complex_conjugate

lemma is_conformal_map_conj : is_conformal_map (conj_lie : ℂ →L[ℝ] ℂ) :=
conj_lie.to_linear_isometry.is_conformal_map

section conformal_into_complex_normed

variables {E : Type*} [normed_group E] [normed_space ℝ E] [normed_space ℂ E]
  [is_scalar_tower ℝ ℂ E] {z : ℂ} {g : ℂ →L[ℝ] E} {f : ℂ → E}

lemma is_conformal_map_complex_linear
  {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) : is_conformal_map (map.restrict_scalars ℝ) :=
begin
  have minor₁ : ∥map 1∥ ≠ 0,
  { simpa [ext_ring_iff] using nonzero },
  refine ⟨∥map 1∥, minor₁, ⟨∥map 1∥⁻¹ • map, _⟩, _⟩,
  { intros x,
    simp only [linear_map.smul_apply],
    have : x = x • 1 := by rw [smul_eq_mul, mul_one],
    nth_rewrite 0 [this],
    rw [_root_.coe_coe map, linear_map.coe_coe_is_scalar_tower],
    simp only [map.coe_coe, map.map_smul, norm_smul, normed_field.norm_inv, norm_norm],
    field_simp [minor₁], },
  { ext1,
    rw [← linear_isometry.coe_to_linear_map],
    simp [minor₁], },
end

lemma is_conformal_map_complex_linear_conj
  {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) :
  is_conformal_map ((map.restrict_scalars ℝ).comp (conj_cle : ℂ →L[ℝ] ℂ)) :=
(is_conformal_map_complex_linear nonzero).comp is_conformal_map_conj

end conformal_into_complex_normed

section conformal_into_complex_plane

open continuous_linear_map

variables {f : ℂ → ℂ} {z : ℂ} {g : ℂ →L[ℝ] ℂ}

lemma is_conformal_map.is_complex_or_conj_linear (h : is_conformal_map g) :
  (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g) ∨
  (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g ∘L ↑conj_cle) :=
begin
  rcases h with ⟨c, hc, li, hg⟩,
  rcases linear_isometry_complex (li.to_linear_isometry_equiv rfl) with ⟨a, ha⟩,
  let rot := c • (a : ℂ) • continuous_linear_map.id ℂ ℂ,
  cases ha,
  { refine or.intro_left _ ⟨rot, _⟩,
    ext1,
    simp only [coe_restrict_scalars', hg, ← li.coe_to_linear_isometry_equiv, ha,
               pi.smul_apply, continuous_linear_map.smul_apply, rotation_apply,
               continuous_linear_map.id_apply, smul_eq_mul], },
  { refine or.intro_right _ ⟨rot, _⟩,
    ext1,
    rw [continuous_linear_map.coe_comp', hg, ← li.coe_to_linear_isometry_equiv, ha],
    simp only [coe_restrict_scalars', function.comp_app, pi.smul_apply,
               linear_isometry_equiv.coe_trans, conj_lie_apply,
               rotation_apply, continuous_linear_equiv.coe_apply, conj_cle_apply],
    simp only [continuous_linear_map.smul_apply, continuous_linear_map.id_apply,
               smul_eq_mul, conj_conj], },
end

/-- A real continuous linear map on the complex plane is conformal if and only if the map or its
    conjugate is complex linear, and the map is nonvanishing. -/
lemma is_conformal_map_iff_is_complex_or_conj_linear:
  is_conformal_map g ↔
  ((∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g) ∨
   (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g ∘L ↑conj_cle)) ∧ g ≠ 0 :=
begin
  split,
  { exact λ h, ⟨h.is_complex_or_conj_linear, h.ne_zero⟩, },
  { rintros ⟨⟨map, rfl⟩ | ⟨map, hmap⟩, h₂⟩,
    { refine is_conformal_map_complex_linear _,
      contrapose! h₂ with w,
      simp [w] },
    { have minor₁ : g = (map.restrict_scalars ℝ) ∘L ↑conj_cle,
      { ext1,
        simp [hmap] },
      rw minor₁ at ⊢ h₂,
      refine is_conformal_map_complex_linear_conj _,
      contrapose! h₂ with w,
      simp [w] } }
end

end conformal_into_complex_plane


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

! This file was ported from Lean 3 source module measure_theory.measure.haar_quotient
! leanprover-community/mathlib commit 10079b92f69b50c7f9819d026e6fe12fdd7a08d5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.Haar
import Mathbin.MeasureTheory.Group.FundamentalDomain
import Mathbin.Algebra.Group.Opposite

/-!
# Haar quotient measure

In this file, we consider properties of fundamental domains and measures for the action of a
subgroup of a group `G` on `G` itself.

## Main results

* `measure_theory.is_fundamental_domain.smul_invariant_measure_map `: given a subgroup `Γ` of a
  topological group `G`, the pushforward to the coset space `G ⧸ Γ` of the restriction of a both
  left- and right-invariant measure on `G` to a fundamental domain `𝓕` is a `G`-invariant measure
  on `G ⧸ Γ`.

* `measure_theory.is_fundamental_domain.is_mul_left_invariant_map `: given a normal subgroup `Γ` of
  a topological group `G`, the pushforward to the quotient group `G ⧸ Γ` of the restriction of
  a both left- and right-invariant measure on `G` to a fundamental domain `𝓕` is a left-invariant
  measure on `G ⧸ Γ`.

Note that a group `G` with Haar measure that is both left and right invariant is called
**unimodular**.
-/

open Set MeasureTheory TopologicalSpace MeasureTheory.Measure

open Pointwise NNReal

variable {G : Type _} [Group G] [MeasurableSpace G] [TopologicalSpace G] [TopologicalGroup G]
  [BorelSpace G] {μ : Measure G} {Γ : Subgroup G}

/-- Measurability of the action of the topological group `G` on the left-coset space `G/Γ`. -/
@[to_additive
      "Measurability of the action of the additive topological group `G` on the left-coset\n  space `G/Γ`."]
instance QuotientGroup.hasMeasurableSmul [MeasurableSpace (G ⧸ Γ)] [BorelSpace (G ⧸ Γ)] :
    HasMeasurableSmul G (G ⧸ Γ)
    where
  measurable_const_smul g := (continuous_const_smul g).Measurable
  measurable_smul_const x := (QuotientGroup.continuous_smul₁ x).Measurable
#align quotient_group.has_measurable_smul QuotientGroup.hasMeasurableSmul
#align quotient_add_group.has_measurable_vadd quotientAddGroup.has_measurable_vadd

variable {𝓕 : Set G} (h𝓕 : IsFundamentalDomain Γ.opposite 𝓕 μ)

include h𝓕

variable [Countable Γ] [MeasurableSpace (G ⧸ Γ)] [BorelSpace (G ⧸ Γ)]

/-- The pushforward to the coset space `G ⧸ Γ` of the restriction of a both left- and right-
  invariant measure on `G` to a fundamental domain `𝓕` is a `G`-invariant measure on `G ⧸ Γ`. -/
@[to_additive
      "The pushforward to the coset space `G ⧸ Γ` of the restriction of a both left- and\n  right-invariant measure on an additive topological group `G` to a fundamental domain `𝓕` is a\n  `G`-invariant measure on `G ⧸ Γ`."]
theorem MeasureTheory.IsFundamentalDomain.smulInvariantMeasureMap [μ.IsMulLeftInvariant]
    [μ.IsMulRightInvariant] :
    SmulInvariantMeasure G (G ⧸ Γ) (Measure.map QuotientGroup.mk (μ.restrict 𝓕)) :=
  {
    measure_preimage_smul := by
      let π : G → G ⧸ Γ := QuotientGroup.mk
      have meas_π : Measurable π := continuous_quotient_mk.measurable
      have 𝓕meas : null_measurable_set 𝓕 μ := h𝓕.null_measurable_set
      intro g A hA
      have meas_πA : MeasurableSet (π ⁻¹' A) := measurableSet_preimage meas_π hA
      rw [measure.map_apply meas_π hA,
        measure.map_apply meas_π (measurableSet_preimage (measurable_const_smul g) hA),
        measure.restrict_apply₀' 𝓕meas, measure.restrict_apply₀' 𝓕meas]
      set π_preA := π ⁻¹' A
      have : QuotientGroup.mk ⁻¹' ((fun x : G ⧸ Γ => g • x) ⁻¹' A) = Mul.mul g ⁻¹' π_preA :=
        by
        ext1
        simp
      rw [this]
      have : μ (Mul.mul g ⁻¹' π_preA ∩ 𝓕) = μ (π_preA ∩ Mul.mul g⁻¹ ⁻¹' 𝓕) :=
        by
        trans μ (Mul.mul g ⁻¹' (π_preA ∩ Mul.mul g⁻¹ ⁻¹' 𝓕))
        · rw [preimage_inter]
          congr
          rw [← preimage_comp, comp_mul_left, mul_left_inv]
          ext
          simp
        rw [measure_preimage_mul]
      rw [this]
      have h𝓕_translate_fundom : is_fundamental_domain Γ.opposite (g • 𝓕) μ := h𝓕.smul_of_comm g
      rw [h𝓕.measure_set_eq h𝓕_translate_fundom meas_πA, ← preimage_smul_inv]
      rfl
      rintro ⟨γ, γ_in_Γ⟩
      ext
      have : π (x * MulOpposite.unop γ) = π x := by simpa [QuotientGroup.eq'] using γ_in_Γ
      simp [(· • ·), this] }
#align measure_theory.is_fundamental_domain.smul_invariant_measure_map MeasureTheory.IsFundamentalDomain.smulInvariantMeasureMap
#align measure_theory.is_add_fundamental_domain.vadd_invariant_measure_map MeasureTheory.IsAddFundamentalDomain.vadd_invariant_measure_map

/-- Assuming `Γ` is a normal subgroup of a topological group `G`, the pushforward to the quotient
  group `G ⧸ Γ` of the restriction of a both left- and right-invariant measure on `G` to a
  fundamental domain `𝓕` is a left-invariant measure on `G ⧸ Γ`. -/
@[to_additive
      "Assuming `Γ` is a normal subgroup of an additive topological group `G`, the\n  pushforward to the quotient group `G ⧸ Γ` of the restriction of a both left- and right-invariant\n  measure on `G` to a fundamental domain `𝓕` is a left-invariant measure on `G ⧸ Γ`."]
theorem MeasureTheory.IsFundamentalDomain.isMulLeftInvariantMap [Subgroup.Normal Γ]
    [μ.IsMulLeftInvariant] [μ.IsMulRightInvariant] :
    (Measure.map (QuotientGroup.mk' Γ) (μ.restrict 𝓕)).IsMulLeftInvariant :=
  {
    map_mul_left_eq_self := by
      intro x
      apply measure.ext
      intro A hA
      obtain ⟨x₁, _⟩ := @Quotient.exists_rep _ (QuotientGroup.leftRel Γ) x
      haveI := h𝓕.smul_invariant_measure_map
      convert measure_preimage_smul x₁ ((measure.map QuotientGroup.mk) (μ.restrict 𝓕)) A using 1
      rw [← h, measure.map_apply]
      · rfl
      · exact measurable_const_mul _
      · exact hA }
#align measure_theory.is_fundamental_domain.is_mul_left_invariant_map MeasureTheory.IsFundamentalDomain.isMulLeftInvariantMap
#align measure_theory.is_add_fundamental_domain.is_add_left_invariant_map MeasureTheory.IsAddFundamentalDomain.is_add_left_invariant_map

variable [T2Space (G ⧸ Γ)] [SecondCountableTopology (G ⧸ Γ)] (K : PositiveCompacts (G ⧸ Γ))

/-- Given a normal subgroup `Γ` of a topological group `G` with Haar measure `μ`, which is also
  right-invariant, and a finite volume fundamental domain `𝓕`, the pushforward to the quotient
  group `G ⧸ Γ` of the restriction of `μ` to `𝓕` is a multiple of Haar measure on `G ⧸ Γ`. -/
@[to_additive
      "Given a normal subgroup `Γ` of an additive topological group `G` with Haar measure\n  `μ`, which is also right-invariant, and a finite volume fundamental domain `𝓕`, the pushforward\n  to the quotient group `G ⧸ Γ` of the restriction of `μ` to `𝓕` is a multiple of Haar measure on\n  `G ⧸ Γ`."]
theorem MeasureTheory.IsFundamentalDomain.map_restrict_quotient [Subgroup.Normal Γ]
    [MeasureTheory.Measure.IsHaarMeasure μ] [μ.IsMulRightInvariant] (h𝓕_finite : μ 𝓕 < ⊤) :
    Measure.map (QuotientGroup.mk' Γ) (μ.restrict 𝓕) =
      μ (𝓕 ∩ QuotientGroup.mk' Γ ⁻¹' K) • MeasureTheory.Measure.haarMeasure K :=
  by
  let π : G →* G ⧸ Γ := QuotientGroup.mk' Γ
  have meas_π : Measurable π := continuous_quotient_mk.measurable
  have 𝓕meas : null_measurable_set 𝓕 μ := h𝓕.null_measurable_set
  haveI : is_finite_measure (μ.restrict 𝓕) :=
    ⟨by
      rw [measure.restrict_apply₀' 𝓕meas, univ_inter]
      exact h𝓕_finite⟩
  -- the measure is left-invariant, so by the uniqueness of Haar measure it's enough to show that
  -- it has the stated size on the reference compact set `K`.
  haveI : (measure.map (QuotientGroup.mk' Γ) (μ.restrict 𝓕)).IsMulLeftInvariant :=
    h𝓕.is_mul_left_invariant_map
  rw [measure.haar_measure_unique (measure.map (QuotientGroup.mk' Γ) (μ.restrict 𝓕)) K,
    measure.map_apply meas_π, measure.restrict_apply₀' 𝓕meas, inter_comm]
  exact K.is_compact.measurable_set
#align measure_theory.is_fundamental_domain.map_restrict_quotient MeasureTheory.IsFundamentalDomain.map_restrict_quotient
#align measure_theory.is_add_fundamental_domain.map_restrict_quotient MeasureTheory.IsAddFundamentalDomain.map_restrict_quotient

/-- Given a normal subgroup `Γ` of a topological group `G` with Haar measure `μ`, which is also
  right-invariant, and a finite volume fundamental domain `𝓕`, the quotient map to `G ⧸ Γ` is
  measure-preserving between appropriate multiples of Haar measure on `G` and `G ⧸ Γ`. -/
@[to_additive MeasurePreservingQuotientAddGroup.mk'
      "Given a normal subgroup `Γ` of an additive\n  topological group `G` with Haar measure `μ`, which is also right-invariant, and a finite volume\n  fundamental domain `𝓕`, the quotient map to `G ⧸ Γ` is measure-preserving between appropriate\n  multiples of Haar measure on `G` and `G ⧸ Γ`."]
theorem MeasurePreservingQuotientGroup.mk' [Subgroup.Normal Γ]
    [MeasureTheory.Measure.IsHaarMeasure μ] [μ.IsMulRightInvariant] (h𝓕_finite : μ 𝓕 < ⊤) (c : ℝ≥0)
    (h : μ (𝓕 ∩ QuotientGroup.mk' Γ ⁻¹' K) = c) :
    MeasurePreserving (QuotientGroup.mk' Γ) (μ.restrict 𝓕)
      (c • MeasureTheory.Measure.haarMeasure K) :=
  { Measurable := continuous_quotient_mk'.Measurable
    map_eq := by rw [h𝓕.map_restrict_quotient K h𝓕_finite, h] <;> rfl }
#align measure_preserving_quotient_group.mk' MeasurePreservingQuotientGroup.mk'
#align measure_preserving_quotient_add_group.mk' MeasurePreservingQuotientAddGroup.mk'


-- Producto_por_cero_por_a.lean
-- Si R es un anillo y a ∈ R, entonces 0 * a = 0.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 5-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si R es un anillo y a ∈ R, entonces
--    0 * a = 0
-- ----------------------------------------------------------------------

import algebra.ring

variables {R : Type*} [ring R]
variable (a : R)

-- 1ª demostración
-- ===============

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
    calc 0 * a + 0 * a
         = (0 + 0) * a : (add_mul 0 0 a).symm
     ... = 0 * a       : congr_arg (λ x, x * a) (add_zero 0)
     ... = 0 * a + 0   : self_eq_add_right.mpr rfl,
  rw add_left_cancel h
end

-- 2ª demostración
-- ===============

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
    calc 0 * a + 0 * a
         = (0 + 0) * a : by rw add_mul
     ... = 0 * a       : by rw add_zero
     ... = 0 * a + 0   : by rw add_zero,
  rw add_left_cancel h
end

-- 3ª demostración
-- ===============

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
  { rw [←add_mul, add_zero, add_zero] },
  rw add_left_cancel h
end

-- 4ª demostración
-- ===============

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
    calc 0 * a + 0 * a
         = (0 + 0) * a : by simp
     ... = 0 * a       : by simp
     ... = 0 * a + 0   : by simp,
  simp,
end

-- 5ª demostración
-- ===============

example : 0 * a = 0 :=
by simp


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

/-!
# Local homeomorphisms

This file defines local homeomorphisms.

## Main definitions

* `is_locally_homeomorph`: A function `f : X → Y` satisfies `is_locally_homeomorph` if for each
  point `x : X`, the restriction of `f` to some open neighborhood `U` of `x` gives a homeomorphism
  between `U` and an open subset of `Y`.

  Note that `is_locally_homeomorph` is a global condition. This is in contrast to
  `local_homeomorph`, which is a homeomorphism between specific open subsets.
-/

open_locale topological_space

variables {X Y Z : Type*} [topological_space X] [topological_space Y] [topological_space Z]
  (g : Y → Z) (f : X →  Y)

/-- A function `f : X → Y` satisfies `is_locally_homeomorph` if each `x : x` is contained in
  the source of some `e : local_homeomorph X Y` with `f = e`. -/
def is_locally_homeomorph :=
∀ x : X, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ f = e

namespace is_locally_homeomorph

/-- Proves that `f` satisfies `is_locally_homeomorph`. The condition `h` is weaker than definition
of `is_locally_homeomorph`, since it only requires `e : local_homeomorph X Y` to agree with `f` on
its source `e.source`, as opposed to on the whole space `X`. -/
lemma mk (h : ∀ x : X, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ ∀ x, x ∈ e.source → f x = e x) :
  is_locally_homeomorph f :=
begin
  intro x,
  obtain ⟨e, hx, he⟩ := h x,
  exact ⟨{ to_fun := f,
    map_source' := λ x hx, by rw he x hx; exact e.map_source' hx,
    left_inv' := λ x hx, by rw he x hx; exact e.left_inv' hx,
    right_inv' := λ y hy, by rw he _ (e.map_target' hy); exact e.right_inv' hy,
    continuous_to_fun := (continuous_on_congr he).mpr e.continuous_to_fun,
    .. e }, hx, rfl⟩,
end

variables {g f}

lemma map_nhds_eq (hf : is_locally_homeomorph f) (x : X) : (𝓝 x).map f = 𝓝 (f x) :=
begin
  obtain ⟨e, hx, rfl⟩ := hf x,
  exact e.map_nhds_eq hx,
end

protected lemma continuous (hf : is_locally_homeomorph f) : continuous f :=
continuous_iff_continuous_at.mpr (λ x, le_of_eq (hf.map_nhds_eq x))

lemma is_open_map (hf : is_locally_homeomorph f) : is_open_map f :=
is_open_map.of_nhds_le (λ x, ge_of_eq (hf.map_nhds_eq x))

protected lemma comp (hg : is_locally_homeomorph g) (hf : is_locally_homeomorph f) :
  is_locally_homeomorph (g ∘ f) :=
begin
  intro x,
  obtain ⟨eg, hxg, rfl⟩ := hg (f x),
  obtain ⟨ef, hxf, rfl⟩ := hf x,
  exact ⟨ef.trans eg, ⟨hxf, hxg⟩, rfl⟩,
end

end is_locally_homeomorph


/-
Copyright (c) 2021 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Ines Wright, Joachim Breitner
-/

import group_theory.quotient_group
import group_theory.solvable
import group_theory.p_group
import group_theory.sylow
import data.nat.factorization.basic
import tactic.tfae

/-!

# Nilpotent groups

An API for nilpotent groups, that is, groups for which the upper central series
reaches `⊤`.

## Main definitions

Recall that if `H K : subgroup G` then `⁅H, K⁆ : subgroup G` is the subgroup of `G` generated
by the commutators `hkh⁻¹k⁻¹`. Recall also Lean's conventions that `⊤` denotes the
subgroup `G` of `G`, and `⊥` denotes the trivial subgroup `{1}`.

* `upper_central_series G : ℕ → subgroup G` : the upper central series of a group `G`.
     This is an increasing sequence of normal subgroups `H n` of `G` with `H 0 = ⊥` and
     `H (n + 1) / H n` is the centre of `G / H n`.
* `lower_central_series G : ℕ → subgroup G` : the lower central series of a group `G`.
     This is a decreasing sequence of normal subgroups `H n` of `G` with `H 0 = ⊤` and
     `H (n + 1) = ⁅H n, G⁆`.
* `is_nilpotent` : A group G is nilpotent if its upper central series reaches `⊤`, or
    equivalently if its lower central series reaches `⊥`.
* `nilpotency_class` : the length of the upper central series of a nilpotent group.
* `is_ascending_central_series (H : ℕ → subgroup G) : Prop` and
* `is_descending_central_series (H : ℕ → subgroup G) : Prop` : Note that in the literature
    a "central series" for a group is usually defined to be a *finite* sequence of normal subgroups
    `H 0`, `H 1`, ..., starting at `⊤`, finishing at `⊥`, and with each `H n / H (n + 1)`
    central in `G / H (n + 1)`. In this formalisation it is convenient to have two weaker predicates
    on an infinite sequence of subgroups `H n` of `G`: we say a sequence is a *descending central
    series* if it starts at `G` and `⁅H n, ⊤⁆ ⊆ H (n + 1)` for all `n`. Note that this series
    may not terminate at `⊥`, and the `H i` need not be normal. Similarly a sequence is an
    *ascending central series* if `H 0 = ⊥` and `⁅H (n + 1), ⊤⁆ ⊆ H n` for all `n`, again with no
    requirement that the series reaches `⊤` or that the `H i` are normal.

## Main theorems

`G` is *defined* to be nilpotent if the upper central series reaches `⊤`.
* `nilpotent_iff_finite_ascending_central_series` : `G` is nilpotent iff some ascending central
    series reaches `⊤`.
* `nilpotent_iff_finite_descending_central_series` : `G` is nilpotent iff some descending central
    series reaches `⊥`.
* `nilpotent_iff_lower` : `G` is nilpotent iff the lower central series reaches `⊥`.
* The `nilpotency_class` can likeways be obtained from these equivalent
  definitions, see `least_ascending_central_series_length_eq_nilpotency_class`,
  `least_descending_central_series_length_eq_nilpotency_class` and
  `lower_central_series_length_eq_nilpotency_class`.
* If `G` is nilpotent, then so are its subgroups, images, quotients and preimages.
  Binary and finite products of nilpotent groups are nilpotent.
  Infinite products are nilpotent if their nilpotent class is bounded.
  Corresponding lemmas about the `nilpotency_class` are provided.
* The `nilpotency_class` of `G ⧸ center G` is given explicitly, and an induction principle
  is derived from that.
* `is_nilpotent.to_is_solvable`: If `G` is nilpotent, it is solvable.

## Warning

A "central series" is usually defined to be a finite sequence of normal subgroups going
from `⊥` to `⊤` with the property that each subquotient is contained within the centre of
the associated quotient of `G`. This means that if `G` is not nilpotent, then
none of what we have called `upper_central_series G`, `lower_central_series G` or
the sequences satisfying `is_ascending_central_series` or `is_descending_central_series`
are actually central series. Note that the fact that the upper and lower central series
are not central series if `G` is not nilpotent is a standard abuse of notation.

-/

open subgroup

section with_group

variables {G : Type*} [group G] (H : subgroup G) [normal H]

/-- If `H` is a normal subgroup of `G`, then the set `{x : G | ∀ y : G, x*y*x⁻¹*y⁻¹ ∈ H}`
is a subgroup of `G` (because it is the preimage in `G` of the centre of the
quotient group `G/H`.)
-/
def upper_central_series_step : subgroup G :=
{ carrier := {x : G | ∀ y : G, x * y * x⁻¹ * y⁻¹ ∈ H},
  one_mem' := λ y, by simp [subgroup.one_mem],
  mul_mem' := λ a b ha hb y, begin
    convert subgroup.mul_mem _ (ha (b * y * b⁻¹)) (hb y) using 1,
    group,
  end,
  inv_mem' := λ x hx y, begin
    specialize hx y⁻¹,
    rw [mul_assoc, inv_inv] at ⊢ hx,
    exact subgroup.normal.mem_comm infer_instance hx,
  end }

lemma mem_upper_central_series_step (x : G) :
  x ∈ upper_central_series_step H ↔ ∀ y, x * y * x⁻¹ * y⁻¹ ∈ H := iff.rfl

open quotient_group

/-- The proof that `upper_central_series_step H` is the preimage of the centre of `G/H` under
the canonical surjection. -/
lemma upper_central_series_step_eq_comap_center :
  upper_central_series_step H = subgroup.comap (mk' H) (center (G ⧸ H)) :=
begin
  ext,
  rw [mem_comap, mem_center_iff, forall_coe],
  apply forall_congr,
  intro y,
  rw [coe_mk', ←quotient_group.coe_mul, ←quotient_group.coe_mul, eq_comm, eq_iff_div_mem,
    div_eq_mul_inv, mul_inv_rev, mul_assoc],
end

instance : normal (upper_central_series_step H) :=
begin
  rw upper_central_series_step_eq_comap_center,
  apply_instance,
end

variable (G)

/-- An auxiliary type-theoretic definition defining both the upper central series of
a group, and a proof that it is normal, all in one go. -/
def upper_central_series_aux : ℕ → Σ' (H : subgroup G), normal H
| 0 := ⟨⊥, infer_instance⟩
| (n + 1) := let un := upper_central_series_aux n, un_normal := un.2 in
   by exactI ⟨upper_central_series_step un.1, infer_instance⟩

/-- `upper_central_series G n` is the `n`th term in the upper central series of `G`. -/
def upper_central_series (n : ℕ) : subgroup G := (upper_central_series_aux G n).1

instance (n : ℕ) : normal (upper_central_series G n) := (upper_central_series_aux G n).2

@[simp] lemma upper_central_series_zero : upper_central_series G 0 = ⊥ := rfl

@[simp] lemma upper_central_series_one : upper_central_series G 1 = center G :=
begin
  ext,
  simp only [upper_central_series, upper_central_series_aux, upper_central_series_step, center,
    set.center, mem_mk, mem_bot, set.mem_set_of_eq],
  exact forall_congr (λ y, by rw [mul_inv_eq_one, mul_inv_eq_iff_eq_mul, eq_comm]),
end

/-- The `n+1`st term of the upper central series `H i` has underlying set equal to the `x` such
that `⁅x,G⁆ ⊆ H n`-/
lemma mem_upper_central_series_succ_iff (n : ℕ) (x : G) :
  x ∈ upper_central_series G (n + 1) ↔
  ∀ y : G, x * y * x⁻¹ * y⁻¹ ∈ upper_central_series G n := iff.rfl

-- is_nilpotent is already defined in the root namespace (for elements of rings).
/-- A group `G` is nilpotent if its upper central series is eventually `G`. -/
class group.is_nilpotent (G : Type*) [group G] : Prop :=
(nilpotent [] : ∃ n : ℕ, upper_central_series G n = ⊤)

open group

variable {G}

/-- A sequence of subgroups of `G` is an ascending central series if `H 0` is trivial and
  `⁅H (n + 1), G⁆ ⊆ H n` for all `n`. Note that we do not require that `H n = G` for some `n`. -/
def is_ascending_central_series (H : ℕ → subgroup G) : Prop :=
  H 0 = ⊥ ∧ ∀ (x : G) (n : ℕ), x ∈ H (n + 1) → ∀ g, x * g * x⁻¹ * g⁻¹ ∈ H n

/-- A sequence of subgroups of `G` is a descending central series if `H 0` is `G` and
  `⁅H n, G⁆ ⊆ H (n + 1)` for all `n`. Note that we do not requre that `H n = {1}` for some `n`. -/
def is_descending_central_series (H : ℕ → subgroup G) := H 0 = ⊤ ∧
  ∀ (x : G) (n : ℕ), x ∈ H n → ∀ g, x * g * x⁻¹ * g⁻¹ ∈ H (n + 1)

/-- Any ascending central series for a group is bounded above by the upper central series. -/
lemma ascending_central_series_le_upper (H : ℕ → subgroup G) (hH : is_ascending_central_series H) :
  ∀ n : ℕ, H n ≤ upper_central_series G n
| 0 := hH.1.symm ▸ le_refl ⊥
| (n + 1) := begin
  intros x hx,
  rw mem_upper_central_series_succ_iff,
  exact λ y, ascending_central_series_le_upper n (hH.2 x n hx y),
end

variable (G)

/-- The upper central series of a group is an ascending central series. -/
lemma upper_central_series_is_ascending_central_series :
  is_ascending_central_series (upper_central_series G) :=
⟨rfl, λ x n h, h⟩

lemma upper_central_series_mono : monotone (upper_central_series G) :=
begin
  refine monotone_nat_of_le_succ _,
  intros n x hx y,
  rw [mul_assoc, mul_assoc, ← mul_assoc y x⁻¹ y⁻¹],
  exact mul_mem hx (normal.conj_mem (upper_central_series.subgroup.normal G n) x⁻¹ (inv_mem hx) y)
end

/-- A group `G` is nilpotent iff there exists an ascending central series which reaches `G` in
  finitely many steps. -/
theorem nilpotent_iff_finite_ascending_central_series :
  is_nilpotent G ↔ ∃ n : ℕ, ∃ H : ℕ → subgroup G, is_ascending_central_series H ∧ H n = ⊤ :=
begin
  split,
  { rintro ⟨n, nH⟩,
    refine ⟨_, _, upper_central_series_is_ascending_central_series G, nH⟩ },
  { rintro ⟨n, H, hH, hn⟩,
    use n,
    rw [eq_top_iff, ←hn],
    exact ascending_central_series_le_upper H hH n }
end

lemma is_decending_rev_series_of_is_ascending
  {H: ℕ → subgroup G} {n : ℕ} (hn : H n = ⊤) (hasc : is_ascending_central_series H) :
  is_descending_central_series (λ (m : ℕ), H (n - m)) :=
begin
  cases hasc with h0 hH,
  refine ⟨hn, λ x m hx g, _⟩,
  dsimp at hx,
  by_cases hm : n ≤ m,
  { rw [tsub_eq_zero_of_le hm, h0, subgroup.mem_bot] at hx,
    subst hx,
    convert subgroup.one_mem _,
    group },
  { push_neg at hm,
    apply hH,
    convert hx,
    rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hm), nat.succ_sub_succ] },
end

lemma is_ascending_rev_series_of_is_descending
  {H: ℕ → subgroup G} {n : ℕ} (hn : H n = ⊥) (hdesc : is_descending_central_series H) :
  is_ascending_central_series (λ (m : ℕ), H (n - m)) :=
begin
  cases hdesc with h0 hH,
  refine ⟨hn, λ x m hx g, _⟩,
  dsimp only at hx ⊢,
  by_cases hm : n ≤ m,
  { have hnm : n - m = 0 := tsub_eq_zero_iff_le.mpr hm,
    rw [hnm, h0],
    exact mem_top _ },
  { push_neg at hm,
    convert hH x _ hx g,
    rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hm), nat.succ_sub_succ] },
end

/-- A group `G` is nilpotent iff there exists a descending central series which reaches the
  trivial group in a finite time. -/
theorem nilpotent_iff_finite_descending_central_series :
  is_nilpotent G ↔ ∃ n : ℕ, ∃ H : ℕ → subgroup G, is_descending_central_series H ∧ H n = ⊥ :=
begin
  rw nilpotent_iff_finite_ascending_central_series,
  split,
  { rintro ⟨n, H, hH, hn⟩,
    refine ⟨n, λ m, H (n - m), is_decending_rev_series_of_is_ascending G hn hH, _⟩,
    rw tsub_self,
    exact hH.1 },
  { rintro ⟨n, H, hH, hn⟩,
    refine ⟨n, λ m, H (n - m), is_ascending_rev_series_of_is_descending G hn hH, _⟩,
    rw tsub_self,
    exact hH.1 },
end

/-- The lower central series of a group `G` is a sequence `H n` of subgroups of `G`, defined
  by `H 0` is all of `G` and for `n≥1`, `H (n + 1) = ⁅H n, G⁆` -/
def lower_central_series (G : Type*) [group G] : ℕ → subgroup G
| 0 := ⊤
| (n+1) := ⁅lower_central_series n, ⊤⁆

variable {G}

@[simp] lemma lower_central_series_zero : lower_central_series G 0 = ⊤ := rfl

@[simp] lemma lower_central_series_one : lower_central_series G 1 = commutator G := rfl

lemma mem_lower_central_series_succ_iff (n : ℕ) (q : G) :
  q ∈ lower_central_series G (n + 1) ↔
  q ∈ closure {x | ∃ (p ∈ lower_central_series G n) (q ∈ (⊤ : subgroup G)), p * q * p⁻¹ * q⁻¹ = x}
:= iff.rfl

lemma lower_central_series_succ (n : ℕ) :
  lower_central_series G (n + 1) =
  closure {x | ∃ (p ∈ lower_central_series G n) (q ∈ (⊤ : subgroup G)), p * q * p⁻¹ * q⁻¹ = x} :=
rfl

instance (n : ℕ) : normal (lower_central_series G n) :=
begin
  induction n with d hd,
  { exact (⊤ : subgroup G).normal_of_characteristic },
  { exactI subgroup.commutator_normal (lower_central_series G d) ⊤ },
end

lemma lower_central_series_antitone :
  antitone (lower_central_series G) :=
begin
  refine antitone_nat_of_succ_le (λ n x hx, _),
  simp only [mem_lower_central_series_succ_iff, exists_prop, mem_top, exists_true_left, true_and]
    at hx,
  refine closure_induction hx _ (subgroup.one_mem _) (@subgroup.mul_mem _ _ _)
    (@subgroup.inv_mem _ _ _),
  rintros y ⟨z, hz, a, ha⟩,
  rw [← ha, mul_assoc, mul_assoc, ← mul_assoc a z⁻¹ a⁻¹],
  exact mul_mem hz (normal.conj_mem (lower_central_series.subgroup.normal n) z⁻¹ (inv_mem hz) a)
end

/-- The lower central series of a group is a descending central series. -/
theorem lower_central_series_is_descending_central_series :
  is_descending_central_series (lower_central_series G) :=
begin
  split, refl,
  intros x n hxn g,
  exact commutator_mem_commutator hxn (mem_top g),
end

/-- Any descending central series for a group is bounded below by the lower central series. -/
lemma descending_central_series_ge_lower (H : ℕ → subgroup G)
  (hH : is_descending_central_series H) : ∀ n : ℕ, lower_central_series G n ≤ H n
| 0 := hH.1.symm ▸ le_refl ⊤
| (n + 1) := commutator_le.mpr (λ x hx q _, hH.2 x n (descending_central_series_ge_lower n hx) q)

/-- A group is nilpotent if and only if its lower central series eventually reaches
  the trivial subgroup. -/
theorem nilpotent_iff_lower_central_series : is_nilpotent G ↔ ∃ n, lower_central_series G n = ⊥ :=
begin
  rw nilpotent_iff_finite_descending_central_series,
  split,
  { rintro ⟨n, H, ⟨h0, hs⟩, hn⟩,
    use n,
    rw [eq_bot_iff, ←hn],
    exact descending_central_series_ge_lower H ⟨h0, hs⟩ n },
  { rintro ⟨n, hn⟩,
    exact ⟨n, lower_central_series G, lower_central_series_is_descending_central_series, hn⟩ },
end

section classical

open_locale classical

variables [hG : is_nilpotent G]
include hG

variable (G)

/-- The nilpotency class of a nilpotent group is the smallest natural `n` such that
the `n`'th term of the upper central series is `G`. -/
noncomputable def group.nilpotency_class : ℕ :=
nat.find (is_nilpotent.nilpotent G)

variable {G}

@[simp]
lemma upper_central_series_nilpotency_class :
  upper_central_series G (group.nilpotency_class G) = ⊤ :=
nat.find_spec (is_nilpotent.nilpotent G)

lemma upper_central_series_eq_top_iff_nilpotency_class_le {n : ℕ} :
  (upper_central_series G n = ⊤) ↔ (group.nilpotency_class G ≤ n) :=
begin
  split,
  { intro h,
    exact (nat.find_le h), },
  { intro h,
    apply eq_top_iff.mpr,
    rw ← upper_central_series_nilpotency_class,
    exact (upper_central_series_mono _ h), }
end

/-- The nilpotency class of a nilpotent `G` is equal to the smallest `n` for which an ascending
central series reaches `G` in its `n`'th term. -/
lemma least_ascending_central_series_length_eq_nilpotency_class :
  nat.find ((nilpotent_iff_finite_ascending_central_series G).mp hG) = group.nilpotency_class G :=
begin
  refine le_antisymm (nat.find_mono _) (nat.find_mono _),
  { intros n hn,
    exact ⟨upper_central_series G, upper_central_series_is_ascending_central_series G, hn ⟩, },
  { rintros n ⟨H, ⟨hH, hn⟩⟩,
    rw [←top_le_iff, ←hn],
    exact ascending_central_series_le_upper H hH n, }
end

/-- The nilpotency class of a nilpotent `G` is equal to the smallest `n` for which the descending
central series reaches `⊥` in its `n`'th term. -/
lemma least_descending_central_series_length_eq_nilpotency_class :
  nat.find ((nilpotent_iff_finite_descending_central_series G).mp hG) = group.nilpotency_class G :=
begin
  rw ← least_ascending_central_series_length_eq_nilpotency_class,
  refine le_antisymm (nat.find_mono _) (nat.find_mono _),
  { rintros n ⟨H, ⟨hH, hn⟩⟩,
    refine ⟨(λ m, H (n - m)), is_decending_rev_series_of_is_ascending G hn hH, _⟩,
    rw tsub_self,
    exact hH.1 },
  { rintros n ⟨H, ⟨hH, hn⟩⟩,
    refine ⟨(λ m, H (n - m)), is_ascending_rev_series_of_is_descending G hn hH, _⟩,
    rw tsub_self,
    exact hH.1 },
end

/-- The nilpotency class of a nilpotent `G` is equal to the length of the lower central series. -/
lemma lower_central_series_length_eq_nilpotency_class :
  nat.find (nilpotent_iff_lower_central_series.mp hG) = @group.nilpotency_class G _ _ :=
begin
  rw ← least_descending_central_series_length_eq_nilpotency_class,
  refine le_antisymm (nat.find_mono _) (nat.find_mono _),
  { rintros n ⟨H, ⟨hH, hn⟩⟩,
    rw [←le_bot_iff, ←hn],
    exact (descending_central_series_ge_lower H hH n), },
  { rintros n h,
    exact ⟨lower_central_series G, ⟨lower_central_series_is_descending_central_series, h⟩⟩ },
end

@[simp]
lemma lower_central_series_nilpotency_class :
  lower_central_series G (group.nilpotency_class G) = ⊥ :=
begin
  rw ← lower_central_series_length_eq_nilpotency_class,
  exact (nat.find_spec (nilpotent_iff_lower_central_series.mp _))
end

lemma lower_central_series_eq_bot_iff_nilpotency_class_le {n : ℕ} :
  (lower_central_series G n = ⊥) ↔ (group.nilpotency_class G ≤ n) :=
begin
  split,
  { intro h,
    rw ← lower_central_series_length_eq_nilpotency_class,
    exact (nat.find_le h), },
  { intro h,
    apply eq_bot_iff.mpr,
    rw ← lower_central_series_nilpotency_class,
    exact (lower_central_series_antitone h), }
end

end classical

lemma lower_central_series_map_subtype_le (H : subgroup G) (n : ℕ) :
  (lower_central_series H n).map H.subtype ≤ lower_central_series G n :=
begin
  induction n with d hd,
  { simp },
  { rw [lower_central_series_succ, lower_central_series_succ, monoid_hom.map_closure],
    apply subgroup.closure_mono,
    rintros x1 ⟨x2, ⟨x3, hx3, x4, hx4, rfl⟩, rfl⟩,
    exact ⟨x3, (hd (mem_map.mpr ⟨x3, hx3, rfl⟩)), x4, by simp⟩ }
end

/-- A subgroup of a nilpotent group is nilpotent -/
instance subgroup.is_nilpotent (H : subgroup G) [hG : is_nilpotent G] :
  is_nilpotent H :=
begin
  rw nilpotent_iff_lower_central_series at *,
  rcases hG with ⟨n, hG⟩,
  use n,
  have := lower_central_series_map_subtype_le H n,
  simp only [hG, set_like.le_def, mem_map, forall_apply_eq_imp_iff₂, exists_imp_distrib] at this,
  exact eq_bot_iff.mpr (λ x hx, subtype.ext (this x hx)),
end

/-- A the nilpotency class of a subgroup is less or equal the the nilpotency class of the group -/
lemma subgroup.nilpotency_class_le (H : subgroup G) [hG : is_nilpotent G] :
  group.nilpotency_class H ≤ group.nilpotency_class G :=
begin
  repeat { rw ← lower_central_series_length_eq_nilpotency_class },
  apply nat.find_mono,
  intros n hG,
  have := lower_central_series_map_subtype_le H n,
  simp only [hG, set_like.le_def, mem_map, forall_apply_eq_imp_iff₂, exists_imp_distrib] at this,
  exact eq_bot_iff.mpr (λ x hx, subtype.ext (this x hx)),
end

@[priority 100]
instance is_nilpotent_of_subsingleton [subsingleton G] : is_nilpotent G :=
nilpotent_iff_lower_central_series.2 ⟨0, subsingleton.elim ⊤ ⊥⟩

lemma upper_central_series.map {H : Type*} [group H] {f : G →* H} (h : function.surjective f)
  (n : ℕ) : subgroup.map f (upper_central_series G n) ≤ upper_central_series H n :=
begin
  induction n with d hd,
  { simp },
  { rintros _ ⟨x, hx : x ∈ upper_central_series G d.succ, rfl⟩ y',
    rcases h y' with ⟨y, rfl⟩,
    simpa using hd (mem_map_of_mem f (hx y)) }
end

lemma lower_central_series.map {H : Type*} [group H] (f : G →* H) (n : ℕ) :
  subgroup.map f (lower_central_series G n) ≤ lower_central_series H n :=
begin
  induction n with d hd,
  { simp [nat.nat_zero_eq_zero] },
  { rintros a ⟨x, hx : x ∈ lower_central_series G d.succ, rfl⟩,
    refine closure_induction hx _ (by simp [f.map_one, subgroup.one_mem _])
      (λ y z hy hz, by simp [monoid_hom.map_mul, subgroup.mul_mem _ hy hz])
      (λ y hy, by simp [f.map_inv, subgroup.inv_mem _ hy]),
    rintros a ⟨y, hy, z, ⟨-, rfl⟩⟩,
    apply mem_closure.mpr,
    exact λ K hK, hK ⟨f y, hd (mem_map_of_mem f hy), by simp [commutator_element_def]⟩ }
end

lemma lower_central_series_succ_eq_bot {n : ℕ} (h : lower_central_series G n ≤ center G) :
  lower_central_series G (n + 1) = ⊥ :=
begin
  rw [lower_central_series_succ, closure_eq_bot_iff, set.subset_singleton_iff],
  rintro x ⟨y, hy1, z, ⟨⟩, rfl⟩,
  rw [mul_assoc, ←mul_inv_rev, mul_inv_eq_one, eq_comm],
  exact mem_center_iff.mp (h hy1) z,
end

/-- The preimage of a nilpotent group is nilpotent if the kernel of the homomorphism is contained
in the center -/
lemma is_nilpotent_of_ker_le_center {H : Type*} [group H] (f : G →* H)
  (hf1 : f.ker ≤ center G) (hH : is_nilpotent H) : is_nilpotent G :=
begin
  rw nilpotent_iff_lower_central_series at *,
  rcases hH with ⟨n, hn⟩,
  use (n + 1),
  refine lower_central_series_succ_eq_bot (le_trans ((subgroup.map_eq_bot_iff _).mp _) hf1),
  exact eq_bot_iff.mpr (hn ▸ (lower_central_series.map f n)),
end

lemma nilpotency_class_le_of_ker_le_center {H : Type*} [group H] (f : G →* H)
  (hf1 : f.ker ≤ center G) (hH : is_nilpotent H) :
  @group.nilpotency_class G _ (is_nilpotent_of_ker_le_center f hf1 hH) ≤
    group.nilpotency_class H + 1 :=
begin
  rw ← lower_central_series_length_eq_nilpotency_class,
  apply nat.find_min',
  refine lower_central_series_succ_eq_bot (le_trans ((subgroup.map_eq_bot_iff _).mp _) hf1),
  apply eq_bot_iff.mpr,
  apply (le_trans (lower_central_series.map f _)),
  simp only [lower_central_series_nilpotency_class, le_bot_iff],
end

/-- The range of a surjective homomorphism from a nilpotent group is nilpotent -/
lemma nilpotent_of_surjective {G' : Type*} [group G'] [h : is_nilpotent G]
  (f : G →* G') (hf : function.surjective f) :
  is_nilpotent G' :=
begin
  unfreezingI { rcases h with ⟨n, hn⟩ },
  use n,
  apply eq_top_iff.mpr,
  calc ⊤ = f.range : symm (f.range_top_of_surjective hf)
    ... = subgroup.map f ⊤ : monoid_hom.range_eq_map _
    ... = subgroup.map f (upper_central_series G n) : by rw hn
    ... ≤ upper_central_series G' n : upper_central_series.map hf n,
end

/-- The nilpotency class of the range of a surejctive homomorphism from a
nilpotent group is less or equal the nilpotency class of the domain -/
lemma nilpotency_class_le_of_surjective
  {G' : Type*} [group G'] (f : G →* G') (hf : function.surjective f) [h : is_nilpotent G] :
  @group.nilpotency_class G' _ (nilpotent_of_surjective _ hf) ≤
    group.nilpotency_class G :=
begin
  apply nat.find_mono,
  intros n hn,
  apply eq_top_iff.mpr,
  calc ⊤ = f.range : symm (f.range_top_of_surjective hf)
    ... = subgroup.map f ⊤ : monoid_hom.range_eq_map _
    ... = subgroup.map f (upper_central_series G n) : by rw hn
    ... ≤ upper_central_series G' n : upper_central_series.map hf n,
end

/-- Nilpotency respects isomorphisms -/
lemma nilpotent_of_mul_equiv {G' : Type*} [group G'] [h : is_nilpotent G] (f : G ≃* G') :
  is_nilpotent G' :=
nilpotent_of_surjective f.to_monoid_hom (mul_equiv.surjective f)

/-- A quotient of a nilpotent group is nilpotent -/
instance nilpotent_quotient_of_nilpotent (H : subgroup G) [H.normal] [h : is_nilpotent G] :
  is_nilpotent (G ⧸ H) :=
 nilpotent_of_surjective _ (show function.surjective (quotient_group.mk' H), by tidy)

/-- The nilpotency class of a quotient of `G` is less or equal the nilpotency class of `G` -/
lemma nilpotency_class_quotient_le (H : subgroup G) [H.normal] [h : is_nilpotent G] :
  group.nilpotency_class (G ⧸ H) ≤ group.nilpotency_class G := nilpotency_class_le_of_surjective _ _

-- This technical lemma helps with rewriting the subgroup, which occurs in indices
private lemma comap_center_subst {H₁ H₂ : subgroup G} [normal H₁] [normal H₂] (h : H₁ = H₂) :
  comap (mk' H₁) (center (G ⧸ H₁)) = comap (mk' H₂) (center (G ⧸ H₂)) :=
by unfreezingI { subst h }

lemma comap_upper_central_series_quotient_center (n : ℕ) :
  comap (mk' (center G)) (upper_central_series (G ⧸ center G) n) = upper_central_series G n.succ :=
begin
  induction n with n ih,
  { simp, },
  { let Hn := upper_central_series (G ⧸ center G) n,
    calc comap (mk' (center G)) (upper_central_series_step Hn)
        = comap (mk' (center G)) (comap (mk' Hn) (center ((G ⧸ center G) ⧸ Hn))) :
        by rw upper_central_series_step_eq_comap_center
    ... = comap (mk' (comap (mk' (center G)) Hn)) (center (G ⧸ (comap (mk' (center G)) Hn))) :
        quotient_group.comap_comap_center
    ... = comap (mk' (upper_central_series G n.succ)) (center (G ⧸ upper_central_series G n.succ)) :
        comap_center_subst ih
    ... = upper_central_series_step (upper_central_series G n.succ) :
        symm (upper_central_series_step_eq_comap_center _), }
end

lemma nilpotency_class_zero_iff_subsingleton [is_nilpotent G] :
  group.nilpotency_class G = 0 ↔ subsingleton G :=
by simp [group.nilpotency_class, nat.find_eq_zero, subsingleton_iff_bot_eq_top]

/-- Quotienting the `center G` reduces the nilpotency class by 1 -/
lemma nilpotency_class_quotient_center [hH : is_nilpotent G] :
  group.nilpotency_class (G ⧸ center G) = group.nilpotency_class G - 1 :=
begin
  generalize hn : group.nilpotency_class G = n,
  rcases n with rfl | n,
  { simp [nilpotency_class_zero_iff_subsingleton] at *,
    haveI := hn,
    apply_instance, },
  { suffices : group.nilpotency_class (G ⧸ center G) = n, by simpa,
    apply le_antisymm,
    { apply upper_central_series_eq_top_iff_nilpotency_class_le.mp,
      apply (@comap_injective G _ _ _ (mk' (center G)) (surjective_quot_mk _)),
      rw [ comap_upper_central_series_quotient_center, comap_top, ← hn],
      exact upper_central_series_nilpotency_class, },
    { apply le_of_add_le_add_right,
      calc n + 1 = n.succ : rfl
        ... = group.nilpotency_class G : symm hn
        ... ≤ group.nilpotency_class (G ⧸ center G) + 1
            : nilpotency_class_le_of_ker_le_center _ (le_of_eq (ker_mk _)) _, } }
end

/-- The nilpotency class of a non-trivial group is one more than its quotient by the center -/
lemma nilpotency_class_eq_quotient_center_plus_one [hH : is_nilpotent G] [nontrivial G] :
  group.nilpotency_class G = group.nilpotency_class (G ⧸ center G) + 1 :=
begin
  rw nilpotency_class_quotient_center,
  rcases h : group.nilpotency_class G,
  { exfalso,
    rw nilpotency_class_zero_iff_subsingleton at h, resetI,
    apply (false_of_nontrivial_of_subsingleton G), },
  { simp }
end

/-- If the quotient by `center G` is nilpotent, then so is G. -/
lemma of_quotient_center_nilpotent (h : is_nilpotent (G ⧸ center G)) : is_nilpotent G :=
begin
  obtain ⟨n, hn⟩ := h.nilpotent,
  use n.succ,
  simp [← comap_upper_central_series_quotient_center, hn],
end

/-- A custom induction principle for nilpotent groups. The base case is a trivial group
(`subsingleton G`), and in the induction step, one can assume the hypothesis for
the group quotiented by its center. -/
@[elab_as_eliminator]
lemma nilpotent_center_quotient_ind
  {P : Π G [group G], by exactI ∀ [is_nilpotent G], Prop}
  (G : Type*) [group G] [is_nilpotent G]
  (hbase : ∀ G [group G] [subsingleton G], by exactI P G)
  (hstep : ∀ G [group G], by exactI ∀ [is_nilpotent G], by exactI ∀ (ih : P (G ⧸ center G)), P G) :
  P G :=
begin
  obtain ⟨n, h⟩ : ∃ n, group.nilpotency_class G = n := ⟨ _, rfl⟩,
  unfreezingI { induction n with n ih generalizing G },
  { haveI := nilpotency_class_zero_iff_subsingleton.mp h,
    exact hbase _, },
  { have hn : group.nilpotency_class (G ⧸ center G) = n :=
      by simp [nilpotency_class_quotient_center, h],
    exact hstep _ (ih _ hn), },
end

lemma derived_le_lower_central (n : ℕ) : derived_series G n ≤ lower_central_series G n :=
by { induction n with i ih, { simp }, { apply commutator_mono ih, simp } }

/-- Abelian groups are nilpotent -/
@[priority 100]
instance comm_group.is_nilpotent {G : Type*} [comm_group G] : is_nilpotent G :=
begin
  use 1,
  rw upper_central_series_one,
  apply comm_group.center_eq_top,
end

/-- Abelian groups have nilpotency class at most one -/
lemma comm_group.nilpotency_class_le_one {G : Type*} [comm_group G] :
  group.nilpotency_class G ≤ 1 :=
begin
  apply upper_central_series_eq_top_iff_nilpotency_class_le.mp,
  rw upper_central_series_one,
  apply comm_group.center_eq_top,
end

/-- Groups with nilpotency class at most one are abelian -/
def comm_group_of_nilpotency_class [is_nilpotent G] (h : group.nilpotency_class G ≤ 1) :
  comm_group G :=
group.comm_group_of_center_eq_top $
begin
  rw ← upper_central_series_one,
  exact upper_central_series_eq_top_iff_nilpotency_class_le.mpr h,
end

section prod

variables {G₁ G₂ : Type*} [group G₁] [group G₂]

lemma lower_central_series_prod (n : ℕ):
  lower_central_series (G₁ × G₂) n = (lower_central_series G₁ n).prod (lower_central_series G₂ n) :=
begin
  induction n with n ih,
  { simp, },
  { calc lower_central_series (G₁ × G₂) n.succ
        = ⁅lower_central_series (G₁ × G₂) n, ⊤⁆  : rfl
    ... = ⁅(lower_central_series G₁ n).prod (lower_central_series G₂ n), ⊤⁆ : by rw ih
    ... = ⁅(lower_central_series G₁ n).prod (lower_central_series G₂ n), (⊤ : subgroup G₁).prod ⊤⁆ :
      by simp
    ... = ⁅lower_central_series G₁ n, (⊤ : subgroup G₁)⁆.prod ⁅lower_central_series G₂ n, ⊤⁆ :
      commutator_prod_prod _ _ _ _
    ... = (lower_central_series G₁ n.succ).prod (lower_central_series G₂ n.succ) : rfl }
end

/-- Products of nilpotent groups are nilpotent -/
instance is_nilpotent_prod [is_nilpotent G₁] [is_nilpotent G₂] :
  is_nilpotent (G₁ × G₂) :=
begin
  rw nilpotent_iff_lower_central_series,
  refine ⟨max (group.nilpotency_class G₁) (group.nilpotency_class G₂), _ ⟩,
  rw [lower_central_series_prod,
    lower_central_series_eq_bot_iff_nilpotency_class_le.mpr (le_max_left _ _),
    lower_central_series_eq_bot_iff_nilpotency_class_le.mpr (le_max_right _ _), bot_prod_bot],
end

/-- The nilpotency class of a product is the max of the nilpotency classes of the factors -/
lemma nilpotency_class_prod [is_nilpotent G₁] [is_nilpotent G₂] :
  group.nilpotency_class (G₁ × G₂) = max (group.nilpotency_class G₁) (group.nilpotency_class G₂) :=
begin
  refine eq_of_forall_ge_iff (λ k, _),
  simp only [max_le_iff, ← lower_central_series_eq_bot_iff_nilpotency_class_le,
    lower_central_series_prod, prod_eq_bot_iff ],
end

end prod

section bounded_pi

-- First the case of infinite products with bounded nilpotency class

variables {η : Type*} {Gs : η → Type*} [∀ i, group (Gs i)]

lemma lower_central_series_pi_le (n : ℕ):
  lower_central_series (Π i, Gs i) n ≤ subgroup.pi set.univ (λ i, lower_central_series (Gs i) n) :=
begin
  let pi := λ (f : Π i, subgroup (Gs i)), subgroup.pi set.univ f,
  induction n with n ih,
  { simp [pi_top] },
  { calc lower_central_series (Π i, Gs i) n.succ
        = ⁅lower_central_series (Π i, Gs i) n, ⊤⁆           : rfl
    ... ≤ ⁅pi (λ i, (lower_central_series (Gs i) n)), ⊤⁆    : commutator_mono ih (le_refl _)
    ... = ⁅pi (λ i, (lower_central_series (Gs i) n)), pi (λ i, ⊤)⁆ : by simp [pi, pi_top]
    ... ≤ pi (λ i, ⁅(lower_central_series (Gs i) n), ⊤⁆)    : commutator_pi_pi_le _ _
    ... = pi (λ i, lower_central_series (Gs i) n.succ)      : rfl }
end

/-- products of nilpotent groups are nilpotent if their nipotency class is bounded -/
lemma is_nilpotent_pi_of_bounded_class [∀ i, is_nilpotent (Gs i)]
  (n : ℕ) (h : ∀ i, group.nilpotency_class (Gs i) ≤ n) :
  is_nilpotent (Π i, Gs i) :=
begin
  rw nilpotent_iff_lower_central_series,
  refine ⟨n, _⟩,
  rw eq_bot_iff,
  apply le_trans (lower_central_series_pi_le _),
  rw [← eq_bot_iff, pi_eq_bot_iff],
  intros i,
  apply lower_central_series_eq_bot_iff_nilpotency_class_le.mpr (h i),
end

end bounded_pi

section finite_pi

-- Now for finite products

variables {η : Type*} {Gs : η → Type*} [∀ i, group (Gs i)]

lemma lower_central_series_pi_of_finite [finite η] (n : ℕ) :
  lower_central_series (Π i, Gs i) n = subgroup.pi set.univ (λ i, lower_central_series (Gs i) n) :=
begin
  let pi := λ (f : Π i, subgroup (Gs i)), subgroup.pi set.univ f,
  induction n with n ih,
  { simp [pi_top] },
  { calc lower_central_series (Π i, Gs i) n.succ
        = ⁅lower_central_series (Π i, Gs i) n, ⊤⁆          : rfl
    ... = ⁅pi (λ i, (lower_central_series (Gs i) n)), ⊤⁆   : by rw ih
    ... = ⁅pi (λ i, (lower_central_series (Gs i) n)), pi (λ i, ⊤)⁆ : by simp [pi, pi_top]
    ... = pi (λ i, ⁅(lower_central_series (Gs i) n), ⊤⁆)   : commutator_pi_pi_of_finite _ _
    ... = pi (λ i, lower_central_series (Gs i) n.succ)     : rfl }
end

/-- n-ary products of nilpotent groups are nilpotent -/
instance is_nilpotent_pi [finite η] [∀ i, is_nilpotent (Gs i)] : is_nilpotent (Π i, Gs i) :=
begin
  casesI nonempty_fintype η,
  rw nilpotent_iff_lower_central_series,
  refine ⟨finset.univ.sup (λ i, group.nilpotency_class (Gs i)), _⟩,
  rw [lower_central_series_pi_of_finite, pi_eq_bot_iff],
  intros i,
  apply lower_central_series_eq_bot_iff_nilpotency_class_le.mpr,
  exact @finset.le_sup _ _ _ _ finset.univ (λ i, group.nilpotency_class (Gs i)) _
    (finset.mem_univ i),
end

/-- The nilpotency class of an n-ary product is the sup of the nilpotency classes of the factors -/
lemma nilpotency_class_pi [fintype η] [∀ i, is_nilpotent (Gs i)] :
  group.nilpotency_class (Π i, Gs i) = finset.univ.sup (λ i, group.nilpotency_class (Gs i)) :=
begin
  apply eq_of_forall_ge_iff,
  intros k,
  simp only [finset.sup_le_iff, ← lower_central_series_eq_bot_iff_nilpotency_class_le,
    lower_central_series_pi_of_finite, pi_eq_bot_iff, finset.mem_univ, true_implies_iff ],
end

end finite_pi

/-- A nilpotent subgroup is solvable -/
@[priority 100]
instance is_nilpotent.to_is_solvable [h : is_nilpotent G]: is_solvable G :=
begin
  obtain ⟨n, hn⟩ := nilpotent_iff_lower_central_series.1 h,
  use n,
  rw [eq_bot_iff, ←hn],
  exact derived_le_lower_central n,
end

lemma normalizer_condition_of_is_nilpotent [h : is_nilpotent G] : normalizer_condition G :=
begin
  -- roughly based on https://groupprops.subwiki.org/wiki/Nilpotent_implies_normalizer_condition
  rw normalizer_condition_iff_only_full_group_self_normalizing,
  apply nilpotent_center_quotient_ind G; unfreezingI { clear_dependent G },
  { introsI G _ _ H _, apply subsingleton.elim, },
  { introsI G _ _ ih H hH,

    have hch : center G ≤ H := subgroup.center_le_normalizer.trans (le_of_eq hH),
    have hkh : (mk' (center G)).ker ≤ H, by simpa using hch,
    have hsur : function.surjective (mk' (center G)), by exact surjective_quot_mk _,

    let H' := H.map (mk' (center G)),
    have hH' : H'.normalizer = H',
    { apply comap_injective hsur,
      rw [comap_normalizer_eq_of_surjective _ hsur, comap_map_eq_self hkh],
      exact hH, },
    apply map_injective_of_ker_le (mk' (center G)) hkh le_top,
    exact (ih H' hH').trans (symm (map_top_of_surjective _ hsur)), },
end

end with_group

section with_finite_group

open group fintype

variables {G : Type*} [hG : group G]
include hG

/-- A p-group is nilpotent -/
lemma is_p_group.is_nilpotent [finite G] {p : ℕ} [hp : fact (nat.prime p)] (h : is_p_group p G) :
  is_nilpotent G :=
begin
  casesI nonempty_fintype G,
  classical,
  unfreezingI
  { revert hG,
    induction val using fintype.induction_subsingleton_or_nontrivial with G hG hS G hG hN ih },
  { apply_instance, },
  { introI _, intro h,
    have hcq : fintype.card (G ⧸ center G) < fintype.card G,
    { rw card_eq_card_quotient_mul_card_subgroup (center G),
      apply lt_mul_of_one_lt_right,
      exact (fintype.card_pos_iff.mpr has_one.nonempty),
      exact ((subgroup.one_lt_card_iff_ne_bot _).mpr (ne_of_gt h.bot_lt_center)), },
    have hnq : is_nilpotent (G ⧸ center G) := ih _ hcq (h.to_quotient (center G)),
    exact (of_quotient_center_nilpotent hnq), }
end

variables [fintype G]

/-- If a finite group is the direct product of its Sylow groups, it is nilpotent -/
theorem is_nilpotent_of_product_of_sylow_group
  (e : (Π p : (fintype.card G).factorization.support, Π P : sylow p G, (↑P : subgroup G)) ≃* G) :
  is_nilpotent G :=
begin
  classical,
  let ps := (fintype.card G).factorization.support,
  haveI : ∀ (p : ps) (P : sylow p G), is_nilpotent (↑P : subgroup G),
  { intros p P,
    haveI : fact (nat.prime ↑p) := fact.mk (nat.prime_of_mem_factorization (finset.coe_mem p)),
    exact P.is_p_group'.is_nilpotent, },
  exact nilpotent_of_mul_equiv e,
end

/-- A finite group is nilpotent iff the normalizer condition holds, and iff all maximal groups are
normal and iff all sylow groups are normal and iff the group is the direct product of its sylow
groups. -/
theorem is_nilpotent_of_finite_tfae : tfae
  [ is_nilpotent G,
    normalizer_condition G,
    ∀ (H : subgroup G), is_coatom H → H.normal,
    ∀ (p : ℕ) (hp : fact p.prime) (P : sylow p G), (↑P : subgroup G).normal,
    nonempty ((Π p : (card G).factorization.support, Π P : sylow p G, (↑P : subgroup G)) ≃* G) ] :=
begin
  tfae_have : 1 → 2, { exact @normalizer_condition_of_is_nilpotent _ _ },
  tfae_have : 2 → 3, { exact λ h H, normalizer_condition.normal_of_coatom H h },
  tfae_have : 3 → 4, { introsI h p _ P, exact sylow.normal_of_all_max_subgroups_normal h _ },
  tfae_have : 4 → 5, { exact λ h, nonempty.intro (sylow.direct_product_of_normal h) },
  tfae_have : 5 → 1, { rintros ⟨e⟩, exact is_nilpotent_of_product_of_sylow_group e },
  tfae_finish,
end

end with_finite_group


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

import ring_theory.polynomial.cyclotomic

/-!
# Not all coefficients of cyclotomic polynomials are -1, 0, or 1

We show that not all coefficients of cyclotomic polynomials are equal to `0`, `-1` or `1`, in the
theorem `not_forall_coeff_cyclotomic_neg_one_zero_one`. We prove this with the counterexample
`coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2`.
-/

section computation

lemma prime_3 : nat.prime 3 := by norm_num

lemma prime_5 : nat.prime 5 := by norm_num

lemma prime_7 : nat.prime 7 := by norm_num

lemma proper_divisors_15 : nat.proper_divisors 15 = {1, 3, 5} := rfl

lemma proper_divisors_21 : nat.proper_divisors 21 = {1, 3, 7} := rfl

lemma proper_divisors_35 : nat.proper_divisors 35 = {1, 5, 7} := rfl

lemma proper_divisors_105 : nat.proper_divisors 105 = {1, 3, 5, 7, 15, 21, 35} := rfl

end computation

open polynomial

lemma cyclotomic_3 : cyclotomic 3 ℤ = 1 + X + X ^ 2 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 3, by norm_num) _).2 _).symm,
  rw nat.prime.proper_divisors prime_3,
  simp only [finset.prod_singleton, cyclotomic_one],
  ring
end

lemma cyclotomic_5 : cyclotomic 5 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 :=
begin
  refine ((eq_cyclotomic_iff (nat.prime.pos prime_5) _).2 _).symm,
  rw nat.prime.proper_divisors prime_5,
  simp only [finset.prod_singleton, cyclotomic_one],
  ring
end

lemma cyclotomic_7 : cyclotomic 7 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 + X ^ 5 + X ^ 6 :=
begin
  refine ((eq_cyclotomic_iff (nat.prime.pos prime_7) _).2 _).symm,
  rw nat.prime.proper_divisors prime_7,
  simp only [finset.prod_singleton, cyclotomic_one],
  ring
end

lemma cyclotomic_15 : cyclotomic 15 ℤ = 1 - X + X ^ 3 - X ^ 4 + X ^ 5 - X ^ 7 + X ^ 8 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 15, by norm_num) _).2 _).symm,
  rw [proper_divisors_15, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_3, cyclotomic_5],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_21 : cyclotomic 21 ℤ =
  1 - X + X ^ 3 - X ^ 4 + X ^ 6 - X ^ 8 + X ^ 9 - X ^ 11 + X ^ 12 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 21, by norm_num) _).2 _).symm,
  rw [proper_divisors_21, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_3, cyclotomic_7],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_35 : cyclotomic 35 ℤ =
  1 - X + X ^ 5 - X ^ 6 + X ^ 7 - X ^ 8 + X ^ 10 - X ^ 11 + X ^ 12 - X ^ 13 + X ^ 14 - X ^ 16 +
  X ^ 17 - X ^ 18 + X ^ 19 - X ^ 23 + X ^ 24 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 35, by norm_num) _).2 _).symm,
  rw [proper_divisors_35, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_5, cyclotomic_7],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_105 : cyclotomic 105 ℤ =
  1 + X + X ^ 2 - X ^ 5 - X ^ 6 - 2 * X ^ 7 - X ^ 8 - X ^ 9 + X ^ 12 + X ^ 13 + X ^ 14 + X ^ 15
  + X ^ 16 + X ^ 17 - X ^ 20 - X ^ 22 - X ^ 24 - X ^ 26 - X ^ 28 + X ^ 31 + X ^ 32 + X ^ 33 +
  X ^ 34 + X ^ 35 + X ^ 36 - X ^ 39 - X ^ 40 - 2 * X ^ 41 - X ^ 42 - X ^ 43 + X ^ 46 + X ^ 47 +
  X ^ 48 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 105, by norm_num) _).2 _).symm,
  rw proper_divisors_105,
  repeat {rw finset.prod_insert _},
  rw [finset.prod_singleton, cyclotomic_one, cyclotomic_3, cyclotomic_5, cyclotomic_7,
    cyclotomic_15, cyclotomic_21, cyclotomic_35],
  ring,
  repeat { norm_num }
end

lemma coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2 :=
begin
  simp [cyclotomic_105, coeff_X_pow, coeff_one, coeff_X_of_ne_one, coeff_bit0_mul, coeff_bit1_mul]
end

lemma not_forall_coeff_cyclotomic_neg_one_zero_one :
  ¬∀ n i, coeff (cyclotomic n ℤ) i ∈ ({-1, 0, 1} : set ℤ) :=
begin
  intro h,
  replace h := h 105 7,
  rw coeff_cyclotomic_105 at h,
  norm_num at h
end