import algebra.group
import data.complex.module
import group_theory.subgroup
import group_theory.quotient_group
import linear_algebra.basic
import linear_algebra.finite_dimensional
import linear_algebra.matrix

import data.zmod.basic

-- Abstract algebra: groups, rings, fields, etc.

-- 1. GROUPS
-- We already saw the definition of a group in an earlier lecture.

#check group

-- But there's more to group theory than just groups! For example:

-- group homomorphisms...

variables {G H : Type*} [group G] [group H]

#check monoid_hom G H
#check G →* H

variables (f : G →* H)
#check (f : G → H)

section
variables (g : G)
#check f g
end

#check f.map_one
#check f.map_mul
#check f.map_inv

variables {K : Type*} [group K] (f' : H →* K)
#check f'.comp f
#check (monoid_hom.id G : G →* G)

-- subgroups & quotients...

#check subgroup G

variables (N : subgroup G)
#check (N : set G)

section
variables (g : G)
#check (g ∈ N)
end

#check N.inv_mem'

#check N.mul_mem
#check N.inv_mem

#check N.normal

section
open subgroup quotient_group

variables [normal N]

#check (1 : quotient_group.quotient N)
#check (mk' N : G →* quotient_group.quotient N)   -- g ↦ [g] ∈ G/N.

end

-- group actions...

variables {X : Type*} [mul_action G X]
variables (g : G) (x : X)
#check g • x                    -- • = \bu

variables {Y : Type*} [mul_action G Y]
#check X →[G] Y

-- and a bunch more, including:
-- * constructions of groups
--     (free groups, free abelian groups, symmetric groups, dihedral groups, ...)
-- * theorems from an undergrad abstract algebra course
--     (Lagrange's theorem, Sylow's theorems)

-- THEN, the same pattern for rings (& also Lie algebras):
-- ring homomorphisms (→+*), subrings, ideals & their quotients, modules,
-- and a fair bit of commutative algebra.
-- This is basically parallel to the story for groups.

/-
File organization: Roughly,

* `algebra/` = basic "universal algebra" stuff about groups, rings etc.
  e.g. group homomorphisms.

* `group_theory/`, `ring_theory/`, `linear_algebra/`, ... = more subject-specific.

-/

-- 2. Let's focus on the setting of LINEAR ALGEBRA.

variables {k : Type*} [field k]

variables (V : Type*) [add_comm_group V] [vector_space k V]
variables (W : Type*) [add_comm_group W] [vector_space k W]

section

variables (v₁ v₂ : V)
#check v₁ + v₂

end

#check V →ₗ[k] W

#check (show vector_space k (V →ₗ[k] W), by apply_instance)
#check (show ring (V →ₗ[k] V), by apply_instance)

-- Constructing vector spaces

#check (show vector_space k (fin 37 → k), by apply_instance)

variables {α : Type*} [fintype α]
#check (show vector_space k (α → k), by apply_instance)

variables {β : Type*}
#check (show vector_space k (β → k), by apply_instance)
#check (show vector_space k (β →₀ k), by apply_instance)

-- Dimension
open finite_dimensional

example : finite_dimensional k (fin 37 → k) :=
by apply_instance

#check vector_space.dim
example : findim k (fin 37 → k) = 37 :=
by simp

example : findim ℝ ℂ = 2 :=
complex.findim_real_complex

-- notation `dim` := findim ℝ

-- Maps between finite-dimensional vector spaces are equivalent to MATRICES.
-- In mathlib, matrices are indexed by arbitrary finite types, not just by `fin n`.
-- A matrix `A : matrix m n k` is really just a function `A : m → n → k`.

variables {m n l : Type*} [fintype m] [fintype n] [fintype l]

#check matrix m n k
#check (show vector_space k (matrix m n k), by apply_instance)

variables (A A' : matrix m n k) (B : matrix l m k)
#check A + A'
#check B.mul A    -- BA

-- Matrix notation
example : fin 3 → ℝ := ![1, 2, -3]

example : matrix (fin 2) (fin 2) ℝ := ![
  ![0, -1],
  ![1, 0]
]

--open_locale classical
--noncomputable theory

variables [decidable_eq n]

-- Equivalence between matrices and linear maps
example : matrix m n k ≃ₗ[k] ((n → k) →ₗ[k] (m → k)) :=
matrix.to_lin'

/-
If F : k^n → k^m is a linear map then the (i,j) entry of the corresponding matrix
is the i component (i.e. value on (i : m)) of F applied to the standard basis vector e_j...
but we need decidable equality on the type of j to define e_j = [ 0 ... 0 1 0 ... 0 ]ᵗ.
-/

section
def foo : fact (nat.prime 37) := show (nat.prime 37), by norm_num
local attribute [instance] foo

#check (show field (zmod 37), by apply_instance)
end


import incidence_world.level05 --hide
open IncidencePlane --hide

/-
We end this world by proving the existence of triangles
using only incidence axioms.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma :
There exist three lines that do not have a point in common.
-/
lemma three_distinct_lines : ∃ (r s t: Line Ω), (∀ (P : Ω),
¬(P ∈ r ∧ P ∈ s ∧ P ∈ t)) :=
begin
  rcases existence Ω with ⟨A, B, C, ⟨hAB, hAC, hBC, h⟩⟩,
  use line_through A B,
  use line_through A C,
  use line_through B C,
  intros P H,
  have h1 : line_through A C ≠ line_through A B,
  {
    exact ne_of_not_share_point (line_through_right A C) h,
  },
  by_cases hPA : P = A,
  {
    have hAlBC : A ∈ line_through B C,
    {
      rw ← hPA,
      exact H.2.2,
    },
    have H1 : line_through A C = line_through B C,
    {
      exact equal_lines_of_contain_two_points hAC (line_through_left A C) hAlBC (line_through_right A C) (line_through_right B C),
    },
    have H2 : line_through A C = line_through A B,
    {
      rw H1,
      exact equal_lines_of_contain_two_points hAB hAlBC (line_through_left A B) (line_through_left B C) (line_through_right A B),
    },
    exact h1 H2,
  },
  {
    have h2 : line_through A C = line_through A B,
    {
      exact equal_lines_of_contain_two_points hPA H.2.1 H.1 (line_through_left A C) (line_through_left A B),
    },
    exact h1 h2,
  }

end


import data.list.basic

open list

variables {α : Type*} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]

attribute [simp] reverse_mk_symm

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by { simp at h, assumption }

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (reverse (mk_symm ys) ++ reverse xs) :=
by { simp [-reverse_mk_symm] at h, assumption }

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (reverse (mk_symm ys) ++ reverse xs) :=
by { simp only [reverse_append] at h, assumption }


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import data.set.intervals.basic
import data.set.function

/-!
# Monotone surjective functions are surjective on intervals

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

A monotone surjective function sends any interval in the domain onto the interval with corresponding
endpoints in the range.  This is expressed in this file using `set.surj_on`, and provided for all
permutations of interval endpoints.
-/

variables {α : Type*} {β : Type*} [linear_order α] [partial_order β] {f : α → β}

open set function order_dual (to_dual)

lemma surj_on_Ioo_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a b : α) :
  surj_on f (Ioo a b) (Ioo (f a) (f b)) :=
begin
  intros p hp,
  rcases h_surj p with ⟨x, rfl⟩,
  refine ⟨x, mem_Ioo.2 _, rfl⟩,
  contrapose! hp,
  exact λ h, h.2.not_le (h_mono $ hp $ h_mono.reflect_lt h.1)
end

lemma surj_on_Ico_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a b : α) :
  surj_on f (Ico a b) (Ico (f a) (f b)) :=
begin
  obtain hab | hab := lt_or_le a b,
  { intros p hp,
    rcases eq_left_or_mem_Ioo_of_mem_Ico hp with rfl|hp',
    { exact mem_image_of_mem f (left_mem_Ico.mpr hab) },
    { have := surj_on_Ioo_of_monotone_surjective h_mono h_surj a b hp',
      exact image_subset f Ioo_subset_Ico_self this } },
  { rw Ico_eq_empty (h_mono hab).not_lt,
    exact surj_on_empty f _ }
end

lemma surj_on_Ioc_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a b : α) :
  surj_on f (Ioc a b) (Ioc (f a) (f b)) :=
by simpa using surj_on_Ico_of_monotone_surjective h_mono.dual h_surj (to_dual b) (to_dual a)

-- to see that the hypothesis `a ≤ b` is necessary, consider a constant function
lemma surj_on_Icc_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) {a b : α} (hab : a ≤ b) :
  surj_on f (Icc a b) (Icc (f a) (f b)) :=
begin
  intros p hp,
  rcases eq_endpoints_or_mem_Ioo_of_mem_Icc hp with (rfl|rfl|hp'),
  { exact ⟨a, left_mem_Icc.mpr hab, rfl⟩ },
  { exact ⟨b, right_mem_Icc.mpr hab, rfl⟩ },
  { have := surj_on_Ioo_of_monotone_surjective h_mono h_surj a b hp',
    exact image_subset f Ioo_subset_Icc_self this }
end

lemma surj_on_Ioi_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
  surj_on f (Ioi a) (Ioi (f a)) :=
begin
  rw [← compl_Iic, ← compl_compl (Ioi (f a))],
  refine maps_to.surj_on_compl _ h_surj,
  exact λ x hx, (h_mono hx).not_lt
end

lemma surj_on_Iio_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
  surj_on f (Iio a) (Iio (f a)) :=
@surj_on_Ioi_of_monotone_surjective _ _ _ _ _ h_mono.dual h_surj a

lemma surj_on_Ici_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
  surj_on f (Ici a) (Ici (f a)) :=
begin
  rw [← Ioi_union_left, ← Ioi_union_left],
  exact (surj_on_Ioi_of_monotone_surjective h_mono h_surj a).union_union
    (@image_singleton _ _ f a ▸ surj_on_image _ _)
end

lemma surj_on_Iic_of_monotone_surjective
  (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
  surj_on f (Iic a) (Iic (f a)) :=
@surj_on_Ici_of_monotone_surjective _ _ _ _ _ h_mono.dual h_surj a


import SciLean.Basic
import SciLean.Tactic

set_option synthInstance.maxHeartbeats 5000

open SciLean

variable (f df : ℝ ⟿ ℝ)

-- TODO: Move this somewhere else ...
@[simp high] theorem differential_of_hom_subtype {X Y} [Vec X] [Vec Y] : ∂ (Subtype.val : (X ⟿ Y) → (X → Y)) = λ f df => df.1 := sorry

example : ∂ (λ (f : (ℝ ⟿ ℝ)) => (mkIntegral λ t => f t)) f df = mkIntegral λ t => df t := by
  simp[mkIntegral] admit

example : ∂ (λ (f : (ℝ ⟿ ℝ)) (t : ℝ) => (f t) * (f t)) f df = λ t => (df t) * (f t) + (f t) * (df t) :=
by
  simp done

example (t b : ℝ) : ∂ (fun (f : ℝ ⟿ ℝ) (t : ℝ) => (f t) * (f t)) f df t = (df t) * (f t) + (f t) * (df t) := by simp done
example (t : ℝ) : ∂ (fun (f : ℝ ⟿ ℝ) (t : ℝ) => (f t) * (f t)) f df t = (df t) * (f t) + (f t) * (df t) := by simp done

variable (f : ℝ ⟿ ℝ) (x : ℝ×ℝ)

-- #check ∂ (∫ t, f t)

class Dual (X Y : Type) where
  dual : (X → Y) → X

class Integral (X Y : Type) where
  Result : Type
  integral : X → Result

attribute [reducible] Integral.Result

-- def int {X Y} [FinVec X] [SemiHilbert Y] (f : X → Y) (Ω : 𝓓 (X ⟿ Y)) : Y := sorry

-- instance (priority := low) {X : Type}

noncomputable
instance (priority := low) {X : Type} [SemiHilbert X] : Dual X (𝓓 X → ℝ) where
  dual := dual

noncomputable
instance [Hilbert X] : Dual X ℝ where
  dual := λ f => dual (λ x _ => f x)

#check Dual.dual (∂ (λ x : ℝ×ℝ => ⟪x, 1⟫) x)
#check Dual.dual ((∂ λ f : ℝ ⟿ ℝ => λ Ω => ⟪f, 1⟫[Ω]) f)

-- example : ∂ (λ (f : (ℝ ⟿ ℝ)) => (∫ t, (f t) * (f t) + (f t))) f df = ∫ t, (df t) * (f t) + (f t + 1) * (df t) :=
-- by
--   simp[integral]
--   simp[mkIntegral, integral]
--   done


import game.sets.sets_level04 -- hide

namespace xena -- hide

variable X : Type --hide

/-
# Chapter 1 : Sets

## Level 5
-/

/-
You should now be able to prove the theorem below if you
use `split` and `cases` together with `set.subset.antisymm`.
-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \subseteq B \iff A \cap B = A.$$
-/
theorem subset_iff_intersection_eq (A : set X) (B : set X) : A ⊆ B ↔ A ∩ B = A :=
begin
    split,
    intro H, apply set.subset.antisymm,
    intros x hx, cases hx with hA hB, exact hA,
    intros x hx, split, exact hx, exact H hx,
    intro H, intros x hx,
    have G : x ∈ A ∩ B, rw H, exact hx,
    cases G with hA hB, exact hB, done
end

end xena -- hide


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

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_275
  (x : ℝ)
  (h : ((11:ℝ)^(1 / 4))^(3 * x - 3) = 1 / 5) :
  ((11:ℝ)^(1 / 4))^(6 * x + 2) = 121 / 25 :=
begin
  revert x h,
  norm_num,
end


/- Additional lemmas on modular equality. -/

import data.nat.modeq

open nat

namespace modeq
  variables {a r n k : ℕ}
  lemma mod_of_modeq : a ≡ r [MOD n] → r < n → a % n = r :=
    begin
      rw modeq,
      intros e l,
      have h : r % n = r := mod_eq_of_lt l,
      rw [e, h]
    end

  lemma rep_of_modeq : a ≡ r [MOD n] → r < n → ∃ q : ℕ, a = n * q + r :=
    begin
      intros e l,
      existsi (a / n),
      apply symm,
      rw [add_comm, ←(mod_of_modeq e l)],
      apply mod_add_div
    end

  lemma n_mod_n : n ≡ 0 [MOD n] :=
    begin rw [modeq, mod_self, zero_mod] end

  lemma modeq_of_rep_0 : n*k + r ≡ 0*k + r [MOD n] :=
    modeq.modeq_add (modeq.modeq_mul_right k n_mod_n) (modeq.refl r)
  lemma modeq_of_rep : n*k + r ≡ r [MOD n] :=
    begin
      apply (modeq.trans modeq_of_rep_0 _),
      simp
    end
end modeq


-- Inverso_derecha.lean
-- Si G es un grupo y a ∈ G, entonces a * a⁻¹ = 1
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 14-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, se declara que G es un grupo mediante la expresión
--    variables {G : Type*} [group G]
-- y, como consecuencia, se tiene los siguientes axiomas
--    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
--
-- Demostrar que si G es un grupo y a ∈ G, entonces
--    a * a⁻¹ = 1
-- ---------------------------------------------------------------------

import algebra.group
variables {G : Type*} [group G]
variables a : G

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

example : a * a⁻¹ = 1 :=
calc a * a⁻¹
     = 1 * (a * a⁻¹)
       : (one_mul (a * a⁻¹)).symm
 ... = (1 * a) * a⁻¹
       : (mul_assoc 1 a  a⁻¹).symm
 ... = (((a⁻¹)⁻¹ * a⁻¹)  * a) * a⁻¹
       : congr_arg (λ x, (x * a) * a⁻¹) (mul_left_inv a⁻¹).symm
 ... = ((a⁻¹)⁻¹ * (a⁻¹  * a)) * a⁻¹
       : congr_fun (congr_arg has_mul.mul (mul_assoc a⁻¹⁻¹ a⁻¹ a)) a⁻¹
 ... = ((a⁻¹)⁻¹ * 1) * a⁻¹
       : congr_arg (λ x, (a⁻¹⁻¹ * x) * a⁻¹) (mul_left_inv a)
 ... = (a⁻¹)⁻¹ * (1 * a⁻¹)
       : mul_assoc (a⁻¹)⁻¹ 1 a⁻¹
 ... = (a⁻¹)⁻¹ * a⁻¹
       : congr_arg (λ x, (a⁻¹)⁻¹ * x) (one_mul a⁻¹)
 ... = 1
       : mul_left_inv a⁻¹

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

example : a * a⁻¹ = 1 :=
calc
  a * a⁻¹ = 1 * (a * a⁻¹)                : by rw one_mul
      ... = (1 * a) * a⁻¹                : by rw mul_assoc
      ... = (((a⁻¹)⁻¹ * a⁻¹)  * a) * a⁻¹ : by rw mul_left_inv
      ... = ((a⁻¹)⁻¹ * (a⁻¹  * a)) * a⁻¹ : by rw ← mul_assoc
      ... = ((a⁻¹)⁻¹ * 1) * a⁻¹          : by rw mul_left_inv
      ... = (a⁻¹)⁻¹ * (1 * a⁻¹)          : by rw mul_assoc
      ... = (a⁻¹)⁻¹ * a⁻¹                : by rw one_mul
      ... = 1                            : by rw mul_left_inv

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

example : a * a⁻¹ = 1 :=
calc
  a * a⁻¹ = 1 * (a * a⁻¹)                : by simp
      ... = (1 * a) * a⁻¹                : by simp
      ... = (((a⁻¹)⁻¹ * a⁻¹)  * a) * a⁻¹ : by simp
      ... = ((a⁻¹)⁻¹ * (a⁻¹  * a)) * a⁻¹ : by simp
      ... = ((a⁻¹)⁻¹ * 1) * a⁻¹          : by simp
      ... = (a⁻¹)⁻¹ * (1 * a⁻¹)          : by simp
      ... = (a⁻¹)⁻¹ * a⁻¹                : by simp
      ... = 1                            : by simp

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

example : a * a⁻¹ = 1 :=
by simp

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

example : a * a⁻¹ = 1 :=
-- by library_search
mul_inv_self a


import tactic.interactive
import tactic.finish
import data.int.parity
import init.function

universes u1 u2 u3 u4

constant α : Sort u1
constant β : Sort u2
constant γ : Sort u3

def injective {α : Sort u1} {β : Sort u2} (f : α → β ) : Prop :=
      ∀ (x1 x2 : α ), f x1 = f x2 → x1 = x2

def surjective {α : Sort u1} {β : Sort u2} (f : α → β ) : Prop :=
  ∀ y : β, ∃ x : α, f x = y

def bijective {α : Sort u1} {β : Sort u2} (f : α → β ) : Prop :=
  injective f ∧ surjective f

def in_bijection (A : Sort u1) (B : Sort u2): Prop := ∃ f : A → B , bijective f

def comp {α : Sort u1} {β : Sort u2} {γ : Sort u3} (f : β → γ ) (g : α  → β  ) := λx : α ,  f (g x)

lemma ass_comp {α : Sort u1} {β : Sort u2} {γ : Sort u3} {θ : Sort u4} {f : β → γ } {g : α  → β} {h : γ → θ}:
comp h (comp f g) = comp (comp h f) g :=
  by rw [comp,comp,comp,comp];simp

lemma forall_exists_unique_imp_forall_exists {α : Sort u1} {β : Sort u2} {f : α → β } :
  (∀ (y : β), ∃! (x : α), f x = y ) → ∀ (y : β), ∃ (x : α), f x = y :=
  begin
    intros a b,
    apply (exists_of_exists_unique (a b))
  end

lemma injective_of_bij_equiv {α : Sort u1} {β : Sort u2} {f : α → β } {x1 x2 : α} :
  (∀ (y : β), ∃! (x : α), f x = y ) → f x1 = f x2 → x1 = x2 :=
  begin
    intro sup,
    assume a,
    apply (unique_of_exists_unique (sup (f x2))),
    exact a,
    refl
  end

theorem bijective_equiv {α : Sort u1} {β : Sort u2} (f : α → β ) :
   bijective f ↔ ∀ y : β, ∃! x : α, f x = y :=
  begin
    apply iff.intro,
      intros p y,
      cases ((and.elim_right p) y) with x hx,
      rw exists_unique,
      use x,
      apply and.intro,
        exact hx,
        intro x1,
        rw (eq.symm hx),
        apply (and.elim_left p),
      intro sup,
        apply and.intro,
          intros x1 x2,
          apply (injective_of_bij_equiv sup),
        intro a,
        apply (exists_of_exists_unique (sup a))
  end

theorem comp_of_inj_inj {α : Sort u1} {β : Sort u2} {γ  : Sort u3}  (f : α → β ) (g : β →  γ ) :
  injective f ∧ injective g → injective (comp g f) :=
    begin
      intro andinj,
      intros x1 x2,
      exact implies.trans (and.elim_right andinj (f x1) (f x2)) (and.elim_left andinj x1 x2)
    end

theorem comp_of_surj_surj {α : Sort u1} {β : Sort u2} {γ  : Sort u3}  (f : α → β ) (g : β →  γ ) :
  surjective f ∧ surjective g → surjective (comp g f) :=
  begin
    intro andsurj,
    intro y,
    cases ((and.elim_right andsurj) y) with x1 hx1,
    cases ((and.elim_left andsurj) x1) with x2 hx2,
    use x2,
    calc
       comp g f x2 = g (f x2) : by refl
              ...  = g x1 : by rw hx2
              ... = y : by rw hx1
  end

theorem comp_of_bij_bij {α : Sort u1} {β : Sort u2} {γ  : Sort u3}  (f : α → β) (g : β →  γ) :
  bijective f ∧ bijective g → bijective (comp g f) :=
  begin
    intro hyp,
    apply and.intro,
      apply comp_of_inj_inj,
        apply and.intro,
          apply and.elim_left (and.elim_left hyp),
          apply and.elim_left (and.elim_right hyp),
      apply comp_of_surj_surj,
        apply and.intro,
          apply and.elim_right (and.elim_left hyp),
          apply and.elim_right (and.elim_right hyp)
  end

def id_bij {α : Sort u1 } : bijective (id : α → α ) :=
  begin
   apply and.intro,
        intros x1 x2,
        simp,
        intro y,
      apply exists.intro,
      rw id
  end

theorem bij_refl : reflexive in_bijection :=
  begin
    intro A,
      apply exists.intro,
      apply id_bij,
  end

theorem bij_trans : transitive in_bijection :=
  begin
    intros A B C,
    intros F G,
    cases F with f hf,
    cases G with g hg,
    apply exists.intro,
    apply comp_of_bij_bij f g,
    apply and.intro,
    apply hf,
    apply hg
  end

lemma map_eq {A : Sort u1} {B : Sort u2} (f : A → B) {x1 x2 : A} :  x1 = x2 → f x1 = f x2 :=
  begin
    intro a,
    rw a
  end

theorem single_exists_unique {α : Type u1} {p : α → Prop} :
  (∃! x : α, p x) ↔ nonempty {x : α // p x} ∧ subsingleton {x : α // p x} :=
  begin
    split,
      intro hyp,
      split,
      use hyp.some,
      apply hyp.some_spec.left,
      apply subsingleton.intro,
      intros a b,
      apply subtype.eq,
      apply exists_unique.unique hyp a.property b.property,
    intro hyp,
    let sing := hyp.right,
    apply exists_unique.intro,
    let v : {x // p x} := (nonempty.some hyp.left),
    exact v.property,
    intro y,
    intro h,
    let u : {x // p x} := {val := y, property := h},
    apply map_eq subtype.val  (@subsingleton.elim {x : α // p x} sing u (nonempty.some hyp.left))
  end

noncomputable def inverse {α : Sort u1} {β : Sort u2} (f : α → β) (p : bijective f) : β → α :=
  λ y : β, (((iff.elim_left (bijective_equiv f)) p) y ).some

theorem id_inv_left {α : Sort u1} {β : Sort u2} (f : α → β) (p : bijective f) :
  ∀ y : β  , f (inverse f p y) = y :=
  begin
    intro y,
    rw inverse,
    simp,
    apply (Exists.some_spec (((iff.elim_left (bijective_equiv f)) p) y )).left
  end

theorem inv_bij {α : Sort u1} {β : Sort u2} (f : α → β) (p : bijective f) : bijective (inverse f p) :=
  begin
    apply iff.elim_right (bijective_equiv (inverse f p)),
    intro y,
    split,
    split,
      simp,
      show (inverse f p (f y) = y),
      rw inverse,
      simp,
      apply p.left (Exists.some _) (y)
        ((Exists.some_spec (inverse._proof_1 f p (f y))).left),
    intro x,
    simp,
    intro hyp,
    have h := (map_eq f hyp),
    rw eq.symm (id_inv_left f p x),
    exact h
  end

theorem bij_sym : symmetric in_bijection :=
  begin
    intros A B,
    intro inbij,
    cases inbij with f hf,
    apply exists.intro,
    apply inv_bij f hf
  end

theorem bij_eq : equivalence in_bijection :=
  begin
    apply and.intro,
      apply bij_refl,
    apply and.intro,
      apply bij_sym,
      apply bij_trans
  end

theorem comp_inj_inj {α : Sort u1} {β : Sort u2} {γ : Sort u3 } {f : α → β } {g : β → γ} :
  injective (comp g f) → injective f :=
  begin
    contrapose,
    rw injective,
    simp,
    intros x1 x2 eq1 neq1,
    rw injective,
    simp,
    use x1,
    use x2,
    split,
    rw comp,
    simp,
    rw eq1,
    exact neq1
  end

theorem comp_surj_surj  {α : Sort u1} {β : Sort u2} {γ : Sort u3} {f : α → β } {g : β → γ} :
  surjective (comp g f) → surjective g :=
  begin
    intro h,
    intro y,
    rw comp at h,
    let x := f (h y).some,
    use x,
    change x with f (h y).some,
    exact Exists.some_spec (h y)
  end

theorem comp_id_is_bij  {α : Sort u1} {β : Sort u2} {f : α → β } {g : β → α } {h : β → α } :
comp f g = id ∧ comp h f = id → bijective f ∧ g= h :=
  begin
    intro p,
    have hg := p.left,
    have hd := p.right,
    split,
    split,
    have compinj : injective (comp h f) :=
      by rw hd; exact id_bij.left,
      exact comp_inj_inj compinj,
    have compsurj : surjective (comp f g) :=
      by rw hg; exact id_bij.right,
      exact comp_surj_surj compsurj,
    have eq1 : comp (comp h f) g = g := by rw [hd,comp];simp,
    have eq2 : comp (comp h f) g = h := by rw [eq.symm ass_comp,hg,comp];simp,
    finish,
  end


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.special_functions.exp
import topology.continuous_function.basic

/-!
# The circle

This file defines `circle` to be the metric sphere (`metric.sphere`) in `ℂ` centred at `0` of
radius `1`.  We equip it with the following structure:

* a submonoid of `ℂ`
* a group
* a topological group

We furthermore define `exp_map_circle` to be the natural map `λ t, exp (t * I)` from `ℝ` to
`circle`, and show that this map is a group homomorphism.

## Implementation notes

Because later (in `geometry.manifold.instances.sphere`) one wants to equip the circle with a smooth
manifold structure borrowed from `metric.sphere`, the underlying set is
`{z : ℂ | abs (z - 0) = 1}`.  This prevents certain algebraic facts from working definitionally --
for example, the circle is not defeq to `{z : ℂ | abs z = 1}`, which is the kernel of `complex.abs`
considered as a homomorphism from `ℂ` to `ℝ`, nor is it defeq to `{z : ℂ | norm_sq z = 1}`, which
is the kernel of the homomorphism `complex.norm_sq` from `ℂ` to `ℝ`.

-/

noncomputable theory

open complex metric
open_locale complex_conjugate

/-- The unit circle in `ℂ`, here given the structure of a submonoid of `ℂ`. -/
def circle : submonoid ℂ :=
{ carrier := sphere (0:ℂ) 1,
  one_mem' := by simp,
  mul_mem' := λ a b, begin
    simp only [norm_eq_abs, mem_sphere_zero_iff_norm],
    intros ha hb,
    simp [ha, hb],
  end }

@[simp] lemma mem_circle_iff_abs {z : ℂ} : z ∈ circle ↔ abs z = 1 := mem_sphere_zero_iff_norm

lemma circle_def : ↑circle = {z : ℂ | abs z = 1} := set.ext $ λ z, mem_circle_iff_abs

@[simp] lemma abs_coe_circle (z : circle) : abs z = 1 :=
mem_circle_iff_abs.mp z.2

lemma mem_circle_iff_norm_sq {z : ℂ} : z ∈ circle ↔ norm_sq z = 1 :=
by rw [mem_circle_iff_abs, complex.abs, real.sqrt_eq_one]

@[simp] lemma norm_sq_eq_of_mem_circle (z : circle) : norm_sq z = 1 := by simp [norm_sq_eq_abs]

lemma ne_zero_of_mem_circle (z : circle) : (z:ℂ) ≠ 0 := ne_zero_of_mem_unit_sphere z

instance : comm_group circle :=
{ inv := λ z, ⟨conj (z : ℂ), by simp⟩,
  mul_left_inv := λ z, subtype.ext $ by { simp [has_inv.inv, ← norm_sq_eq_conj_mul_self,
    ← mul_self_abs] },
  .. circle.to_comm_monoid }

lemma coe_inv_circle_eq_conj (z : circle) : ↑(z⁻¹) = conj (z : ℂ) := rfl

@[simp] lemma coe_inv_circle (z : circle) : ↑(z⁻¹) = (z : ℂ)⁻¹ :=
begin
  rw coe_inv_circle_eq_conj,
  apply eq_inv_of_mul_right_eq_one,
  rw [mul_comm, ← complex.norm_sq_eq_conj_mul_self],
  simp,
end

@[simp] lemma coe_div_circle (z w : circle) : ↑(z / w) = (z:ℂ) / w :=
show ↑(z * w⁻¹) = (z:ℂ) * w⁻¹, by simp

/-- The elements of the circle embed into the units. -/
@[simps]
def circle.to_units : circle →* units ℂ :=
{ to_fun := λ x, units.mk0 x $ ne_zero_of_mem_circle _,
  map_one' := units.ext rfl,
  map_mul' := λ x y, units.ext rfl }

instance : compact_space circle := metric.sphere.compact_space _ _

-- the following result could instead be deduced from the Lie group structure on the circle using
-- `topological_group_of_lie_group`, but that seems a little awkward since one has to first provide
-- and then forget the model space
instance : topological_group circle :=
{ continuous_mul := let h : continuous (λ x : circle, (x : ℂ)) := continuous_subtype_coe in
    continuous_induced_rng (continuous_mul.comp (h.prod_map h)),
  continuous_inv := continuous_induced_rng $
    complex.conj_cle.continuous.comp continuous_subtype_coe }

/-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ`. -/
def exp_map_circle : C(ℝ, circle) :=
{ to_fun := λ t, ⟨exp (t * I), by simp [exp_mul_I, abs_cos_add_sin_mul_I]⟩ }

@[simp] lemma exp_map_circle_apply (t : ℝ) : ↑(exp_map_circle t) = complex.exp (t * complex.I) :=
rfl

@[simp] lemma exp_map_circle_zero : exp_map_circle 0 = 1 :=
subtype.ext $ by rw [exp_map_circle_apply, of_real_zero, zero_mul, exp_zero, submonoid.coe_one]

@[simp] lemma exp_map_circle_add (x y : ℝ) :
  exp_map_circle (x + y) = exp_map_circle x * exp_map_circle y :=
subtype.ext $ by simp only [exp_map_circle_apply, submonoid.coe_mul, of_real_add, add_mul,
  complex.exp_add]

/-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ`, considered as a homomorphism of
groups. -/
@[simps]
def exp_map_circle_hom : ℝ →+ (additive circle) :=
{ to_fun := additive.of_mul ∘ exp_map_circle,
  map_zero' := exp_map_circle_zero,
  map_add' := exp_map_circle_add }

@[simp] lemma exp_map_circle_sub (x y : ℝ) :
  exp_map_circle (x - y) = exp_map_circle x / exp_map_circle y :=
exp_map_circle_hom.map_sub x y


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mitchell Rowett, Scott Morrison, Johan Commelin, Mario Carneiro,
  Michael Howes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.subgroup
import Mathlib.deprecated.submonoid
import Mathlib.PostPort

universes u_3 l u_1 u_2 u_4

namespace Mathlib

/-- `s` is an additive subgroup: a set containing 0 and closed under addition and negation. -/
class is_add_subgroup {A : Type u_3} [add_group A] (s : set A)
extends is_add_submonoid s
where
  neg_mem : ∀ {a : A}, a ∈ s → -a ∈ s

/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
class is_subgroup {G : Type u_1} [group G] (s : set G)
extends is_submonoid s
where
  inv_mem : ∀ {a : G}, a ∈ s → a⁻¹ ∈ s

theorem is_subgroup.div_mem {G : Type u_1} [group G] {s : set G} [is_subgroup s] {x : G} {y : G} (hx : x ∈ s) (hy : y ∈ s) : x / y ∈ s := sorry

theorem additive.is_add_subgroup {G : Type u_1} [group G] (s : set G) [is_subgroup s] : is_add_subgroup s :=
  is_add_subgroup.mk is_subgroup.inv_mem

theorem additive.is_add_subgroup_iff {G : Type u_1} [group G] {s : set G} : is_add_subgroup s ↔ is_subgroup s := sorry

theorem multiplicative.is_subgroup {A : Type u_3} [add_group A] (s : set A) [is_add_subgroup s] : is_subgroup s :=
  is_subgroup.mk is_add_subgroup.neg_mem

theorem multiplicative.is_subgroup_iff {A : Type u_3} [add_group A] {s : set A} : is_subgroup s ↔ is_add_subgroup s := sorry

/-- The group structure on a subgroup coerced to a type. -/
def subtype.group {G : Type u_1} [group G] {s : set G} [is_subgroup s] : group ↥s :=
  group.mk monoid.mul sorry monoid.one sorry sorry (fun (x : ↥s) => { val := ↑x⁻¹, property := sorry })
    (fun (x y : ↥s) => { val := ↑x / ↑y, property := sorry }) sorry

/-- The commutative group structure on a commutative subgroup coerced to a type. -/
def subtype.comm_group {G : Type u_1} [comm_group G] {s : set G} [is_subgroup s] : comm_group ↥s :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

@[simp] theorem is_subgroup.coe_inv {G : Type u_1} [group G] {s : set G} [is_subgroup s] (a : ↥s) : ↑(a⁻¹) = (↑a⁻¹) :=
  rfl

@[simp] theorem is_subgroup.coe_gpow {G : Type u_1} [group G] {s : set G} [is_subgroup s] (a : ↥s) (n : ℤ) : ↑(a ^ n) = ↑a ^ n := sorry

@[simp] theorem is_add_subgroup.gsmul_coe {A : Type u_3} [add_group A] {s : set A} [is_add_subgroup s] (a : ↥s) (n : ℤ) : ↑(n •ℤ a) = n •ℤ ↑a := sorry

theorem is_add_subgroup.of_add_neg {G : Type u_1} [add_group G] (s : set G) (one_mem : 0 ∈ s) (div_mem : ∀ {a b : G}, a ∈ s → b ∈ s → a + -b ∈ s) : is_add_subgroup s := sorry

theorem is_add_subgroup.of_sub {A : Type u_3} [add_group A] (s : set A) (zero_mem : 0 ∈ s) (sub_mem : ∀ {a b : A}, a ∈ s → b ∈ s → a - b ∈ s) : is_add_subgroup s := sorry

protected instance is_add_subgroup.inter {G : Type u_1} [add_group G] (s₁ : set G) (s₂ : set G) [is_add_subgroup s₁] [is_add_subgroup s₂] : is_add_subgroup (s₁ ∩ s₂) :=
  is_add_subgroup.mk
    fun (x : G) (hx : x ∈ s₁ ∩ s₂) =>
      { left := is_add_subgroup.neg_mem (and.left hx), right := is_add_subgroup.neg_mem (and.right hx) }

protected instance is_add_subgroup.Inter {G : Type u_1} [add_group G] {ι : Sort u_2} (s : ι → set G) [h : ∀ (y : ι), is_add_subgroup (s y)] : is_add_subgroup (set.Inter s) :=
  is_add_subgroup.mk
    fun (x : G) (h_1 : x ∈ set.Inter s) =>
      iff.mpr set.mem_Inter fun (y : ι) => is_add_subgroup.neg_mem (iff.mp set.mem_Inter h_1 y)

theorem is_add_subgroup_Union_of_directed {G : Type u_1} [add_group G] {ι : Type u_2} [hι : Nonempty ι] (s : ι → set G) [∀ (i : ι), is_add_subgroup (s i)] (directed : ∀ (i j : ι), ∃ (k : ι), s i ⊆ s k ∧ s j ⊆ s k) : is_add_subgroup (set.Union fun (i : ι) => s i) := sorry

def gpowers {G : Type u_1} [group G] (x : G) : set G :=
  set.range (pow x)

def gmultiples {A : Type u_3} [add_group A] (x : A) : set A :=
  set.range fun (i : ℤ) => i •ℤ x

protected instance gpowers.is_subgroup {G : Type u_1} [group G] (x : G) : is_subgroup (gpowers x) :=
  is_subgroup.mk fun (x₀ : G) (_x : x₀ ∈ gpowers x) => sorry

protected instance gmultiples.is_add_subgroup {A : Type u_3} [add_group A] (x : A) : is_add_subgroup (gmultiples x) :=
  iff.mp multiplicative.is_subgroup_iff (gpowers.is_subgroup x)

theorem is_subgroup.gpow_mem {G : Type u_1} [group G] {a : G} {s : set G} [is_subgroup s] (h : a ∈ s) {i : ℤ} : a ^ i ∈ s :=
  int.cases_on i (fun (i : ℕ) => idRhs (a ^ i ∈ s) (is_submonoid.pow_mem h))
    fun (i : ℕ) => idRhs (a ^ Nat.succ i⁻¹ ∈ s) (is_subgroup.inv_mem (is_submonoid.pow_mem h))

theorem is_add_subgroup.gsmul_mem {A : Type u_3} [add_group A] {a : A} {s : set A} [is_add_subgroup s] : a ∈ s → ∀ {i : ℤ}, i •ℤ a ∈ s :=
  is_subgroup.gpow_mem

theorem gpowers_subset {G : Type u_1} [group G] {a : G} {s : set G} [is_subgroup s] (h : a ∈ s) : gpowers a ⊆ s := sorry

theorem gmultiples_subset {A : Type u_3} [add_group A] {a : A} {s : set A} [is_add_subgroup s] (h : a ∈ s) : gmultiples a ⊆ s :=
  gpowers_subset h

theorem mem_gpowers {G : Type u_1} [group G] {a : G} : a ∈ gpowers a := sorry

theorem mem_gmultiples {A : Type u_3} [add_group A] {a : A} : a ∈ gmultiples a := sorry

namespace is_subgroup

theorem inv_mem_iff {G : Type u_1} {a : G} [group G] (s : set G) [is_subgroup s] : a⁻¹ ∈ s ↔ a ∈ s := sorry

theorem Mathlib.is_add_subgroup.add_mem_cancel_right {G : Type u_1} {a : G} {b : G} [add_group G] (s : set G) [is_add_subgroup s] (h : a ∈ s) : b + a ∈ s ↔ b ∈ s := sorry

theorem Mathlib.is_add_subgroup.add_mem_cancel_left {G : Type u_1} {a : G} {b : G} [add_group G] (s : set G) [is_add_subgroup s] (h : a ∈ s) : a + b ∈ s ↔ b ∈ s := sorry

end is_subgroup

class normal_add_subgroup {A : Type u_3} [add_group A] (s : set A)
extends is_add_subgroup s
where
  normal : ∀ (n : A), n ∈ s → ∀ (g : A), g + n + -g ∈ s

class normal_subgroup {G : Type u_1} [group G] (s : set G)
extends is_subgroup s
where
  normal : ∀ (n : G), n ∈ s → ∀ (g : G), g * n * (g⁻¹) ∈ s

theorem normal_add_subgroup_of_add_comm_group {G : Type u_1} [add_comm_group G] (s : set G) [hs : is_add_subgroup s] : normal_add_subgroup s := sorry

theorem additive.normal_add_subgroup {G : Type u_1} [group G] (s : set G) [normal_subgroup s] : normal_add_subgroup s :=
  normal_add_subgroup.mk normal_subgroup.normal

theorem additive.normal_add_subgroup_iff {G : Type u_1} [group G] {s : set G} : normal_add_subgroup s ↔ normal_subgroup s := sorry

theorem multiplicative.normal_subgroup {A : Type u_3} [add_group A] (s : set A) [normal_add_subgroup s] : normal_subgroup s :=
  normal_subgroup.mk normal_add_subgroup.normal

theorem multiplicative.normal_subgroup_iff {A : Type u_3} [add_group A] {s : set A} : normal_subgroup s ↔ normal_add_subgroup s := sorry

namespace is_subgroup

-- Normal subgroup properties

theorem mem_norm_comm {G : Type u_1} [group G] {s : set G} [normal_subgroup s] {a : G} {b : G} (hab : a * b ∈ s) : b * a ∈ s := sorry

theorem Mathlib.is_add_subgroup.mem_norm_comm_iff {G : Type u_1} [add_group G] {s : set G} [normal_add_subgroup s] {a : G} {b : G} : a + b ∈ s ↔ b + a ∈ s :=
  { mp := is_add_subgroup.mem_norm_comm, mpr := is_add_subgroup.mem_norm_comm }

/-- The trivial subgroup -/
def trivial (G : Type u_1) [group G] : set G :=
  singleton 1

@[simp] theorem Mathlib.is_add_subgroup.mem_trivial {G : Type u_1} [add_group G] {g : G} : g ∈ is_add_subgroup.trivial G ↔ g = 0 :=
  set.mem_singleton_iff

protected instance Mathlib.is_add_subgroup.trivial_normal {G : Type u_1} [add_group G] : normal_add_subgroup (is_add_subgroup.trivial G) := sorry

theorem Mathlib.is_add_subgroup.eq_trivial_iff {G : Type u_1} [add_group G] {s : set G} [is_add_subgroup s] : s = is_add_subgroup.trivial G ↔ ∀ (x : G), x ∈ s → x = 0 := sorry

protected instance univ_subgroup {G : Type u_1} [group G] : normal_subgroup set.univ :=
  normal_subgroup.mk
    (eq.mpr
      (id
        (Eq.trans
          (forall_congr_eq
            fun (n : G) =>
              Eq.trans
                (imp_congr_eq (propext ((fun {α : Type u_1} (x : α) => iff_true_intro (set.mem_univ x)) n))
                  (Eq.trans
                    (forall_congr_eq
                      fun (g : G) =>
                        propext ((fun {α : Type u_1} (x : α) => iff_true_intro (set.mem_univ x)) (g * n * (g⁻¹))))
                    (propext (forall_const G))))
                (propext (forall_prop_of_true True.intro)))
          (propext (forall_const G))))
      trivial)

def Mathlib.is_add_subgroup.add_center (G : Type u_1) [add_group G] : set G :=
  set_of fun (z : G) => ∀ (g : G), g + z = z + g

theorem mem_center {G : Type u_1} [group G] {a : G} : a ∈ center G ↔ ∀ (g : G), g * a = a * g :=
  iff.rfl

protected instance center_normal {G : Type u_1} [group G] : normal_subgroup (center G) := sorry

def Mathlib.is_add_subgroup.add_normalizer {G : Type u_1} [add_group G] (s : set G) : set G :=
  set_of fun (g : G) => ∀ (n : G), n ∈ s ↔ g + n + -g ∈ s

protected instance Mathlib.is_add_subgroup.normalizer_is_add_subgroup {G : Type u_1} [add_group G] (s : set G) : is_add_subgroup (is_add_subgroup.add_normalizer s) := sorry

theorem Mathlib.is_add_subgroup.subset_add_normalizer {G : Type u_1} [add_group G] (s : set G) [is_add_subgroup s] : s ⊆ is_add_subgroup.add_normalizer s := sorry

/-- Every subgroup is a normal subgroup of its normalizer -/
protected instance Mathlib.is_add_subgroup.add_normal_in_add_normalizer {G : Type u_1} [add_group G] (s : set G) [is_add_subgroup s] : normal_add_subgroup (subtype.val ⁻¹' s) :=
  normal_add_subgroup.mk
    fun (a : ↥(is_add_subgroup.add_normalizer s)) (ha : a ∈ subtype.val ⁻¹' s)
      (_x : ↥(is_add_subgroup.add_normalizer s)) => sorry

end is_subgroup

-- Homomorphism subgroups

namespace is_group_hom

def ker {G : Type u_1} {H : Type u_2} [group H] (f : G → H) : set G :=
  f ⁻¹' is_subgroup.trivial H

theorem Mathlib.is_add_group_hom.mem_ker {G : Type u_1} {H : Type u_2} [add_group H] (f : G → H) {x : G} : x ∈ is_add_group_hom.ker f ↔ f x = 0 :=
  is_add_subgroup.mem_trivial

theorem Mathlib.is_add_group_hom.zero_ker_neg {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] {a : G} {b : G} (h : f (a + -b) = 0) : f a = f b := sorry

theorem one_ker_inv' {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] {a : G} {b : G} (h : f (a⁻¹ * b) = 1) : f a = f b := sorry

theorem Mathlib.is_add_group_hom.neg_ker_zero {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] {a : G} {b : G} (h : f a = f b) : f (a + -b) = 0 := sorry

theorem inv_ker_one' {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] {a : G} {b : G} (h : f a = f b) : f (a⁻¹ * b) = 1 := sorry

theorem Mathlib.is_add_group_hom.zero_iff_ker_neg {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] (a : G) (b : G) : f a = f b ↔ f (a + -b) = 0 :=
  { mp := is_add_group_hom.neg_ker_zero f, mpr := is_add_group_hom.zero_ker_neg f }

theorem one_iff_ker_inv' {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] (a : G) (b : G) : f a = f b ↔ f (a⁻¹ * b) = 1 :=
  { mp := inv_ker_one' f, mpr := one_ker_inv' f }

theorem inv_iff_ker {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [w : is_group_hom f] (a : G) (b : G) : f a = f b ↔ a * (b⁻¹) ∈ ker f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (f a = f b ↔ a * (b⁻¹) ∈ ker f)) (propext (mem_ker f)))) (one_iff_ker_inv f a b)

theorem inv_iff_ker' {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [w : is_group_hom f] (a : G) (b : G) : f a = f b ↔ a⁻¹ * b ∈ ker f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (f a = f b ↔ a⁻¹ * b ∈ ker f)) (propext (mem_ker f)))) (one_iff_ker_inv' f a b)

protected instance Mathlib.is_add_group_hom.image_add_subgroup {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] (s : set G) [is_add_subgroup s] : is_add_subgroup (f '' s) :=
  is_add_subgroup.mk fun (a : H) (_x : a ∈ f '' s) => sorry

protected instance range_subgroup {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] : is_subgroup (set.range f) :=
  set.image_univ ▸ is_group_hom.image_subgroup f set.univ

protected instance preimage {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] (s : set H) [is_subgroup s] : is_subgroup (f ⁻¹' s) :=
  is_subgroup.mk
    (eq.mpr
      (id
        (Eq.trans
          (forall_congr_eq
            fun (a : G) =>
              Eq.trans
                (imp_congr_ctx_eq (propext set.mem_preimage)
                  fun (_h : f a ∈ s) =>
                    Eq.trans
                      (Eq.trans (propext set.mem_preimage)
                        ((fun (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : set H) (e_3 : ᾰ_2 = ᾰ_3) =>
                            congr (congr_arg has_mem.mem e_2) e_3)
                          (f (a⁻¹)) (f a⁻¹) (map_inv f a) s s (Eq.refl s)))
                      (propext
                        ((fun [c : is_subgroup s] {a : H} (ᾰ : a ∈ s) => iff_true_intro (is_subgroup.inv_mem ᾰ))
                          (iff.mpr (iff_true_intro _h) True.intro))))
                (propext forall_true_iff))
          (propext (forall_const G))))
      trivial)

protected instance preimage_normal {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] (s : set H) [normal_subgroup s] : normal_subgroup (f ⁻¹' s) := sorry

protected instance normal_subgroup_ker {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] : normal_subgroup (ker f) :=
  is_group_hom.preimage_normal f (is_subgroup.trivial H)

theorem Mathlib.is_add_group_hom.injective_of_trivial_ker {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] (h : is_add_group_hom.ker f = is_add_subgroup.trivial G) : function.injective f := sorry

theorem trivial_ker_of_injective {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G → H) [is_group_hom f] (h : function.injective f) : ker f = is_subgroup.trivial G := sorry

theorem Mathlib.is_add_group_hom.injective_iff_trivial_ker {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] : function.injective f ↔ is_add_group_hom.ker f = is_add_subgroup.trivial G :=
  { mp := is_add_group_hom.trivial_ker_of_injective f, mpr := is_add_group_hom.injective_of_trivial_ker f }

theorem Mathlib.is_add_group_hom.trivial_ker_iff_eq_zero {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] : is_add_group_hom.ker f = is_add_subgroup.trivial G ↔ ∀ (x : G), f x = 0 → x = 0 := sorry

end is_group_hom

protected instance subtype_val.is_add_group_hom {G : Type u_1} [add_group G] {s : set G} [is_add_subgroup s] : is_add_group_hom subtype.val :=
  is_add_group_hom.mk

protected instance coe.is_add_group_hom {G : Type u_1} [add_group G] {s : set G} [is_add_subgroup s] : is_add_group_hom coe :=
  is_add_group_hom.mk

protected instance subtype_mk.is_group_hom {G : Type u_1} {H : Type u_2} [group G] [group H] {s : set G} [is_subgroup s] (f : H → G) [is_group_hom f] (h : ∀ (x : H), f x ∈ s) : is_group_hom fun (x : H) => { val := f x, property := h x } :=
  is_group_hom.mk

protected instance set_inclusion.is_group_hom {G : Type u_1} [group G] {s : set G} {t : set G} [is_subgroup s] [is_subgroup t] (h : s ⊆ t) : is_group_hom (set.inclusion h) :=
  subtype_mk.is_group_hom (fun (x : ↥s) => ↑x) fun (x : ↥s) => set.inclusion._proof_1 h x

/-- `subtype.val : set.range f → H` as a monoid homomorphism, when `f` is a monoid homomorphism. -/
def monoid_hom.range_subtype_val {G : Type u_1} {H : Type u_2} [monoid G] [monoid H] (f : G →* H) : ↥(set.range ⇑f) →* H :=
  monoid_hom.of subtype.val

/-- `set.range_factorization f : G → set.range f` as a monoid homomorphism, when `f` is a monoid
homomorphism. -/
def add_monoid_hom.range_factorization {G : Type u_1} {H : Type u_2} [add_monoid G] [add_monoid H] (f : G →+ H) : G →+ ↥(set.range ⇑f) :=
  add_monoid_hom.mk (set.range_factorization ⇑f) sorry sorry

namespace add_group

inductive in_closure {A : Type u_3} [add_group A] (s : set A) : A → Prop
where
| basic : ∀ {a : A}, a ∈ s → in_closure s a
| zero : in_closure s 0
| neg : ∀ {a : A}, in_closure s a → in_closure s (-a)
| add : ∀ {a b : A}, in_closure s a → in_closure s b → in_closure s (a + b)

end add_group

namespace group

inductive in_closure {G : Type u_1} [group G] (s : set G) : G → Prop
where
| basic : ∀ {a : G}, a ∈ s → in_closure s a
| one : in_closure s 1
| inv : ∀ {a : G}, in_closure s a → in_closure s (a⁻¹)
| mul : ∀ {a b : G}, in_closure s a → in_closure s b → in_closure s (a * b)

/-- `group.closure s` is the subgroup closed over `s`, i.e. the smallest subgroup containg s. -/
def Mathlib.add_group.closure {G : Type u_1} [add_group G] (s : set G) : set G :=
  set_of fun (a : G) => add_group.in_closure s a

theorem Mathlib.add_group.mem_closure {G : Type u_1} [add_group G] {s : set G} {a : G} : a ∈ s → a ∈ add_group.closure s :=
  add_group.in_closure.basic

protected instance closure.is_subgroup {G : Type u_1} [group G] (s : set G) : is_subgroup (closure s) :=
  is_subgroup.mk fun (a : G) => in_closure.inv

theorem Mathlib.add_group.subset_closure {G : Type u_1} [add_group G] {s : set G} : s ⊆ add_group.closure s :=
  fun (a : G) => add_group.mem_closure

theorem Mathlib.add_group.closure_subset {G : Type u_1} [add_group G] {s : set G} {t : set G} [is_add_subgroup t] (h : s ⊆ t) : add_group.closure s ⊆ t := sorry

theorem Mathlib.add_group.closure_subset_iff {G : Type u_1} [add_group G] (s : set G) (t : set G) [is_add_subgroup t] : add_group.closure s ⊆ t ↔ s ⊆ t :=
  { mp := fun (h : add_group.closure s ⊆ t) (b : G) (ha : b ∈ s) => h (add_group.mem_closure ha),
    mpr := fun (h : s ⊆ t) (b : G) (ha : b ∈ add_group.closure s) => add_group.closure_subset h ha }

theorem Mathlib.add_group.closure_mono {G : Type u_1} [add_group G] {s : set G} {t : set G} (h : s ⊆ t) : add_group.closure s ⊆ add_group.closure t :=
  add_group.closure_subset (set.subset.trans h add_group.subset_closure)

@[simp] theorem closure_subgroup {G : Type u_1} [group G] (s : set G) [is_subgroup s] : closure s = s :=
  set.subset.antisymm (closure_subset (set.subset.refl s)) subset_closure

theorem Mathlib.add_group.exists_list_of_mem_closure {G : Type u_1} [add_group G] {s : set G} {a : G} (h : a ∈ add_group.closure s) : ∃ (l : List G), (∀ (x : G), x ∈ l → x ∈ s ∨ -x ∈ s) ∧ list.sum l = a := sorry

theorem Mathlib.add_group.image_closure {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] (f : G → H) [is_add_group_hom f] (s : set G) : f '' add_group.closure s = add_group.closure (f '' s) := sorry

theorem Mathlib.add_group.mclosure_subset {G : Type u_1} [add_group G] {s : set G} : add_monoid.closure s ⊆ add_group.closure s :=
  add_monoid.closure_subset add_group.subset_closure

theorem Mathlib.add_group.mclosure_neg_subset {G : Type u_1} [add_group G] {s : set G} : add_monoid.closure (Neg.neg ⁻¹' s) ⊆ add_group.closure s :=
  add_monoid.closure_subset
    fun (x : G) (hx : x ∈ Neg.neg ⁻¹' s) => neg_neg x ▸ is_add_subgroup.neg_mem (add_group.subset_closure hx)

theorem Mathlib.add_group.closure_eq_mclosure {G : Type u_1} [add_group G] {s : set G} : add_group.closure s = add_monoid.closure (s ∪ Neg.neg ⁻¹' s) := sorry

theorem Mathlib.add_group.mem_closure_union_iff {G : Type u_1} [add_comm_group G] {s : set G} {t : set G} {x : G} : x ∈ add_group.closure (s ∪ t) ↔
  ∃ (y : G), ∃ (H : y ∈ add_group.closure s), ∃ (z : G), ∃ (H : z ∈ add_group.closure t), y + z = x := sorry

theorem gpowers_eq_closure {G : Type u_1} [group G] {a : G} : gpowers a = closure (singleton a) := sorry

end group

namespace is_subgroup

theorem Mathlib.is_add_subgroup.trivial_eq_closure {G : Type u_1} [add_group G] : is_add_subgroup.trivial G = add_group.closure ∅ := sorry

end is_subgroup

/-The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/

namespace group

theorem conjugates_subset {G : Type u_1} [group G] {t : set G} [normal_subgroup t] {a : G} (h : a ∈ t) : conjugates a ⊆ t := sorry

theorem conjugates_of_set_subset' {G : Type u_1} [group G] {s : set G} {t : set G} [normal_subgroup t] (h : s ⊆ t) : conjugates_of_set s ⊆ t :=
  set.bUnion_subset fun (x : G) (H : x ∈ s) => conjugates_subset (h H)

/-- The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/
def normal_closure {G : Type u_1} [group G] (s : set G) : set G :=
  closure (conjugates_of_set s)

theorem conjugates_of_set_subset_normal_closure {G : Type u_1} {s : set G} [group G] : conjugates_of_set s ⊆ normal_closure s :=
  subset_closure

theorem subset_normal_closure {G : Type u_1} {s : set G} [group G] : s ⊆ normal_closure s :=
  set.subset.trans subset_conjugates_of_set conjugates_of_set_subset_normal_closure

/-- The normal closure of a set is a subgroup. -/
protected instance normal_closure.is_subgroup {G : Type u_1} [group G] (s : set G) : is_subgroup (normal_closure s) :=
  closure.is_subgroup (conjugates_of_set s)

/-- The normal closure of s is a normal subgroup. -/
protected instance normal_closure.is_normal {G : Type u_1} {s : set G} [group G] : normal_subgroup (normal_closure s) := sorry

/-- The normal closure of s is the smallest normal subgroup containing s. -/
theorem normal_closure_subset {G : Type u_1} [group G] {s : set G} {t : set G} [normal_subgroup t] (h : s ⊆ t) : normal_closure s ⊆ t := sorry

theorem normal_closure_subset_iff {G : Type u_1} [group G] {s : set G} {t : set G} [normal_subgroup t] : s ⊆ t ↔ normal_closure s ⊆ t :=
  { mp := normal_closure_subset, mpr := set.subset.trans subset_normal_closure }

theorem normal_closure_mono {G : Type u_1} [group G] {s : set G} {t : set G} : s ⊆ t → normal_closure s ⊆ normal_closure t :=
  fun (h : s ⊆ t) => normal_closure_subset (set.subset.trans h subset_normal_closure)

end group

class simple_group (G : Type u_4) [group G]
where
  simple : ∀ (N : set G) [_inst_1_1 : normal_subgroup N], N = is_subgroup.trivial G ∨ N = set.univ

class simple_add_group (A : Type u_4) [add_group A]
where
  simple : ∀ (N : set A) [_inst_1_1 : normal_add_subgroup N], N = is_add_subgroup.trivial A ∨ N = set.univ

theorem additive.simple_add_group_iff {G : Type u_1} [group G] : simple_add_group (additive G) ↔ simple_group G := sorry

protected instance additive.simple_add_group {G : Type u_1} [group G] [simple_group G] : simple_add_group (additive G) :=
  iff.mpr additive.simple_add_group_iff _inst_2

theorem multiplicative.simple_group_iff {A : Type u_3} [add_group A] : simple_group (multiplicative A) ↔ simple_add_group A := sorry

protected instance multiplicative.simple_group {A : Type u_3} [add_group A] [simple_add_group A] : simple_group (multiplicative A) :=
  iff.mpr multiplicative.simple_group_iff _inst_2

theorem simple_add_group_of_surjective {G : Type u_1} {H : Type u_2} [add_group G] [add_group H] [simple_add_group G] (f : G → H) [is_add_group_hom f] (hf : function.surjective f) : simple_add_group H := sorry

/-- Create a bundled subgroup from a set `s` and `[is_subroup s]`. -/
def subgroup.of {G : Type u_1} [group G] (s : set G) [h : is_subgroup s] : subgroup G :=
  subgroup.mk s sorry sorry is_subgroup.inv_mem

protected instance subgroup.is_subgroup {G : Type u_1} [group G] (K : subgroup G) : is_subgroup ↑K :=
  is_subgroup.mk (subgroup.inv_mem' K)

protected instance subgroup.of_normal {G : Type u_1} [group G] (s : set G) [h : is_subgroup s] [n : normal_subgroup s] : subgroup.normal (subgroup.of s) :=
  subgroup.normal.mk normal_subgroup.normal


import game.world10.level12 -- hide
namespace mynat -- hide
/-

# Inequality world.

## Level 13: `not_succ_le_self`

Turns out that `¬ P` is *by definition* `P → false`, so you can just
start this one with `intro h` if you like.

## Pro tip:

```
  conv begin
    to_lhs,
    rw hc,
  end,
```

is an incantation which rewrites `hc` only on the left hand side of the goal.
Look carefully at the commas. You don't need to use `conv` to solve this,
but it's a helpful trick when `rw` is rewriting too much.
-/

/- Lemma
For all naturals $a$, $\operatorname{succ}(a)$ is not at most $a$.
-/
theorem not_succ_le_self (a : mynat) : ¬ (succ a ≤ a) :=
begin [nat_num_game]
  intro h,
  cases h with c h,
  induction a with d hd,
  { rw succ_add at h,
    exact zero_ne_succ _ h,
  },
  { rw succ_add at h,
    apply hd,
    apply succ_inj,
    exact h,
  }

end

end mynat -- hide

-- thanks to Filip Szczepański for this proof (nicer than the original; I was doing -- hide
-- induction a before cases h) -- hide


/-
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.trace
import ring_theory.norm
import number_theory.number_field.basic

/-!
# Discriminant of a family of vectors

Given an `A`-algebra `B` and `b`, an `ι`-indexed family of elements of `B`, we define the
*discriminant* of `b` as the determinant of the matrix whose `(i j)`-th element is the trace of
`b i * b j`.

## Main definition

* `algebra.discr A b` : the discriminant of `b : ι → B`.

## Main results

* `algebra.discr_zero_of_not_linear_independent` : if `b` is not linear independent, then
  `algebra.discr A b = 0`.
* `algebra.discr_of_matrix_vec_mul` and `discr_of_matrix_mul_vec` : formulas relating
  `algebra.discr A ι b` with `algebra.discr A ((P.map (algebra_map A B)).vec_mul b)` and
  `algebra.discr A ((P.map (algebra_map A B)).mul_vec b)`.
* `algebra.discr_not_zero_of_basis` : over a field, if `b` is a basis, then
  `algebra.discr K b ≠ 0`.
* `algebra.discr_eq_det_embeddings_matrix_reindex_pow_two` : if `L/K` is a field extension and
  `b : ι → L`, then `discr K b` is the square of the determinant of the matrix whose `(i, j)`
  coefficient is `σⱼ (b i)`, where `σⱼ : L →ₐ[K] E` is the embedding in an algebraically closed
  field `E` corresponding to `j : ι` via a bijection `e : ι ≃ (L →ₐ[K] E)`.
* `algebra.discr_of_power_basis_eq_prod` : the discriminant of a power basis.
* `discr_is_integral` : if `K` and `L` are fields and `is_scalar_tower R K L`, is `b : ι → L`
  satisfies ` ∀ i, is_integral R (b i)`, then `is_integral R (discr K b)`.
* `discr_mul_is_integral_mem_adjoin` : let `K` be the fraction field of an integrally closed domain
  `R` and let `L` be a finite separable extension of `K`. Let `B : power_basis K L` be such that
  `is_integral R B.gen`. Then for all, `z : L` we have
  `(discr K B.basis) • z ∈ adjoin R ({B.gen} : set L)`.

## Implementation details

Our definition works for any `A`-algebra `B`, but note that if `B` is not free as an `A`-module,
then `trace A B = 0` by definition, so `discr A b = 0` for any `b`.
-/

universes u v w z

open_locale matrix big_operators

open matrix finite_dimensional fintype polynomial finset intermediate_field

namespace algebra

variables (A : Type u) {B : Type v} (C : Type z) {ι : Type w}
variables [comm_ring A] [comm_ring B] [algebra A B] [comm_ring C] [algebra A C]

section discr

/-- Given an `A`-algebra `B` and `b`, an `ι`-indexed family of elements of `B`, we define
`discr A ι b` as the determinant of `trace_matrix A ι b`. -/
noncomputable
def discr (A : Type u) {B : Type v} [comm_ring A] [comm_ring B] [algebra A B] [fintype ι]
  (b : ι → B) := by { classical, exact (trace_matrix A b).det }

lemma discr_def [decidable_eq ι] [fintype ι] (b : ι → B) :
  discr A b = (trace_matrix A b).det := by convert rfl

variables {ι' : Type*} [fintype ι'] [fintype ι]

section basic

@[simp] lemma discr_reindex (b : basis ι A B) (f : ι ≃ ι') :
  discr A (b ∘ ⇑(f.symm)) = discr A b :=
begin
  classical,
  rw [← basis.coe_reindex, discr_def, trace_matrix_reindex, det_reindex_self, ← discr_def]
end

/-- If `b` is not linear independent, then `algebra.discr A b = 0`. -/
lemma discr_zero_of_not_linear_independent [is_domain A] {b : ι → B}
  (hli : ¬linear_independent A b) : discr A b = 0 :=
begin
  classical,
  obtain ⟨g, hg, i, hi⟩ := fintype.not_linear_independent_iff.1 hli,
  have : (trace_matrix A b).mul_vec g = 0,
  { ext i,
    have : ∀ j, (trace A B) (b i * b j) * g j = (trace A B) (((g j) • (b j)) * b i),
    { intro j, simp [mul_comm], },
    simp only [mul_vec, dot_product, trace_matrix_apply, pi.zero_apply, trace_form_apply,
      λ j, this j, ← linear_map.map_sum, ← sum_mul, hg, zero_mul, linear_map.map_zero] },
  by_contra h,
  rw discr_def at h,
  simpa [matrix.eq_zero_of_mul_vec_eq_zero h this] using hi,
end

variable {A}

/-- Relation between `algebra.discr A ι b` and
`algebra.discr A ((P.map (algebra_map A B)).vec_mul b)`. -/
lemma discr_of_matrix_vec_mul [decidable_eq ι] (b : ι → B) (P : matrix ι ι A) :
  discr A ((P.map (algebra_map A B)).vec_mul b) = P.det ^ 2 * discr A b :=
by rw [discr_def, trace_matrix_of_matrix_vec_mul, det_mul, det_mul, det_transpose, mul_comm,
    ← mul_assoc, discr_def, pow_two]

/-- Relation between `algebra.discr A ι b` and
`algebra.discr A ((P.map (algebra_map A B)).mul_vec b)`. -/
lemma discr_of_matrix_mul_vec [decidable_eq ι] (b : ι → B) (P : matrix ι ι A) :
  discr A ((P.map (algebra_map A B)).mul_vec b) = P.det ^ 2 * discr A b :=
by rw [discr_def, trace_matrix_of_matrix_mul_vec, det_mul, det_mul, det_transpose,
  mul_comm, ← mul_assoc, discr_def, pow_two]

end basic

section field

variables (K : Type u) {L : Type v} (E : Type z) [field K] [field L] [field E]
variables [algebra K L] [algebra K E]
variables [module.finite K L]  [is_alg_closed E]

/-- Over a field, if `b` is a basis, then `algebra.discr K b ≠ 0`. -/
lemma discr_not_zero_of_basis [is_separable K L] (b : basis ι K L) : discr K b ≠ 0 :=
begin
  casesI is_empty_or_nonempty ι,
  { simp [discr] },
  { have := span_eq_top_of_linear_independent_of_card_eq_finrank b.linear_independent
      (finrank_eq_card_basis b).symm,
    classical,
    rw [discr_def, trace_matrix],
    simp_rw [← basis.mk_apply b.linear_independent this.ge],
    rw [← trace_matrix, trace_matrix_of_basis, ← bilin_form.nondegenerate_iff_det_ne_zero],
    exact trace_form_nondegenerate _ _ },
end

/-- Over a field, if `b` is a basis, then `algebra.discr K b` is a unit. -/
lemma discr_is_unit_of_basis [is_separable K L] (b : basis ι K L) : is_unit (discr K b) :=
is_unit.mk0 _ (discr_not_zero_of_basis _ _)

variables (b : ι → L) (pb : power_basis K L)

/-- If `L/K` is a field extension and `b : ι → L`, then `discr K b` is the square of the
determinant of the matrix whose `(i, j)` coefficient is `σⱼ (b i)`, where `σⱼ : L →ₐ[K] E` is the
embedding in an algebraically closed field `E` corresponding to `j : ι` via a bijection
`e : ι ≃ (L →ₐ[K] E)`. -/
lemma discr_eq_det_embeddings_matrix_reindex_pow_two [decidable_eq ι] [is_separable K L]
  (e : ι ≃ (L →ₐ[K] E)) : algebra_map K E (discr K b) =
  (embeddings_matrix_reindex K E b e).det ^ 2 :=
by rw [discr_def, ring_hom.map_det, ring_hom.map_matrix_apply,
    trace_matrix_eq_embeddings_matrix_reindex_mul_trans, det_mul, det_transpose, pow_two]

/-- The discriminant of a power basis. -/
lemma discr_power_basis_eq_prod (e : fin pb.dim ≃ (L →ₐ[K] E)) [is_separable K L] :
  algebra_map K E (discr K pb.basis) =
  ∏ i : fin pb.dim, ∏ j in Ioi i, (e j pb.gen- (e i pb.gen)) ^ 2 :=
begin
  rw [discr_eq_det_embeddings_matrix_reindex_pow_two K E pb.basis e,
    embeddings_matrix_reindex_eq_vandermonde, det_transpose, det_vandermonde, ← prod_pow],
  congr, ext i,
  rw [← prod_pow]
end

/-- A variation of `of_power_basis_eq_prod`. -/
lemma discr_power_basis_eq_prod' [is_separable K L] (e : fin pb.dim ≃ (L →ₐ[K] E)) :
  algebra_map K E (discr K pb.basis) =
  ∏ i : fin pb.dim, ∏ j in Ioi i, -((e j pb.gen - e i pb.gen) * (e i pb.gen - e j pb.gen)) :=
begin
  rw [discr_power_basis_eq_prod _ _ _ e],
  congr, ext i, congr, ext j,
  ring
end

local notation `n` := finrank K L

/-- A variation of `of_power_basis_eq_prod`. -/
lemma discr_power_basis_eq_prod'' [is_separable K L] (e : fin pb.dim ≃ (L →ₐ[K] E)) :
  algebra_map K E (discr K pb.basis) =
  (-1) ^ (n * (n - 1) / 2) * ∏ i : fin pb.dim, ∏ j in Ioi i,
    (e j pb.gen - e i pb.gen) * (e i pb.gen - e j pb.gen) :=
begin
  rw [discr_power_basis_eq_prod' _ _ _ e],
  simp_rw [λ i j, neg_eq_neg_one_mul ((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))),
    prod_mul_distrib],
  congr,
  simp only [prod_pow_eq_pow_sum, prod_const],
  congr,
  rw [← @nat.cast_inj ℚ, nat.cast_sum],
  have : ∀ (x : fin pb.dim), (↑x + 1) ≤ pb.dim := by simp [nat.succ_le_iff, fin.is_lt],
  simp_rw [fin.card_Ioi, nat.sub_sub, add_comm 1],
  simp only [nat.cast_sub, this, finset.card_fin, nsmul_eq_mul, sum_const, sum_sub_distrib,
    nat.cast_add, nat.cast_one, sum_add_distrib, mul_one],
  rw [← nat.cast_sum, ← @finset.sum_range ℕ _ pb.dim (λ i, i), sum_range_id ],
  have hn : n = pb.dim,
  { rw [← alg_hom.card K L E, ← fintype.card_fin pb.dim],
    exact card_congr (equiv.symm e) },
  have h₂ : 2 ∣ (pb.dim * (pb.dim - 1)) := even_iff_two_dvd.1 (nat.even_mul_self_pred _),
  have hne : ((2 : ℕ) : ℚ) ≠ 0 := by simp,
  have hle : 1 ≤ pb.dim,
  { rw [← hn, nat.one_le_iff_ne_zero, ← zero_lt_iff, finite_dimensional.finrank_pos_iff],
    apply_instance },
  rw [hn, nat.cast_div h₂ hne, nat.cast_mul, nat.cast_sub hle],
  field_simp,
  ring,
end

/-- Formula for the discriminant of a power basis using the norm of the field extension. -/
lemma discr_power_basis_eq_norm [is_separable K L] : discr K pb.basis =
  (-1) ^ (n * (n - 1) / 2) * (norm K (aeval pb.gen (minpoly K pb.gen).derivative)) :=
begin
  let E := algebraic_closure L,
  letI := λ (a b : E), classical.prop_decidable (eq a b),

  have e : fin pb.dim ≃ (L →ₐ[K] E),
  { refine equiv_of_card_eq _,
    rw [fintype.card_fin, alg_hom.card],
    exact (power_basis.finrank pb).symm },
  have hnodup : (map (algebra_map K E) (minpoly K pb.gen)).roots.nodup :=
    nodup_roots (separable.map (is_separable.separable K pb.gen)),
  have hroots : ∀ σ : L →ₐ[K] E, σ pb.gen ∈ (map (algebra_map K E) (minpoly K pb.gen)).roots,
  { intro σ,
    rw [mem_roots, is_root.def, eval_map, ← aeval_def, aeval_alg_hom_apply],
    repeat { simp [minpoly.ne_zero (is_separable.is_integral K pb.gen)] } },

  apply (algebra_map K E).injective,
  rw [ring_hom.map_mul, ring_hom.map_pow, ring_hom.map_neg, ring_hom.map_one,
    discr_power_basis_eq_prod'' _ _ _ e],
  congr,
  rw [norm_eq_prod_embeddings, prod_prod_Ioi_mul_eq_prod_prod_off_diag],
  conv_rhs { congr, skip, funext,
    rw [← aeval_alg_hom_apply, aeval_root_derivative_of_splits (minpoly.monic
      (is_separable.is_integral K pb.gen)) (is_alg_closed.splits_codomain _) (hroots σ),
      ← finset.prod_mk _ (hnodup.erase _)] },
  rw [prod_sigma', prod_sigma'],
  refine prod_bij (λ i hi, ⟨e i.2, e i.1 pb.gen⟩) (λ i hi, _) (λ i hi, by simp at hi)
    (λ i j hi hj hij, _) (λ σ hσ, _),
  { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma],
    rw [multiset.mem_erase_of_ne (λ h, _)],
    { exact hroots _ },
    { simp only [true_and, mem_univ, ne.def, mem_sigma, mem_compl, mem_singleton] at hi,
      rw [← power_basis.lift_equiv_apply_coe, ← power_basis.lift_equiv_apply_coe] at h,
      exact hi (e.injective $ pb.lift_equiv.injective $ subtype.eq h.symm) } },
  { simp only [equiv.apply_eq_iff_eq, heq_iff_eq] at hij,
    have h := hij.2,
    rw [← power_basis.lift_equiv_apply_coe, ← power_basis.lift_equiv_apply_coe] at h,
    refine sigma.eq (equiv.injective e (equiv.injective _ (subtype.eq h))) (by simp [hij.1]) },
  { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma] at ⊢ hσ,
    simp only [sigma.exists, exists_prop, mem_compl, mem_singleton, ne.def],
    refine ⟨e.symm (power_basis.lift pb σ.2 _), e.symm σ.1, ⟨λ h, _, sigma.eq _ _⟩⟩,
    { rw [aeval_def, eval₂_eq_eval_map, ← is_root.def, ← mem_roots],
      { exact multiset.erase_subset _ _ hσ },
      { simp [minpoly.ne_zero (is_separable.is_integral K pb.gen)] } },
    { replace h := alg_hom.congr_fun (equiv.injective _ h) pb.gen,
      rw [power_basis.lift_gen] at h,
      rw [← h] at hσ,
      exact hnodup.not_mem_erase hσ },
    all_goals { simp } }
end

section integral

variables {R : Type z} [comm_ring R] [algebra R K] [algebra R L] [is_scalar_tower R K L]

/-- If `K` and `L` are fields and `is_scalar_tower R K L`, and `b : ι → L` satisfies
` ∀ i, is_integral R (b i)`, then `is_integral R (discr K b)`. -/
lemma discr_is_integral {b : ι → L} (h : ∀ i, is_integral R (b i)) :
  is_integral R (discr K b) :=
begin
  classical,
  rw [discr_def],
  exact is_integral.det (λ i j, is_integral_trace (is_integral_mul (h i) (h j)))
end

/-- If `b` and `b'` are `ℚ`-bases of a number field `K` such that
`∀ i j, is_integral ℤ (b.to_matrix b' i j)` and `∀ i j, is_integral ℤ (b'.to_matrix b i j)` then
`discr ℚ b = discr ℚ b'`. -/
lemma discr_eq_discr_of_to_matrix_coeff_is_integral [number_field K] {b : basis ι ℚ K}
  {b' : basis ι' ℚ K} (h : ∀ i j, is_integral ℤ (b.to_matrix b' i j))
  (h' : ∀ i j, is_integral ℤ (b'.to_matrix b i j)) :
  discr ℚ b = discr ℚ b' :=
begin
  replace h' : ∀ i j, is_integral ℤ (b'.to_matrix ((b.reindex (b.index_equiv b'))) i j),
  { intros i j,
    convert h' i ((b.index_equiv b').symm j),
    simpa },
  classical,
  rw [← (b.reindex (b.index_equiv b')).to_matrix_map_vec_mul b', discr_of_matrix_vec_mul,
    ← one_mul (discr ℚ b), basis.coe_reindex, discr_reindex],
  congr,
  have hint : is_integral ℤ (((b.reindex (b.index_equiv b')).to_matrix b').det) :=
    is_integral.det (λ i j, h _ _),
  obtain ⟨r, hr⟩ := is_integrally_closed.is_integral_iff.1 hint,
  have hunit : is_unit r,
  { have : is_integral ℤ ((b'.to_matrix (b.reindex (b.index_equiv b'))).det) :=
      is_integral.det (λ i j, h' _ _),
    obtain ⟨r', hr'⟩ := is_integrally_closed.is_integral_iff.1 this,
    refine is_unit_iff_exists_inv.2 ⟨r', _⟩,
    suffices : algebra_map ℤ ℚ (r * r') = 1,
    { rw [← ring_hom.map_one (algebra_map ℤ ℚ)] at this,
      exact (is_fraction_ring.injective ℤ ℚ) this },
    rw [ring_hom.map_mul, hr, hr', ← det_mul, basis.to_matrix_mul_to_matrix_flip, det_one] },
  rw [← ring_hom.map_one (algebra_map ℤ ℚ), ← hr],
  cases int.is_unit_iff.1 hunit with hp hm,
  { simp [hp] },
  { simp [hm] }
end

/-- Let `K` be the fraction field of an integrally closed domain `R` and let `L` be a finite
separable extension of `K`. Let `B : power_basis K L` be such that `is_integral R B.gen`.
Then for all, `z : L` that are integral over `R`, we have
`(discr K B.basis) • z ∈ adjoin R ({B.gen} : set L)`. -/
lemma discr_mul_is_integral_mem_adjoin [is_domain R] [is_separable K L] [is_integrally_closed R]
  [is_fraction_ring R K] {B : power_basis K L} (hint : is_integral R B.gen) {z : L}
  (hz : is_integral R z) : (discr K B.basis) • z ∈ adjoin R ({B.gen} : set L) :=
begin
  have hinv : is_unit (trace_matrix K B.basis).det :=
    by simpa [← discr_def] using discr_is_unit_of_basis _ B.basis,

  have H : (trace_matrix K B.basis).det • (trace_matrix K B.basis).mul_vec (B.basis.equiv_fun z) =
    (trace_matrix K B.basis).det • (λ i, trace K L (z * B.basis i)),
  { congr, exact trace_matrix_of_basis_mul_vec _ _ },
  have cramer := mul_vec_cramer (trace_matrix K B.basis) (λ i, trace K L (z * B.basis i)),

  suffices : ∀ i, ((trace_matrix K B.basis).det • (B.basis.equiv_fun z)) i ∈ (⊥ : subalgebra R K),
  { rw [← B.basis.sum_repr z, finset.smul_sum],
    refine subalgebra.sum_mem _ (λ i hi, _),
    replace this := this i,
    rw [← discr_def, pi.smul_apply, mem_bot] at this,
    obtain ⟨r, hr⟩ := this,
    rw [basis.equiv_fun_apply] at hr,
    rw [← smul_assoc, ← hr, algebra_map_smul],
    refine subalgebra.smul_mem _ _ _,
    rw [B.basis_eq_pow i],
    refine subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton _)) _},
  intro i,
  rw [← H, ← mul_vec_smul] at cramer,
  replace cramer := congr_arg (mul_vec (trace_matrix K B.basis)⁻¹) cramer,
  rw [mul_vec_mul_vec, nonsing_inv_mul _ hinv, mul_vec_mul_vec, nonsing_inv_mul _ hinv,
    one_mul_vec, one_mul_vec] at cramer,
  rw [← congr_fun cramer i, cramer_apply, det_apply],
  refine subalgebra.sum_mem _ (λ σ _, subalgebra.zsmul_mem _ (subalgebra.prod_mem _ (λ j _, _)) _),
  by_cases hji : j = i,
  { simp only [update_column_apply, hji, eq_self_iff_true, power_basis.coe_basis],
    exact mem_bot.2 (is_integrally_closed.is_integral_iff.1 $ is_integral_trace $
      is_integral_mul hz $ is_integral.pow hint _) },
  { simp only [update_column_apply, hji, power_basis.coe_basis],
    exact mem_bot.2 (is_integrally_closed.is_integral_iff.1 $ is_integral_trace
      $ is_integral_mul (is_integral.pow hint _) (is_integral.pow hint _)) }
end

end integral

end field

end discr

end algebra


import data.zmod.basic data.nat.prime
  data.zmod.quadratic_reciprocity
  tactic.find tactic.omega data.vector
  list_lemma

namespace ElGamal
/-
A Schnorr group is a large prime-order subgroup of ℤ∗𝑝,
the multiplicative group of integers modulo 𝑝.
To generate such a group, we find 𝑝=𝑞𝑟+1 such that 𝑝 and 𝑞
are prime. Then, we choose any ℎ
in the range 1<ℎ<𝑝 such that ℎ^r ≠ 1 (mod𝑝)
The value 𝑔=ℎ^𝑟(mod𝑝) is a generator of a subgroup ℤ∗𝑝 of order 𝑞.
By Fermat's little theorem
g^q = h^(rq) = h^(p-1) = 1 (mod p)
-/

variables
  (p : ℕ) (q : ℕ) (r : ℕ)
  (Hr : 2 ≤ r)
  (Hp : nat.prime p)
  (Hq : nat.prime q)
  (Hdiv : p = q * r + 1)
  (h : zmodp p Hp)
  (Hh₁ : h ≠ 0)
  (Hh₂ : h^r ≠ 1)
  (g : zmodp p Hp) /- generator of a subgroup of ℤ⋆p of order q -/
  (Hg : g = h^r)

section
include Hg Hdiv Hh₁
theorem generator_proof : g ^ q = 1 :=
begin
  rw [Hg, <- pow_mul, mul_comm],
  have Ht : p - 1 = q * r := nat.pred_eq_of_eq_succ Hdiv,
  rw <- Ht, exact zmodp.fermat_little Hp Hh₁
end
end

variables
  (prikey : zmodp q Hq) /- private key -/
  (pubkey : zmodp p Hp) /- public key -/
  (Hrel : pubkey = g^prikey.val)

def elgamal_enc (m : zmodp p Hp) (r : zmodp q Hq) :=
  (g^r.val, g^m.val * pubkey^r.val)

def elgamal_dec (c : zmodp p Hp ×  zmodp p Hp) :=
  c.2 * (c.1^prikey.val)⁻¹

def elgamal_reenc (c : zmodp p Hp ×  zmodp p Hp)
  (r : zmodp q Hq) :=
  (c.1 * g^r.val, c.2 * pubkey^r.val)

def ciphertext_mult (c : zmodp p Hp × zmodp p Hp)
     (d : zmodp p Hp ×  zmodp p Hp) :=
     (c.1 * d.1, c.2 * d.2)

def vector_elegamal_enc {n : ℕ} :
  vector (zmodp p Hp) n -> vector (zmodp q Hq) n ->
  vector (zmodp p Hp × zmodp p Hp) n
  | ⟨ms, Hm⟩  ⟨rs, Hr⟩ :=
    ⟨list.zip_with (elgamal_enc p q Hp Hq g pubkey) ms rs,
    begin
      have Ht : list.length ms = list.length rs :=
      begin rw [Hm, Hr] end,
      rw <- Hm, apply zip_with_len_l, exact Ht
    end ⟩

def vector_elegamal_dec {n : ℕ} :
  vector (zmodp p Hp × zmodp p Hp) n ->
  vector (zmodp p Hp) n
  | ⟨cs, Hc⟩  :=
    ⟨list.map (elgamal_dec p q Hp Hq prikey) cs,
    begin
      rw <- Hc, apply map_with_len_l,
    end ⟩

def vector_elegamal_reenc {n : ℕ} :
  vector (zmodp p Hp × zmodp p Hp) n -> vector (zmodp q Hq) n ->
  vector (zmodp p Hp × zmodp p Hp) n
  | ⟨cs, Hc⟩  ⟨rs, Hr⟩ :=
    ⟨list.zip_with (elgamal_reenc p q Hp Hq g pubkey) cs rs,
    begin
      have Ht : list.length cs = list.length rs :=
      begin rw [Hc, Hr] end,
      rw <- Hc, apply zip_with_len_l, exact Ht
    end ⟩

def vector_ciphertext_mult {n : ℕ} :
  vector (zmodp p Hp × zmodp p Hp) n -> vector (zmodp p Hp × zmodp p Hp) n ->
  vector (zmodp p Hp × zmodp p Hp) n
  | ⟨cs₁ , Hc₁⟩  ⟨cs₂, Hc₂⟩ :=
    ⟨list.zip_with (ciphertext_mult p Hp) cs₁  cs₂,
    begin
      have Ht : list.length cs₁ = list.length cs₂ :=
      begin rw [Hc₁, Hc₂] end,
      rw <- Hc₁, apply zip_with_len_l, exact Ht,
    end ⟩

#print vector_ciphertext_mult._main

/-
inductive count

1. a ballot encrypted with [g^0, g^0, ....]
2. a ballot is valid add it to the running margin
3. invalid, discard it and permute it by
    a secret permutation
4. when no more ballot left, then honest decryption

Zero-Knowledge-Proof framework

Wikstrom Shuffle proof
Extend it to the Coq as well, plug these
proofs in Coq.

-/

include Hrel Hg Hh₁
theorem elgama_enc_dec_identity :
∀ m r', elgamal_dec p q Hp Hq prikey
       (elgamal_enc p q Hp Hq g pubkey m r') = g^m.val :=
begin
  unfold elgamal_enc elgamal_dec,
  intros, simp, rw [Hrel, <- pow_mul, <- pow_mul],
  have Ht : g ≠ 0 := begin
  rw Hg, exact pow_ne_zero r Hh₁ end,
  have Ht₁ : g ^ (prikey.val * r'.val) ≠ 0 :=
    pow_ne_zero _ Ht,
  have Ht₂ : r'.val * prikey.val = prikey.val * r'.val :=
       mul_comm r'.val prikey.val,
  rw [Ht₂, mul_assoc, mul_inv_cancel Ht₁], ring
end

theorem additive_homomorphic_property : forall c d m₁ m₂ r₁ r₂,
 c = elgamal_enc p q Hp Hq g pubkey m₁ r₁ ->
 d = elgamal_enc p q Hp Hq g pubkey m₂ r₂ ->
 (g^(r₁.val + r₂.val), g^(m₁.val + m₂.val) *
 pubkey^(r₁.val + r₂.val)) = ciphertext_mult p Hp c d :=
begin
  unfold elgamal_enc ciphertext_mult,
  intros c d m₁ m₂ r₁ r₂ Hc Hd, simp,
  have Ht₁ : g ^ (r₁.val + r₂.val) = c.fst * d.fst :=
  begin
    rw [Hc, Hd], simp, exact pow_add g r₁.val r₂.val
  end,
  have Ht₂ : g ^ (m₁.val + m₂.val) * pubkey ^ (r₁.val + r₂.val) =
      c.snd * d.snd :=  begin
        rw [Hc, Hd, pow_add,
        pow_add], simp, ring
        end,
  exact and.intro Ht₁ Ht₂
end

end ElGamal

#check ElGamal.elgamal_enc


-- Notes 10/3/2019

-- example of a polymorphic function: identity function
def identity {α : Type} : α → α
| x := x

-- explicit type arguments are denoted by ()
-- implicit type arguments are denoted by {}

def id' (α : Type) (a : α) : α := a

#eval id' nat 3
#check (id' nat) -- we can partially evaluate id', making a monomorphic version of this function

def not_predicate {α : Type} : (α → bool) → (α → bool)
| f := λ x, ¬(f x)

def is_even : nat → bool
| 0 := tt
| 1 := ff
| (n' + 2) := is_even n'

def is_odd := not_predicate is_even

#eval is_even 2
#eval is_odd 1

-- Back to our boxed example

inductive boxed ( α : Type )
| box : α → boxed

def unbox {α : Type} : (boxed α) → α
| (boxed.box x) := x

#eval unbox (boxed.box 3)
#eval unbox (boxed.box "hello")
#reduce unbox (boxed.box (boxed.box (boxed.box 3)))

/-
A polymorphic ordered pair example (cartesian product)
-/

inductive mprod (α β : Type)
| pair : α → β → mprod

-- return the first element of our pair
def first {α β : Type} : (mprod α β) → α
| (mprod.pair x _) := x

-- return the second element of our pair
def second {α β : Type} : (mprod α β) → β
| (mprod.pair _ y) := y

def ex := mprod.pair 2 3
#check ex

#eval first ex

def p1 : (mprod string nat) := (mprod.pair "cat" 1)

#eval second p1

-- Challenge time!

def swap {α β : Type} : (mprod α β) → (mprod β α)
| (mprod.pair x y) := (mprod.pair y x)

#reduce swap ex


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

import order.complete_boolean_algebra
import order.modular_lattice
import data.fintype.basic

/-!
# Atoms, Coatoms, and Simple Lattices

This module defines atoms, which are minimal non-`⊥` elements in bounded lattices, simple lattices,
which are lattices with only two elements, and related ideas.

## Main definitions

### Atoms and Coatoms
  * `is_atom a` indicates that the only element below `a` is `⊥`.
  * `is_coatom a` indicates that the only element above `a` is `⊤`.

### Atomic and Atomistic Lattices
  * `is_atomic` indicates that every element other than `⊥` is above an atom.
  * `is_coatomic` indicates that every element other than `⊤` is below a coatom.
  * `is_atomistic` indicates that every element is the `Sup` of a set of atoms.
  * `is_coatomistic` indicates that every element is the `Inf` of a set of coatoms.

### Simple Lattices
  * `is_simple_lattice` indicates that a bounded lattice has only two elements, `⊥` and `⊤`.
  * `is_simple_lattice.bounded_distrib_lattice`
  * Given an instance of `is_simple_lattice`, we provide the following definitions. These are not
    made global instances as they contain data :
    * `is_simple_lattice.boolean_algebra`
    * `is_simple_lattice.complete_lattice`
    * `is_simple_lattice.complete_boolean_algebra`

## Main results
  * `is_atom_dual_iff_is_coatom` and `is_coatom_dual_iff_is_atom` express the (definitional) duality
   of `is_atom` and `is_coatom`.
  * `is_simple_lattice_iff_is_atom_top` and `is_simple_lattice_iff_is_coatom_bot` express the
  connection between atoms, coatoms, and simple lattices
  * `is_compl.is_atom_iff_is_coatom` and `is_compl.is_coatom_if_is_atom`: In a modular
  bounded lattice, a complement of an atom is a coatom and vice versa.
  * ``is_atomic_iff_is_coatomic`: A modular complemented lattice is atomic iff it is coatomic.

-/

variable {α : Type*}

section atoms

section is_atom

variable [order_bot α]

/-- An atom of an `order_bot` is an element with no other element between it and `⊥`,
  which is not `⊥`. -/
def is_atom (a : α) : Prop := a ≠ ⊥ ∧ (∀ b, b < a → b = ⊥)

lemma eq_bot_or_eq_of_le_atom {a b : α} (ha : is_atom a) (hab : b ≤ a) : b = ⊥ ∨ b = a :=
hab.lt_or_eq.imp_left (ha.2 b)

lemma is_atom.Iic {x a : α} (ha : is_atom a) (hax : a ≤ x) : is_atom (⟨a, hax⟩ : set.Iic x) :=
⟨λ con, ha.1 (subtype.mk_eq_mk.1 con), λ ⟨b, hb⟩ hba, subtype.mk_eq_mk.2 (ha.2 b hba)⟩

lemma is_atom.of_is_atom_coe_Iic {x : α} {a : set.Iic x} (ha : is_atom a) : is_atom (a : α) :=
⟨λ con, ha.1 (subtype.ext con), λ b hba, subtype.mk_eq_mk.1 (ha.2 ⟨b, hba.le.trans a.prop⟩ hba)⟩

end is_atom

section is_coatom

variable [order_top α]

/-- A coatom of an `order_top` is an element with no other element between it and `⊤`,
  which is not `⊤`. -/
def is_coatom (a : α) : Prop := a ≠ ⊤ ∧ (∀ b, a < b → b = ⊤)

lemma eq_top_or_eq_of_coatom_le {a b : α} (ha : is_coatom a) (hab : a ≤ b) : b = ⊤ ∨ b = a :=
hab.lt_or_eq.imp (ha.2 b) eq_comm.2

lemma is_coatom.Ici {x a : α} (ha : is_coatom a) (hax : x ≤ a) : is_coatom (⟨a, hax⟩ : set.Ici x) :=
⟨λ con, ha.1 (subtype.mk_eq_mk.1 con), λ ⟨b, hb⟩ hba, subtype.mk_eq_mk.2 (ha.2 b hba)⟩

lemma is_coatom.of_is_coatom_coe_Ici {x : α} {a : set.Ici x} (ha : is_coatom a) :
  is_coatom (a : α) :=
⟨λ con, ha.1 (subtype.ext con), λ b hba, subtype.mk_eq_mk.1 (ha.2 ⟨b, le_trans a.prop hba.le⟩ hba)⟩

end is_coatom

section pairwise

lemma is_atom.inf_eq_bot_of_ne [semilattice_inf_bot α] {a b : α}
  (ha : is_atom a) (hb : is_atom b) (hab : a ≠ b) : a ⊓ b = ⊥ :=
or.elim (eq_bot_or_eq_of_le_atom ha inf_le_left) id
  (λ h1, or.elim (eq_bot_or_eq_of_le_atom hb inf_le_right) id
  (λ h2, false.rec _ (hab (le_antisymm (inf_eq_left.mp h1) (inf_eq_right.mp h2)))))

lemma is_atom.disjoint_of_ne [semilattice_inf_bot α] {a b : α}
  (ha : is_atom a) (hb : is_atom b) (hab : a ≠ b) : disjoint a b :=
disjoint_iff.mpr (is_atom.inf_eq_bot_of_ne ha hb hab)

lemma is_coatom.sup_eq_top_of_ne [semilattice_sup_top α] {a b : α}
  (ha : is_coatom a) (hb : is_coatom b) (hab : a ≠ b) : a ⊔ b = ⊤ :=
or.elim (eq_top_or_eq_of_coatom_le ha le_sup_left) id
  (λ h1, or.elim (eq_top_or_eq_of_coatom_le hb le_sup_right) id
  (λ h2, false.rec _ (hab (le_antisymm (sup_eq_right.mp h2) (sup_eq_left.mp h1)))))

end pairwise

variables [bounded_lattice α] {a : α}

@[simp]
lemma is_coatom_dual_iff_is_atom : is_coatom (order_dual.to_dual a) ↔ is_atom a := iff.refl _

@[simp]
lemma is_atom_dual_iff_is_coatom : is_atom (order_dual.to_dual a) ↔ is_coatom a := iff.refl _

end atoms

section atomic

variables (α) [bounded_lattice α]

/-- A lattice is atomic iff every element other than `⊥` has an atom below it. -/
class is_atomic : Prop :=
(eq_bot_or_exists_atom_le : ∀ (b : α), b = ⊥ ∨ ∃ (a : α), is_atom a ∧ a ≤ b)

/-- A lattice is coatomic iff every element other than `⊤` has a coatom above it. -/
class is_coatomic : Prop :=
(eq_top_or_exists_le_coatom : ∀ (b : α), b = ⊤ ∨ ∃ (a : α), is_coatom a ∧ b ≤ a)

export is_atomic (eq_bot_or_exists_atom_le) is_coatomic (eq_top_or_exists_le_coatom)

variable {α}

@[simp] theorem is_coatomic_dual_iff_is_atomic : is_coatomic (order_dual α) ↔ is_atomic α :=
⟨λ h, ⟨λ b, by apply h.eq_top_or_exists_le_coatom⟩, λ h, ⟨λ b, by apply h.eq_bot_or_exists_atom_le⟩⟩

@[simp] theorem is_atomic_dual_iff_is_coatomic : is_atomic (order_dual α) ↔ is_coatomic α :=
⟨λ h, ⟨λ b, by apply h.eq_bot_or_exists_atom_le⟩, λ h, ⟨λ b, by apply h.eq_top_or_exists_le_coatom⟩⟩

namespace is_atomic

instance is_coatomic_dual [h : is_atomic α] : is_coatomic (order_dual α) :=
is_coatomic_dual_iff_is_atomic.2 h

variables [is_atomic α]

instance {x : α} : is_atomic (set.Iic x) :=
⟨λ ⟨y, hy⟩, (eq_bot_or_exists_atom_le y).imp subtype.mk_eq_mk.2
  (λ ⟨a, ha, hay⟩, ⟨⟨a, hay.trans hy⟩, ha.Iic (hay.trans hy), hay⟩)⟩

end is_atomic

namespace is_coatomic
instance is_coatomic [h : is_coatomic α] : is_atomic (order_dual α) :=
is_atomic_dual_iff_is_coatomic.2 h

variables [is_coatomic α]

instance {x : α} : is_coatomic (set.Ici x) :=
⟨λ ⟨y, hy⟩, (eq_top_or_exists_le_coatom y).imp subtype.mk_eq_mk.2
  (λ ⟨a, ha, hay⟩, ⟨⟨a, le_trans hy hay⟩, ha.Ici (le_trans hy hay), hay⟩)⟩

end is_coatomic

theorem is_atomic_iff_forall_is_atomic_Iic :
  is_atomic α ↔ ∀ (x : α), is_atomic (set.Iic x) :=
⟨@is_atomic.set.Iic.is_atomic _ _, λ h, ⟨λ x, ((@eq_bot_or_exists_atom_le _ _ (h x))
  (⊤ : set.Iic x)).imp subtype.mk_eq_mk.1 (exists_imp_exists' coe
  (λ ⟨a, ha⟩, and.imp_left (is_atom.of_is_atom_coe_Iic)))⟩⟩

theorem is_coatomic_iff_forall_is_coatomic_Ici :
  is_coatomic α ↔ ∀ (x : α), is_coatomic (set.Ici x) :=
is_atomic_dual_iff_is_coatomic.symm.trans $ is_atomic_iff_forall_is_atomic_Iic.trans $ forall_congr
  (λ x, is_coatomic_dual_iff_is_atomic.symm.trans iff.rfl)

end atomic

section atomistic

variables (α) [complete_lattice α]

/-- A lattice is atomistic iff every element is a `Sup` of a set of atoms. -/
class is_atomistic : Prop :=
(eq_Sup_atoms : ∀ (b : α), ∃ (s : set α), b = Sup s ∧ ∀ a, a ∈ s → is_atom a)

/-- A lattice is coatomistic iff every element is an `Inf` of a set of coatoms. -/
class is_coatomistic: Prop :=
(eq_Inf_coatoms : ∀ (b : α), ∃ (s : set α), b = Inf s ∧ ∀ a, a ∈ s → is_coatom a)

export is_atomistic (eq_Sup_atoms) is_coatomistic (eq_Inf_coatoms)

variable {α}

@[simp]
theorem is_coatomistic_dual_iff_is_atomistic : is_coatomistic (order_dual α) ↔ is_atomistic α :=
⟨λ h, ⟨λ b, by apply h.eq_Inf_coatoms⟩, λ h, ⟨λ b, by apply h.eq_Sup_atoms⟩⟩

@[simp]
theorem is_atomistic_dual_iff_is_coatomistic : is_atomistic (order_dual α) ↔ is_coatomistic α :=
⟨λ h, ⟨λ b, by apply h.eq_Sup_atoms⟩, λ h, ⟨λ b, by apply h.eq_Inf_coatoms⟩⟩

namespace is_atomistic

instance is_coatomistic_dual [h : is_atomistic α] : is_coatomistic (order_dual α) :=
is_coatomistic_dual_iff_is_atomistic.2 h

variable [is_atomistic α]

@[priority 100]
instance : is_atomic α :=
⟨λ b, by { rcases eq_Sup_atoms b with ⟨s, rfl, hs⟩,
  cases s.eq_empty_or_nonempty with h h,
  { simp [h] },
  { exact or.intro_right _ ⟨h.some, hs _ h.some_spec, le_Sup h.some_spec⟩ } } ⟩

end is_atomistic

section is_atomistic
variables [is_atomistic α]

@[simp]
theorem Sup_atoms_le_eq (b : α) : Sup {a : α | is_atom a ∧ a ≤ b} = b :=
begin
  rcases eq_Sup_atoms b with ⟨s, rfl, hs⟩,
  exact le_antisymm (Sup_le (λ _, and.right)) (Sup_le_Sup (λ a ha, ⟨hs a ha, le_Sup ha⟩)),
end

@[simp]
theorem Sup_atoms_eq_top : Sup {a : α | is_atom a} = ⊤ :=
begin
  refine eq.trans (congr rfl (set.ext (λ x, _))) (Sup_atoms_le_eq ⊤),
  exact (and_iff_left le_top).symm,
end

theorem le_iff_atom_le_imp {a b : α} :
  a ≤ b ↔ ∀ c : α, is_atom c → c ≤ a → c ≤ b :=
⟨λ ab c hc ca, le_trans ca ab, λ h, begin
  rw [← Sup_atoms_le_eq a, ← Sup_atoms_le_eq b],
  exact Sup_le_Sup (λ c hc, ⟨hc.1, h c hc.1 hc.2⟩),
end⟩

end is_atomistic

namespace is_coatomistic

instance is_atomistic_dual [h : is_coatomistic α] : is_atomistic (order_dual α) :=
is_atomistic_dual_iff_is_coatomistic.2 h

variable [is_coatomistic α]

@[priority 100]
instance : is_coatomic α :=
⟨λ b, by { rcases eq_Inf_coatoms b with ⟨s, rfl, hs⟩,
  cases s.eq_empty_or_nonempty with h h,
  { simp [h] },
  { exact or.intro_right _ ⟨h.some, hs _ h.some_spec, Inf_le h.some_spec⟩ } } ⟩

end is_coatomistic
end atomistic

/-- A lattice is simple iff it has only two elements, `⊥` and `⊤`. -/
class is_simple_lattice (α : Type*) [bounded_lattice α] extends nontrivial α : Prop :=
(eq_bot_or_eq_top : ∀ (a : α), a = ⊥ ∨ a = ⊤)

export is_simple_lattice (eq_bot_or_eq_top)

theorem is_simple_lattice_iff_is_simple_lattice_order_dual [bounded_lattice α] :
  is_simple_lattice α ↔ is_simple_lattice (order_dual α) :=
begin
  split; intro i; haveI := i,
  { exact { exists_pair_ne := @exists_pair_ne α _,
      eq_bot_or_eq_top := λ a, or.symm (eq_bot_or_eq_top ((order_dual.of_dual a)) : _ ∨ _) } },
  { exact { exists_pair_ne := @exists_pair_ne (order_dual α) _,
      eq_bot_or_eq_top := λ a, or.symm (eq_bot_or_eq_top (order_dual.to_dual a)) } }
end

section is_simple_lattice

variables [bounded_lattice α] [is_simple_lattice α]

instance : is_simple_lattice (order_dual α) :=
is_simple_lattice_iff_is_simple_lattice_order_dual.1 (by apply_instance)

@[simp] lemma is_atom_top : is_atom (⊤ : α) :=
⟨top_ne_bot, λ a ha, or.resolve_right (eq_bot_or_eq_top a) (ne_of_lt ha)⟩

@[simp] lemma is_coatom_bot : is_coatom (⊥ : α) := is_atom_dual_iff_is_coatom.1 is_atom_top

end is_simple_lattice

namespace is_simple_lattice

variables [bounded_lattice α] [is_simple_lattice α]

/-- A simple `bounded_lattice` is also distributive. -/
@[priority 100]
instance : bounded_distrib_lattice α :=
{ le_sup_inf := λ x y z, by { rcases eq_bot_or_eq_top x with rfl | rfl; simp },
  .. (infer_instance : bounded_lattice α) }

@[priority 100]
instance : is_atomic α :=
⟨λ b, (eq_bot_or_eq_top b).imp_right (λ h, ⟨⊤, ⟨is_atom_top, ge_of_eq h⟩⟩)⟩

@[priority 100]
instance : is_coatomic α := is_atomic_dual_iff_is_coatomic.1 is_simple_lattice.is_atomic

section decidable_eq
variable [decidable_eq α]

/-- Every simple lattice is order-isomorphic to `bool`. -/
def order_iso_bool : α ≃o bool :=
{ to_fun := λ x, x = ⊤,
  inv_fun := λ x, cond x ⊤ ⊥,
  left_inv := λ x, by { rcases (eq_bot_or_eq_top x) with rfl | rfl; simp [bot_ne_top] },
  right_inv := λ x, by { cases x; simp [bot_ne_top] },
  map_rel_iff' := λ a b, begin
    rcases (eq_bot_or_eq_top a) with rfl | rfl,
    { simp [bot_ne_top] },
    { rcases (eq_bot_or_eq_top b) with rfl | rfl,
      { simp [bot_ne_top.symm, bot_ne_top, bool.ff_lt_tt] },
      { simp [bot_ne_top] } }
  end }

@[priority 200]
instance : fintype α := fintype.of_equiv bool (order_iso_bool.to_equiv).symm

/-- A simple `bounded_lattice` is also a `boolean_algebra`. -/
protected def boolean_algebra : boolean_algebra α :=
{ compl := λ x, if x = ⊥ then ⊤ else ⊥,
  sdiff := λ x y, if x = ⊤ ∧ y = ⊥ then ⊤ else ⊥,
  sdiff_eq := λ x y, by rcases eq_bot_or_eq_top x with rfl | rfl;
      simp [bot_ne_top, has_sdiff.sdiff, compl],
  inf_compl_le_bot := λ x, by rcases eq_bot_or_eq_top x with rfl | rfl; simp,
  top_le_sup_compl := λ x, by rcases eq_bot_or_eq_top x with rfl | rfl; simp,
  sup_inf_sdiff := λ x y, by rcases eq_bot_or_eq_top x with rfl | rfl;
      rcases eq_bot_or_eq_top y with rfl | rfl; simp [bot_ne_top],
  inf_inf_sdiff := λ x y, by rcases eq_bot_or_eq_top x with rfl | rfl;
      rcases eq_bot_or_eq_top y with rfl | rfl; simp,
  .. is_simple_lattice.bounded_distrib_lattice }

end decidable_eq

open_locale classical

/-- A simple `bounded_lattice` is also complete. -/
protected noncomputable def complete_lattice : complete_lattice α :=
{ Sup := λ s, if ⊤ ∈ s then ⊤ else ⊥,
  Inf := λ s, if ⊥ ∈ s then ⊥ else ⊤,
  le_Sup := λ s x h, by { rcases eq_bot_or_eq_top x with rfl | rfl,
    { exact bot_le },
    { rw if_pos h } },
  Sup_le := λ s x h, by { rcases eq_bot_or_eq_top x with rfl | rfl,
    { rw if_neg,
      intro con,
      exact bot_ne_top (eq_top_iff.2 (h ⊤ con)) },
    { exact le_top } },
  Inf_le := λ s x h, by { rcases eq_bot_or_eq_top x with rfl | rfl,
    { rw if_pos h },
    { exact le_top } },
  le_Inf := λ s x h, by { rcases eq_bot_or_eq_top x with rfl | rfl,
    { exact bot_le },
    { rw if_neg,
      intro con,
      exact top_ne_bot (eq_bot_iff.2 (h ⊥ con)) } },
  .. (infer_instance : bounded_lattice α) }

/-- A simple `bounded_lattice` is also a `complete_boolean_algebra`. -/
protected noncomputable def complete_boolean_algebra : complete_boolean_algebra α :=
{ infi_sup_le_sup_Inf := λ x s, by { rcases eq_bot_or_eq_top x with rfl | rfl,
    { simp only [bot_sup_eq, ← Inf_eq_infi], apply le_refl },
    { simp only [top_sup_eq, le_top] }, },
  inf_Sup_le_supr_inf := λ x s, by { rcases eq_bot_or_eq_top x with rfl | rfl,
    { simp only [bot_inf_eq, bot_le] },
    { simp only [top_inf_eq, ← Sup_eq_supr], apply le_refl } },
  .. is_simple_lattice.complete_lattice,
  .. is_simple_lattice.boolean_algebra }

end is_simple_lattice

namespace is_simple_lattice
variables [complete_lattice α] [is_simple_lattice α]
set_option default_priority 100

instance : is_atomistic α :=
⟨λ b, (eq_bot_or_eq_top b).elim
  (λ h, ⟨∅, ⟨h.trans Sup_empty.symm, λ a ha, false.elim (set.not_mem_empty _ ha)⟩⟩)
  (λ h, ⟨{⊤}, h.trans Sup_singleton.symm, λ a ha, (set.mem_singleton_iff.1 ha).symm ▸ is_atom_top⟩)⟩

instance : is_coatomistic α := is_atomistic_dual_iff_is_coatomistic.1 is_simple_lattice.is_atomistic

end is_simple_lattice
namespace fintype
namespace is_simple_lattice
variables [bounded_lattice α] [is_simple_lattice α] [decidable_eq α]

lemma univ : (finset.univ : finset α) = {⊤, ⊥} :=
begin
  change finset.map _ (finset.univ : finset bool) = _,
  rw fintype.univ_bool,
  simp only [finset.map_insert, function.embedding.coe_fn_mk, finset.map_singleton],
  refl,
end

lemma card : fintype.card α = 2 :=
(fintype.of_equiv_card _).trans fintype.card_bool

end is_simple_lattice
end fintype

namespace bool

instance : is_simple_lattice bool :=
⟨λ a, begin
  rw [← finset.mem_singleton, or.comm, ← finset.mem_insert,
      top_eq_tt, bot_eq_ff, ← fintype.univ_bool],
  apply finset.mem_univ,
end⟩

end bool

theorem is_simple_lattice_iff_is_atom_top [bounded_lattice α] :
  is_simple_lattice α ↔ is_atom (⊤ : α) :=
⟨λ h, @is_atom_top _ _ h, λ h, {
  exists_pair_ne := ⟨⊤, ⊥, h.1⟩,
  eq_bot_or_eq_top := λ a, ((eq_or_lt_of_le (@le_top _ _ a)).imp_right (h.2 a)).symm }⟩

theorem is_simple_lattice_iff_is_coatom_bot [bounded_lattice α] :
  is_simple_lattice α ↔ is_coatom (⊥ : α) :=
is_simple_lattice_iff_is_simple_lattice_order_dual.trans is_simple_lattice_iff_is_atom_top

namespace set

theorem is_simple_lattice_Iic_iff_is_atom [bounded_lattice α] {a : α} :
  is_simple_lattice (Iic a) ↔ is_atom a :=
is_simple_lattice_iff_is_atom_top.trans $ and_congr (not_congr subtype.mk_eq_mk)
  ⟨λ h b ab, subtype.mk_eq_mk.1 (h ⟨b, le_of_lt ab⟩ ab),
    λ h ⟨b, hab⟩ hbotb, subtype.mk_eq_mk.2 (h b (subtype.mk_lt_mk.1 hbotb))⟩

theorem is_simple_lattice_Ici_iff_is_coatom [bounded_lattice α] {a : α} :
  is_simple_lattice (Ici a) ↔ is_coatom a :=
is_simple_lattice_iff_is_coatom_bot.trans $ and_congr (not_congr subtype.mk_eq_mk)
  ⟨λ h b ab, subtype.mk_eq_mk.1 (h ⟨b, le_of_lt ab⟩ ab),
    λ h ⟨b, hab⟩ hbotb, subtype.mk_eq_mk.2 (h b (subtype.mk_lt_mk.1 hbotb))⟩

end set

namespace order_iso

variables [bounded_lattice α] {β : Type*} [bounded_lattice β] (f : α ≃o β)
include f

@[simp] lemma is_atom_iff (a : α) : is_atom (f a) ↔ is_atom a :=
and_congr (not_congr ⟨λ h, f.injective (f.map_bot.symm ▸ h), λ h, f.map_bot ▸ (congr rfl h)⟩)
  ⟨λ h b hb, f.injective ((h (f b) ((f : α ↪o β).lt_iff_lt.2 hb)).trans f.map_bot.symm),
  λ h b hb, f.symm.injective begin
    rw f.symm.map_bot,
    apply h,
    rw [← f.symm_apply_apply a],
    exact (f.symm : β ↪o α).lt_iff_lt.2 hb,
  end⟩

@[simp] lemma is_coatom_iff (a : α) : is_coatom (f a) ↔ is_coatom a := f.dual.is_atom_iff a

lemma is_simple_lattice_iff (f : α ≃o β) : is_simple_lattice α ↔ is_simple_lattice β :=
by rw [is_simple_lattice_iff_is_atom_top, is_simple_lattice_iff_is_atom_top,
  ← f.is_atom_iff ⊤, f.map_top]

lemma is_simple_lattice [h : is_simple_lattice β] (f : α ≃o β) : is_simple_lattice α :=
f.is_simple_lattice_iff.mpr h

lemma is_atomic_iff : is_atomic α ↔ is_atomic β :=
begin
  suffices : (∀ b : α, b = ⊥ ∨ ∃ (a : α), is_atom a ∧ a ≤ b) ↔
    (∀ b : β, b = ⊥ ∨ ∃ (a : β), is_atom a ∧ a ≤ b),
  from ⟨λ ⟨p⟩, ⟨this.mp p⟩, λ ⟨p⟩, ⟨this.mpr p⟩⟩,
  apply f.to_equiv.forall_congr,
  simp_rw [rel_iso.coe_fn_to_equiv],
  intro b, apply or_congr,
  { rw [f.apply_eq_iff_eq_symm_apply, map_bot], },
  { split,
    { exact λ ⟨a, ha⟩, ⟨f a, ⟨(f.is_atom_iff a).mpr ha.1, f.le_iff_le.mpr ha.2⟩⟩, },
    { rintros ⟨b, ⟨hb1, hb2⟩⟩,
      refine ⟨f.symm b, ⟨(f.symm.is_atom_iff b).mpr hb1, _⟩⟩,
      rwa [←f.le_iff_le, f.apply_symm_apply], }, },
end

lemma is_coatomic_iff : is_coatomic α ↔ is_coatomic β :=
by { rw [←is_atomic_dual_iff_is_coatomic, ←is_atomic_dual_iff_is_coatomic],
  exact f.dual.is_atomic_iff, }

end order_iso

section is_modular_lattice
variables [bounded_lattice α] [is_modular_lattice α]

namespace is_compl
variables {a b : α} (hc : is_compl a b)
include hc

lemma is_atom_iff_is_coatom : is_atom a ↔ is_coatom b :=
set.is_simple_lattice_Iic_iff_is_atom.symm.trans $ hc.Iic_order_iso_Ici.is_simple_lattice_iff.trans
  set.is_simple_lattice_Ici_iff_is_coatom

lemma is_coatom_iff_is_atom : is_coatom a ↔ is_atom b := hc.symm.is_atom_iff_is_coatom.symm

end is_compl

variables [is_complemented α]

lemma is_coatomic_of_is_atomic_of_is_complemented_of_is_modular [is_atomic α] : is_coatomic α :=
⟨λ x, begin
  rcases exists_is_compl x with ⟨y, xy⟩,
  apply (eq_bot_or_exists_atom_le y).imp _ _,
  { rintro rfl,
    exact eq_top_of_is_compl_bot xy },
  { rintro ⟨a, ha, ay⟩,
    rcases exists_is_compl (xy.symm.Iic_order_iso_Ici ⟨a, ay⟩) with ⟨⟨b, xb⟩, hb⟩,
    refine ⟨↑(⟨b, xb⟩ : set.Ici x), is_coatom.of_is_coatom_coe_Ici _, xb⟩,
    rw [← hb.is_atom_iff_is_coatom, order_iso.is_atom_iff],
    apply ha.Iic }
end⟩

lemma is_atomic_of_is_coatomic_of_is_complemented_of_is_modular [is_coatomic α] : is_atomic α :=
is_coatomic_dual_iff_is_atomic.1 is_coatomic_of_is_atomic_of_is_complemented_of_is_modular

theorem is_atomic_iff_is_coatomic : is_atomic α ↔ is_coatomic α :=
⟨λ h, @is_coatomic_of_is_atomic_of_is_complemented_of_is_modular _ _ _ _ h,
  λ h, @is_atomic_of_is_coatomic_of_is_complemented_of_is_modular _ _ _ _ h⟩

end is_modular_lattice


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

! This file was ported from Lean 3 source module data.nat.even_odd_rec
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Basic

/-! # A recursion principle based on even and odd numbers.

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

namespace Nat

#print Nat.evenOddRec /-
/-- Recursion principle on even and odd numbers: if we have `P 0`, and for all `i : ℕ` we can
extend from `P i` to both `P (2 * i)` and `P (2 * i + 1)`, then we have `P n` for all `n : ℕ`.
This is nothing more than a wrapper around `nat.binary_rec`, to avoid having to switch to
dealing with `bit0` and `bit1`. -/
@[elab_as_elim]
def evenOddRec {P : ℕ → Sort _} (h0 : P 0) (h_even : ∀ (n) (ih : P n), P (2 * n))
    (h_odd : ∀ (n) (ih : P n), P (2 * n + 1)) (n : ℕ) : P n :=
  by
  refine' @binary_rec P h0 (fun b i hi => _) n
  cases b
  · simpa [bit, bit0_val i] using h_even i hi
  · simpa [bit, bit1_val i] using h_odd i hi
#align nat.even_odd_rec Nat.evenOddRec
-/

#print Nat.evenOddRec_zero /-
@[simp]
theorem evenOddRec_zero (P : ℕ → Sort _) (h0 : P 0) (h_even : ∀ i, P i → P (2 * i))
    (h_odd : ∀ i, P i → P (2 * i + 1)) : @evenOddRec _ h0 h_even h_odd 0 = h0 :=
  binaryRec_zero _ _
#align nat.even_odd_rec_zero Nat.evenOddRec_zero
-/

#print Nat.evenOddRec_even /-
@[simp]
theorem evenOddRec_even (n : ℕ) (P : ℕ → Sort _) (h0 : P 0) (h_even : ∀ i, P i → P (2 * i))
    (h_odd : ∀ i, P i → P (2 * i + 1)) (H : h_even 0 h0 = h0) :
    @evenOddRec _ h0 h_even h_odd (2 * n) = h_even n (evenOddRec h0 h_even h_odd n) :=
  by
  convert binary_rec_eq _ ff n
  · exact (bit0_eq_two_mul _).symm
  · exact (bit0_eq_two_mul _).symm
  · apply heq_of_cast_eq
    rfl
  · exact H
#align nat.even_odd_rec_even Nat.evenOddRec_even
-/

#print Nat.evenOddRec_odd /-
@[simp]
theorem evenOddRec_odd (n : ℕ) (P : ℕ → Sort _) (h0 : P 0) (h_even : ∀ i, P i → P (2 * i))
    (h_odd : ∀ i, P i → P (2 * i + 1)) (H : h_even 0 h0 = h0) :
    @evenOddRec _ h0 h_even h_odd (2 * n + 1) = h_odd n (evenOddRec h0 h_even h_odd n) :=
  by
  convert binary_rec_eq _ tt n
  · exact (bit0_eq_two_mul _).symm
  · exact (bit0_eq_two_mul _).symm
  · apply heq_of_cast_eq
    rfl
  · exact H
#align nat.even_odd_rec_odd Nat.evenOddRec_odd
-/

end Nat