/-
Copyright (c) 2018 Mitchell Rowett. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mitchell Rowett, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.subgroup
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-- The left coset `a*s` corresponding to an element `a : α` and a subset `s : set α` -/
def left_coset {α : Type u_1} [Mul α] (a : α) (s : set α) : set α :=
  (fun (x : α) => a * x) '' s

/-- The right coset `s*a` corresponding to an element `a : α` and a subset `s : set α` -/
def right_coset {α : Type u_1} [Mul α] (s : set α) (a : α) : set α :=
  (fun (x : α) => x * a) '' s

theorem mem_left_coset {α : Type u_1} [Mul α] {s : set α} {x : α} (a : α) (hxS : x ∈ s) : a * x ∈ left_coset a s :=
  set.mem_image_of_mem (fun (b : α) => a * b) hxS

theorem mem_right_coset {α : Type u_1} [Mul α] {s : set α} {x : α} (a : α) (hxS : x ∈ s) : x * a ∈ right_coset s a :=
  set.mem_image_of_mem (fun (b : α) => b * a) hxS

/-- Equality of two left cosets `a*s` and `b*s` -/
def left_coset_equiv {α : Type u_1} [Mul α] (s : set α) (a : α) (b : α) :=
  left_coset a s = left_coset b s

theorem left_add_coset_equiv_rel {α : Type u_1} [Add α] (s : set α) : equivalence (left_add_coset_equiv s) :=
  mk_equivalence (left_add_coset_equiv s) (fun (a : α) => rfl) (fun (a b : α) => Eq.symm) fun (a b c : α) => Eq.trans

@[simp] theorem left_coset_assoc {α : Type u_1} [semigroup α] (s : set α) (a : α) (b : α) : left_coset a (left_coset b s) = left_coset (a * b) s := sorry

@[simp] theorem left_add_coset_assoc {α : Type u_1} [add_semigroup α] (s : set α) (a : α) (b : α) : left_add_coset a (left_add_coset b s) = left_add_coset (a + b) s := sorry

@[simp] theorem right_coset_assoc {α : Type u_1} [semigroup α] (s : set α) (a : α) (b : α) : right_coset (right_coset s a) b = right_coset s (a * b) := sorry

@[simp] theorem right_add_coset_assoc {α : Type u_1} [add_semigroup α] (s : set α) (a : α) (b : α) : right_add_coset (right_add_coset s a) b = right_add_coset s (a + b) := sorry

theorem left_add_coset_right_add_coset {α : Type u_1} [add_semigroup α] (s : set α) (a : α) (b : α) : right_add_coset (left_add_coset a s) b = left_add_coset a (right_add_coset s b) := sorry

@[simp] theorem one_left_coset {α : Type u_1} [monoid α] (s : set α) : left_coset 1 s = s := sorry

@[simp] theorem zero_left_add_coset {α : Type u_1} [add_monoid α] (s : set α) : left_add_coset 0 s = s := sorry

@[simp] theorem right_coset_one {α : Type u_1} [monoid α] (s : set α) : right_coset s 1 = s := sorry

@[simp] theorem right_add_coset_zero {α : Type u_1} [add_monoid α] (s : set α) : right_add_coset s 0 = s := sorry

theorem mem_own_left_coset {α : Type u_1} [monoid α] (s : submonoid α) (a : α) : a ∈ left_coset a ↑s := sorry

theorem mem_own_right_add_coset {α : Type u_1} [add_monoid α] (s : add_submonoid α) (a : α) : a ∈ right_add_coset (↑s) a := sorry

theorem mem_left_coset_left_coset {α : Type u_1} [monoid α] (s : submonoid α) {a : α} (ha : left_coset a ↑s = ↑s) : a ∈ s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ s)) (Eq.symm (propext submonoid.mem_coe))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ ↑s)) (Eq.symm ha))) (mem_own_left_coset s a))

theorem mem_right_add_coset_right_add_coset {α : Type u_1} [add_monoid α] (s : add_submonoid α) {a : α} (ha : right_add_coset (↑s) a = ↑s) : a ∈ s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ s)) (Eq.symm (propext add_submonoid.mem_coe))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ ↑s)) (Eq.symm ha))) (mem_own_right_add_coset s a))

theorem mem_left_coset_iff {α : Type u_1} [group α] {s : set α} {x : α} (a : α) : x ∈ left_coset a s ↔ a⁻¹ * x ∈ s := sorry

theorem mem_right_coset_iff {α : Type u_1} [group α] {s : set α} {x : α} (a : α) : x ∈ right_coset s a ↔ x * (a⁻¹) ∈ s := sorry

theorem left_coset_mem_left_coset {α : Type u_1} [group α] (s : subgroup α) {a : α} (ha : a ∈ s) : left_coset a ↑s = ↑s := sorry

theorem right_add_coset_mem_right_add_coset {α : Type u_1} [add_group α] (s : add_subgroup α) {a : α} (ha : a ∈ s) : right_add_coset (↑s) a = ↑s := sorry

theorem normal_of_eq_cosets {α : Type u_1} [group α] (s : subgroup α) (N : subgroup.normal s) (g : α) : left_coset g ↑s = right_coset (↑s) g := sorry

theorem eq_cosets_of_normal {α : Type u_1} [group α] (s : subgroup α) (h : ∀ (g : α), left_coset g ↑s = right_coset (↑s) g) : subgroup.normal s := sorry

theorem normal_iff_eq_add_cosets {α : Type u_1} [add_group α] (s : add_subgroup α) : add_subgroup.normal s ↔ ∀ (g : α), left_add_coset g ↑s = right_add_coset (↑s) g :=
  { mp := normal_of_eq_add_cosets s, mpr := eq_add_cosets_of_normal s }

namespace quotient_group

/-- The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup.-/
def Mathlib.quotient_add_group.left_rel {α : Type u_1} [add_group α] (s : add_subgroup α) : setoid α :=
  setoid.mk (fun (x y : α) => -x + y ∈ s) sorry

protected instance left_rel_decidable {α : Type u_1} [group α] (s : subgroup α) [d : decidable_pred fun (a : α) => a ∈ s] : DecidableRel setoid.r :=
  fun (_x _x_1 : α) => d (_x⁻¹ * _x_1)

/-- `quotient s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `quotient s` is a group -/
def quotient {α : Type u_1} [group α] (s : subgroup α) :=
  quotient (left_rel s)

end quotient_group

namespace quotient_add_group

/-- `quotient s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `quotient s` is a group -/
def quotient {α : Type u_1} [add_group α] (s : add_subgroup α) :=
  quotient (left_rel s)

end quotient_add_group

namespace quotient_group

protected instance Mathlib.quotient_add_group.fintype {α : Type u_1} [add_group α] [fintype α] (s : add_subgroup α) [DecidableRel setoid.r] : fintype (quotient_add_group.quotient s) :=
  quotient.fintype (quotient_add_group.left_rel s)

/-- The canonical map from a group `α` to the quotient `α/s`. -/
def Mathlib.quotient_add_group.mk {α : Type u_1} [add_group α] {s : add_subgroup α} (a : α) : quotient_add_group.quotient s :=
  quotient.mk' a

theorem induction_on {α : Type u_1} [group α] {s : subgroup α} {C : quotient s → Prop} (x : quotient s) (H : ∀ (z : α), C (mk z)) : C x :=
  quotient.induction_on' x H

protected instance quotient.has_coe_t {α : Type u_1} [group α] {s : subgroup α} : has_coe_t α (quotient s) :=
  has_coe_t.mk mk

theorem induction_on' {α : Type u_1} [group α] {s : subgroup α} {C : quotient s → Prop} (x : quotient s) (H : ∀ (z : α), C ↑z) : C x :=
  quotient.induction_on' x H

protected instance quotient.inhabited {α : Type u_1} [group α] (s : subgroup α) : Inhabited (quotient s) :=
  { default := ↑1 }

protected theorem eq {α : Type u_1} [group α] {s : subgroup α} {a : α} {b : α} : ↑a = ↑b ↔ a⁻¹ * b ∈ s :=
  quotient.eq'

theorem Mathlib.quotient_add_group.eq_class_eq_left_coset {α : Type u_1} [add_group α] (s : add_subgroup α) (g : α) : (set_of fun (x : α) => ↑x = ↑g) = left_add_coset g ↑s := sorry

theorem preimage_image_coe {α : Type u_1} [group α] (N : subgroup α) (s : set α) : coe ⁻¹' (coe '' s) = set.Union fun (x : ↥N) => (fun (y : α) => y * ↑x) '' s := sorry

end quotient_group

namespace subgroup

/-- The natural bijection between the cosets `g*s` and `s` -/
def Mathlib.add_subgroup.left_coset_equiv_add_subgroup {α : Type u_1} [add_group α] {s : add_subgroup α} (g : α) : ↥(left_add_coset g ↑s) ≃ ↥s :=
  equiv.mk (fun (x : ↥(left_add_coset g ↑s)) => { val := -g + subtype.val x, property := sorry })
    (fun (x : ↥s) => { val := g + subtype.val x, property := sorry }) sorry sorry

/-- A (non-canonical) bijection between a group `α` and the product `(α/s) × s` -/
def Mathlib.add_subgroup.add_group_equiv_quotient_times_add_subgroup {α : Type u_1} [add_group α] {s : add_subgroup α} : α ≃ quotient_add_group.quotient s × ↥s :=
  equiv.trans
    (equiv.trans
      (equiv.trans (equiv.symm (equiv.sigma_preimage_equiv quotient_add_group.mk))
        (equiv.sigma_congr_right
          fun (L : quotient_add_group.quotient s) =>
            eq.mpr sorry (id (eq.mpr sorry (equiv.refl (Subtype fun (x : α) => quotient.mk' x = L))))))
      (equiv.sigma_congr_right
        fun (L : quotient_add_group.quotient s) => add_subgroup.left_coset_equiv_add_subgroup (quotient.out' L)))
    (equiv.sigma_equiv_prod (quotient_add_group.quotient s) ↥s)

end subgroup

namespace quotient_group

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

/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α/s`, then
there is a (typically non-canonical) bijection between the preimage of `t` in
`α` and the product `s × t`. -/
def preimage_mk_equiv_subgroup_times_set {α : Type u_1} [group α] (s : subgroup α) (t : set (quotient s)) : ↥(mk ⁻¹' t) ≃ ↥s × ↥t :=
  (fun
      (h :
      ∀ {x : quotient s} {a : α}, x ∈ t → a ∈ s → quotient.mk' (quotient.out' x * a) = quotient.mk' (quotient.out' x)) =>
      equiv.mk (fun (_x : ↥(mk ⁻¹' t)) => sorry) (fun (_x : ↥s × ↥t) => sorry) sorry sorry)
    sorry

end quotient_group

/--
We use the class `has_coe_t` instead of `has_coe` if the first argument is a variable,


/-
Copyright (c) 2023 Tian Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tian Chen
-/

import ineq.majorize
import data.fin.tuple.sort

open_locale big_operators

open finset

variables {α : Type*}
  [linear_ordered_add_comm_monoid α]
  [decidable_rel ((≤) : α → α → Prop)]

section

variables {n : ℕ} {a b : fin n → α}

lemma monotone.sort_eq_of_fn (ha : monotone a) :
  (univ.val.map a).sort (≤) = list.of_fn a :=
begin
  apply list.eq_of_perm_of_sorted _ (multiset.sort_sorted _ _) (list.monotone.of_fn_sorted ha),
  rw [← multiset.coe_eq_coe, multiset.sort_eq],
  show multiset.map _ ↑(list.fin_range n) = _,
  rw multiset.coe_map,
  congr,
  apply list.ext_le,
  { rw [list.length_map, list.length_fin_range, list.length_of_fn] },
  intros,
  rw [list.nth_le_of_fn', list.nth_le_map', list.nth_le_fin_range]
end

lemma antitone.sort_eq_of_fn (ha : antitone a) :
  (univ.val.map a).sort (≥) = list.of_fn a :=
monotone.sort_eq_of_fn ha.dual_right

lemma antitone.majorize (ha : antitone a) (hb : antitone b) :
  majorize a b ↔
    (∀ i, ((list.of_fn a).take i).sum ≤ ((list.of_fn b).take i).sum)
    ∧ ∑ i, a i = ∑ i, b i :=
begin
  simp_rw [← ha.sort_eq_of_fn, ← hb.sort_eq_of_fn],
  refl
end

end

variables {ι : Type*} [fintype ι] (l : ι → α)

/-- Sort a vector. -/
def sort_desc : fin (fintype.card ι) → α :=
  λ i, list.nth_le ((univ.val.map l).sort (≥)) i $
    by rw [multiset.length_sort, multiset.card_map]; exact i.2

lemma sort_desc_antitone : antitone (sort_desc l) :=
begin
  intros i j h,
  have : fintype.card ι = ((univ.val.map ((@order_dual.to_dual α) ∘ l)).sort (≤)).length,
  { rw [multiset.length_sort, multiset.card_map], refl },
  let f := fin.cast this,
  rw sort_desc,
  exact ((univ.val.map ((@order_dual.to_dual α) ∘ l)).sort_sorted (≤)).nth_le_mono
    (show f i ≤ f j, from h)
end

lemma of_fn_sort_desc : list.of_fn (sort_desc l) = (univ.val.map l).sort (≥) :=
begin
  rw sort_desc,
  apply list.ext_le,
  { rw [list.length_of_fn, multiset.length_sort, multiset.card_map], refl },
  intros,
  apply list.nth_le_of_fn'
end

lemma map_sort_desc : univ.val.map (sort_desc l) = univ.val.map l :=
begin
  show multiset.map _ ↑(list.fin_range _) = _,
  rw multiset.coe_map,
  rw ← multiset.sort_eq (≥) (univ.val.map l),
  congr,
  apply list.ext_le,
  { rw [list.length_map, list.length_fin_range, multiset.length_sort, multiset.card_map], refl },
  intros,
  rw [list.nth_le_map', list.nth_le_fin_range],
  refl
end

lemma sum_sort_desc : ∑ i, sort_desc l i = ∑ i, l i :=
begin
  rw [finset.sum_eq_multiset_sum, finset.sum_eq_multiset_sum, map_sort_desc]
end

theorem sort_desc_majorize_iff (a b : ι → α) :
  majorize (sort_desc a) (sort_desc b) ↔ majorize a b :=
begin
  rw [majorize_def, majorize_def,
    ← of_fn_sort_desc a, ← of_fn_sort_desc b,
    antitone.sort_eq_of_fn (sort_desc_antitone a),
    antitone.sort_eq_of_fn (sort_desc_antitone b),
    sum_sort_desc,
    sum_sort_desc]
end


import group.definitions -- definition of a group and a comm_group

/-
class group (G : Type) extends has_group_notation G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

and `comm_group G` has the extra axiom

`mul_comm : ∀ (x y : G), x * y = y * x`

You access these axioms with `group.mul_assoc`, `group.one_mul` etc.
-/

-- This entire project takes place in the mygroup namespace
namespace mygroup

/- Our goal is to prove the following theorems (in the order
  listed) :

`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
`eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹`
`mul_left_eq_self {a b : G} : a * b = b ↔ a = 1`
`eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹`
`inv_inv (a : G) : a ⁻¹ ⁻¹ = a`
`inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b`

and possibly more to come if we run into stuff we need.

We start with only `mul_assoc`, `one_mul` and `mul_left_inv`.

mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)
one_mul : ∀ (a : G), 1 * a = a
mul_left_inv : ∀ (a : G), a⁻¹ * a = 1

-/
namespace group

variables {G : Type} [group G]

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
  -- We want to prove b = c.
  -- the left hand side is 1 * b
  rw ←one_mul b,
  -- which is (a⁻¹ * a) * b
  rw ←mul_left_inv a,
  -- which is a⁻¹ * (a * b) by associativity
  rw mul_assoc,
  -- which is a⁻¹ * (a * c) by our hypothesis
  rw Habac,
  -- and now we do the same but bakwards
  rw [←mul_assoc, mul_left_inv, one_mul],
end

-- chance to use rwa
lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  rwa [←mul_assoc, mul_left_inv, one_mul],
end

theorem mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_left_inv,
end

theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_one,
end

-- new
lemma eq_inv_mul_iff_mul_eq {a x y : G} : x = a⁻¹ * y ↔ a * x = y :=
begin
  split,
    exact mul_eq_of_eq_inv_mul,
  intro h,
  apply mul_left_cancel a,
  rwa [←mul_assoc, mul_right_inv, one_mul],
end

-- new
lemma mul_right_cancel (a x y : G) (Habac : x * a = y * a) : x = y :=
begin
  apply_fun (λ t, t * a⁻¹) at Habac,
  rwa [mul_assoc, mul_assoc, mul_right_inv, mul_one, mul_one] at Habac,
end

lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  apply mul_right_cancel c,
  rw h, simp [mul_assoc, mul_left_inv, mul_one],
end

--new
lemma eq_mul_inv_iff_mul_eq {a b c : G} : a = b * c⁻¹ ↔ a * c = b :=
begin
  split,
    intro h,
    apply mul_right_cancel c⁻¹,
    rw [mul_assoc, mul_right_inv, mul_one, h],
  exact eq_mul_inv_of_mul_eq,
end

--new
lemma eq_mul_of_inv_mul_eq {a x y : G} (h : a⁻¹ * x = y) : x = a * y :=
begin
  rw [←h, ←mul_assoc, mul_right_inv, one_mul]
end

lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  rw ←eq_mul_inv_iff_mul_eq,
  rw mul_right_inv,
end

lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
begin
  rwa [←eq_mul_inv_iff_mul_eq, one_mul] at h,
end

lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  apply mul_left_cancel a,
  rw [mul_right_inv, h]
end

lemma inv_inv (a : G) : a ⁻¹ ⁻¹ = a :=
begin
  apply mul_left_cancel a⁻¹,
  rw [mul_left_inv, mul_right_inv]
end

end group

end mygroup


theorem and_commutative (p q : Prop) : p ∧ q → q ∧ p :=
assume hpq : p ∧ q,
have hp : p, from and.left hpq,
have hq : q, from and.right hpq,
show q ∧ p, from and.intro hq hp


/-
# Orders

Groups, rings, fields, modules etc are in the "algebra hierarchy".

Metric and topological spaces are in the "topology hierarchy".

The other important hierarchy is the "order hierarchy".

It starts with partially ordered sets, and then goes on to lattices.

Because I like algebra, let's demonstrate the order hierarchy by
making an algebraic type, namely the type of subgroups of a group G,
and then working up the order hierarchy with it. Subgroups of a group
are ordered by inclusion, and this is where we shall start. We will
then define infs and sups, and bot and top, and go on from there.

-/
import tactic

-- We will be using all of the theory of subsets of a type
-- without further comment (e.g. `inter_subset_left A B : A ∩ B ⊆ A`)
-- so let's open the `set` namespace.

open set

-- The type of subgroups of a group G is called `subgroup G` in Lean.
-- It already has a lattice structure in Lean.

-- So let's just redo the entire theory and call it `my_subgroup G`.

/-- The type of subgroups of a group `G`. -/
structure my_subgroup (G : Type) [group G] :=
-- A subgroup of G is a sub*set* of G, called `carrier`
(carrier : set G)
-- and then axioms saying it's closed under the group structure (i.e. *, 1, ⁻¹)
(mul_mem {a b : G} : a ∈ carrier → b ∈ carrier → a * b ∈ carrier)
(one_mem : (1 : G) ∈ carrier)
(inv_mem {a : G} : a ∈ carrier → a⁻¹ ∈ carrier)

namespace my_subgroup

/-
Note in particular that we have a function `my_subgroup.carrier : my_subgroup G → set G`,
sending a subgroup of `G` to the underlying subset (`set G` is the type
of subsets of G).
-/

-- Let G be a group, let H,J,K be subgroups of G, and let a,b,c be elements of G.
variables {G : Type} [group G] (H J K : my_subgroup G) (a b c : G)

/- # Extensionality

One of the first things you should consider proving about a newly-defined
type is an extensionality lemma: a sensible criterion to check that
two terms are equal. When are two subgroups of `G` equal? A subgroup
is defined by four things: a subset, and three proofs. But two proofs
of a proposition `P` are equal by definition in Lean, so two subgroups
of `G` are equal iff their underlying subsets are equal, which is
true iff their underlying subsets have the same elements. Let's give
names to these basic results because they'll show up everywhere.

Let's start by showing that two subgroups are equal if their
underlying subsets are equal. This is precisely the statement that
`∀ H J : my_subgroup G, H.carrier = J.carrier → H = J`, and a good name
for this would be `carrier_injective`. We adopt the Lean tradition
of putting as many things to the left of the `:` as we can; it
doesn't change the statement of the theorem.
-/

lemma carrier_injective (H J : my_subgroup G) (h : H.carrier = J.carrier) : H = J :=
begin
  -- take H and J apart
  cases H, cases J,
  -- and note that they are the same set, and then a bunch of proofs
  -- which are equal by definition, so it's obvious
  simp * at *,
end

-- Now let's prove that two subgroups are equal iff they have the same elements.
-- This is the most useful "extensionality lemma" so we tag it `@[ext]`.
@[ext] theorem ext {H J : my_subgroup G} (h : ∀ (x : G), x ∈ H.carrier ↔ x ∈ J.carrier) :
  H = J :=
begin
  -- it suffices to prove the subsets are equal
  apply carrier_injective,
  -- Now let's use extensionality for subsets
  ext x,
  exact h x,
end

-- We also want the `iff` version of this.
theorem ext_iff {H J : my_subgroup G} : H = J ↔ ∀ (x : G), x ∈ H.carrier ↔ x ∈ J.carrier :=
begin
  sorry
end

/-

## Partial orders

-/

-- These are familiar to most mathematicians. We will put a partial order
-- structure on `my_subgroup G`. In other words, we will create a term of
-- type `partial_order (my_subgroup G)`.

-- Let's define `H ≤ J` to mean `H.carrier ⊆ J.carrier`, using the `has_le` notation typeclass
instance : has_le (my_subgroup G) := ⟨λ H J, H.carrier ⊆ J.carrier⟩

-- "tidy" is a one-size-fits-all tactic which solves certain kinds of "follow your nose" goals.
instance : partial_order (my_subgroup G) :=
{ le := (≤),
  le_refl := by tidy,
  le_trans := by tidy,
  le_antisymm := by tidy }

/- Here is a second proof. If X → Y is injective, and Y is partially ordered,
then X inherits a partial order. This construction (it's not a theorem, because
it involves data) is called `partial_order.lift`. Applying it to the injection
`my_subgroup.carrier` and the fact that Lean already knows that `set G` is partially
ordered, turns into this second construction,  (which I won't call an `instance`
because if I did then I would have committed the sin of making two terms of
type `partial_order (my_subgroup G)`, and `partial_order (my_subgroup G)` is a class so
should have at most one instance):
-/

-- partial_order.lift is the function which pulls a partial order back along an injection.
example : partial_order (my_subgroup G) := partial_order.lift my_subgroup.carrier carrier_injective

/- Note that we magically just inherited `<` notatation, because
   `#check partial_order` tells you that `partial_order` extends `preorder`,
   which extends `has_lt`, which is a notation typeclass. In other words,
   `#check (H < J)` makes sense, and is a `Prop`. In fact `H < J` is
  defined to mean `H ≤ J ∧ ¬ (J ≤ H)`.

# From partial orders to lattices.

Let's now prove that `my_subgroup G` is a `semilattice_inf_top`. This is a class
which extends `partial_order` -- it is a partial order equipped with a top element,
and a function `inf : my_subgroup G → my_subgroup G → my_subgroup G` (called "inf" or "meet"
  or "greatest lower bound", satisfying some axioms. In our case, `top`
  will be the subgroup `G` of `G` (or more precisely `univ`), and `inf` will
  just be intersection. The work we need to do is to check that these are
  subgroups, and to prove the axioms for a `semilattice_inf_top`, which
  we'll come to later.

First let's define `top` -- the biggest subgroup. The underlying carrier
is `univ : set G`, i.e. the subset `G` of `G`. I'll leave it to you to prove
that the subgroup axioms hold!

The useful piece of interface for `univ` you'll need is `mem_univ g : g ∈ univ`.

-/
def top : my_subgroup G :=
{ carrier := set.univ,
  mul_mem := begin
    sorry
  end,
  one_mem := begin
    sorry
  end,
  inv_mem := begin
    sorry
  end }

-- Add the `⊤` notation (typed with `\top`) for this subgroup:
instance : has_top (my_subgroup G) := ⟨top⟩

-- Now `#check (⊤ : my_subgroup G)` works

/-
  We'll now prove the theorem that the intersection of
  two subgroups is a subgroup. This is a *definition* in Lean,
  indeed it is a construction which given two subgroups `H` and `K` of `G`
  produces a third subgroup `H ⊓ K` (Lean's notation for `inf H K`).

  The part of the interface for `∩` you'll need is that `a ∈ B ∩ C` is
  definitionally equal to `a ∈ B ∧ a ∈ C`, so you can use `split`
  if you have a goal `⊢ a ∈ B ∩ C`, and you can use `cases h` if you
  have a hypothesis `h : a ∈ B ∩ C`. Don't forget `mul_mem H`, `one_mem H`
  and `inv_mem H`, the axioms for `H` if `H : my_subgroup G`.
-/

/-- "Theorem" : intersection of two my_subgroups is a my_subgroup -/
definition inf (H K : my_subgroup G) : my_subgroup G :=
{ carrier := H.carrier ∩ K.carrier,
  mul_mem := begin
    sorry
  end,
  one_mem := begin
    sorry
  end,
  inv_mem := begin
    sorry
  end }

-- Add the `⊓` notation (type with `\inf`) for the intersection (inf) of two subgroups:
instance : has_inf (my_subgroup G) := ⟨inf⟩

-- We now check the four axioms for a semilattice_inf_top.
-- They are called `le_top`, `inf_le_left`, `inf_le_right` and `le_inf`.
-- You might be able to guess the statementss of the axioms
-- from their names.

lemma le_top (H : my_subgroup G) : H ≤ ⊤ :=
begin
  sorry
end

lemma inf_le_left (H K : my_subgroup G) : H ⊓ K ≤ H :=
begin
  -- by definition this says `H.carrier ∩ K.carrier ⊆ H.carrier`
  change H.carrier ∩ K.carrier ⊆ H.carrier,
  -- now try `library_search`, to find that this is called `inter_subset_left
  apply inter_subset_left,
end

lemma inf_le_right (H K : my_subgroup G) : H ⊓ K ≤ K :=
begin
  sorry
end

-- Can you use `library_search`, or other methods, to find the name of the
-- statement that if `A B C : set G` then `A ⊆ B → A ⊆ C → A ⊆ (B ∩ C)`?
lemma le_inf (H J K : my_subgroup G) (h1 : H ≤ J) (h2 : H ≤ K) : H ≤ J ⊓ K :=
begin
  sorry
end

-- Now we're ready to make the instance.
instance : semilattice_inf_top (my_subgroup G) :=
{ top := top,
  le_top := le_top,
  inf := inf,
  inf_le_left := inf_le_left,
  inf_le_right := inf_le_right,
  le_inf := le_inf,
  .. my_subgroup.partial_order } -- don't forget to inlude the partial order

/- The logic behind `semilattice_inf_top` is that it is the simplest class
which is closed under all finite "meet"s. The meet of 0 subgroups
is `top`, the meet of one subgroup is the subgroup, the meet of two
subgroups is their inf, and for three or more you proceed by induction.

We could now go on to make a `semilattice_sup_bot` structure, and then
a lattice structure. But let's jump straight to the strongest type
in the order hierarchy -- a `complete_lattice`. This has arbitrary `Inf` and `Sup`s.

So let's first note that we can do better than finite intersections -- we can take
arbitrary intersections! Let's now define the `Inf` of an arbitrary
set of subgroups of `G`.

The part of the interface for sets you'll need to know here is that if `S` is a
set of subsets of `G`, then `⋂₀ S` is notation for their intersection, and
to work with it you'll need to know
`set.mem_sInter : g ∈ ⋂₀ S ↔ ∀ (U : set G), U ∈ S → g ∈ U`.
-/

def Inf (S : set (my_subgroup G)) : my_subgroup G :=
{ carrier := Inf (my_subgroup.carrier '' S),
  mul_mem :=  begin
    sorry
  end,
  one_mem := begin
    sorry
  end,
  inv_mem := begin
    sorry
  end }

-- We now equip `my_subgroup G` with an Inf. I think the notation is `⨅`, or `\Inf`,
-- but I find it hard to use, and `#print notation ⨅` returns garbage.
instance : has_Inf (my_subgroup G) := ⟨Inf⟩

/- # Complete lattices

Let's jump straight from `semilattice_inf_bot` to `complete_lattice`.
A complete lattice has arbitrary Infs and arbitrary Sups, and satisfies
some other axioms which you can probably imagine. Our next goal
is to make `my_subgroup G` into a complete lattice. We will do it in two ways.
The first way is to show that if our `Inf` satisfies
`(∀ (S : set (my_subgroup G)), is_glb S (Inf S))` then we can build a complete
lattice from this, using `complete_lattice_of_Inf`.
-/

instance : complete_lattice (my_subgroup G) := complete_lattice_of_Inf _ begin
-- ⊢ ∀ (s : set (my_subgroup G)), is_glb s (has_Inf.Inf s)
--  See if you can figure out what this says, and how to prove it.
-- You might find the function `is_glb.of_image` useful.
  sorry
end

/- Now let me show you another way to do this.

# Galois connections

A Galois conection is a pair of adjoint functors between two
partially ordered sets, considered as categories whose hom sets Hom(H,J) have
size 1 if H ≤ J and size 0 otherwise. In other words, a Galois
connection between two partial orders α and β is a pair of monotone functions
`l : α → β` and `u : β → α` such that `∀ (a : α) (b : β), l a ≤ b ↔ a ≤ u b`.

There is an example coming from Galois theory (between subfields and subgroups),
and an example coming from classical algebraic geometry (between affine
varieties and ideals); note that in both cases you have to use the opposite
partial order on one side to make everything covariant.

The examples we want to keep in mind here are:
1) α = subsets of G, β = subgroups of G, l = "subgroup generated by", u = `carrier`
2) X : Type, α := set (set X), β := topologies on X,
  l = topology generated by a collection of open sets, u = the open sets regarded as subsets.

As you can imagine, there are a bunch of abstract theorems with simple proofs
proved for Galois connections. You can see them by `#check galois_connection`,
jumping to the definition, and reading the next 150 lines of the mathlib file
after the definition. Examples of theorems you might recognise from contexts
where you have seen this before:

lemma le_u_l (a : α) : a ≤ u (l a) := ...

lemma l_u_le (b : β) : l (u b) ≤ b := ...

lemma u_l_u_eq_u : u ∘ l ∘ u = u := ...

lemma l_u_l_eq_l : l ∘ u ∘ l = l := ...

# Galois insertions

A particularly cool kind of Galois connection is a Galois insertion, which
is a Galois connection such that `l ∘ u = id`. This is true for both
the examples we're keeping in mind (the subgroup of `G` generated
by a subgroup is the same subgroup; the topology on `X` generated by a
topology is the same topology).

Our new goal: let's make subgroups of a group into a complete lattice,
using the fact that `carrier` is part of a Galois insertion.

-/

-- The adjoint functor to the `carrier` functor is the `span` functor
-- from subsets to my_subgroups. Here we will CHEAT by using `Inf` to
-- define `span`. We could have built `span` directly with
-- an inductive definition.
def span (S : set G) : my_subgroup G := Inf {H : my_subgroup G | S ⊆ H.carrier}

-- Here are some theorems about it.
lemma monotone_carrier : monotone (my_subgroup.carrier : my_subgroup G → set G) :=
begin
  sorry
end

lemma monotone_span : monotone (span : set G → my_subgroup G) :=
begin
  sorry
end

lemma subset_span (S : set G) : S ≤ (span S).carrier :=
begin
  sorry
end

lemma span_my_subgroup (H : my_subgroup G) : span H.carrier = H :=
begin
  sorry
end

-- We have proved all the things we need to show that `span` and `carrier`
-- form a Galois insertion, using `galois_insertion.monotone_intro`.
def gi_my_subgroup : galois_insertion (span : set G → my_subgroup G) (my_subgroup.carrier : my_subgroup G → set G) :=
galois_insertion.monotone_intro monotone_carrier monotone_span subset_span span_my_subgroup

-- Note that `set G` is already a complete lattice:
example : complete_lattice (set G) := by apply_instance

-- and now `my_subgroup G` can also be made into a complete lattice, by
-- a theorem about Galois insertions. Again, I don't use `instance`
-- because we already made the instance above.

example : complete_lattice (my_subgroup G) := galois_insertion.lift_complete_lattice gi_my_subgroup

end my_subgroup

-- Because Alex defined the topology generated by a collection of subsets
-- yesterday, I'll show you how you can use Galois insertions to prove
-- that if `X : Type` then the type of topological space structures on `X`
-- is a complete lattice. We use the topology generated by a collection
-- of subsets, which is a functor adjoint to the forgetful functor.

-- We start by literally copying some stuff from Alex' talk.

open set

@[ext]
class topological_space (X : Type) :=
  (is_open : set X → Prop) -- why set X → Prop not set (set X)? former plays
                           -- nicer with typeclasses later
  (univ_mem : is_open univ)
  (union : ∀ (B : set (set X)) (h : ∀ b ∈ B, is_open b), is_open (⋃₀ B))
  (inter : ∀ (A B : set X) (hA : is_open A) (hB : is_open B), is_open (A ∩ B))

namespace topological_space

def forget {X : Type} : topological_space X → set (set X) := @is_open X

/-- The open sets of the least topology containing a collection of basic sets. -/
inductive generated_open (X : Type) (g : set (set X)) : set X → Prop
| basic  : ∀ s ∈ g, generated_open s
| univ   : generated_open univ
| inter  : ∀s t, generated_open s → generated_open t → generated_open (s ∩ t)
| sUnion : ∀k, (∀ s ∈  k, generated_open s) → generated_open (⋃₀ k)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from {X : Type} (g : set (set X)) : topological_space X :=
{ is_open   := generated_open X g,
  univ_mem  := sorry,
  inter     := sorry,
  union     := sorry }

-- Recall that `topological_space X` is the type of topological space structures
-- on `X`. Our Galois insertion will use the adjoint functors
-- `generate_from` and `is_open`.

-- We'd better start by giving the collection of topological space structures on X
-- a partial order:

instance (X : Type) : partial_order (topological_space X) :=
partial_order.lift (forget)
begin
  -- need to show that a top space is determined by its open sets
  intros τ₁ τ₂ h,
  cases τ₁, cases τ₂,
  simp [forget, *] at *,
end

-- Exercise (LONG): First, show that we have a Galois insertion.

lemma monotone_is_open {X : Type} :
  monotone (forget : topological_space X → set (set X)) :=
begin
  sorry
end

lemma monotone_span {X : Type} :
  monotone (generate_from : set (set X) → topological_space X) :=
begin
  sorry
end

lemma subset_forget {X : Type} (Us : set (set X)) :
  Us ≤ forget (generate_from Us) :=
begin
  sorry
end

lemma generate_forget {X : Type} (τ : topological_space X) :
  generate_from (forget τ) = τ :=
begin
  sorry
end

def gi_top (X : Type) :
  galois_insertion (generate_from : set (set X) → topological_space X)
    (forget : topological_space X → set (set X)) :=
galois_insertion.monotone_intro monotone_is_open monotone_span subset_forget generate_forget

/-
Then deduce that the type of topological space structures on X
is a complete lattice, i.e. that there is a good definition of
arbitrary Infs and Sups of topological space structures on a type, and
they satisfy all the correct properties of Infs and Sups. In
other words,
-/

example (X : Type) : complete_lattice (topological_space X) :=
  galois_insertion.lift_complete_lattice (gi_top X)

end topological_space


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Irrationality of real numbers.
-/
import data.real.basic data.nat.prime

open real rat

def irrational (x : ℝ) := ¬ ∃ q : ℚ, x = q

theorem sqrt_two_irrational : irrational (sqrt 2)
| ⟨⟨n, d, h, c⟩, e⟩ := begin
  simp [num_denom', mk_eq_div] at e,
  have := mul_self_sqrt (le_of_lt two_pos),
  have d0 : (0:ℝ) < d := nat.cast_pos.2 h,
  rw [e, div_mul_div, div_eq_iff_mul_eq (ne_of_gt $ mul_pos d0 d0),
      ← int.cast_mul, ← int.nat_abs_mul_self] at this,
  revert c this, generalize : n.nat_abs = a, intros,
  have E : 2 * (d * d) = a * a := (@nat.cast_inj ℝ _ _ _ _ _).1 (by simpa),
  have ae : 2 ∣ a,
  { refine (or_self _).1 (nat.prime_two.dvd_mul.1 _),
    rw ← E, apply dvd_mul_right },
  have de : 2 ∣ d,
  { have := mul_dvd_mul ae ae,
    refine (or_self _).1 (nat.prime_two.dvd_mul.1 _),
    rwa [← E, nat.mul_dvd_mul_iff_left (nat.succ_pos 1)] at this },
  exact nat.not_coprime_of_dvd_of_dvd (nat.lt_succ_self _) ae de c
end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import field_theory.finite.basic

/-!
# The Chevalley–Warning theorem

This file contains a proof of the Chevalley–Warning theorem.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

## Main results

1. Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
   such that the total degree of `f` is less than `(q-1)` times the cardinality of `σ`.
   Then the evaluation of `f` on all points of `σ → K` (aka `K^σ`) sums to `0`.
   (`sum_mv_polynomial_eq_zero`)
2. The Chevalley–Warning theorem (`char_dvd_card_solutions`).
   Let `f i` be a finite family of multivariate polynomials
   in finitely many variables (`X s`, `s : σ`) such that
   the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
   Then the number of common solutions of the `f i`
   is divisible by the characteristic of `K`.

## Notation

- `K` is a finite field
- `q` is notation for the cardinality of `K`
- `σ` is the indexing type for the variables of a multivariate polynomial ring over `K`

-/

universes u v

open_locale big_operators

section finite_field
open mv_polynomial function (hiding eval) finset finite_field

variables {K : Type*} {σ : Type*} [fintype K] [field K] [fintype σ]
local notation `q` := fintype.card K

lemma mv_polynomial.sum_mv_polynomial_eq_zero [decidable_eq σ] (f : mv_polynomial σ K)
  (h : f.total_degree < (q - 1) * fintype.card σ) :
  (∑ x, eval x f) = 0 :=
begin
  haveI : decidable_eq K := classical.dec_eq K,
  calc (∑ x, eval x f)
        = ∑ x : σ → K, ∑ d in f.support, f.coeff d * ∏ i, x i ^ d i : by simp only [eval_eq']
    ... = ∑ d in f.support, ∑ x : σ → K, f.coeff d * ∏ i, x i ^ d i : sum_comm
    ... = 0 : sum_eq_zero _,
  intros d hd,
  obtain ⟨i, hi⟩ : ∃ i, d i < q - 1, from f.exists_degree_lt (q - 1) h hd,
  calc (∑ x : σ → K, f.coeff d * ∏ i, x i ^ d i)
        = f.coeff d * (∑ x : σ → K, ∏ i, x i ^ d i) : mul_sum.symm
    ... = 0                                         : (mul_eq_zero.mpr ∘ or.inr) _,
  calc (∑ x : σ → K, ∏ i, x i ^ d i)
        = ∑ (x₀ : {j // j ≠ i} → K) (x : {x : σ → K // x ∘ coe = x₀}), ∏ j, (x : σ → K) j ^ d j :
              (fintype.sum_fiberwise _ _).symm
    ... = 0 : fintype.sum_eq_zero _ _,
  intros x₀,
  let e : K ≃ {x // x ∘ coe = x₀} := (equiv.subtype_equiv_codomain _).symm,
  calc (∑ x : {x : σ → K // x ∘ coe = x₀}, ∏ j, (x : σ → K) j ^ d j)
        = ∑ a : K, ∏ j : σ, (e a : σ → K) j ^ d j : (e.sum_comp _).symm
    ... = ∑ a : K, (∏ j, x₀ j ^ d j) * a ^ d i    : fintype.sum_congr _ _ _
    ... = (∏ j, x₀ j ^ d j) * ∑ a : K, a ^ d i    : by rw mul_sum
    ... = 0                                       : by rw [sum_pow_lt_card_sub_one _ hi, mul_zero],
  intros a,
  let e' : {j // j = i} ⊕ {j // j ≠ i} ≃ σ := equiv.sum_compl _,
  letI : unique {j // j = i} :=
  { default := ⟨i, rfl⟩, uniq := λ ⟨j, h⟩, subtype.val_injective h },
  calc (∏ j : σ, (e a : σ → K) j ^ d j)
        = (e a : σ → K) i ^ d i * (∏ (j : {j // j ≠ i}), (e a : σ → K) j ^ d j) :
        by { rw [← e'.prod_comp, fintype.prod_sum_type, univ_unique, prod_singleton], refl }
    ... = a ^ d i * (∏ (j : {j // j ≠ i}), (e a : σ → K) j ^ d j) :
        by rw equiv.subtype_equiv_codomain_symm_apply_eq
    ... = a ^ d i * (∏ j, x₀ j ^ d j) : congr_arg _ (fintype.prod_congr _ _ _) -- see below
    ... = (∏ j, x₀ j ^ d j) * a ^ d i : mul_comm _ _,
  { -- the remaining step of the calculation above
    rintros ⟨j, hj⟩,
    show (e a : σ → K) j ^ d j = x₀ ⟨j, hj⟩ ^ d j,
    rw equiv.subtype_equiv_codomain_symm_apply_ne, }
end

variables [decidable_eq K] [decidable_eq σ]

/-- The Chevalley–Warning theorem.
Let `(f i)` be a finite family of multivariate polynomials
in finitely many variables (`X s`, `s : σ`) over a finite field of characteristic `p`.
Assume that the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
Then the number of common solutions of the `f i` is divisible by `p`. -/
theorem char_dvd_card_solutions_family (p : ℕ) [char_p K p]
  {ι : Type*} {s : finset ι} {f : ι → mv_polynomial σ K}
  (h : (∑ i in s, (f i).total_degree) < fintype.card σ) :
  p ∣ fintype.card {x : σ → K // ∀ i ∈ s, eval x (f i) = 0} :=
begin
  have hq : 0 < q - 1, { rw [← fintype.card_units, fintype.card_pos_iff], exact ⟨1⟩ },
  let S : finset (σ → K) := { x ∈ univ | ∀ i ∈ s, eval x (f i) = 0 },
  have hS : ∀ (x : σ → K), x ∈ S ↔ ∀ (i : ι), i ∈ s → eval x (f i) = 0,
  { intros x, simp only [S, true_and, sep_def, mem_filter, mem_univ], },
  /- The polynomial `F = ∏ i in s, (1 - (f i)^(q - 1))` has the nice property
  that it takes the value `1` on elements of `{x : σ → K // ∀ i ∈ s, (f i).eval x = 0}`
  while it is `0` outside that locus.
  Hence the sum of its values is equal to the cardinality of
  `{x : σ → K // ∀ i ∈ s, (f i).eval x = 0}` modulo `p`. -/
  let F : mv_polynomial σ K := ∏ i in s, (1 - (f i)^(q - 1)),
  have hF : ∀ x, eval x F = if x ∈ S then 1 else 0,
  { intro x,
    calc eval x F = ∏ i in s, eval x (1 - f i ^ (q - 1)) : eval_prod s _ x
              ... = if x ∈ S then 1 else 0 : _,
    simp only [(eval x).map_sub, (eval x).map_pow, (eval x).map_one],
    split_ifs with hx hx,
    { apply finset.prod_eq_one,
      intros i hi,
      rw hS at hx,
      rw [hx i hi, zero_pow hq, sub_zero], },
    { obtain ⟨i, hi, hx⟩ : ∃ (i : ι), i ∈ s ∧ eval x (f i) ≠ 0,
      { simpa only [hS, not_forall, not_imp] using hx },
      apply finset.prod_eq_zero hi,
      rw [pow_card_sub_one_eq_one (eval x (f i)) hx, sub_self], } },
  -- In particular, we can now show:
  have key : ∑ x, eval x F = fintype.card {x : σ → K // ∀ i ∈ s, eval x (f i) = 0},
  rw [fintype.card_of_subtype S hS, card_eq_sum_ones, nat.cast_sum, nat.cast_one,
      ← fintype.sum_extend_by_zero S, sum_congr rfl (λ x hx, hF x)],
  -- With these preparations under our belt, we will approach the main goal.
  show p ∣ fintype.card {x // ∀ (i : ι), i ∈ s → eval x (f i) = 0},
  rw [← char_p.cast_eq_zero_iff K, ← key],
  show ∑ x, eval x F = 0,
  -- We are now ready to apply the main machine, proven before.
  apply F.sum_mv_polynomial_eq_zero,
  -- It remains to verify the crucial assumption of this machine
  show F.total_degree < (q - 1) * fintype.card σ,
  calc F.total_degree ≤ ∑ i in s, (1 - (f i)^(q - 1)).total_degree : total_degree_finset_prod s _
                  ... ≤ ∑ i in s, (q - 1) * (f i).total_degree     : sum_le_sum $ λ i hi, _ -- see ↓
                  ... = (q - 1) * (∑ i in s, (f i).total_degree)   : mul_sum.symm
                  ... < (q - 1) * (fintype.card σ)                 : by rwa mul_lt_mul_left hq,
  -- Now we prove the remaining step from the preceding calculation
  show (1 - f i ^ (q - 1)).total_degree ≤ (q - 1) * (f i).total_degree,
  calc (1 - f i ^ (q - 1)).total_degree
        ≤ max (1 : mv_polynomial σ K).total_degree (f i ^ (q - 1)).total_degree :
        total_degree_sub _ _
    ... ≤ (f i ^ (q - 1)).total_degree : by simp only [max_eq_right, nat.zero_le, total_degree_one]
    ... ≤ (q - 1) * (f i).total_degree : total_degree_pow _ _
end

/-- The Chevalley–Warning theorem.
Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
over a finite field of characteristic `p`.
Assume that the total degree of `f` is less than the cardinality of `σ`.
Then the number of solutions of `f` is divisible by `p`.
See `char_dvd_card_solutions_family` for a version that takes a family of polynomials `f i`. -/
theorem char_dvd_card_solutions (p : ℕ) [char_p K p]
  {f : mv_polynomial σ K} (h : f.total_degree < fintype.card σ) :
  p ∣ fintype.card {x : σ → K // eval x f = 0} :=
begin
  let F : unit → mv_polynomial σ K := λ _, f,
  have : ∑ i : unit, (F i).total_degree < fintype.card σ,
  { simpa only [fintype.univ_punit, sum_singleton] using h, },
  have key := char_dvd_card_solutions_family p this,
  simp only [F, fintype.univ_punit, forall_eq, mem_singleton] at key,
  convert key,
end

end finite_field


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro
-/
import data.real.sqrt

/-!
# The complex numbers

The complex numbers are modelled as ℝ^2 in the obvious way and it is shown that they form a field
of characteristic zero. The result that the complex numbers are algebraically closed, see
`field_theory.algebraic_closure`.
-/

open_locale big_operators

/-! ### Definition and basic arithmmetic -/

/-- Complex numbers consist of two `real`s: a real part `re` and an imaginary part `im`. -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

noncomputable instance : decidable_eq ℂ := classical.dec_eq _

/-- The equivalence between the complex numbers and `ℝ × ℝ`. -/
def equiv_real_prod : ℂ ≃ (ℝ × ℝ) :=
{ to_fun := λ z, ⟨z.re, z.im⟩,
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := λ ⟨x, y⟩, rfl,
  right_inv := λ ⟨x, y⟩, rfl }

@[simp] theorem equiv_real_prod_apply (z : ℂ) : equiv_real_prod z = (z.re, z.im) := rfl
theorem equiv_real_prod_symm_re (x y : ℝ) : (equiv_real_prod.symm (x, y)).re = x := rfl
theorem equiv_real_prod_symm_im (x y : ℝ) : (equiv_real_prod.symm (x, y)).im = y := rfl

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨a, b⟩ := rfl

@[ext]
theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

instance : has_coe ℝ ℂ := ⟨λ r, ⟨r, 0⟩⟩

@[simp, norm_cast] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp, norm_cast] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl
lemma of_real_def (r : ℝ) : (r : ℂ) = ⟨r, 0⟩ := rfl

@[simp, norm_cast] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

instance : has_zero ℂ := ⟨(0 : ℝ)⟩
instance : inhabited ℂ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℂ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl

@[simp] lemma bit0_re (z : ℂ) : (bit0 z).re = bit0 z.re := rfl
@[simp] lemma bit1_re (z : ℂ) : (bit1 z).re = bit1 z.re := rfl
@[simp] lemma bit0_im (z : ℂ) : (bit0 z).im = bit0 z.im := eq.refl _
@[simp] lemma bit1_im (z : ℂ) : (bit1 z).im = bit0 z.im := add_zero _

@[simp, norm_cast] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s :=
ext_iff.2 $ by simp

@[simp, norm_cast] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r :=
ext_iff.2 $ by simp [bit0]

@[simp, norm_cast] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r :=
ext_iff.2 $ by simp [bit1]

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl
@[simp, norm_cast] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

instance : has_sub ℂ := ⟨λ z w, ⟨z.re - w.re, z.im - w.im⟩⟩

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl
@[simp, norm_cast] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

lemma of_real_mul_re (r : ℝ) (z : ℂ) : (↑r * z).re = r * z.re := by simp
lemma of_real_mul_im (r : ℝ) (z : ℂ) : (↑r * z).im = r * z.im := by simp
lemma of_real_mul' (r : ℝ) (z : ℂ) : (↑r * z) = ⟨r * z.re, r * z.im⟩ :=
ext (of_real_mul_re _ _) (of_real_mul_im _ _)

/-! ### The imaginary unit, `I` -/

/-- The imaginary unit. -/
def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_im : I.im = 1 := rfl

@[simp] lemma I_mul_I : I * I = -1 := ext_iff.2 $ by simp
lemma I_mul (z : ℂ) : I * z = ⟨-z.im, z.re⟩ :=
ext_iff.2 $ by simp

lemma I_ne_zero : (I : ℂ) ≠ 0 := mt (congr_arg im) zero_ne_one.symm

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z :=
ext_iff.2 $ by simp

/-! ### Commutative ring instance and lemmas -/

instance : comm_ring ℂ :=
by refine_struct { zero := (0 : ℂ), add := (+), neg := has_neg.neg, sub := has_sub.sub, one := 1,
  mul := (*), nsmul := @nsmul_rec _ ⟨(0)⟩ ⟨(+)⟩, npow := @npow_rec _ ⟨(1)⟩ ⟨(*)⟩,
  gsmul := @gsmul_rec _ ⟨(0)⟩ ⟨(+)⟩ ⟨has_neg.neg⟩ };
intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf}

instance re.is_add_group_hom : is_add_group_hom complex.re :=
{ map_add := complex.add_re }

instance im.is_add_group_hom : is_add_group_hom complex.im :=
{ map_add := complex.add_im }

@[simp] lemma I_pow_bit0 (n : ℕ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [pow_bit0', I_mul_I]

@[simp] lemma I_pow_bit1 (n : ℕ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [pow_bit1', I_mul_I]

/-! ### Complex conjugation -/

/-- The complex conjugate. -/
def conj : ℂ →+* ℂ :=
begin
  refine_struct { to_fun := λ z : ℂ, (⟨z.re, -z.im⟩ : ℂ), .. };
  { intros, ext; simp [add_comm], },
end

@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := rfl

@[simp] lemma conj_of_real (r : ℝ) : conj r = r := ext_iff.2 $ by simp [conj]

@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp

@[simp] lemma conj_bit0 (z : ℂ) : conj (bit0 z) = bit0 (conj z) := ext_iff.2 $ by simp [bit0]
@[simp] lemma conj_bit1 (z : ℂ) : conj (bit1 z) = bit1 (conj z) := ext_iff.2 $ by simp [bit0]

@[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp

@[simp] lemma conj_conj (z : ℂ) : conj (conj z) = z :=
ext_iff.2 $ by simp

lemma conj_involutive : function.involutive conj := conj_conj

lemma conj_bijective : function.bijective conj := conj_involutive.bijective

lemma conj_inj {z w : ℂ} : conj z = conj w ↔ z = w :=
conj_bijective.1.eq_iff

@[simp] lemma conj_eq_zero {z : ℂ} : conj z = 0 ↔ z = 0 :=
by simpa using @conj_inj z 0

lemma eq_conj_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r :=
⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩,
 λ ⟨h, e⟩, by rw [e, conj_of_real]⟩

lemma eq_conj_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z :=
eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩

lemma eq_conj_iff_im {z : ℂ} : conj z = z ↔ z.im = 0 :=
⟨λ h, add_self_eq_zero.mp (neg_eq_iff_add_eq_zero.mp (congr_arg im h)),
  λ h, ext rfl (neg_eq_iff_add_eq_zero.mpr (add_self_eq_zero.mpr h))⟩

instance : star_ring ℂ :=
{ star := λ z, conj z,
  star_involutive := λ z, by simp,
  star_mul := λ r s, by { ext; simp [mul_comm], },
  star_add := by simp, }

/-! ### Norm squared -/

/-- The norm squared function. -/
@[pp_nodot] def norm_sq : monoid_with_zero_hom ℂ ℝ :=
{ to_fun := λ z, z.re * z.re + z.im * z.im,
  map_zero' := by simp,
  map_one' := by simp,
  map_mul' := λ z w, by { dsimp, ring } }

lemma norm_sq_apply (z : ℂ) : norm_sq z = z.re * z.re + z.im * z.im := rfl

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

lemma norm_sq_eq_conj_mul_self {z : ℂ} : (norm_sq z : ℂ) = conj z * z :=
by { ext; simp [norm_sq, mul_comm], }

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := norm_sq.map_zero
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := norm_sq.map_one
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
⟨λ h, ext
  (eq_zero_of_mul_self_add_mul_self_eq_zero h)
  (eq_zero_of_mul_self_add_mul_self_eq_zero $ (add_comm _ _).trans h),
 λ h, h.symm ▸ norm_sq_zero⟩

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
(norm_sq_nonneg z).lt_iff_ne.trans $ not_congr (eq_comm.trans norm_sq_eq_zero)

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
norm_sq.map_mul z w

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm, sub_eq_neg_add, add_comm]

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

/-- The coercion `ℝ → ℂ` as a `ring_hom`. -/
def of_real : ℝ →+* ℂ := ⟨coe, of_real_one, of_real_mul, of_real_zero, of_real_add⟩

@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma I_sq : I ^ 2 = -1 := by rw [sq, I_mul_I]

@[simp] lemma sub_re (z w : ℂ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_im (z w : ℂ) : (z - w).im = z.im - w.im := rfl
@[simp, norm_cast] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℂ) = r - s := ext_iff.2 $ by simp
@[simp, norm_cast] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℂ) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : ℂ) : z - conj z = (2 * z.im : ℝ) * I :=
ext_iff.2 $ by simp [two_mul, sub_eq_add_neg]

lemma norm_sq_sub (z w : ℂ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by rw [sub_eq_add_neg, norm_sq_add]; simp [-mul_re, add_comm, add_left_comm, sub_eq_add_neg]

/-! ### Inversion -/

noncomputable instance : has_inv ℂ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℂ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℂ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_im (z : ℂ) : (z⁻¹).im = -z.im / norm_sq z := by simp [inv_def, division_def]

@[simp, norm_cast] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℂ) = r⁻¹ :=
ext_iff.2 $ by simp

protected

protected theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

/-! ### Field instance and lemmas -/

noncomputable instance : field ℂ :=
{ inv := has_inv.inv,
  exists_pair_ne := ⟨0, 1, mt (congr_arg re) zero_ne_one⟩,
  mul_inv_cancel := @complex.mul_inv_cancel,
  inv_zero := complex.inv_zero,
  ..complex.comm_ring }

@[simp] lemma I_fpow_bit0 (n : ℤ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [fpow_bit0', I_mul_I]

@[simp] lemma I_fpow_bit1 (n : ℤ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [fpow_bit1', I_mul_I]

lemma div_re (z w : ℂ) : (z / w).re = z.re * w.re / norm_sq w + z.im * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg]
lemma div_im (z w : ℂ) : (z / w).im = z.im * w.re / norm_sq w - z.re * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm]

@[simp, norm_cast] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s :=
of_real.map_div r s

@[simp, norm_cast] lemma of_real_fpow (r : ℝ) (n : ℤ) : ((r ^ n : ℝ) : ℂ) = (r : ℂ) ^ n :=
of_real.map_fpow r n

@[simp] lemma div_I (z : ℂ) : z / I = -(z * I) :=
(div_eq_iff_mul_eq I_ne_zero).2 $ by simp [mul_assoc]

@[simp] lemma inv_I : I⁻¹ = -I :=
by simp [inv_eq_one_div]

@[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
norm_sq.map_inv' z

@[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w :=
norm_sq.map_div z w

/-! ### Cast lemmas -/

@[simp, norm_cast] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : ℂ) = n :=
of_real.map_nat_cast n

@[simp, norm_cast] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n :=
by rw [← of_real_nat_cast, of_real_re]

@[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℂ).im = 0 :=
by rw [← of_real_nat_cast, of_real_im]

@[simp, norm_cast] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : ℂ) = n :=
of_real.map_int_cast n

@[simp, norm_cast] lemma int_cast_re (n : ℤ) : (n : ℂ).re = n :=
by rw [← of_real_int_cast, of_real_re]

@[simp, norm_cast] lemma int_cast_im (n : ℤ) : (n : ℂ).im = 0 :=
by rw [← of_real_int_cast, of_real_im]

@[simp, norm_cast] theorem of_real_rat_cast (n : ℚ) : ((n : ℝ) : ℂ) = n :=
of_real.map_rat_cast n

@[simp, norm_cast] lemma rat_cast_re (q : ℚ) : (q : ℂ).re = q :=
by rw [← of_real_rat_cast, of_real_re]

@[simp, norm_cast] lemma rat_cast_im (q : ℚ) : (q : ℂ).im = 0 :=
by rw [← of_real_rat_cast, of_real_im]

/-! ### Characteristic zero -/

instance char_zero_complex : char_zero ℂ :=
char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

/-- A complex number `z` plus its conjugate `conj z` is `2` times its real part. -/
theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 :=
by simp only [add_conj, of_real_mul, of_real_one, of_real_bit0,
     mul_div_cancel_left (z.re:ℂ) two_ne_zero']

/-- A complex number `z` minus its conjugate `conj z` is `2i` times its imaginary part. -/
theorem im_eq_sub_conj (z : ℂ) : (z.im : ℂ) = (z - conj(z))/(2 * I) :=
by simp only [sub_conj, of_real_mul, of_real_one, of_real_bit0, mul_right_comm,
     mul_div_cancel_left _ (mul_ne_zero two_ne_zero' I_ne_zero : 2 * I ≠ 0)]

/-! ### Absolute value -/

/-- The complex absolute value function, defined as the square root of the norm squared. -/
@[pp_nodot] noncomputable def abs (z : ℂ) : ℝ := (norm_sq z).sqrt

local notation `abs'` := _root_.abs

@[simp, norm_cast] lemma abs_of_real (r : ℝ) : abs r = abs' r :=
by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

lemma abs_of_nat (n : ℕ) : complex.abs n = n :=
calc complex.abs n = complex.abs (n:ℝ) : by rw [of_real_nat_cast]
  ... = _ : abs_of_nonneg (nat.cast_nonneg n)

lemma mul_self_abs (z : ℂ) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

@[simp] lemma abs_zero : abs 0 = 0 := by simp [abs]
@[simp] lemma abs_one : abs 1 = 1 := by simp [abs]
@[simp] lemma abs_I : abs I = 1 := by simp [abs]

@[simp] lemma abs_two : abs 2 = 2 :=
calc abs 2 = abs (2 : ℝ) : by rw [of_real_bit0, of_real_one]
... = (2 : ℝ) : abs_of_nonneg (by norm_num)

lemma abs_nonneg (z : ℂ) : 0 ≤ abs z :=
real.sqrt_nonneg _

@[simp] lemma abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 :=
(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero

lemma abs_ne_zero {z : ℂ} : abs z ≠ 0 ↔ z ≠ 0 :=
not_congr abs_eq_zero

@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z :=
by simp [abs]

@[simp] lemma abs_mul (z w : ℂ) : abs (z * w) = abs z * abs w :=
by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl

lemma abs_re_le_abs (z : ℂ) : abs' z.re ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.re) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply re_sq_le_norm_sq

lemma abs_im_le_abs (z : ℂ) : abs' z.im ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.im) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply im_sq_le_norm_sq

lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : ℂ) : z.im ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

lemma abs_add (z w : ℂ) : abs (z + w) ≤ abs z + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg _)
  (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
      add_right_comm, norm_sq_add, add_le_add_iff_left,
      mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _)],
  simpa [-mul_re] using re_le_abs (z * conj w)
end

instance : is_absolute_value abs :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }
open is_absolute_value

@[simp] lemma abs_abs (z : ℂ) : abs' (abs z) = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp] lemma abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp] lemma abs_neg : ∀ z, abs (-z) = abs z := abv_neg abs
lemma abs_sub : ∀ z w, abs (z - w) = abs (w - z) := abv_sub abs
lemma abs_sub_le : ∀ a b c, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs
@[simp] theorem abs_inv : ∀ z, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp] theorem abs_div : ∀ z w, abs (z / w) = abs z / abs w := abv_div abs

lemma abs_abs_sub_le_abs_sub : ∀ z w, abs' (abs z - abs w) ≤ abs (z - w) :=
abs_abv_sub_le_abv_sub abs

lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ abs' z.re + abs' z.im :=
by simpa [re_add_im] using abs_add z.re (z.im * I)

lemma abs_re_div_abs_le_one (z : ℂ) : abs' (z.re / z.abs) ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_re_le_abs] }

lemma abs_im_div_abs_le_one (z : ℂ) : abs' (z.im / z.abs) ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_im_le_abs] }

@[simp, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : ℂ) = n :=
by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)]

@[simp, norm_cast] lemma int_cast_abs (n : ℤ) : ↑(abs' n) = abs n :=
by rw [← of_real_int_cast, abs_of_real, int.cast_abs]

lemma norm_sq_eq_abs (x : ℂ) : norm_sq x = abs x ^ 2 :=
by rw [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)]

/--
We put a partial order on ℂ so that `z ≤ w` exactly if `w - z` is real and nonnegative.
Complex numbers with different imaginary parts are incomparable.
-/
def complex_order : partial_order ℂ :=
{ le := λ z w, ∃ x : ℝ, 0 ≤ x ∧ w = z + x,
  le_refl := λ x, ⟨0, by simp⟩,
  le_trans := λ x y z h₁ h₂,
  begin
    obtain ⟨w₁, l₁, rfl⟩ := h₁,
    obtain ⟨w₂, l₂, rfl⟩ := h₂,
    refine ⟨w₁ + w₂, _, _⟩,
    { linarith, },
    { simp [add_assoc], },
  end,
  le_antisymm := λ z w h₁ h₂,
  begin
    obtain ⟨w₁, l₁, rfl⟩ := h₁,
    obtain ⟨w₂, l₂, e⟩ := h₂,
    have h₃ : w₁ + w₂ = 0,
    { symmetry,
      rw add_assoc at e,
      apply of_real_inj.mp,
      apply add_left_cancel,
      convert e; simp, },
    have h₄ : w₁ = 0, linarith,
    simp [h₄],
  end, }

localized "attribute [instance] complex_order" in complex_order

section complex_order
open_locale complex_order

lemma le_def {z w : ℂ} : z ≤ w ↔ ∃ x : ℝ, 0 ≤ x ∧ w = z + x := iff.refl _
lemma lt_def {z w : ℂ} : z < w ↔ ∃ x : ℝ, 0 < x ∧ w = z + x :=
begin
  rw [lt_iff_le_not_le],
  fsplit,
  { rintro ⟨⟨x, l, rfl⟩, h⟩,
    by_cases hx : x = 0,
    { simp [hx] at h, exfalso, exact h (le_refl _), },
    { replace l : 0 < x := l.lt_of_ne (ne.symm hx),
      exact ⟨x, l, rfl⟩, } },
  { rintro ⟨x, l, rfl⟩,
    fsplit,
    { exact ⟨x, l.le, rfl⟩, },
    { rintro ⟨x', l', e⟩,
      rw [add_assoc] at e,
      replace e := add_left_cancel (by { convert e, simp }),
      norm_cast at e,
      linarith, } }
end

@[simp, norm_cast] lemma real_le_real {x y : ℝ} : (x : ℂ) ≤ (y : ℂ) ↔ x ≤ y :=
begin
  rw [le_def],
  fsplit,
  { rintro ⟨r, l, e⟩,
    norm_cast at e,
    subst e,
    exact le_add_of_nonneg_right l, },
  { intro h,
    exact ⟨y - x, sub_nonneg.mpr h, (by simp)⟩, },
end
@[simp, norm_cast] lemma real_lt_real {x y : ℝ} : (x : ℂ) < (y : ℂ) ↔ x < y :=
begin
  rw [lt_def],
  fsplit,
  { rintro ⟨r, l, e⟩,
    norm_cast at e,
    subst e,
    exact lt_add_of_pos_right x l, },
  { intro h,
    exact ⟨y - x, sub_pos.mpr h, (by simp)⟩, },
end
@[simp, norm_cast] lemma zero_le_real {x : ℝ} : (0 : ℂ) ≤ (x : ℂ) ↔ 0 ≤ x := real_le_real
@[simp, norm_cast] lemma zero_lt_real {x : ℝ} : (0 : ℂ) < (x : ℂ) ↔ 0 < x := real_lt_real

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is an ordered ring.
-/
def complex_ordered_comm_ring : ordered_comm_ring ℂ :=
{ zero_le_one := ⟨1, zero_le_one, by simp⟩,
  add_le_add_left := λ w z h y,
  begin
    obtain ⟨x, l, rfl⟩ := h,
    exact ⟨x, l, by simp [add_assoc]⟩,
  end,
  mul_pos := λ z w hz hw,
  begin
    obtain ⟨zx, lz, rfl⟩ := lt_def.mp hz,
    obtain ⟨wx, lw, rfl⟩ := lt_def.mp hw,
    norm_cast,
    simp only [mul_pos, lz, lw, zero_add],
  end,
  le_of_add_le_add_left := λ u v z h,
  begin
    obtain ⟨x, l, e⟩ := h,
    rw add_assoc at e,
    exact ⟨x, l, add_left_cancel e⟩,
  end,
  mul_lt_mul_of_pos_left := λ u v z h₁ h₂,
  begin
    obtain ⟨x₁, l₁, rfl⟩ := lt_def.mp h₁,
    obtain ⟨x₂, l₂, rfl⟩ := lt_def.mp h₂,
    simp only [mul_add, zero_add],
    exact lt_def.mpr ⟨x₂ * x₁, mul_pos l₂ l₁, (by norm_cast)⟩,
  end,
  mul_lt_mul_of_pos_right := λ u v z h₁ h₂,
  begin
    obtain ⟨x₁, l₁, rfl⟩ := lt_def.mp h₁,
    obtain ⟨x₂, l₂, rfl⟩ := lt_def.mp h₂,
    simp only [add_mul, zero_add],
    exact lt_def.mpr ⟨x₁ * x₂, mul_pos l₁ l₂, (by norm_cast)⟩,
  end,
-- we need more instances here because comm_ring doesn't have zero_add et al as fields,
-- they are derived as lemmas
  ..(by apply_instance : partial_order ℂ),
  ..(by apply_instance : comm_ring ℂ),
  ..(by apply_instance : comm_semiring ℂ),
  ..(by apply_instance : add_cancel_monoid ℂ) }

localized "attribute [instance] complex_ordered_comm_ring" in complex_order

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a star ordered ring.
(That is, an ordered ring in which every element of the form `star z * z` is nonnegative.)

In fact, the nonnegative elements are precisely those of this form.
This hold in any `C^*`-algebra, e.g. `ℂ`,
but we don't yet have `C^*`-algebras in mathlib.
-/
def complex_star_ordered_ring : star_ordered_ring ℂ :=
{ star_mul_self_nonneg := λ z,
  begin
    refine ⟨z.abs^2, pow_nonneg (abs_nonneg z) 2, _⟩,
    simp only [has_star.star, of_real_pow, zero_add],
    norm_cast,
    rw [←norm_sq_eq_abs, norm_sq_eq_conj_mul_self],
  end, }

localized "attribute [instance] complex_star_ordered_ring" in complex_order

end complex_order

/-! ### Cauchy sequences -/

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).im) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

/-- The real part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_re (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_re f⟩

/-- The imaginary part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_im f⟩

lemma is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) :
  is_cau_seq abs' (abs ∘ f) :=
λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩

/-- The limit of a Cauchy sequence of complex numbers. -/
noncomputable def lim_aux (f : cau_seq ℂ abs) : ℂ :=
⟨cau_seq.lim (cau_seq_re f), cau_seq.lim (cau_seq_im f)⟩

theorem equiv_lim_aux (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim_aux f) :=
λ ε ε0, (exists_forall_ge_and
  (cau_seq.equiv_lim ⟨_, is_cau_seq_re f⟩ _ (half_pos ε0))
  (cau_seq.equiv_lim ⟨_, is_cau_seq_im f⟩ _ (half_pos ε0))).imp $
λ i H j ij, begin
  cases H _ ij with H₁ H₂,
  apply lt_of_le_of_lt (abs_le_abs_re_add_abs_im _),
  dsimp [lim_aux] at *,
  have := add_lt_add H₁ H₂,
  rwa add_halves at this,
end

noncomputable instance : cau_seq.is_complete ℂ abs :=
⟨λ f, ⟨lim_aux f, equiv_lim_aux f⟩⟩

open cau_seq

lemma lim_eq_lim_im_add_lim_re (f : cau_seq ℂ abs) : lim f =
  ↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I :=
lim_eq_of_equiv_const $
calc f ≈ _ : equiv_lim_aux f
... = cau_seq.const abs (↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I) :
  cau_seq.ext (λ _, complex.ext (by simp [lim_aux, cau_seq_re]) (by simp [lim_aux, cau_seq_im]))

lemma lim_re (f : cau_seq ℂ abs) : lim (cau_seq_re f) = (lim f).re :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma lim_im (f : cau_seq ℂ abs) : lim (cau_seq_im f) = (lim f).im :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma is_cau_seq_conj (f : cau_seq ℂ abs) : is_cau_seq abs (λ n, conj (f n)) :=
λ ε ε0, let ⟨i, hi⟩ := f.2 ε ε0 in
⟨i, λ j hj, by rw [← conj.map_sub, abs_conj]; exact hi j hj⟩

/-- The complex conjugate of a complex Cauchy sequence, as a complex Cauchy sequence. -/
noncomputable def cau_seq_conj (f : cau_seq ℂ abs) : cau_seq ℂ abs :=
⟨_, is_cau_seq_conj f⟩

lemma lim_conj (f : cau_seq ℂ abs) : lim (cau_seq_conj f) = conj (lim f) :=
complex.ext (by simp [cau_seq_conj, (lim_re _).symm, cau_seq_re])
  (by simp [cau_seq_conj, (lim_im _).symm, cau_seq_im, (lim_neg _).symm]; refl)

/-- The absolute value of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_abs f.2⟩

lemma lim_abs (f : cau_seq ℂ abs) : lim (cau_seq_abs f) = abs (lim f) :=
lim_eq_of_equiv_const (λ ε ε0,
let ⟨i, hi⟩ := equiv_lim f ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩)

@[simp, norm_cast] lemma of_real_prod {α : Type*} (s : finset α) (f : α → ℝ) :
  ((∏ i in s, f i : ℝ) : ℂ) = ∏ i in s, (f i : ℂ) :=
ring_hom.map_prod of_real _ _

@[simp, norm_cast] lemma of_real_sum {α : Type*} (s : finset α) (f : α → ℝ) :
  ((∑ i in s, f i : ℝ) : ℂ) = ∑ i in s, (f i : ℂ) :=
ring_hom.map_sum of_real _ _

end complex


import data.nat.prime
import data.real.basic
import topology.basic -- for namespace fiddling

/-
  Some experiments based on LFTCM20
-/

namespace nat -- in place of 'open'

theorem infinitude_of_primes : ∀ N, ∃p ≥ N, prime p:=
begin
  intro N,

  let M := factorial N + 1,
  let p := min_fac M,

  have pp: prime p :=
  begin
    refine min_fac_prime _,
    refine ne_of_gt _,
    have : factorial N > 0 := factorial_pos N,
    exact succ_lt_succ this,
    /-
    otherwise "import tactic.linarith" at the beginning and
    put "linarith," here.
    -/
  end,

  use p,
  split,
  { by_contradiction,
    have h₁ : p ∣ factorial N + 1:= min_fac_dvd M, -- divides is '\|'
    have h₂ : p ∣ factorial N :=
    begin
      show_term { refine dvd_factorial _ _,
      exact prime.pos pp,
      exact le_of_not_ge h, }
    end,
    -- I can leave "by library search," below
    have h : p ∣ 1 := iff.mp (nat.dvd_add_right h₂) h₁,
    -- 'iff' in place of 'Iff'
    -- hint here: use 'library_search,' with nothing after it
    exact prime.not_dvd_one pp h, },
  { exact pp },
end

end nat

lemma mylemma: ∀x:ℕ, 0 ≤ x :=
begin
  intro,
  exact zero_le x
end

#check `[exact λ (x : ℕ), zero_le x]

open nat

example (m n: ℕ) (h : m ≤ n): (m:ℝ) ≤ n :=
begin
  exact cast_le.2 h,
end

#check cast_lt.2

lemma real_not_nat : ∃ (x : ℝ), ∀ (n : ℕ), x ≠ n :=
begin
  use -1,
  intro,
  have : (-1:ℝ) < (0:ℕ) := by norm_num,
  have : ∀ (n : ℕ), (0 : ℝ) ≤ n := cast_nonneg,
  have : ∀ (n : ℕ), (0 : ℝ) < n +1 :=
  begin
    intro m,
    exact cast_add_one_pos m
  end,
  have : ∀ (n : ℕ), (-1 : ℝ) < n :=
  begin
    intro n,
    exact neg_lt_iff_pos_add.mpr (this n)
  end,
  exact ne_of_lt (this n),
end

example (P R : Prop) (p: P) (q: ¬P) : R := absurd p q

example (P R : Prop) (p: P) (q: ¬P) : R := false.rec R (q p)

-- Playing around classically.
lemma exists_of_nonempty {α : Type}  [nonempty α] : (∃ x : α, true) :=
begin
  by_contradiction,
  push_neg at h,
  apply nonempty.elim,
  assumption,
  intro alp,
  apply h alp trivial,
end

-- Experimenting with namespaces and `_root_`.
namespace is_open

#check and                -- topology lemma
#check _root_.is_open.and -- same as above
#check _root_.and         -- logical `and` at the root namespace

end is_open

-- Example using `constructor`
example {α : Type*} (P Q : α → Prop) : (∀ x, P x ∧ Q x) → (∀x, P x ∨ Q x) :=
begin
  intros h x,
  constructor, -- Chooses the lhs, first constructor that matches.
  exact (h x).left
end

section including_omitting

class cls := (val : ℕ) -- From the Reference Manual, Sect. 3.2

variables (x : ℝ) [c : cls]

def ex2b : ℕ := 5

#check ex2b       -- ex2b : ℕ
#check @ex2b      -- ex2b : ℕ

include c

def ex2c : ℕ := 5

#check ex2c       -- ex2c : ℕ
#check @ex2c      -- ex2c : Π [c : cls], ℕ

example : ex2c = (5 : ℕ) := rfl -- Here the `5` is just natural

omit c
include x

def ex2d : ℕ := 5

#check ex2d       -- ex2d : ℝ → ℕ
#check @ex2d      -- ex2d : ℝ → ℕ

example : ex2d = (5 : ℕ) := rfl -- Here the `5` is coerced to `ℝ → ℕ`

end including_omitting

example : ex2d = (5 : ℕ) := rfl -- Here too

-- Useful tracing for turning non-terminal `simp`s into `simp only`s:
set_option trace.simplify.rewrite true
set_option trace.simplify.failure false
set_option trace.simplify.rewrite_failure false
-- Accompanying terminal (xD) script. End input with Ctrl-D.
/-
echo [`sed  -e "s/.*\\[simplify.rewrite\\] \\[\([^[]*\)]:.*/\\1/g" -e "s/set\\.//g" -e "s/^  .*//g"  | grep -v "^$" | sort | uniq | tr '\\n' ',' && printf \\\\b`]
-/
-- ... though it seems to be already done in lean :facepalm: