import .love05_inductive_predicates_demo
import .love13_rational_and_real_numbers_demo

/-! # LoVe Exercise 13: Rational and Real Numbers -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Rationals

1.1. Prove the following lemma.

Hint: The lemma `fraction.mk.inj_eq` might be useful. -/

#check fraction.mk.inj_eq

lemma fraction.ext (a b : fraction) (hnum : fraction.num a = fraction.num b)
    (hdenom : fraction.denom a = fraction.denom b) :
  a = b :=
begin
  cases' a,
  cases' b,
  rw fraction.mk.inj_eq,
  exact and.intro hnum hdenom
end

/-! 1.2. Extending the `fraction.has_mul` instance from the lecture, declare
`fraction` as an instance of `semigroup`.

Hint: Use the lemma `fraction.ext` above, and possibly `fraction.mul_num`, and
`fraction.mul_denom`. -/

#check fraction.ext
#check fraction.mul_num
#check fraction.mul_denom

@[instance] def fraction.semigroup : semigroup fraction :=
{ mul_assoc :=
    begin
      intros,
      apply fraction.ext,
      repeat {
        simp [fraction.mul_num, fraction.mul_denom],
        cc }
    end,
  ..fraction.has_mul }

/-! 1.3. Extending the `rat.has_mul` instance from the lecture, declare `rat` as
an instance of `semigroup`. -/

@[instance] def rat.semigroup : semigroup rat :=
{ mul_assoc :=
    begin
      intros x y z,
      apply quotient.induction_on x,
      apply quotient.induction_on y,
      apply quotient.induction_on z,
      intros a b c,
      apply quotient.sound,
      rw mul_assoc
    end,
  ..rat.has_mul }

end LoVe


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

! This file was ported from Lean 3 source module analysis.convex.contractible
! leanprover-community/mathlib commit 3339976e2bcae9f1c81e620836d1eb736e3c4700
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Star
import Mathbin.Topology.Homotopy.Contractible

/-!
# A convex set is contractible

In this file we prove that a (star) convex set in a real topological vector space is a contractible
topological space.
-/

variable {E : Type _} [AddCommGroup E] [Module ℝ E] [TopologicalSpace E] [ContinuousAdd E]
  [ContinuousSMul ℝ E] {s : Set E} {x : E}

/-- A non-empty star convex set is a contractible space. -/
protected theorem StarConvex.contractibleSpace (h : StarConvex ℝ x s) (hne : s.Nonempty) :
    ContractibleSpace s :=
  by
  refine'
    (contractible_iff_id_nullhomotopic _).2
      ⟨⟨x, h.mem hne⟩, ⟨⟨⟨fun p => ⟨p.1.1 • x + (1 - p.1.1) • p.2, _⟩, _⟩, fun x => _, fun x => _⟩⟩⟩
  · exact h p.2.2 p.1.2.1 (sub_nonneg.2 p.1.2.2) (add_sub_cancel'_right _ _)
  ·
    exact
      ((continuous_subtype_val.fst'.smul continuous_const).add
            ((continuous_const.sub continuous_subtype_val.fst').smul
              continuous_subtype_val.snd')).subtype_mk
        _
  · ext1
    simp
  · ext1
    simp
#align star_convex.contractible_space StarConvex.contractibleSpace

/-- A non-empty convex set is a contractible space. -/
protected theorem Convex.contractibleSpace (hs : Convex ℝ s) (hne : s.Nonempty) :
    ContractibleSpace s :=
  let ⟨x, hx⟩ := hne
  (hs.StarConvex hx).ContractibleSpace hne
#align convex.contractible_space Convex.contractibleSpace

instance (priority := 100) RealTopologicalVectorSpace.contractibleSpace : ContractibleSpace E :=
  (Homeomorph.Set.univ E).contractibleSpace_iff.mp <|
    convex_univ.ContractibleSpace Set.univ_nonempty
#align real_topological_vector_space.contractible_space RealTopologicalVectorSpace.contractibleSpace


/-
We just restarted Lean behind the scenes,
so let's re-import the natural numbers, but this time without
addition and multiplication.
-/

import mynat.definition -- import Peano's definition of the natural numbers {0,1,2,3,4,...}
namespace mynat -- hide

/-

# Tutorial world

## Level 3: Peano's axioms.

The import above gives us the type `mynat` of natural numbers. But it
also gives us some other things, which we'll take a look at now:

  * a term `0 : mynat`, interpreted as the number zero.
  * a function `succ : mynat → mynat`, with `succ n` interpreted as "the number after $n$".
  * The principle of mathematical induction.

These axioms are essentially the axioms isolated by Peano which uniquely characterise
the natural numbers (we also need recursion, but we can ignore it for now).
The first axiom says that $0$ is a natural number. The second says that there
is a `succ` function which eats a number and spits out the number after it,
so $\operatorname{succ}(0)=1$, $\operatorname{succ}(1)=2$ and so on.

Peano's last axiom is the principle of mathematical induction. This is a deeper
fact. It says that if we have infinitely many true/false statements $P(0)$, $P(1)$,
$P(2)$ and so on, and if $P(0)$ is true, and if for every natural number $d$
we know that $P(d)$ implies $P(\operatorname{succ}(d))$, then $P(n)$ must be true for every
natural number $n$. It's like saying that if you have a long line of dominoes, and if
you knock the first one down, and if you know that if a domino falls down then the one
after it will fall down too, then you can deduce that all the dominos will fall down.
One can also think of it as saying that every natural number
can be built by starting at `0` and then applying `succ` a finite number of times.

Peano's insights were firstly that these axioms completely characterise
the natural numbers, and secondly that these axioms alone can be used to build
a whole bunch of other structure on the natural numbers, for example
addition, multiplication and so on.

This game is all about seeing how far these axioms of Peano can take us.

Let's practice our use of the `rw` tactic in the following example.
Our hypothesis `h` is a proof that `succ(a) = b` and we want to prove that
`succ(succ(a))=succ(b)`. In words, we're going to prove that if
`b` is the number after `a` then `succ(b)` is the number after `succ(a)`.
Now here's a tricky question. If our goal is `⊢ succ (succ a) = succ b`,
and our hypothesis is `h : succ a = b`, then what will the goal change
to when we type

`rw h,`

and hit enter whilst not forgetting the comma? Remember that `rw h` will
look for the *left* hand side of `h` in the goal, and will replace it with
the *right* hand side. Try and figure out how the goal will change, and
then try it.

The answer: Lean changed `succ a` into `b`, so the goal became `succ b = succ b`.
That goal is of the form `X = X`, so you can prove this new goal with

`refl,`

on the line after `rw h,`. Don't forget the commas!

**Important note** : the tactic `rw` expects
a proof afterwards (e.g. `rw h1`). But `refl` is just `refl`.
Note also that the system sometimes drops brackets when they're not
necessary, and `succ b` just means `succ(b)`.

You may be wondering whether we could have just substituted in the definition of `b`
and proved the goal that way. To do that, we would want to replace the right hand
side of `h` with the left hand side. You do this in Lean by writing `rw ← h`. You get the
left-arrow by typing `\l` and then a space; note that this is a small letter L,
not a number 1. You can just edit your proof and try it.

You may also be wondering why we keep writing `succ(b)` instead of `b+1`. This
is because we haven't defined addition yet! On the next level, the final level
of Tutorial World, we will introduce addition, and then
we'll be ready to enter Addition World.
-/

/- Lemma : no-side-bar
If $\operatorname{succ}(a) = b$, then
$$\operatorname{succ}(\operatorname{succ}(a)) = \operatorname{succ}(b).$$
-/
lemma example3 (a b : mynat) (h : succ a = b) : succ(succ(a)) = succ(b) :=
begin [nat_num_game]
  rw h,
  refl,

end

end mynat -- hide


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

! This file was ported from Lean 3 source module number_theory.legendre_symbol.jacobi_symbol
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.LegendreSymbol.QuadraticReciprocity

/-!
# The Jacobi Symbol

We define the Jacobi symbol and prove its main properties.

## Main definitions

We define the Jacobi symbol, `jacobi_sym a b`, for integers `a` and natural numbers `b`
as the product over the prime factors `p` of `b` of the Legendre symbols `legendre_sym p a`.
This agrees with the mathematical definition when `b` is odd.

The prime factors are obtained via `nat.factors`. Since `nat.factors 0 = []`,
this implies in particular that `jacobi_sym a 0 = 1` for all `a`.

## Main statements

We prove the main properties of the Jacobi symbol, including the following.

* Multiplicativity in both arguments (`jacobi_sym.mul_left`, `jacobi_sym.mul_right`)

* The value of the symbol is `1` or `-1` when the arguments are coprime
  (`jacobi_sym.eq_one_or_neg_one`)

* The symbol vanishes if and only if `b ≠ 0` and the arguments are not coprime
  (`jacobi_sym.eq_zero_iff`)

* If the symbol has the value `-1`, then `a : zmod b` is not a square
  (`zmod.nonsquare_of_jacobi_sym_eq_neg_one`); the converse holds when `b = p` is a prime
  (`zmod.nonsquare_iff_jacobi_sym_eq_neg_one`); in particular, in this case `a` is a
  square mod `p` when the symbol has the value `1` (`zmod.is_square_of_jacobi_sym_eq_one`).

* Quadratic reciprocity (`jacobi_sym.quadratic_reciprocity`,
  `jacobi_sym.quadratic_reciprocity_one_mod_four`,
  `jacobi_sym.quadratic_reciprocity_three_mod_four`)

* The supplementary laws for `a = -1`, `a = 2`, `a = -2` (`jacobi_sym.at_neg_one`,
  `jacobi_sym.at_two`, `jacobi_sym.at_neg_two`)

* The symbol depends on `a` only via its residue class mod `b` (`jacobi_sym.mod_left`)
  and on `b` only via its residue class mod `4*a` (`jacobi_sym.mod_right`)

## Notations

We define the notation `J(a | b)` for `jacobi_sym a b`, localized to `number_theory_symbols`.

## Tags
Jacobi symbol, quadratic reciprocity
-/

section Jacobi

/-!
### Definition of the Jacobi symbol

We define the Jacobi symbol $\Bigl(\frac{a}{b}\Bigr)$ for integers `a` and natural numbers `b`
as the product of the Legendre symbols $\Bigl(\frac{a}{p}\Bigr)$, where `p` runs through the
prime divisors (with multiplicity) of `b`, as provided by `b.factors`. This agrees with the
Jacobi symbol when `b` is odd and gives less meaningful values when it is not (e.g., the symbol
is `1` when `b = 0`). This is called `jacobi_sym a b`.

We define localized notation (locale `number_theory_symbols`) `J(a | b)` for the Jacobi
symbol `jacobi_sym a b`.
-/

open Nat ZMod

-- Since we need the fact that the factors are prime, we use `list.pmap`.
/-- The Jacobi symbol of `a` and `b` -/
def jacobiSym (a : ℤ) (b : ℕ) : ℤ :=
  (b.factors.pmap (fun p pp => @legendreSym p ⟨pp⟩ a) fun p pf => prime_of_mem_factors pf).Prod
#align jacobi_sym jacobiSym

-- mathport name: «exprJ( | )»
-- Notation for the Jacobi symbol.
scoped[NumberTheorySymbols] notation "J(" a " | " b ")" => jacobiSym a b

/-!
### Properties of the Jacobi symbol
-/

namespace jacobiSym

/-- The symbol `J(a | 0)` has the value `1`. -/
@[simp]
theorem zero_right (a : ℤ) : J(a | 0) = 1 := by
  simp only [jacobiSym, factors_zero, List.prod_nil, List.pmap]
#align jacobi_sym.zero_right jacobiSym.zero_right

/-- The symbol `J(a | 1)` has the value `1`. -/
@[simp]
theorem one_right (a : ℤ) : J(a | 1) = 1 := by
  simp only [jacobiSym, factors_one, List.prod_nil, List.pmap]
#align jacobi_sym.one_right jacobiSym.one_right

/-- The Legendre symbol `legendre_sym p a` with an integer `a` and a prime number `p`
is the same as the Jacobi symbol `J(a | p)`. -/
theorem legendreSym.to_jacobiSym (p : ℕ) [fp : Fact p.Prime] (a : ℤ) : legendreSym p a = J(a | p) :=
  by simp only [jacobiSym, factors_prime fp.1, List.prod_cons, List.prod_nil, mul_one, List.pmap]
#align legendre_sym.to_jacobi_sym legendreSym.to_jacobiSym

/-- The Jacobi symbol is multiplicative in its second argument. -/
theorem mul_right' (a : ℤ) {b₁ b₂ : ℕ} (hb₁ : b₁ ≠ 0) (hb₂ : b₂ ≠ 0) :
    J(a | b₁ * b₂) = J(a | b₁) * J(a | b₂) :=
  by
  rw [jacobiSym, ((perm_factors_mul hb₁ hb₂).pmap _).prod_eq, List.pmap_append, List.prod_append]
  exacts[rfl, fun p hp => (list.mem_append.mp hp).elim prime_of_mem_factors prime_of_mem_factors]
#align jacobi_sym.mul_right' jacobiSym.mul_right'

/-- The Jacobi symbol is multiplicative in its second argument. -/
theorem mul_right (a : ℤ) (b₁ b₂ : ℕ) [NeZero b₁] [NeZero b₂] :
    J(a | b₁ * b₂) = J(a | b₁) * J(a | b₂) :=
  mul_right' a (NeZero.ne b₁) (NeZero.ne b₂)
#align jacobi_sym.mul_right jacobiSym.mul_right

/-- The Jacobi symbol takes only the values `0`, `1` and `-1`. -/
theorem trichotomy (a : ℤ) (b : ℕ) : J(a | b) = 0 ∨ J(a | b) = 1 ∨ J(a | b) = -1 :=
  ((@SignType.castHom ℤ _ _).toMonoidHom.mrange.copy {0, 1, -1} <|
        by
        rw [Set.pair_comm]
        exact (SignType.range_eq SignType.castHom).symm).list_prod_mem
    (by
      intro _ ha'
      rcases list.mem_pmap.mp ha' with ⟨p, hp, rfl⟩
      haveI : Fact p.prime := ⟨prime_of_mem_factors hp⟩
      exact quadraticChar_isQuadratic (ZMod p) a)
#align jacobi_sym.trichotomy jacobiSym.trichotomy

/-- The symbol `J(1 | b)` has the value `1`. -/
@[simp]
theorem one_left (b : ℕ) : J(1 | b) = 1 :=
  List.prod_eq_one fun z hz => by
    let ⟨p, hp, he⟩ := List.mem_pmap.1 hz
    rw [← he, legendreSym.at_one]
#align jacobi_sym.one_left jacobiSym.one_left

/-- The Jacobi symbol is multiplicative in its first argument. -/
theorem mul_left (a₁ a₂ : ℤ) (b : ℕ) : J(a₁ * a₂ | b) = J(a₁ | b) * J(a₂ | b) :=
  by
  simp_rw [jacobiSym, List.pmap_eq_map_attach, legendreSym.mul]
  exact List.prod_map_mul
#align jacobi_sym.mul_left jacobiSym.mul_left

/-- The symbol `J(a | b)` vanishes iff `a` and `b` are not coprime (assuming `b ≠ 0`). -/
theorem eq_zero_iff_not_coprime {a : ℤ} {b : ℕ} [NeZero b] : J(a | b) = 0 ↔ a.gcd b ≠ 1 :=
  List.prod_eq_zero_iff.trans
    (by
      rw [List.mem_pmap, Int.gcd_eq_natAbs, Ne, prime.not_coprime_iff_dvd]
      simp_rw [legendreSym.eq_zero_iff, int_coe_zmod_eq_zero_iff_dvd, mem_factors (NeZero.ne b), ←
        Int.coe_nat_dvd_left, Int.coe_nat_dvd, exists_prop, and_assoc', and_comm'])
#align jacobi_sym.eq_zero_iff_not_coprime jacobiSym.eq_zero_iff_not_coprime

/-- The symbol `J(a | b)` is nonzero when `a` and `b` are coprime. -/
protected theorem ne_zero {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a | b) ≠ 0 :=
  by
  cases' eq_zero_or_neZero b with hb
  · rw [hb, zero_right]
    exact one_ne_zero
  · contrapose! h
    exact eq_zero_iff_not_coprime.1 h
#align jacobi_sym.ne_zero jacobiSym.ne_zero

/-- The symbol `J(a | b)` vanishes if and only if `b ≠ 0` and `a` and `b` are not coprime. -/
theorem eq_zero_iff {a : ℤ} {b : ℕ} : J(a | b) = 0 ↔ b ≠ 0 ∧ a.gcd b ≠ 1 :=
  ⟨fun h => by
    cases' eq_or_ne b 0 with hb hb
    · rw [hb, zero_right] at h
      cases h
    exact ⟨hb, mt jacobiSym.ne_zero <| Classical.not_not.2 h⟩, fun ⟨hb, h⟩ =>
    by
    rw [← neZero_iff] at hb
    exact eq_zero_iff_not_coprime.2 h⟩
#align jacobi_sym.eq_zero_iff jacobiSym.eq_zero_iff

/-- The symbol `J(0 | b)` vanishes when `b > 1`. -/
theorem zero_left {b : ℕ} (hb : 1 < b) : J(0 | b) = 0 :=
  (@eq_zero_iff_not_coprime 0 b ⟨ne_zero_of_lt hb⟩).mpr <|
    by
    rw [Int.gcd_zero_left, Int.natAbs_ofNat]
    exact hb.ne'
#align jacobi_sym.zero_left jacobiSym.zero_left

/-- The symbol `J(a | b)` takes the value `1` or `-1` if `a` and `b` are coprime. -/
theorem eq_one_or_neg_one {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a | b) = 1 ∨ J(a | b) = -1 :=
  (trichotomy a b).resolve_left <| jacobiSym.ne_zero h
#align jacobi_sym.eq_one_or_neg_one jacobiSym.eq_one_or_neg_one

/-- We have that `J(a^e | b) = J(a | b)^e`. -/
theorem pow_left (a : ℤ) (e b : ℕ) : J(a ^ e | b) = J(a | b) ^ e :=
  Nat.recOn e (by rw [pow_zero, pow_zero, one_left]) fun _ ih => by
    rw [pow_succ, pow_succ, mul_left, ih]
#align jacobi_sym.pow_left jacobiSym.pow_left

/-- We have that `J(a | b^e) = J(a | b)^e`. -/
theorem pow_right (a : ℤ) (b e : ℕ) : J(a | b ^ e) = J(a | b) ^ e :=
  by
  induction' e with e ih
  · rw [pow_zero, pow_zero, one_right]
  · cases' eq_zero_or_neZero b with hb
    · rw [hb, zero_pow (succ_pos e), zero_right, one_pow]
    · rw [pow_succ, pow_succ, mul_right, ih]
#align jacobi_sym.pow_right jacobiSym.pow_right

/-- The square of `J(a | b)` is `1` when `a` and `b` are coprime. -/
theorem sq_one {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a | b) ^ 2 = 1 := by
  cases' eq_one_or_neg_one h with h₁ h₁ <;> rw [h₁] <;> rfl
#align jacobi_sym.sq_one jacobiSym.sq_one

/-- The symbol `J(a^2 | b)` is `1` when `a` and `b` are coprime. -/
theorem sq_one' {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a ^ 2 | b) = 1 := by rw [pow_left, sq_one h]
#align jacobi_sym.sq_one' jacobiSym.sq_one'

/-- The symbol `J(a | b)` depends only on `a` mod `b`. -/
theorem mod_left (a : ℤ) (b : ℕ) : J(a | b) = J(a % b | b) :=
  congr_arg List.prod <|
    List.pmap_congr _
      (by
        rintro p hp _ _
        conv_rhs =>
          rw [legendreSym.mod, Int.emod_emod_of_dvd _ (Int.coe_nat_dvd.2 <| dvd_of_mem_factors hp),
            ← legendreSym.mod])
#align jacobi_sym.mod_left jacobiSym.mod_left

/-- The symbol `J(a | b)` depends only on `a` mod `b`. -/
theorem mod_left' {a₁ a₂ : ℤ} {b : ℕ} (h : a₁ % b = a₂ % b) : J(a₁ | b) = J(a₂ | b) := by
  rw [mod_left, h, ← mod_left]
#align jacobi_sym.mod_left' jacobiSym.mod_left'

end jacobiSym

namespace ZMod

open jacobiSym

/-- If `J(a | b)` is `-1`, then `a` is not a square modulo `b`. -/
theorem nonsquare_of_jacobiSym_eq_neg_one {a : ℤ} {b : ℕ} (h : J(a | b) = -1) :
    ¬IsSquare (a : ZMod b) := fun ⟨r, ha⟩ =>
  by
  rw [← r.coe_val_min_abs, ← Int.cast_mul, int_coe_eq_int_coe_iff', ← sq] at ha
  apply (by norm_num : ¬(0 : ℤ) ≤ -1)
  rw [← h, mod_left, ha, ← mod_left, pow_left]
  apply sq_nonneg
#align zmod.nonsquare_of_jacobi_sym_eq_neg_one ZMod.nonsquare_of_jacobiSym_eq_neg_one

/-- If `p` is prime, then `J(a | p)` is `-1` iff `a` is not a square modulo `p`. -/
theorem nonsquare_iff_jacobiSym_eq_neg_one {a : ℤ} {p : ℕ} [Fact p.Prime] :
    J(a | p) = -1 ↔ ¬IsSquare (a : ZMod p) :=
  by
  rw [← legendreSym.to_jacobiSym]
  exact legendreSym.eq_neg_one_iff p
#align zmod.nonsquare_iff_jacobi_sym_eq_neg_one ZMod.nonsquare_iff_jacobiSym_eq_neg_one

/-- If `p` is prime and `J(a | p) = 1`, then `a` is q square mod `p`. -/
theorem isSquare_of_jacobiSym_eq_one {a : ℤ} {p : ℕ} [Fact p.Prime] (h : J(a | p) = 1) :
    IsSquare (a : ZMod p) :=
  Classical.not_not.mp <| by
    rw [← nonsquare_iff_jacobi_sym_eq_neg_one, h]
    decide
#align zmod.is_square_of_jacobi_sym_eq_one ZMod.isSquare_of_jacobiSym_eq_one

end ZMod

/-!
### Values at `-1`, `2` and `-2`
-/

namespace jacobiSym

/-- If `χ` is a multiplicative function such that `J(a | p) = χ p` for all odd primes `p`,
then `J(a | b)` equals `χ b` for all odd natural numbers `b`. -/
theorem value_at (a : ℤ) {R : Type _} [CommSemiring R] (χ : R →* ℤ)
    (hp : ∀ (p : ℕ) (pp : p.Prime) (h2 : p ≠ 2), @legendreSym p ⟨pp⟩ a = χ p) {b : ℕ} (hb : Odd b) :
    J(a | b) = χ b :=
  by
  conv_rhs => rw [← prod_factors hb.pos.ne', cast_list_prod, χ.map_list_prod]
  rw [jacobiSym, List.map_map, ← List.pmap_eq_map Nat.Prime _ _ fun _ => prime_of_mem_factors]
  congr 1; apply List.pmap_congr
  exact fun p h pp _ => hp p pp (hb.ne_two_of_dvd_nat <| dvd_of_mem_factors h)
#align jacobi_sym.value_at jacobiSym.value_at

/-- If `b` is odd, then `J(-1 | b)` is given by `χ₄ b`. -/
theorem at_neg_one {b : ℕ} (hb : Odd b) : J(-1 | b) = χ₄ b :=
  value_at (-1) χ₄ (fun p pp => @legendreSym.at_neg_one p ⟨pp⟩) hb
#align jacobi_sym.at_neg_one jacobiSym.at_neg_one

/-- If `b` is odd, then `J(-a | b) = χ₄ b * J(a | b)`. -/
protected theorem neg (a : ℤ) {b : ℕ} (hb : Odd b) : J(-a | b) = χ₄ b * J(a | b) := by
  rw [neg_eq_neg_one_mul, mul_left, at_neg_one hb]
#align jacobi_sym.neg jacobiSym.neg

/-- If `b` is odd, then `J(2 | b)` is given by `χ₈ b`. -/
theorem at_two {b : ℕ} (hb : Odd b) : J(2 | b) = χ₈ b :=
  value_at 2 χ₈ (fun p pp => @legendreSym.at_two p ⟨pp⟩) hb
#align jacobi_sym.at_two jacobiSym.at_two

/-- If `b` is odd, then `J(-2 | b)` is given by `χ₈' b`. -/
theorem at_neg_two {b : ℕ} (hb : Odd b) : J(-2 | b) = χ₈' b :=
  value_at (-2) χ₈' (fun p pp => @legendreSym.at_neg_two p ⟨pp⟩) hb
#align jacobi_sym.at_neg_two jacobiSym.at_neg_two

end jacobiSym

/-!
### Quadratic Reciprocity
-/

/-- The bi-multiplicative map giving the sign in the Law of Quadratic Reciprocity -/
def qrSign (m n : ℕ) : ℤ :=
  J(χ₄ m | n)
#align qr_sign qrSign

namespace qrSign

/-- We can express `qr_sign m n` as a power of `-1` when `m` and `n` are odd. -/
theorem neg_one_pow {m n : ℕ} (hm : Odd m) (hn : Odd n) : qrSign m n = (-1) ^ (m / 2 * (n / 2)) :=
  by
  rw [qrSign, pow_mul, ← χ₄_eq_neg_one_pow (odd_iff.mp hm)]
  cases' odd_mod_four_iff.mp (odd_iff.mp hm) with h h
  · rw [χ₄_nat_one_mod_four h, jacobiSym.one_left, one_pow]
  · rw [χ₄_nat_three_mod_four h, ← χ₄_eq_neg_one_pow (odd_iff.mp hn), jacobiSym.at_neg_one hn]
#align qr_sign.neg_one_pow qrSign.neg_one_pow

/-- When `m` and `n` are odd, then the square of `qr_sign m n` is `1`. -/
theorem sq_eq_one {m n : ℕ} (hm : Odd m) (hn : Odd n) : qrSign m n ^ 2 = 1 := by
  rw [neg_one_pow hm hn, ← pow_mul, mul_comm, pow_mul, neg_one_sq, one_pow]
#align qr_sign.sq_eq_one qrSign.sq_eq_one

/-- `qr_sign` is multiplicative in the first argument. -/
theorem mul_left (m₁ m₂ n : ℕ) : qrSign (m₁ * m₂) n = qrSign m₁ n * qrSign m₂ n := by
  simp_rw [qrSign, Nat.cast_mul, map_mul, jacobiSym.mul_left]
#align qr_sign.mul_left qrSign.mul_left

/-- `qr_sign` is multiplicative in the second argument. -/
theorem mul_right (m n₁ n₂ : ℕ) [NeZero n₁] [NeZero n₂] :
    qrSign m (n₁ * n₂) = qrSign m n₁ * qrSign m n₂ :=
  jacobiSym.mul_right (χ₄ m) n₁ n₂
#align qr_sign.mul_right qrSign.mul_right

/-- `qr_sign` is symmetric when both arguments are odd. -/
protected theorem symm {m n : ℕ} (hm : Odd m) (hn : Odd n) : qrSign m n = qrSign n m := by
  rw [neg_one_pow hm hn, neg_one_pow hn hm, mul_comm (m / 2)]
#align qr_sign.symm qrSign.symm

/-- We can move `qr_sign m n` from one side of an equality to the other when `m` and `n` are odd. -/
theorem eq_iff_eq {m n : ℕ} (hm : Odd m) (hn : Odd n) (x y : ℤ) :
    qrSign m n * x = y ↔ x = qrSign m n * y := by
  refine'
      ⟨fun h' =>
        let h := h'.symm
        _,
        fun h => _⟩ <;>
    rw [h, ← mul_assoc, ← pow_two, sq_eq_one hm hn, one_mul]
#align qr_sign.eq_iff_eq qrSign.eq_iff_eq

end qrSign

namespace jacobiSym

/-- The Law of Quadratic Reciprocity for the Jacobi symbol, version with `qr_sign` -/
theorem quadratic_reciprocity' {a b : ℕ} (ha : Odd a) (hb : Odd b) :
    J(a | b) = qrSign b a * J(b | a) :=
  by
  -- define the right hand side for fixed `a` as a `ℕ →* ℤ`
  let rhs : ℕ → ℕ →* ℤ := fun a =>
    { toFun := fun x => qrSign x a * J(x | a)
      map_one' := by
        convert← mul_one _
        symm
        all_goals apply one_left
      map_mul' := fun x y => by rw [qrSign.mul_left, Nat.cast_mul, mul_left, mul_mul_mul_comm] }
  have rhs_apply : ∀ a b : ℕ, rhs a b = qrSign b a * J(b | a) := fun a b => rfl
  refine' value_at a (rhs a) (fun p pp hp => Eq.symm _) hb
  have hpo := pp.eq_two_or_odd'.resolve_left hp
  rw [@legendreSym.to_jacobiSym p ⟨pp⟩, rhs_apply, Nat.cast_id, qrSign.eq_iff_eq hpo ha,
    qrSign.symm hpo ha]
  refine' value_at p (rhs p) (fun q pq hq => _) ha
  have hqo := pq.eq_two_or_odd'.resolve_left hq
  rw [rhs_apply, Nat.cast_id, ← @legendreSym.to_jacobiSym p ⟨pp⟩, qrSign.symm hqo hpo,
    qrSign.neg_one_pow hpo hqo, @legendreSym.quadratic_reciprocity' p q ⟨pp⟩ ⟨pq⟩ hp hq]
#align jacobi_sym.quadratic_reciprocity' jacobiSym.quadratic_reciprocity'

/-- The Law of Quadratic Reciprocity for the Jacobi symbol -/
theorem quadratic_reciprocity {a b : ℕ} (ha : Odd a) (hb : Odd b) :
    J(a | b) = (-1) ^ (a / 2 * (b / 2)) * J(b | a) := by
  rw [← qrSign.neg_one_pow ha hb, qrSign.symm ha hb, quadratic_reciprocity' ha hb]
#align jacobi_sym.quadratic_reciprocity jacobiSym.quadratic_reciprocity

/-- The Law of Quadratic Reciprocity for the Jacobi symbol: if `a` and `b` are natural numbers
with `a % 4 = 1` and `b` odd, then `J(a | b) = J(b | a)`. -/
theorem quadratic_reciprocity_one_mod_four {a b : ℕ} (ha : a % 4 = 1) (hb : Odd b) :
    J(a | b) = J(b | a) := by
  rw [quadratic_reciprocity (odd_iff.mpr (odd_of_mod_four_eq_one ha)) hb, pow_mul,
    neg_one_pow_div_two_of_one_mod_four ha, one_pow, one_mul]
#align jacobi_sym.quadratic_reciprocity_one_mod_four jacobiSym.quadratic_reciprocity_one_mod_four

/-- The Law of Quadratic Reciprocity for the Jacobi symbol: if `a` and `b` are natural numbers
with `a` odd and `b % 4 = 1`, then `J(a | b) = J(b | a)`. -/
theorem quadratic_reciprocity_one_mod_four' {a b : ℕ} (ha : Odd a) (hb : b % 4 = 1) :
    J(a | b) = J(b | a) :=
  (quadratic_reciprocity_one_mod_four hb ha).symm
#align jacobi_sym.quadratic_reciprocity_one_mod_four' jacobiSym.quadratic_reciprocity_one_mod_four'

/-- The Law of Quadratic Reciprocityfor the Jacobi symbol: if `a` and `b` are natural numbers
both congruent to `3` mod `4`, then `J(a | b) = -J(b | a)`. -/
theorem quadratic_reciprocity_three_mod_four {a b : ℕ} (ha : a % 4 = 3) (hb : b % 4 = 3) :
    J(a | b) = -J(b | a) :=
  by
  let nop := @neg_one_pow_div_two_of_three_mod_four
  rw [quadratic_reciprocity, pow_mul, nop ha, nop hb, neg_one_mul] <;>
    rwa [odd_iff, odd_of_mod_four_eq_three]
#align jacobi_sym.quadratic_reciprocity_three_mod_four jacobiSym.quadratic_reciprocity_three_mod_four

/-- The Jacobi symbol `J(a | b)` depends only on `b` mod `4*a` (version for `a : ℕ`). -/
theorem mod_right' (a : ℕ) {b : ℕ} (hb : Odd b) : J(a | b) = J(a | b % (4 * a)) :=
  by
  rcases eq_or_ne a 0 with (rfl | ha₀)
  · rw [MulZeroClass.mul_zero, mod_zero]
  have hb' : Odd (b % (4 * a)) := hb.mod_even (Even.mul_right (by norm_num) _)
  rcases exists_eq_pow_mul_and_not_dvd ha₀ 2 (by norm_num) with ⟨e, a', ha₁', ha₂⟩
  have ha₁ := odd_iff.mpr (two_dvd_ne_zero.mp ha₁')
  nth_rw 2 [ha₂]; nth_rw 1 [ha₂]
  rw [Nat.cast_mul, mul_left, mul_left, quadratic_reciprocity' ha₁ hb,
    quadratic_reciprocity' ha₁ hb', Nat.cast_pow, pow_left, pow_left, Nat.cast_two, at_two hb,
    at_two hb']
  congr 1; swap; congr 1
  · simp_rw [qrSign]
    rw [χ₄_nat_mod_four, χ₄_nat_mod_four (b % (4 * a)), mod_mod_of_dvd b (dvd_mul_right 4 a)]
  · rw [mod_left ↑(b % _), mod_left b, Int.coe_nat_mod, Int.emod_emod_of_dvd b]
    simp only [ha₂, Nat.cast_mul, ← mul_assoc]
    exact dvd_mul_left a' _
  cases e; · rfl
  · rw [χ₈_nat_mod_eight, χ₈_nat_mod_eight (b % (4 * a)), mod_mod_of_dvd b]
    use 2 ^ e * a'
    rw [ha₂, pow_succ]
    ring
#align jacobi_sym.mod_right' jacobiSym.mod_right'

/-- The Jacobi symbol `J(a | b)` depends only on `b` mod `4*a`. -/
theorem mod_right (a : ℤ) {b : ℕ} (hb : Odd b) : J(a | b) = J(a | b % (4 * a.natAbs)) :=
  by
  cases' Int.natAbs_eq a with ha ha <;> nth_rw 2 [ha] <;> nth_rw 1 [ha]
  · exact mod_right' a.nat_abs hb
  · have hb' : Odd (b % (4 * a.nat_abs)) := hb.mod_even (Even.mul_right (by norm_num) _)
    rw [jacobiSym.neg _ hb, jacobiSym.neg _ hb', mod_right' _ hb, χ₄_nat_mod_four,
      χ₄_nat_mod_four (b % (4 * _)), mod_mod_of_dvd b (dvd_mul_right 4 _)]
#align jacobi_sym.mod_right jacobiSym.mod_right

end jacobiSym

end Jacobi


/-
Homeowork 10
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import lectures.lec10_surj_inj_fact
import lectures.lec11_type_classes
import lectures.lec12_gaussian_integers
import lectures.lec13_structures_on_gaussian_int

open PROOFS
open PROOFS.STR

variables {L M N : Type} [mult_monoid_str L] [mult_monoid_str M] [mult_monoid_str N]

/-! ## Question 1 (20 pts)
First, show that monoid morphisms are closed under composition, i.e. the composition of two monoid morphisms is again a monoid morphism.

Then, show that for any monoid `M`, the type of monoid endomorphism `M →ₘ* M` itself admits a monoid structure. Note that the latter is very different than the type of endofunctions `M → M`. we showed before that whereas there is only one constant endomorphism `ℤ →ₘ* ℤ` there are ℤ-mnay endofunctions `ℤ → ℤ`.
-/

@[simp]
def mult_monoid.morphism.comp (g : M →ₘ* N) (f : L →ₘ* M)  : L →ₘ* N :=
{ to_fun := g ∘ f,
  resp_one := sorry,
  resp_mul := sorry, }

infixr  ` ∘* ` : 90  := mult_monoid.morphism.comp

def mult_monoid.morphism.id : M →ₘ* M :=
{
  to_fun := id,
  resp_one := by {simp},
  resp_mul := by {simp},
}

#check M →ₘ* M

instance : mult_monoid_str (M →ₘ* M) :=
{
  mul := (∘*),
  mul_assoc := sorry,
  one := mult_monoid.morphism.id,
  mul_one := sorry,
  one_mul := sorry,
}

/-! ## Question 2 (20 pts)
Construct the cartesian products of monoids, and show that the two projection are monoid morphisms .
-/

instance mult_monoid_str.product {M N : Type} [mult_monoid_str M] [mult_monoid_str  N] :
  mult_monoid_str (M × N) :=
{
  mul := λ x, λ y, ⟨x.1 * y.1, x.2 * y.2⟩,
  mul_assoc := sorry,
  one := sorry,
  mul_one := sorry,
  one_mul := sorry,
}

instance mon_fst : M × N →ₘ* M :=
sorry

instance snd_fst : M × N →ₘ* N :=
sorry

/-! ## Question 3 (20 pts)
Construct an equivalence of types of gaussian integers ℤ[i] and the cartesian product ℤ × ℤ.
-/
infix ` ≅ `:15 := fun_equiv

def gausssian_int_cartesian_product :
  ℤ[i] ≅ ℤ × ℤ :=
{ to_fun := sorry,
  inv_fun := sorry,
  left_inv := sorry,
  right_inv := sorry, }

/- Is this equivalence a monoid isomorphism? If yes, prove it in below, if no, explain why it is not. -/

def gausssian_int_cartesian_product_monoid_isomorphism : ℤ[i] ≅ₘ* ℤ × ℤ :=
sorry

/-! ## Question 4 (20 pts)
Show that the type of functions `X → M` has a monoid structure if the codomain `M` has a monoid structure. The multiplication on `X → M` is given by pointwise multiplication, i.e. the multiplication of two functions
`f g : X → M` should be a function `f * g : X → M` where
`f * g (x) = (f x) * (g x)`.
-/

@[instance]
def mult_monoid_str.function (X M : Type)  [mult_monoid_str  M] :
  mult_monoid_str (X → M) :=
{
  mul := sorry,
  mul_assoc := sorry,
  one := sorry,
  mul_one := sorry,
  one_mul := sorry,
}

/-! ## Question 5 (20 pts)
Show that `Prop` admit multiplicative and additive monoid structures. -/

instance : comm_mult_monoid_str Prop :=
{
  mul := (∧),
  mul_assoc := sorry,
  one := sorry,
  mul_one := by sorry,
  one_mul := by sorry,
  mul_comm := sorry,
}

instance or_additive : comm_additive_monoid_str Prop :=
{
  add := (∨),
  add_assoc := sorry,
  zero := sorry,
  add_zero := by sorry,
  zero_add := by sorry,
  add_comm := sorry,
}

instance xor_additive : comm_additive_monoid_str Prop :=
{
  add := λ P Q, (P ∨ Q) ∧ ¬ (P ∧ Q),
  add_assoc := by {intros P Q R, ext, split, intro h, simp, split, simp at h, cases h with h₁ h₂, cases h₁ with hpq hr,  sorry, sorry, sorry, sorry, },
  zero := false,
  add_zero := by {intro P, ext, split, intro h, cases h with h₁ h₂, simp at h₁, exact h₁, intro hp, split, left, exact hp, simp,  },
  zero_add := by {intro P, ext, split, intro h, cases h with h₁ h₂, simp at h₁, exact h₁, intro hp, split, right, exact hp, simp,  },
  add_comm := by {intros P Q, simp, rw or_comm P Q, congr',  ext, split, intro h, intro hq, intro hp, apply h, exact hp, exact hq, intro h, intro hp, intro hq, apply h, assumption', },
}

lemma xor_no_ident :
¬(∃ b₁ : bool, ∀ b₂ : bool, (b₁ || b₂) && switch (b₁ && b₂) = b₁) :=
begin
  intro h₁,
  cases h₁ with b₁ hb₁,
  have h₂ : ¬(tt = ff), by {
    simp,
  },
  cases b₁,
  {
    apply h₂,
    rw ← hb₁ tt,
    refl,
  },
  {
    apply h₂,
    rw ← hb₁ tt,
    refl,
  },
end

lemma xor_no_ident :
(∃ b₁ : bool, ∀ b₂ : bool, (b₁ || b₂) && switch (b₁ && b₂) = b₂) :=
begin
  use ff,
  intro b,
end

/-! ## Question 6 (20 pts)
For a type `X`, the type `set X` in Lean is defined as the function type `X → Prop`. Given a set `A : set X`
(i.e. a function `A : X → Prop` and a term `x : X` we write `x ∈ A` as a shorthand for the proposition `A x`.

  set X       X → Prop
----------|------------
    A     |   A : X → Prop
  x ∈ A   |   A x
-/

#check set

/- Show that the __convolution__ multiplication defined a semigroup structure on `set M` when `M` is a monoid.  -/

instance monoid_convolution_alt {M : Type} [mult_monoid_str M] :
  mult_semigroup_str (set M) :=
{
  mul := λ A B, λ m, ∃ x y : M, (m = x * y) ∧ (A x) ∧ (B y),  -- { (x * y) | (x ∈ A) (y ∈ B) }
  mul_assoc := sorry,
}

/- ## Question 7 (20 pts)
In this problem we define the structure of __join semilattice__ in terms of commutative idempotent monoids. You then show that every join semilattice is in fact a preorder.
-/

/-
A monoid is __idempotent__ if each of its elements is idempotent.
-/

@[simp]
def idemp (e : M) := (e * e = e)

def mon_idemp (M : Type) [mult_monoid_str M] : Prop :=
∀ e : M, idemp e

/- A __(join) semilattice__ is a commutative and idempotent additive monoid.  -/

@[class]
structure jslat_str (X : Type) extends comm_mult_monoid_str X :=
(idemp : mon_idemp X)

/-
Mathlib defines the notions of __preorder__ as a type class and it defined the structure of  __partial order__ as an extension of __preorder__ structure. Go ahead and examine this definitions by click&command in below.
-/

#check preorder

def preorder_of_jslat (X : Type) [jslat_str X] :
preorder X :=
{ le := λ x, λ y, (x * y = y),
  lt := λ x, λ y, (x * y = y) ∧ ¬ (y * x = x),
  le_refl := by {intro x, simp, exact (jslat_str.idemp x), },
  le_trans := by {intros x y z, intros h h', simp at *, rw ← h', rw ← mult_mon_assoc, rw h,  },
  lt_iff_le_not_le := by {intros a b, split; intro h; dsimp, exact h, split, exact h.1, exact h.2,  }, }

/-! ## Question 8 (20 pts)
Show that for any monoid morphism `f : M →ₘ* N` the image of the underlying function `f : M → N` inherits a monoid structure from `N`.
-/

structure mult_monoid_image_fact (f : M →ₘ* N) :=
(node : Type)
(mon_node : mult_monoid_str node)
(left_mor : M →ₘ* node)
(right_mor : node →ₘ* N)
(fun_eq : right_mor ∘* left_mor = f)

local notation `im` :15 :=  fun_image

instance mult_monoid_str.fun_image (f : M →ₘ* N) : mult_monoid_str (im f) :=
{
  mul :=  sorry,
  mul_assoc := sorry,
  one := sorry,
  mul_one := sorry,
  one_mul := sorry,
}

/-! ## Question 9 (20 pts)
In this problem, you are asked to construct image factorization for monoids using what you already did in the previous problem. You will show that for any monoid morphism `f : M →ₘ*  N` we can factor `f` into two monoid morphisms `p` and `m` such that `f = m ∘ p`, and `p` is surjective and `m` is injective.
-/

def mon_mor_img_embedding (f : M →ₘ* N) : (im f) →ₘ* N :=
{
  to_fun := fun_image.embedding f,
  resp_one := sorry,
  resp_mul := sorry,
}

def mon_mor_img_cover (f : M →ₘ* N) : M →ₘ* (im f) :=
{
  to_fun := fun_image.cover f,
  resp_one := sorry,
  resp_mul := sorry,
}

def canonical_mult_monoid_image_fact (f : M →ₘ* N) : mult_monoid_image_fact (f : M →ₘ* N)  :=
{
  node := im f,
  mon_node := mult_monoid_str.fun_image f,
  left_mor := mon_mor_img_cover f,
  right_mor := mon_mor_img_embedding f,
  fun_eq := sorry,
}


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

/-!
# Lattice structure on finsupps

This file provides instances of ordered structures on finsupps.

-/

open_locale classical
noncomputable theory
variables {α : Type*} {β : Type*} [has_zero β] {μ : Type*} [canonically_ordered_add_monoid μ]
variables {γ : Type*} [canonically_linear_ordered_add_monoid γ]

namespace finsupp

instance [semilattice_inf β] : semilattice_inf (α →₀ β) :=
{ inf := zip_with (⊓) inf_idem,
  inf_le_left := λ a b c, inf_le_left,
  inf_le_right := λ a b c, inf_le_right,
  le_inf := λ a b c h1 h2 s, le_inf (h1 s) (h2 s),
  ..finsupp.partial_order, }

@[simp]
lemma inf_apply [semilattice_inf β] {a : α} {f g : α →₀ β} : (f ⊓ g) a = f a ⊓ g a := rfl

@[simp]
lemma support_inf {f g : α →₀ γ} : (f ⊓ g).support = f.support ∩ g.support :=
begin
  ext, simp only [inf_apply, mem_support_iff,  ne.def,
    finset.mem_union, finset.mem_filter, finset.mem_inter],
  simp only [inf_eq_min, ← nonpos_iff_eq_zero, min_le_iff, not_or_distrib]
end

instance [semilattice_sup β] : semilattice_sup (α →₀ β) :=
{ sup := zip_with (⊔) sup_idem,
  le_sup_left := λ a b c, le_sup_left,
  le_sup_right := λ a b c, le_sup_right,
  sup_le := λ a b c h1 h2 s, sup_le (h1 s) (h2 s),
  ..finsupp.partial_order, }

@[simp]
lemma sup_apply [semilattice_sup β] {a : α} {f g : α →₀ β} : (f ⊔ g) a = f a ⊔ g a := rfl

@[simp]
lemma support_sup {f g : α →₀ γ} : (f ⊔ g).support = f.support ∪ g.support :=
begin
  ext, simp only [finset.mem_union, mem_support_iff, sup_apply, ne.def, ← bot_eq_zero],
  rw sup_eq_bot_iff, tauto,
end

instance lattice [lattice β] : lattice (α →₀ β) :=
{ .. finsupp.semilattice_inf, .. finsupp.semilattice_sup}

lemma bot_eq_zero : (⊥ : α →₀ γ) = 0 := rfl

lemma disjoint_iff {x y : α →₀ γ} : disjoint x y ↔ disjoint x.support y.support :=
begin
  unfold disjoint, repeat {rw le_bot_iff},
  rw [finsupp.bot_eq_zero, ← finsupp.support_eq_empty, finsupp.support_inf], refl,
end

variable [partial_order β]

/-- The order on `finsupp`s over a partial order embeds into the order on functions -/
def order_embedding_to_fun :
  (α →₀ β) ↪o (α → β) :=
⟨⟨λ (f : α →₀ β) (a : α), f a,  λ f g h, finsupp.ext (λ a, by { dsimp at h, rw h,} )⟩,
  λ a b, (@le_def _ _ _ _ a b).symm⟩

@[simp] lemma order_embedding_to_fun_apply {f : α →₀ β} {a : α} :
  order_embedding_to_fun f a = f a := rfl

lemma monotone_to_fun : monotone (finsupp.to_fun : (α →₀ β) → (α → β)) := λ f g h a, le_def.1 h a

end finsupp


inductive aexp : Type
| ANum   : nat  -> aexp
| APlus  : aexp -> aexp -> aexp
| AMinus : aexp -> aexp -> aexp
| AMult  : aexp -> aexp -> aexp

inductive bexp : Type
| BTrue : bexp
| BFalse : bexp
| BEq : aexp -> aexp -> bexp
| BLe : aexp -> aexp -> bexp
| BNot : bexp -> bexp
| BAnd : bexp -> bexp -> bexp.

open aexp bexp

def aeval : aexp -> nat
|(ANum n)      :=  n
|(APlus a1 a2) := (aeval a1) + (aeval a2)
|(AMinus a1 a2):= (aeval a1) - (aeval a2)
|(AMult a1 a2) := (aeval a1) * (aeval a2)

example : aeval (APlus (ANum 2) (ANum 2)) = 4 := rfl

def beval : bexp -> bool
| BTrue       := true
| BFalse      := false
|(BEq  a1 a2) := (aeval a1) = (aeval a2)
|(BLe  a1 a2) := (aeval a1) <= (aeval a2)
|(BNot b1)    := bnot $ beval b1
|(BAnd b1 b2) := (beval b1) && (beval b2)

example : beval (BEq (APlus (ANum 2) (ANum 3)) (ANum 5)) = true := rfl


import vec_space

universes u v w

namespace vector_space

-- 1.) Prove that -(-v) = v for every v ∈ V
lemma neg_neg' (F : Type u) (α : Type v) [field F] [add_comm_group α] [vector_space F α] :
    ∀ v : α, - (- v) = v :=
begin
    intro v,
    apply @add_right_cancel _ _ _ (-v),
    rw add_neg_self,
    rw neg_add_self,
end

-- 2.) Suppose a ∈ F, v ∈ V, and a • v = 0. Prove that a = 0 or v = 0.
lemma zero_or_zero (F : Type u) (α : Type v) [field F] [add_comm_group α] [vector_space F α] :
    ∀ a : F, ∀ v : α, a • v = 0 → (a = 0) ∨ (v = 0) :=
begin
    intros a v hyp,
    sorry,
end

-- 3.) Suppose v, w ∈ V. Explain why there exists a unique x ∈ V such that v + 3x = w.

-- 4.) maybe skip this one

-- 5.) Show that in the definition of a vector space, the additive inverse condition can be replaced with the condition that 0v = 0 for all v ∈ V.

-- maybe replace add_comm_group with something else? idk
-- this works in just commutative groups, not just vector spaces.
-- simplify maybe? make it an instance of add_comm_group?
lemma zero_smul_zero_iff_add_inv (F : Type u) (α : Type v) [field F] [add_comm_group α] [vector_space F α] :
    (∀ v : α, (0 : F) • v = 0) ↔ (∀ x : α, ∃ y : α, x + y = 0) :=
begin
    split,
    intro hyp,
    intro v,
    specialize hyp v,
    rw ← add_neg_self (1 : F) at hyp,
    rw add_smul at hyp,
    rw one_smul at hyp,
    rw ← hyp,
    use (((-1) : F) • v),
    sorry,
end

end vector_space


import separation_world.definition -- hide

/- Axiom : A topological space is a T₀ space if, from any two points in the topology, there exist and open set that contains one point and not the other
t0 : ∀ (x y : X) (h : y ≠ x) , ∃ (U : set X) (hU : is_open U), ((x ∈ U) ∧ (y ∉ U)) ∨ ((x ∉ U) ∧ (y ∈ U))
-/

/- Axiom : A topological space is a T₁ space if, from any two points in the topology, there exist and open set that contains the first point and not the second
t1 : ∀ (x y : X) (h : y ≠ x), ∃ (U : set X) (hU : is_open U), (x ∈ U) ∧ (y ∉ U)
-/

/-

# Level 1: Every Frechet space is a T₀ space

-/
variables {X : Type} -- hide
variables [topological_space X] -- hide

namespace topological_space -- hide

/- Lemma
Let τ be a topological space. If τ is a frechet space is also a T₀.
-/
lemma T1_is_T0: T1_space X → T0_space X :=
begin
  introI t1,
  fconstructor,
  intros x y hxy,
  obtain ⟨U, hU, hh⟩:= T1_space.t1 x y hxy,
  exact ⟨U, hU, or.inl hh⟩,

end

end topological_space -- hide


/-
Fill in the sorry’s below, to prove the barber paradox.

open classical   -- not needed, but you can use it

-- This is an exercise from Chapter 4. Use it as an axiom here.
axiom not_iff_not_self (P : Prop) : ¬ (P ↔ ¬ P)

example (Q : Prop) : ¬ (Q ↔ ¬ Q) :=
not_iff_not_self Q

section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀ x, shaves barber x ↔ ¬ shaves x x

  -- Show the following:
  example : false :=
  sorry
end
-/

open classical   -- not needed, but you can use it

-- This is an exercise from Chapter 4. Use it as an axiom here.
axiom not_iff_not_self (P : Prop) : ¬ (P ↔ ¬ P)

example (Q : Prop) : ¬ (Q ↔ ¬ Q) :=
not_iff_not_self Q

-- style 1, prove using excluded middle from classical
section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀ x, shaves barber x ↔ ¬ shaves x x

  example : false :=
  have hBarberInverse: shaves barber barber ↔ ¬ shaves barber barber,
  from h(barber),
  or.elim(em(shaves(barber)(barber)))(
    λ hBarberShavesSelf: shaves(barber)(barber),
    have hBarberDoesntShaveSelf: ¬ shaves barber barber,
    from iff.mp(hBarberInverse)(hBarberShavesSelf),
    show false, from hBarberDoesntShaveSelf(hBarberShavesSelf)
  )(
    λ hBarberDoesntShaveSelf: ¬ shaves(barber)(barber),
    have hBarberShavesSelf: shaves barber barber,
    from iff.mpr(hBarberInverse)(hBarberDoesntShaveSelf),
    show false, from hBarberDoesntShaveSelf(hBarberShavesSelf)
  )
end

-- style 2, prove using the not_iff_not_self axiom
section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀ x, shaves barber x ↔ ¬ shaves x x

  example : false :=
  have hBarberInverse: shaves barber barber ↔ ¬ shaves barber barber,
  from h(barber),
  have hNotBarberInverse: ¬ (shaves barber barber ↔ ¬ shaves barber barber),
  from not_iff_not_self(shaves barber barber),
  show false, from hNotBarberInverse(hBarberInverse)
end


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

import ring_theory.polynomial.cyclotomic
import topology.algebra.polynomial
import field_theory.finite.basic

/-!
# Primes congruent to one

We prove that, for any positive `k : ℕ`, there are infinitely many primes `p` such that
`p ≡ 1 [MOD k]`.
-/

namespace nat

open polynomial nat filter

/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
lemma exists_prime_ge_modeq_one (k n : ℕ) (hpos : 0 < k) :
  ∃ (p : ℕ), nat.prime p ∧ n ≤ p ∧ p ≡ 1 [MOD k] :=
begin
  have hli : tendsto (abs ∘ (λ (a : ℕ), |(a : ℚ)|)) at_top at_top,
  { simp only [(∘), abs_cast],
    exact nat.strict_mono_cast.monotone.tendsto_at_top_at_top exists_nat_ge },
  have hcff : int.cast_ring_hom ℚ (cyclotomic k ℤ).leading_coeff ≠ 0,
  { simp only [cyclotomic.monic, ring_hom.eq_int_cast, monic.leading_coeff, int.cast_one, ne.def,
     not_false_iff, one_ne_zero] },
  obtain ⟨a, ha⟩ := tendsto_at_top_at_top.1 (tendsto_abv_eval₂_at_top (int.cast_ring_hom ℚ)
    abs (cyclotomic k ℤ) (degree_cyclotomic_pos k ℤ hpos) hcff hli) 2,
  let b := a * (k * n.factorial),
  have hgt : 1 < (eval ↑(a * (k * n.factorial)) (cyclotomic k ℤ)).nat_abs,
  { suffices hgtabs : 1 < |eval ↑b (cyclotomic k ℤ)|,
    { rw [int.abs_eq_nat_abs] at hgtabs,
      exact_mod_cast hgtabs },
    suffices hgtrat : 1 < |eval ↑b (cyclotomic k ℚ)|,
    { rw [← map_cyclotomic_int k ℚ, ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval_map,
        eval₂_hom, int.coe_cast_ring_hom] at hgtrat,
      assumption_mod_cast },
    suffices hleab : a ≤ b,
    { replace ha := lt_of_lt_of_le one_lt_two (ha b hleab),
      rwa [← eval_map, map_cyclotomic_int k ℚ, abs_cast] at ha },
    exact le_mul_of_pos_right (mul_pos hpos (factorial_pos n)) },
  let p := min_fac (eval ↑b (cyclotomic k ℤ)).nat_abs,
  haveI hprime : fact p.prime := ⟨min_fac_prime (ne_of_lt hgt).symm⟩,
  have hroot : is_root (cyclotomic k (zmod p)) (cast_ring_hom (zmod p) b),
  { rw [is_root.def, ← map_cyclotomic_int k (zmod p), eval_map, coe_cast_ring_hom,
    ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval₂_hom, int.coe_cast_ring_hom,
      zmod.int_coe_zmod_eq_zero_iff_dvd _ _],
    apply int.dvd_nat_abs.1,
    exact_mod_cast min_fac_dvd (eval ↑b (cyclotomic k ℤ)).nat_abs },
  refine ⟨p, hprime.1, _, _⟩,
  { by_contra habs,
    exact (prime.dvd_iff_not_coprime hprime.1).1
      (dvd_factorial (min_fac_pos _) (le_of_not_ge habs))
      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_left_right },
  { have hdiv := order_of_dvd_of_pow_eq_one (zmod.units_pow_card_sub_one_eq_one p
      (zmod.unit_of_coprime b (coprime_of_root_cyclotomic hpos hroot))),
    have : ¬p ∣ k := hprime.1.coprime_iff_not_dvd.1
      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_right_right,
    have := (not_iff_not.mpr $ zmod.nat_coe_zmod_eq_zero_iff_dvd k p).mpr this,
    have : k = order_of (b : zmod p) := ((is_root_cyclotomic_iff this).mp hroot).eq_order_of,
    rw [←order_of_units, zmod.coe_unit_of_coprime, ←this] at hdiv,
    exact ((modeq_iff_dvd' hprime.1.pos).2 hdiv).symm }
end

lemma frequently_at_top_modeq_one (k : ℕ) (hpos : 0 < k) :
  ∃ᶠ p in at_top, nat.prime p ∧ p ≡ 1 [MOD k] :=
begin
  refine frequently_at_top.2 (λ n, _),
  obtain ⟨p, hp⟩ := exists_prime_ge_modeq_one k n hpos,
  exact ⟨p, ⟨hp.2.1, hp.1, hp.2.2⟩⟩
end

lemma infinite_set_of_prime_modeq_one (k : ℕ) (hpos : 0 < k) :
  set.infinite {p : ℕ | nat.prime p ∧ p ≡ 1 [MOD k]} :=
frequently_at_top_iff_infinite.1 (frequently_at_top_modeq_one k hpos)

end nat


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.nat.basic

/-!
# `nat.upto`

`nat.upto p`, with `p` a predicate on `ℕ`, is a subtype of elements `n : ℕ` such that no value
(strictly) below `n` satisfies `p`.

This type has the property that `>` is well-founded when `∃ i, p i`, which allows us to implement
searches on `ℕ`, starting at `0` and with an unknown upper-bound.

It is similar to the well founded relation constructed to define `nat.find` with
the difference that, in `nat.upto p`, `p` does not need to be decidable. In fact,
`nat.find` could be slightly altered to factor decidability out of its
well founded relation and would then fulfill the same purpose as this file.
-/

namespace nat

/-- The subtype of natural numbers `i` which have the property that
no `j` less than `i` satisfies `p`. This is an initial segment of the
natural numbers, up to and including the first value satisfying `p`.

We will be particularly interested in the case where there exists a value
satisfying `p`, because in this case the `>` relation is well-founded.  -/
@[reducible]
def upto (p : ℕ → Prop) : Type := {i : ℕ // ∀ j < i, ¬ p j}

namespace upto

variable {p : ℕ → Prop}

/-- Lift the "greater than" relation on natural numbers to `nat.upto`. -/
protected def gt (p) (x y : upto p) : Prop := x.1 > y.1

instance : has_lt (upto p) := ⟨λ x y, x.1 < y.1⟩

/-- The "greater than" relation on `upto p` is well founded if (and only if) there exists a value
satisfying `p`. -/
protected lemma wf : (∃ x, p x) → well_founded (upto.gt p)
| ⟨x, h⟩ := begin
  suffices : upto.gt p = measure (λ y : nat.upto p, x - y.val),
  { rw this, apply measure_wf },
  ext ⟨a, ha⟩ ⟨b, _⟩,
  dsimp [measure, inv_image, upto.gt],
  rw tsub_lt_tsub_iff_left_of_le,
  exact le_of_not_lt (λ h', ha _ h' h),
end

/-- Zero is always a member of `nat.upto p` because it has no predecessors. -/
def zero : nat.upto p := ⟨0, λ j h, false.elim (nat.not_lt_zero _ h)⟩

/-- The successor of `n` is in `nat.upto p` provided that `n` doesn't satisfy `p`. -/
def succ (x : nat.upto p) (h : ¬ p x.val) : nat.upto p :=
⟨x.val.succ, λ j h', begin
  rcases nat.lt_succ_iff_lt_or_eq.1 h' with h' | rfl;
  [exact x.2 _ h', exact h]
end⟩

end upto
end nat


import .src_real_field
import .src_ordered_field_lemmas
import data.set.basic
import tactic

namespace mth1001

namespace myreal

open myreal_field myordered_field classical

open_locale classical

variables {R : Type} [myreal_field R]

def has_upper_bound (S : set R) := ∃ u : R, upper_bound u S

def has_lower_bound (S : set R) := ∃ v : R, lower_bound v S

lemma sup_is_sup {S : set R} (h₁ : has_upper_bound S) (h₂ : S ≠ ∅) : is_sup (sup S) S :=
begin
  have h₃ : ∃ x : R, is_sup x S, from completeness h₂ h₁,
  have h₄ : sup S = some h₃, from dif_pos h₃,
  rw h₄,
  exact some_spec h₃,
end

theorem sup_monotone (S T : set R) (h₁ : has_upper_bound S) (h₂ : has_upper_bound T)
(h₃ : S ≠ ∅) (h₄ : T ≠ ∅) : S ⊆ T → sup S ≤ sup T :=
begin
  have h₅ : ∀ (v : R), upper_bound v S → sup S ≤ v, from (sup_is_sup h₁ h₃).right,
  have h₆ : upper_bound (sup T) T, from (sup_is_sup h₂ h₄).left,
  intro k,
  apply h₅ (sup T),
  intros s hs,
  have ht : s ∈ T, from k hs,
  exact h₆ s ht,
end

theorem archimedean : ∀ x : R, ∃ n : ℕ, x < n :=
begin
  by_contra h,
  push_neg at h,
  cases h with x hx,
  let S := {m : R | ∃ n : ℕ, (m = n) ∧ (x ≥ n)},
  have h₁ : ↑1 ∈ S, from ⟨1, ⟨rfl, hx 1⟩⟩,
  have h₂ : S ≠ ∅,
  { intro h, rw h at h₁, exact h₁, },
  have h₃ : has_upper_bound S, from ⟨x, λ s ⟨n,hs,hn⟩, hs.symm ▸ hn⟩,
  have h₄ : is_sup (sup S) S, from sup_is_sup h₃ h₂,
  suffices k : upper_bound (sup S +- 1) S,
  { have k₂, from add_le_add (h₄.right (sup S + - 1) k) (le_refl (1 +- sup S)),
    have k₃ : sup S + (1 + -sup S) = 1, rw [add_comm 1 (-sup S), ←add_assoc, add_neg', zero_add],
    have k₄ : sup S +-1 + (1 + -sup S) = 0,
    { rw [add_assoc,  ←add_assoc (-1) 1 (-sup S), neg_add, zero_add, add_neg'], },
    rw [k₃, k₄, ←not_lt_iff_le] at k₂,
    apply k₂,
    rw [lt_iff_pos_neg, neg_zero, add_zero], exact pos_one, },
  rintros _ ⟨m, rfl, xgem⟩,
  have h₆ : ↑(m + 1) ∈ S, from  ⟨m+1, rfl, hx (m+1)⟩,
  convert (add_le_add (h₄.left (↑m + 1) h₆) (le_refl (-1))),
  rw [add_assoc,add_neg',add_zero],
end

theorem inv_lt_of_pos (ε : R) (h : 0 < ε) : ∃ n : ℕ, n ≠ 0 ∧ (↑n)⁻¹ < ε :=
begin
  cases archimedean ε⁻¹ with n hn,
  use n,
  have h₁ : ε ≠ 0, from ne_of_gt h,
  have h₂ : 0 <  ε⁻¹, from (inv_pos h₁).mpr h,
  rw ←inv_inv' ε h₁ ,
  have h₃ : (0 : R) < ↑n, from lt_trans h₂ hn,
  rw (inv_lt_inv h₃ h₂),
  split,
  { intro heq0,
    rw heq0 at h₃,
    exact lt_irrefl h₃, },
  { exact hn, },
end

lemma zero_of_non_neg_of_lt_pos (a : R) (h : 0 ≤ a) (h₂ : ∀ ε > 0, a < ε) : a = 0 :=
begin
  rw le_iff_lt_or_eq at h,
  cases h with hpos heq0,
  { rcases inv_lt_of_pos a hpos with ⟨n, hn0, hn⟩,
    have hnpos : pos (n : R), from pos_nat n hn0,
    have h₃ : (n : R) ≠ 0,
    { intro k, rw [k, ←add_neg' (0 : R), ←lt_iff_pos_neg] at hnpos,
      exact lt_irrefl hnpos, },
    have hninvpos : (0 : R) < (n : R)⁻¹,
    { rwa [(inv_pos h₃), lt_iff_pos_sub, sub_zero], },
    have h₄ : a < n⁻¹, from h₂ _ hninvpos,
    exfalso,
    exact lt_irrefl (lt_trans h₄ hn), },
  { exact heq0.symm, }
end

theorem bounded_iff_abs_lt (S : set R) : bounded S ↔ ∃ m : ℕ, ∀ s ∈ S, abs s < ↑m :=
begin
  split,
  { rintro ⟨⟨ub, hub⟩, lb, hlb⟩,
    rcases archimedean (max (abs ub) (abs lb)) with ⟨n, hn⟩,
    use n,
    intros s hs,
    unfold abs,
    cases max_choice s (-s) with hms hmns,
    { rw hms,
      have h₂ : s ≤ ub, from hub s hs,
      have h₃ : ub ≤ abs ub, from le_abs_self ub,
      have h₄ : abs ub ≤ max (abs ub) (abs lb), from le_max_left _ _,
      apply lt_of_le_of_lt,
      { exact le_trans _ _ _ h₂ (le_trans _ _ _ h₃ h₄)},
      { exact hn, }, },
    { rw hmns,
      have h₂ : -s ≤ -lb, from neg_le_neg_iff.mpr (hlb s hs),
      have h₃ : -lb ≤ abs lb, from neg_le_abs lb,
      have h₄ : abs lb ≤ max (abs ub) (abs lb), from le_max_right _ _,
      apply lt_of_le_of_lt,
      { exact le_trans _ _ _ h₂ (le_trans _ _ _ h₃ h₄) },
      { exact hn, }, }, },
  { rintro ⟨m, hm⟩,
    split,
    { use m,
      intros s hs,
      apply le_trans,
      { exact le_abs_self s, },
      { exact le_iff_lt_or_eq.mpr (or.inl (hm s hs)) }, },
    { use (-m),
      intros s hs,
      rw [←neg_le_neg_iff, neg_neg],
      apply le_trans,
      { exact neg_le_abs s, },
      { exact le_iff_lt_or_eq.mpr (or.inl (hm s hs)), }, }, },
end

end myreal

end mth1001


import game.max.level05 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter 4 : Max and abs

## Level 6

In fact `max_le` can be beefed up to an iff statement.
-/

/- Hint : Tip : using `le_trans`
If your goal is `x ≤ z` and you have a hypothesis `h : y ≤ z`
then of course it will suffice to prove `x ≤ y` and then you
can use transitivity. Instead of `have hxy : x ≤ y,`, opening
a new goal and adding a new hypothesis to our list, you can
do

```
apply le_trans _ h
```

or

```
refine le_trans _ h
```

and this just reduces the goal to proving `x ≤ y` immediately.

-/

/- Lemma
If $a$, $b$, $c$ are real numbers,
then ($a\leq c$ and $b\leq c$) iff $\max(a,b)\leq c.$
-/

theorem max_le_iff {a b c : ℝ} : a ≤ c ∧ b ≤ c ↔ max a b ≤ c :=
begin
  split,
  intro h,
  cases h with t ht,
  exact max_le t ht,
  intro j,
  split,
  apply le_trans _ j,
  apply le_max_left,
  apply le_trans _ j,
  apply le_max_right,

end

end xena --hide


def GrahamSum (p : Nat) : Nat :=
  match p with
    | 0 => 0
    | n + 1 => GrahamSum n + (2*(n+1)-1)

example : ∀ x : Nat, GrahamSum x = x*x :=
  λ(a : Nat) =>
    Nat.recOn a (rfl) (λ(n : Nat) =>
      λ(h1 : GrahamSum n = n*n) =>
        calc
          GrahamSum (n+1) = GrahamSum n + 2*(n+1) - 1              := rfl
          _ = (n * n) + 2*n + 2 - 1                                := by simp[*, Nat.left_distrib, Nat.add_assoc]
          _ = (n * n) + 2*n + 1                                    := rfl
          _ = (n + 1)*(n + 1)                                      := by simp[Nat.add_assoc, Nat.mul_comm, <-Nat.left_distrib, Nat.left_distrib, <-Nat.right_distrib]
    )


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.set.function
import logic.function.iterate
import group_theory.perm.basic

/-!
# Fixed points of a self-map

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

In this file we define

* the predicate `is_fixed_pt f x := f x = x`;
* the set `fixed_points f` of fixed points of a self-map `f`.

We also prove some simple lemmas about `is_fixed_pt` and `∘`, `iterate`, and `semiconj`.

## Tags

fixed point
-/

open equiv

universes u v

variables {α : Type u} {β : Type v} {f fa g : α → α} {x y : α} {fb : β → β} {m n k : ℕ} {e : perm α}

namespace function

/-- A point `x` is a fixed point of `f : α → α` if `f x = x`. -/
def is_fixed_pt (f : α → α) (x : α) := f x = x

/-- Every point is a fixed point of `id`. -/
lemma is_fixed_pt_id (x : α) : is_fixed_pt id x := (rfl : _)

namespace is_fixed_pt

instance [h : decidable_eq α] {f : α → α} {x : α} : decidable (is_fixed_pt f x) :=
h (f x) x

/-- If `x` is a fixed point of `f`, then `f x = x`. This is useful, e.g., for `rw` or `simp`.-/
protected

/-- If `x` is a fixed point of `f` and `g`, then it is a fixed point of `f ∘ g`. -/
protected lemma comp (hf : is_fixed_pt f x) (hg : is_fixed_pt g x) : is_fixed_pt (f ∘ g) x :=
calc f (g x) = f x : congr_arg f hg
         ... = x   : hf

/-- If `x` is a fixed point of `f`, then it is a fixed point of `f^[n]`. -/
protected lemma iterate (hf : is_fixed_pt f x) (n : ℕ) : is_fixed_pt (f^[n]) x :=
iterate_fixed hf n

/-- If `x` is a fixed point of `f ∘ g` and `g`, then it is a fixed point of `f`. -/
lemma left_of_comp (hfg : is_fixed_pt (f ∘ g) x) (hg : is_fixed_pt g x) : is_fixed_pt f x :=
calc f x = f (g x) : congr_arg f hg.symm
     ... = x       : hfg

/-- If `x` is a fixed point of `f` and `g` is a left inverse of `f`, then `x` is a fixed
point of `g`. -/
lemma to_left_inverse (hf : is_fixed_pt f x) (h : left_inverse g f) : is_fixed_pt g x :=
calc g x = g (f x) : congr_arg g hf.symm
     ... = x       : h x

/-- If `g` (semi)conjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
protected lemma map {x : α} (hx : is_fixed_pt fa x) {g : α → β} (h : semiconj g fa fb) :
  is_fixed_pt fb (g x) :=
calc fb (g x) = g (fa x) : (h.eq x).symm
          ... = g x      : congr_arg g hx

protected lemma apply {x : α} (hx : is_fixed_pt f x) : is_fixed_pt f (f x) :=
by convert hx

lemma preimage_iterate {s : set α} (h : is_fixed_pt (set.preimage f) s) (n : ℕ) :
  is_fixed_pt (set.preimage (f^[n])) s :=
by { rw set.preimage_iterate_eq, exact h.iterate n, }

protected lemma equiv_symm (h : is_fixed_pt e x) : is_fixed_pt e.symm x :=
h.to_left_inverse e.left_inverse_symm

protected lemma perm_inv (h : is_fixed_pt e x) : is_fixed_pt ⇑(e⁻¹) x := h.equiv_symm

protected lemma perm_pow (h : is_fixed_pt e x) (n : ℕ) : is_fixed_pt ⇑(e ^ n) x :=
by { rw equiv.perm.coe_pow, exact h.iterate _ }

protected lemma perm_zpow (h : is_fixed_pt e x) : ∀ n : ℤ, is_fixed_pt ⇑(e ^ n) x
| (int.of_nat n) := h.perm_pow _
| (int.neg_succ_of_nat n) := (h.perm_pow $ n + 1).perm_inv

end is_fixed_pt

@[simp] lemma injective.is_fixed_pt_apply_iff (hf : injective f) {x : α} :
  is_fixed_pt f (f x) ↔ is_fixed_pt f x :=
⟨λ h, hf h.eq, is_fixed_pt.apply⟩

/-- The set of fixed points of a map `f : α → α`. -/
def fixed_points (f : α → α) : set α := {x : α | is_fixed_pt f x}

instance fixed_points.decidable [decidable_eq α] (f : α → α) (x : α) :
  decidable (x ∈ fixed_points f) :=
is_fixed_pt.decidable

@[simp] lemma mem_fixed_points : x ∈ fixed_points f ↔ is_fixed_pt f x := iff.rfl

lemma mem_fixed_points_iff {α : Type*} {f : α → α} {x : α} :
  x ∈ fixed_points f ↔ f x = x :=
by refl

@[simp] lemma fixed_points_id : fixed_points (@id α) = set.univ :=
set.ext $ λ _, by simpa using is_fixed_pt_id _

lemma fixed_points_subset_range : fixed_points f ⊆ set.range f :=
λ x hx, ⟨x, hx⟩

/-- If `g` semiconjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
lemma semiconj.maps_to_fixed_pts {g : α → β} (h : semiconj g fa fb) :
  set.maps_to g (fixed_points fa) (fixed_points fb) :=
λ x hx, hx.map h

/-- Any two maps `f : α → β` and `g : β → α` are inverse of each other on the sets of fixed points
of `f ∘ g` and `g ∘ f`, respectively. -/
lemma inv_on_fixed_pts_comp (f : α → β) (g : β → α) :
  set.inv_on f g (fixed_points $ f ∘ g) (fixed_points $ g ∘ f) :=
⟨λ x, id, λ x, id⟩

/-- Any map `f` sends fixed points of `g ∘ f` to fixed points of `f ∘ g`. -/
lemma maps_to_fixed_pts_comp (f : α → β) (g : β → α) :
  set.maps_to f (fixed_points $ g ∘ f) (fixed_points $ f ∘ g) :=
λ x hx, hx.map $ λ x, rfl

/-- Given two maps `f : α → β` and `g : β → α`, `g` is a bijective map between the fixed points
of `f ∘ g` and the fixed points of `g ∘ f`. The inverse map is `f`, see `inv_on_fixed_pts_comp`. -/
lemma bij_on_fixed_pts_comp (f : α → β) (g : β → α) :
  set.bij_on g (fixed_points $ f ∘ g) (fixed_points $ g ∘ f) :=
(inv_on_fixed_pts_comp f g).bij_on (maps_to_fixed_pts_comp g f) (maps_to_fixed_pts_comp f g)

/-- If self-maps `f` and `g` commute, then they are inverse of each other on the set of fixed points
of `f ∘ g`. This is a particular case of `function.inv_on_fixed_pts_comp`. -/
lemma commute.inv_on_fixed_pts_comp (h : commute f g) :
  set.inv_on f g (fixed_points $ f ∘ g) (fixed_points $ f ∘ g) :=
by simpa only [h.comp_eq] using inv_on_fixed_pts_comp f g

/-- If self-maps `f` and `g` commute, then `f` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
lemma commute.left_bij_on_fixed_pts_comp (h : commute f g) :
  set.bij_on f (fixed_points $ f ∘ g) (fixed_points $ f ∘ g) :=
by simpa only [h.comp_eq] using bij_on_fixed_pts_comp g f

/-- If self-maps `f` and `g` commute, then `g` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
lemma commute.right_bij_on_fixed_pts_comp (h : commute f g) :
  set.bij_on g (fixed_points $ f ∘ g) (fixed_points $ f ∘ g) :=
by simpa only [h.comp_eq] using bij_on_fixed_pts_comp f g

end function


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura
-/
prelude

import init.algebra.order init.meta

universe u

export linear_order (min max)

section
open decidable tactic
variables {α : Type u} [linear_order α]

lemma min_def (a b : α) : min a b = if a ≤ b then a else b :=
by rw [congr_fun linear_order.min_def a, min_default]
lemma max_def (a b : α) : max a b = if b ≤ a then a else b :=
by rw [congr_fun linear_order.max_def a, max_default]

private meta def min_tac_step : tactic unit :=
solve1 $ intros
>> `[simp only [min_def, max_def]]
>> try `[simp [*, if_pos, if_neg]]
>> try `[apply le_refl]
>> try `[apply le_of_not_le, assumption]

meta def tactic.interactive.min_tac (a b : interactive.parse lean.parser.pexpr) : tactic unit :=
interactive.by_cases (none, ``(%%a ≤ %%b)); min_tac_step

lemma min_le_left (a b : α) : min a b ≤ a :=
by min_tac a b

lemma min_le_right (a b : α) : min a b ≤ b :=
by min_tac a b

lemma le_min {a b c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) : c ≤ min a b :=
by min_tac a b

lemma le_max_left (a b : α) : a ≤ max a b :=
by min_tac b a

lemma le_max_right (a b : α) : b ≤ max a b :=
by min_tac b a

lemma max_le {a b c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) : max a b ≤ c :=
by min_tac b a

lemma eq_min {a b c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) (h₃ : ∀{d}, d ≤ a → d ≤ b → d ≤ c) :
  c = min a b :=
le_antisymm (le_min h₁ h₂) (h₃ (min_le_left a b) (min_le_right a b))

lemma min_comm (a b : α) : min a b = min b a :=
eq_min (min_le_right a b) (min_le_left a b) (λ c h₁ h₂, le_min h₂ h₁)

lemma min_assoc (a b c : α) : min (min a b) c = min a (min b c) :=
begin
  apply eq_min,
  { apply le_trans, apply min_le_left, apply min_le_left },
  { apply le_min, apply le_trans, apply min_le_left, apply min_le_right, apply min_le_right },
  { intros d h₁ h₂, apply le_min, apply le_min h₁, apply le_trans h₂, apply min_le_left,
    apply le_trans h₂, apply min_le_right }
end

lemma min_left_comm : ∀ (a b c : α), min a (min b c) = min b (min a c) :=
left_comm (@min α _) (@min_comm α _) (@min_assoc α _)

@[simp]
lemma min_self (a : α) : min a a = a :=
by min_tac a a

@[ematch]
lemma min_eq_left {a b : α} (h : a ≤ b) : min a b = a :=
begin apply eq.symm, apply eq_min (le_refl _) h, intros, assumption end

@[ematch]
lemma min_eq_right {a b : α} (h : b ≤ a) : min a b = b :=
eq.subst (min_comm b a) (min_eq_left h)

lemma eq_max {a b c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) (h₃ : ∀{d}, a ≤ d → b ≤ d → c ≤ d) : c = max a b :=
le_antisymm (h₃ (le_max_left a b) (le_max_right a b)) (max_le h₁ h₂)

lemma max_comm (a b : α) : max a b = max b a :=
eq_max (le_max_right a b) (le_max_left a b) (λ c h₁ h₂, max_le h₂ h₁)

lemma max_assoc (a b c : α) : max (max a b) c = max a (max b c) :=
begin
  apply eq_max,
  { apply le_trans, apply le_max_left a b, apply le_max_left },
  { apply max_le, apply le_trans, apply le_max_right a b, apply le_max_left, apply le_max_right },
  { intros d h₁ h₂, apply max_le, apply max_le h₁, apply le_trans (le_max_left _ _) h₂,
    apply le_trans (le_max_right _ _) h₂}
end

lemma max_left_comm : ∀ (a b c : α), max a (max b c) = max b (max a c) :=
left_comm (@max α _) (@max_comm α _) (@max_assoc α _)

@[simp]
lemma max_self (a : α) : max a a = a :=
by min_tac a a

lemma max_eq_left {a b : α} (h : b ≤ a) : max a b = a :=
begin apply eq.symm, apply eq_max (le_refl _) h, intros, assumption end

lemma max_eq_right {a b : α} (h : a ≤ b) : max a b = b :=
eq.subst (max_comm b a) (max_eq_left h)

/- these rely on lt_of_lt -/

lemma min_eq_left_of_lt {a b : α} (h : a < b) : min a b = a :=
min_eq_left (le_of_lt h)

lemma min_eq_right_of_lt {a b : α} (h : b < a) : min a b = b :=
min_eq_right (le_of_lt h)

lemma max_eq_left_of_lt {a b : α} (h : b < a) : max a b = a :=
max_eq_left (le_of_lt h)

lemma max_eq_right_of_lt {a b : α} (h : a < b) : max a b = b :=
max_eq_right (le_of_lt h)

/- these use the fact that it is a linear ordering -/

lemma lt_min {a b c : α} (h₁ : a < b) (h₂ : a < c) : a < min b c :=
or.elim (le_or_gt b c)
  (assume h : b ≤ c, by min_tac b c)
  (assume h : b > c, by min_tac b c)

lemma max_lt {a b c : α} (h₁ : a < c) (h₂ : b < c) : max a b < c :=
or.elim (le_or_gt a b)
  (assume h : a ≤ b, by min_tac b a)
  (assume h : a > b, by min_tac b a)
end


/-
Collection of congruence lemmas
Author: Adrián Doña Mateo
-/

import data.nat.modeq
import data.zmod.basic

namespace nat
namespace modeq

theorem not_modeq_of_lt {a b n : ℕ} (hb : b < n) :
	a < b → ¬ a ≡ b [MOD n] :=
begin
	intro ha,
	rw modeq_iff_dvd' (le_of_lt ha),
	intro hdvd,
	apply not_le_of_gt hb,
	calc n
			≤ b - a : le_of_dvd (nat.sub_pos_of_lt ha) hdvd
	... ≤ b     : sub_le b a,
end

theorem modeq_lt_iff {a b n : ℕ} (ha : a < n) (hb : b < n) :
	a ≡ b [MOD n] ↔ a = b :=
begin
	split, swap,
	{ intro h, rw h },
	by_cases h : a < b,
	{ intro hab,
		exfalso,
		exact not_modeq_of_lt hb h hab },
	intro hab,
	symmetry,
	by_contradiction hne,
	apply not_modeq_of_lt ha _ (modeq.symm hab),
	exact lt_of_le_of_ne (le_of_not_lt h) hne,
end

theorem not_modeq_lt_iff {a b n : ℕ} (ha : a < n) (hb : b < n) :
	¬ a ≡ b [MOD n] ↔ a ≠ b :=
not_iff_not.mpr (modeq_lt_iff ha hb)

theorem not_modeq_of_modeq {a b c n : ℕ} (hb : b < n) (hc : c < n) (ha : a ≡ b [MOD n]) :
	b ≠ c → ¬ a ≡ c [MOD n] :=
λ hbc hac, (not_modeq_lt_iff hb hc).mpr hbc (modeq.trans (modeq.symm ha) hac)

lemma modeq_add_mul_mod {a n : ℕ} (k : ℕ) : a ≡ a + n * k [MOD n] := by simp [modeq]

lemma add_mul_mod_of_modeq {a b n : ℕ} (hab : a ≤ b) (h : a ≡ b [MOD n]) :
	∃ k, a + n * k = b :=
begin
	rw modeq.modeq_iff_dvd' hab at h,
	cases h with k hk, use k,
	rw [← hk, nat.add_sub_cancel' hab],
end

end modeq
end nat

namespace zmod

theorem one_or_two_of_sq_eq_one {a : zmod 3} (h : a * a = ↑1) : a = 1 ∨ a = 2 := by dec_trivial!

end zmod


/-
Copyright (c) 2018 Jan-David Salchow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jan-David Salchow, Patrick Massot
-/
import topology.subset_properties
import topology.metric_space.basic

/-!
# Sequences in topological spaces

In this file we define sequences in topological spaces and show how they are related to
filters and the topology. In particular, we
* define the sequential closure of a set and prove that it's contained in the closure,
* define a type class "sequential_space" in which closure and sequential closure agree,
* define sequential continuity and show that it coincides with continuity in sequential spaces,
* provide an instance that shows that every first-countable (and in particular metric) space is
  a sequential space.
* define sequential compactness, prove that compactness implies sequential compactness in first
  countable spaces, and prove they are equivalent for uniform spaces having a countable uniformity
  basis (in particular metric spaces).
-/

open set filter
open_locale topological_space

variables {α : Type*} {β : Type*}

local notation f ` ⟶ ` limit := tendsto f at_top (𝓝 limit)

/-! ### Sequential closures, sequential continuity, and sequential spaces. -/
section topological_space
variables [topological_space α] [topological_space β]

/-- A sequence converges in the sence of topological spaces iff the associated statement for filter
holds. -/
lemma topological_space.seq_tendsto_iff {x : ℕ → α} {limit : α} :
  tendsto x at_top (𝓝 limit) ↔
    ∀ U : set α, limit ∈ U → is_open U → ∃ N, ∀ n ≥ N, (x n) ∈ U :=
(at_top_basis.tendsto_iff (nhds_basis_opens limit)).trans $
  by simp only [and_imp, exists_prop, true_and, set.mem_Ici, ge_iff_le, id]

/-- The sequential closure of a subset M ⊆ α of a topological space α is
the set of all p ∈ α which arise as limit of sequences in M. -/
def sequential_closure (M : set α) : set α :=
{p | ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ M) ∧ (x ⟶ p)}

lemma subset_sequential_closure (M : set α) : M ⊆ sequential_closure M :=
assume p (_ : p ∈ M), show p ∈ sequential_closure M, from
  ⟨λ n, p, assume n, ‹p ∈ M›, tendsto_const_nhds⟩

/-- A set `s` is sequentially closed if for any converging sequence `x n` of elements of `s`,
the limit belongs to `s` as well. -/
def is_seq_closed (s : set α) : Prop := s = sequential_closure s

/-- A convenience lemma for showing that a set is sequentially closed. -/
lemma is_seq_closed_of_def {A : set α}
  (h : ∀(x : ℕ → α) (p : α), (∀ n : ℕ, x n ∈ A) → (x ⟶ p) → p ∈ A) : is_seq_closed A :=
show A = sequential_closure A, from subset.antisymm
  (subset_sequential_closure A)
  (show ∀ p, p ∈ sequential_closure A → p ∈ A, from
    (assume p ⟨x, _, _⟩, show p ∈ A, from h x p ‹∀ n : ℕ, ((x n) ∈ A)› ‹(x ⟶ p)›))

/-- The sequential closure of a set is contained in the closure of that set.
The converse is not true. -/
lemma sequential_closure_subset_closure (M : set α) : sequential_closure M ⊆ closure M :=
assume p ⟨x, xM, xp⟩,
mem_closure_of_tendsto xp (univ_mem' xM)

/-- A set is sequentially closed if it is closed. -/
lemma is_seq_closed_of_is_closed (M : set α) (_ : is_closed M) : is_seq_closed M :=
suffices sequential_closure M ⊆ M, from
  set.eq_of_subset_of_subset (subset_sequential_closure M) this,
calc sequential_closure M ⊆ closure M : sequential_closure_subset_closure M
  ... = M : is_closed.closure_eq ‹is_closed M›

/-- The limit of a convergent sequence in a sequentially closed set is in that set.-/
lemma mem_of_is_seq_closed {A : set α} (_ : is_seq_closed A) {x : ℕ → α}
  (_ : ∀ n, x n ∈ A) {limit : α} (_ : (x ⟶ limit)) : limit ∈ A :=
have limit ∈ sequential_closure A, from
  show ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ A) ∧ (x ⟶ limit), from ⟨x, ‹∀ n, x n ∈ A›, ‹(x ⟶ limit)›⟩,
eq.subst (eq.symm ‹is_seq_closed A›) ‹limit ∈ sequential_closure A›

/-- The limit of a convergent sequence in a closed set is in that set.-/
lemma mem_of_is_closed_sequential {A : set α} (_ : is_closed A) {x : ℕ → α}
  (_ : ∀ n, x n ∈ A) {limit : α} (_ : x ⟶ limit) : limit ∈ A :=
mem_of_is_seq_closed (is_seq_closed_of_is_closed A ‹is_closed A›) ‹∀ n, x n ∈ A› ‹(x ⟶ limit)›

/-- A sequential space is a space in which 'sequences are enough to probe the topology'. This can be
 formalised by demanding that the sequential closure and the closure coincide. The following
 statements show that other topological properties can be deduced from sequences in sequential
 spaces. -/
class sequential_space (α : Type*) [topological_space α] : Prop :=
(sequential_closure_eq_closure : ∀ M : set α, sequential_closure M = closure M)

/-- In a sequential space, a set is closed iff it's sequentially closed. -/
lemma is_seq_closed_iff_is_closed [sequential_space α] {M : set α} :
  is_seq_closed M ↔ is_closed M :=
iff.intro
  (assume _, closure_eq_iff_is_closed.mp (eq.symm
    (calc M = sequential_closure M : by assumption
        ... = closure M            : sequential_space.sequential_closure_eq_closure M)))
  (is_seq_closed_of_is_closed M)

/-- In a sequential space, a point belongs to the closure of a set iff it is a limit of a sequence
taking values in this set. -/
lemma mem_closure_iff_seq_limit [sequential_space α] {s : set α} {a : α} :
  a ∈ closure s ↔ ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ s) ∧ (x ⟶ a) :=
by { rw ← sequential_space.sequential_closure_eq_closure, exact iff.rfl }

/-- A function between topological spaces is sequentially continuous if it commutes with limit of
 convergent sequences. -/
def sequentially_continuous (f : α → β) : Prop :=
∀ (x : ℕ → α), ∀ {limit : α}, (x ⟶ limit) → (f∘x ⟶ f limit)

/- A continuous function is sequentially continuous. -/
lemma continuous.to_sequentially_continuous {f : α → β} (_ : continuous f) :
  sequentially_continuous f :=
assume x limit (_ : x ⟶ limit),
have tendsto f (𝓝 limit) (𝓝 (f limit)), from continuous.tendsto ‹continuous f› limit,
show (f ∘ x) ⟶ (f limit), from tendsto.comp this ‹(x ⟶ limit)›

/-- In a sequential space, continuity and sequential continuity coincide. -/
lemma continuous_iff_sequentially_continuous {f : α → β} [sequential_space α] :
  continuous f ↔ sequentially_continuous f :=
iff.intro
  (assume _, ‹continuous f›.to_sequentially_continuous)
  (assume : sequentially_continuous f, show continuous f, from
    suffices h : ∀ {A : set β}, is_closed A → is_seq_closed (f ⁻¹' A), from
      continuous_iff_is_closed.mpr (assume A _, is_seq_closed_iff_is_closed.mp $ h ‹is_closed A›),
    assume A (_ : is_closed A),
      is_seq_closed_of_def $
        assume (x : ℕ → α) p (_ : ∀ n, f (x n) ∈ A) (_ : x ⟶ p),
        have (f ∘ x) ⟶ (f p), from ‹sequentially_continuous f› x ‹(x ⟶ p)›,
        show f p ∈ A, from
          mem_of_is_closed_sequential ‹is_closed A› ‹∀ n, f (x n) ∈ A› ‹(f∘x ⟶ f p)›)

end topological_space

namespace topological_space

namespace first_countable_topology

variables [topological_space α] [first_countable_topology α]

/-- Every first-countable space is sequential. -/
@[priority 100] -- see Note [lower instance priority]
instance : sequential_space α :=
⟨show ∀ M, sequential_closure M = closure M, from assume M,
  suffices closure M ⊆ sequential_closure M,
    from set.subset.antisymm (sequential_closure_subset_closure M) this,
  -- For every p ∈ closure M, we need to construct a sequence x in M that converges to p:
  assume (p : α) (hp : p ∈ closure M),
  -- Since we are in a first-countable space, the neighborhood filter around `p` has a decreasing
  -- basis `U` indexed by `ℕ`.
  let ⟨U, hU⟩ := (𝓝 p).exists_antitone_basis in
  -- Since `p ∈ closure M`, there is an element in each `M ∩ U i`
  have hp : ∀ (i : ℕ), ∃ (y : α), y ∈ M ∧ y ∈ U i,
    by simpa using (mem_closure_iff_nhds_basis hU.1).mp hp,
  begin
    -- The axiom of (countable) choice builds our sequence from the later fact
    choose u hu using hp,
    rw forall_and_distrib at hu,
    -- It clearly takes values in `M`
    use [u, hu.1],
    -- and converges to `p` because the basis is decreasing.
    apply hU.tendsto hu.2,
  end⟩

end first_countable_topology

end topological_space

section seq_compact
open topological_space topological_space.first_countable_topology
variables [topological_space α]

/-- A set `s` is sequentially compact if every sequence taking values in `s` has a
converging subsequence. -/
def is_seq_compact (s : set α) :=
  ∀ ⦃u : ℕ → α⦄, (∀ n, u n ∈ s) →
    ∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x)

/-- A space `α` is sequentially compact if every sequence in `α` has a
converging subsequence. -/
class seq_compact_space (α : Type*) [topological_space α] : Prop :=
(seq_compact_univ : is_seq_compact (univ : set α))

lemma is_seq_compact.subseq_of_frequently_in {s : set α} (hs : is_seq_compact s) {u : ℕ → α}
  (hu : ∃ᶠ n in at_top, u n ∈ s) :
  ∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
let ⟨ψ, hψ, huψ⟩ := extraction_of_frequently_at_top hu, ⟨x, x_in, φ, hφ, h⟩ := hs huψ in
⟨x, x_in, ψ ∘ φ, hψ.comp hφ, h⟩

lemma seq_compact_space.tendsto_subseq [seq_compact_space α] (u : ℕ → α) :
  ∃ x (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
let ⟨x, _, φ, mono, h⟩ := seq_compact_space.seq_compact_univ (by simp : ∀ n, u n ∈ univ) in
⟨x, φ, mono, h⟩

section first_countable_topology
variables [first_countable_topology α]
open topological_space.first_countable_topology

lemma is_compact.is_seq_compact {s : set α} (hs : is_compact s) : is_seq_compact s :=
λ u u_in,
let ⟨x, x_in, hx⟩ := @hs (map u at_top) _
  (le_principal_iff.mpr (univ_mem' u_in : _)) in ⟨x, x_in, tendsto_subseq hx⟩

lemma is_compact.tendsto_subseq' {s : set α} {u : ℕ → α} (hs : is_compact s)
  (hu : ∃ᶠ n in at_top, u n ∈ s) :
∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
hs.is_seq_compact.subseq_of_frequently_in hu

lemma is_compact.tendsto_subseq {s : set α} {u : ℕ → α} (hs : is_compact s) (hu : ∀ n, u n ∈ s) :
∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
hs.is_seq_compact hu

@[priority 100] -- see Note [lower instance priority]
instance first_countable_topology.seq_compact_of_compact [compact_space α] : seq_compact_space α :=
⟨compact_univ.is_seq_compact⟩

lemma compact_space.tendsto_subseq [compact_space α] (u : ℕ → α) :
  ∃ x (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
seq_compact_space.tendsto_subseq u

end first_countable_topology
end seq_compact

section uniform_space_seq_compact

open_locale uniformity
open uniform_space prod

variables [uniform_space β] {s : set β}

lemma lebesgue_number_lemma_seq {ι : Type*} [is_countably_generated (𝓤 β)] {c : ι → set β}
  (hs : is_seq_compact s) (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
  ∃ V ∈ 𝓤 β, symmetric_rel V ∧ ∀ x ∈ s, ∃ i, ball x V ⊆ c i :=
begin
  classical,
  obtain ⟨V, hV, Vsymm⟩ :
    ∃ V : ℕ → set (β × β), (𝓤 β).has_antitone_basis V ∧ ∀ n, swap ⁻¹' V n = V n,
      from uniform_space.has_seq_basis β,
  suffices : ∃ n, ∀ x ∈ s, ∃ i, ball x (V n) ⊆ c i,
  { cases this with n hn,
    exact ⟨V n, hV.to_has_basis.mem_of_mem trivial, Vsymm n, hn⟩ },
  by_contradiction H,
  obtain ⟨x, x_in, hx⟩ : ∃ x : ℕ → β, (∀ n, x n ∈ s) ∧ ∀ n i, ¬ ball (x n) (V n) ⊆ c i,
  { push_neg at H,
    choose x hx using H,
    exact ⟨x, forall_and_distrib.mp hx⟩ }, clear H,
  obtain ⟨x₀, x₀_in, φ, φ_mono, hlim⟩ : ∃ (x₀ ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ (x ∘ φ ⟶ x₀),
    from hs x_in, clear hs,
  obtain ⟨i₀, x₀_in⟩ : ∃ i₀, x₀ ∈ c i₀,
  { rcases hc₂ x₀_in with ⟨_, ⟨i₀, rfl⟩, x₀_in_c⟩,
    exact ⟨i₀, x₀_in_c⟩ }, clear hc₂,
  obtain ⟨n₀, hn₀⟩ : ∃ n₀, ball x₀ (V n₀) ⊆ c i₀,
  { rcases (nhds_basis_uniformity hV.to_has_basis).mem_iff.mp
      (is_open_iff_mem_nhds.mp (hc₁ i₀) _ x₀_in) with ⟨n₀, _, h⟩,
    use n₀,
    rwa ← ball_eq_of_symmetry (Vsymm n₀) at h }, clear hc₁,
  obtain ⟨W, W_in, hWW⟩ : ∃ W ∈ 𝓤 β, W ○ W ⊆ V n₀,
    from comp_mem_uniformity_sets (hV.to_has_basis.mem_of_mem trivial),
  obtain ⟨N, x_φ_N_in, hVNW⟩ : ∃ N, x (φ N) ∈ ball x₀ W ∧ V (φ N) ⊆ W,
  { obtain ⟨N₁, h₁⟩ : ∃ N₁, ∀ n ≥ N₁, x (φ n) ∈ ball x₀ W,
      from tendsto_at_top'.mp hlim _ (mem_nhds_left x₀ W_in),
    obtain ⟨N₂, h₂⟩ : ∃ N₂, V (φ N₂) ⊆ W,
    { rcases hV.to_has_basis.mem_iff.mp W_in with ⟨N, _, hN⟩,
      use N,
      exact subset.trans (hV.antitone $ φ_mono.id_le _) hN },
    have : φ N₂ ≤ φ (max N₁ N₂),
      from φ_mono.le_iff_le.mpr (le_max_right _ _),
    exact ⟨max N₁ N₂, h₁ _ (le_max_left _ _), trans (hV.antitone this) h₂⟩ },
  suffices : ball (x (φ N)) (V (φ N)) ⊆ c i₀,
    from hx (φ N) i₀ this,
  calc
    ball (x $ φ N) (V $ φ N) ⊆ ball (x $ φ N) W : preimage_mono hVNW
                         ... ⊆ ball x₀ (V n₀)   : ball_subset_of_comp_subset x_φ_N_in hWW
                         ... ⊆ c i₀             : hn₀,
end

lemma is_seq_compact.totally_bounded (h : is_seq_compact s) : totally_bounded s :=
begin
  classical,
  apply totally_bounded_of_forall_symm,
  unfold is_seq_compact at h,
  contrapose! h,
  rcases h with ⟨V, V_in, V_symm, h⟩,
  simp_rw [not_subset] at h,
  have : ∀ (t : set β), finite t → ∃ a, a ∈ s ∧ a ∉ ⋃ y ∈ t, ball y V,
  { intros t ht,
    obtain ⟨a, a_in, H⟩ : ∃ a ∈ s, ∀ (x : β), x ∈ t → (x, a) ∉ V,
      by simpa [ht] using h t,
    use [a, a_in],
    intro H',
    obtain ⟨x, x_in, hx⟩ := mem_bUnion_iff.mp H',
    exact H x x_in hx },
  cases seq_of_forall_finite_exists this with u hu, clear h this,
  simp [forall_and_distrib] at hu,
  cases hu with u_in hu,
  use [u, u_in], clear u_in,
  intros x x_in φ,
  intros hφ huφ,
  obtain ⟨N, hN⟩ : ∃ N, ∀ p q, p ≥ N → q ≥ N → (u (φ p), u (φ q)) ∈ V,
    from huφ.cauchy_seq.mem_entourage V_in,
  specialize hN N (N+1) (le_refl N) (nat.le_succ N),
  specialize hu (φ $ N+1) (φ N) (hφ $ lt_add_one N),
  exact hu hN,
end

protected lemma is_seq_compact.is_compact [is_countably_generated $ 𝓤 β] (hs : is_seq_compact s) :
  is_compact s :=
begin
  classical,
  rw is_compact_iff_finite_subcover,
  intros ι U Uop s_sub,
  rcases lebesgue_number_lemma_seq hs Uop s_sub with ⟨V, V_in, Vsymm, H⟩,
  rcases totally_bounded_iff_subset.mp hs.totally_bounded V V_in with ⟨t,t_sub, tfin,  ht⟩,
  have : ∀ x : t, ∃ (i : ι), ball x.val V ⊆ U i,
  { rintros ⟨x, x_in⟩,
    exact H x (t_sub x_in) },
  choose i hi using this,
  haveI : fintype t := tfin.fintype,
  use finset.image i finset.univ,
  transitivity ⋃ y ∈ t, ball y V,
  { intros x x_in,
    specialize ht x_in,
    rw mem_bUnion_iff at *,
    simp_rw ball_eq_of_symmetry Vsymm,
    exact ht },
  { apply bUnion_subset_bUnion,
    intros x x_in,
    exact ⟨i ⟨x, x_in⟩, finset.mem_image_of_mem _ (finset.mem_univ _), hi ⟨x, x_in⟩⟩ },
end

/-- A version of Bolzano-Weistrass: in a uniform space with countably generated uniformity filter
(e.g., in a metric space), a set is compact if and only if it is sequentially compact. -/
protected lemma uniform_space.compact_iff_seq_compact [is_countably_generated $ 𝓤 β] :
 is_compact s ↔ is_seq_compact s :=
⟨λ H, H.is_seq_compact, λ H, H.is_compact⟩

lemma uniform_space.compact_space_iff_seq_compact_space [is_countably_generated $ 𝓤 β] :
  compact_space β ↔ seq_compact_space β :=
have key : is_compact (univ : set β) ↔ is_seq_compact univ := uniform_space.compact_iff_seq_compact,
⟨λ ⟨h⟩, ⟨key.mp h⟩, λ ⟨h⟩, ⟨key.mpr h⟩⟩

end uniform_space_seq_compact

section metric_seq_compact

variables [metric_space β] {s : set β}
open metric

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. This version assumes only
that the sequence is frequently in some bounded set. -/
lemma tendsto_subseq_of_frequently_bounded [proper_space β] (hs : bounded s)
  {u : ℕ → β} (hu : ∃ᶠ n in at_top, u n ∈ s) :
  ∃ b ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 b) :=
begin
  have hcs : is_compact (closure s) :=
    compact_iff_closed_bounded.mpr ⟨is_closed_closure, bounded_closure_of_bounded hs⟩,
  replace hcs : is_seq_compact (closure s),
    from uniform_space.compact_iff_seq_compact.mp hcs,
  have hu' : ∃ᶠ n in at_top, u n ∈ closure s,
  { apply frequently.mono hu,
    intro n,
    apply subset_closure },
  exact hcs.subseq_of_frequently_in hu',
end

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. -/
lemma tendsto_subseq_of_bounded [proper_space β] (hs : bounded s)
  {u : ℕ → β} (hu : ∀ n, u n ∈ s) :
∃ b ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 b) :=
tendsto_subseq_of_frequently_bounded hs $ frequently_of_forall hu

lemma seq_compact.lebesgue_number_lemma_of_metric
  {ι : Type*} {c : ι → set β} (hs : is_seq_compact s)
  (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
  ∃ δ > 0, ∀ x ∈ s, ∃ i, ball x δ ⊆ c i :=
begin
  rcases lebesgue_number_lemma_seq hs hc₁ hc₂ with ⟨V, V_in, _, hV⟩,
  rcases uniformity_basis_dist.mem_iff.mp V_in with ⟨δ, δ_pos, h⟩,
  use [δ, δ_pos],
  intros x x_in,
  rcases hV x x_in with ⟨i, hi⟩,
  use i,
  have := ball_mono h x,
  rw ball_eq_ball' at this,
  exact subset.trans this hi,
end

end metric_seq_compact


/-
Copyright (c) 2018 Louis Carlin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Louis Carlin, Mario Carneiro
-/
import logic.nontrivial
import algebra.divisibility.basic
import algebra.group.basic
import algebra.ring.defs

/-!
# Euclidean domains

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

This file introduces Euclidean domains and provides the extended Euclidean algorithm. To be precise,
a slightly more general version is provided which is sometimes called a transfinite Euclidean domain
and differs in the fact that the degree function need not take values in `ℕ` but can take values in
any well-ordered set. Transfinite Euclidean domains were introduced by Motzkin and examples which
don't satisfy the classical notion were provided independently by Hiblot and Nagata.

## Main definitions

* `euclidean_domain`: Defines Euclidean domain with functions `quotient` and `remainder`. Instances
  of `has_div` and `has_mod` are provided, so that one can write `a = b * (a / b) + a % b`.
* `gcd`: defines the greatest common divisors of two elements of a Euclidean domain.
* `xgcd`: given two elements `a b : R`, `xgcd a b` defines the pair `(x, y)` such that
  `x * a + y * b = gcd a b`.
* `lcm`: defines the lowest common multiple of two elements `a` and `b` of a Euclidean domain as
  `a * b / (gcd a b)`

## Main statements

See `algebra.euclidean_domain.basic` for most of the theorems about Eucliean domains,
including Bézout's lemma.

See `algebra.euclidean_domain.instances` for that facts that `ℤ` is a Euclidean domain,
as is any field.

## Notation

`≺` denotes the well founded relation on the Euclidean domain, e.g. in the example of the polynomial
ring over a field, `p ≺ q` for polynomials `p` and `q` if and only if the degree of `p` is less than
the degree of `q`.

## Implementation details

Instead of working with a valuation, `euclidean_domain` is implemented with the existence of a well
founded relation `r` on the integral domain `R`, which in the example of `ℤ` would correspond to
setting `i ≺ j` for integers `i` and `j` if the absolute value of `i` is smaller than the absolute
value of `j`.

## References

* [Th. Motzkin, *The Euclidean algorithm*][MR32592]
* [J.-J. Hiblot, *Des anneaux euclidiens dont le plus petit algorithme n'est pas à valeurs finies*]
  [MR399081]
* [M. Nagata, *On Euclid algorithm*][MR541021]

## Tags

Euclidean domain, transfinite Euclidean domain, Bézout's lemma
-/

universe u

/-- A `euclidean_domain` is an non-trivial commutative ring with a division and a remainder,
  satisfying `b * (a / b) + a % b = a`.
  The definition of a euclidean domain usually includes a valuation function `R → ℕ`.
  This definition is slightly generalised to include a well founded relation
  `r` with the property that `r (a % b) b`, instead of a valuation.  -/
@[protect_proj without mul_left_not_lt r_well_founded]
class euclidean_domain (R : Type u) extends comm_ring R, nontrivial R :=
(quotient : R → R → R)
(quotient_zero : ∀ a, quotient a 0 = 0)
(remainder : R → R → R)
(quotient_mul_add_remainder_eq : ∀ a b, b * quotient a b + remainder a b = a)
(r : R → R → Prop)
(r_well_founded : well_founded r)
(remainder_lt : ∀ a {b}, b ≠ 0 → r (remainder a b) b)
(mul_left_not_lt : ∀ a {b}, b ≠ 0 → ¬r (a * b) a)

namespace euclidean_domain
variable {R : Type u}
variables [euclidean_domain R]

local infix ` ≺ `:50 := euclidean_domain.r

@[priority 70] -- see Note [lower instance priority]
instance : has_div R := ⟨euclidean_domain.quotient⟩

@[priority 70] -- see Note [lower instance priority]
instance : has_mod R := ⟨euclidean_domain.remainder⟩

theorem div_add_mod (a b : R) : b * (a / b) + a % b = a :=
euclidean_domain.quotient_mul_add_remainder_eq _ _

lemma mod_add_div (a b : R) : a % b + b * (a / b) = a :=
(add_comm _ _).trans (div_add_mod _ _)

lemma mod_add_div' (m k : R) : m % k + (m / k) * k = m :=
by { rw mul_comm, exact mod_add_div _ _ }

lemma div_add_mod' (m k : R) : (m / k) * k + m % k = m :=
by { rw mul_comm, exact div_add_mod _ _ }

lemma mod_eq_sub_mul_div {R : Type*} [euclidean_domain R] (a b : R) :
  a % b = a - b * (a / b) :=
calc a % b = b * (a / b) + a % b - b * (a / b) : (add_sub_cancel' _ _).symm
... = a - b * (a / b) : by rw div_add_mod

theorem mod_lt : ∀ a {b : R}, b ≠ 0 → (a % b) ≺ b :=
euclidean_domain.remainder_lt

theorem mul_right_not_lt {a : R} (b) (h : a ≠ 0) : ¬(a * b) ≺ b :=
by { rw mul_comm, exact mul_left_not_lt b h }

@[simp] lemma mod_zero (a : R) : a % 0 = a :=
by simpa only [zero_mul, zero_add] using div_add_mod a 0

lemma lt_one (a : R) : a ≺ (1:R) → a = 0 :=
by { haveI := classical.dec, exact
  not_imp_not.1 (λ h, by simpa only [one_mul] using mul_left_not_lt 1 h) }

@[simp, priority 900] lemma div_zero (a : R) : a / 0 = 0 :=
euclidean_domain.quotient_zero a

section
open_locale classical

@[elab_as_eliminator]
theorem gcd.induction {P : R → R → Prop} : ∀ a b : R,
  (∀ x, P 0 x) →
  (∀ a b, a ≠ 0 → P (b % a) a → P a b) →
  P a b
| a := λ b H0 H1, if a0 : a = 0 then a0.symm ▸ H0 _ else
  have h:_ := mod_lt b a0,
  H1 _ _ a0 (gcd.induction (b%a) a H0 H1)
using_well_founded {dec_tac := tactic.assumption,
  rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]}

end

section gcd
variable [decidable_eq R]

/-- `gcd a b` is a (non-unique) element such that `gcd a b ∣ a` `gcd a b ∣ b`, and for
  any element `c` such that `c ∣ a` and `c ∣ b`, then `c ∣ gcd a b` -/
def gcd : R → R → R
| a := λ b, if a0 : a = 0 then b else
  have h:_ := mod_lt b a0,
  gcd (b%a) a
using_well_founded {dec_tac := tactic.assumption,
  rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]}

@[simp] theorem gcd_zero_left (a : R) : gcd 0 a = a :=
by { rw gcd, exact if_pos rfl }

/--
An implementation of the extended GCD algorithm.
At each step we are computing a triple `(r, s, t)`, where `r` is the next value of the GCD
algorithm, to compute the greatest common divisor of the input (say `x` and `y`), and `s` and `t`
are the coefficients in front of `x` and `y` to obtain `r` (i.e. `r = s * x + t * y`).
The function `xgcd_aux` takes in two triples, and from these recursively computes the next triple:
```
xgcd_aux (r, s, t) (r', s', t') = xgcd_aux (r' % r, s' - (r' / r) * s, t' - (r' / r) * t) (r, s, t)
```
-/
def xgcd_aux : R → R → R → R → R → R → R × R × R
| r := λ s t r' s' t',
if hr : r = 0 then (r', s', t')
  else
  have r' % r ≺ r, from mod_lt _ hr,
  let q := r' / r in xgcd_aux (r' % r) (s' - q * s) (t' - q * t) r s t
using_well_founded {dec_tac := tactic.assumption,
  rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]}

@[simp] theorem xgcd_zero_left {s t r' s' t' : R} : xgcd_aux 0 s t r' s' t' = (r', s', t') :=
by { unfold xgcd_aux, exact if_pos rfl }

theorem xgcd_aux_rec {r s t r' s' t' : R} (h : r ≠ 0) :
  xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - (r' / r) * s) (t' - (r' / r) * t) r s t :=
by { conv {to_lhs, rw [xgcd_aux]}, exact if_neg h}

/-- Use the extended GCD algorithm to generate the `a` and `b` values
  satisfying `gcd x y = x * a + y * b`. -/
def xgcd (x y : R) : R × R := (xgcd_aux x 1 0 y 0 1).2

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a (x y : R) : R := (xgcd x y).1

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b (x y : R) : R := (xgcd x y).2

@[simp] theorem gcd_a_zero_left {s : R} : gcd_a 0 s = 0 :=
by { unfold gcd_a, rw [xgcd, xgcd_zero_left] }

@[simp] theorem gcd_b_zero_left {s : R} : gcd_b 0 s = 1 :=
by { unfold gcd_b, rw [xgcd, xgcd_zero_left] }

theorem xgcd_val (x y : R) : xgcd x y = (gcd_a x y, gcd_b x y) :=
prod.mk.eta.symm

end gcd

section lcm
variables [decidable_eq R]

/-- `lcm a b` is a (non-unique) element such that `a ∣ lcm a b` `b ∣ lcm a b`, and for
  any element `c` such that `a ∣ c` and `b ∣ c`, then `lcm a b ∣ c` -/
def lcm (x y : R) : R :=
x * y / gcd x y

end lcm

end euclidean_domain


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

! This file was ported from Lean 3 source module analysis.complex.roots_of_unity
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Complex.Log
import Mathbin.RingTheory.RootsOfUnity

/-!
# Complex roots of unity

In this file we show that the `n`-th complex roots of unity
are exactly the complex numbers `e ^ (2 * real.pi * complex.I * (i / n))` for `i ∈ finset.range n`.

## Main declarations

* `complex.mem_roots_of_unity`: the complex `n`-th roots of unity are exactly the
  complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`.
* `complex.card_roots_of_unity`: the number of `n`-th roots of unity is exactly `n`.

-/

namespace Complex

open Polynomial Real

open Nat Real

theorem isPrimitiveRoot_exp_of_coprime (i n : ℕ) (h0 : n ≠ 0) (hi : i.coprime n) :
    IsPrimitiveRoot (exp (2 * π * I * (i / n))) n :=
  by
  rw [IsPrimitiveRoot.iff_def]
  simp only [← exp_nat_mul, exp_eq_one_iff]
  have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast h0
  constructor
  · use i
    field_simp [hn0, mul_comm (i : ℂ), mul_comm (n : ℂ)]
  · simp only [hn0, mul_right_comm _ _ ↑n, mul_left_inj' two_pi_I_ne_zero, Ne.def, not_false_iff,
      mul_comm _ (i : ℂ), ← mul_assoc _ (i : ℂ), exists_imp, field_simps]
    norm_cast
    rintro l k hk
    have : n ∣ i * l := by
      rw [← Int.coe_nat_dvd, hk]
      apply dvd_mul_left
    exact hi.symm.dvd_of_dvd_mul_left this
#align complex.is_primitive_root_exp_of_coprime Complex.isPrimitiveRoot_exp_of_coprime

theorem isPrimitiveRoot_exp (n : ℕ) (h0 : n ≠ 0) : IsPrimitiveRoot (exp (2 * π * I / n)) n := by
  simpa only [Nat.cast_one, one_div] using
    is_primitive_root_exp_of_coprime 1 n h0 n.coprime_one_left
#align complex.is_primitive_root_exp Complex.isPrimitiveRoot_exp

theorem isPrimitiveRoot_iff (ζ : ℂ) (n : ℕ) (hn : n ≠ 0) :
    IsPrimitiveRoot ζ n ↔ ∃ i < (n : ℕ), ∃ hi : i.coprime n, exp (2 * π * I * (i / n)) = ζ :=
  by
  have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast hn
  constructor; swap
  · rintro ⟨i, -, hi, rfl⟩
    exact is_primitive_root_exp_of_coprime i n hn hi
  intro h
  obtain ⟨i, hi, rfl⟩ :=
    (is_primitive_root_exp n hn).eq_pow_of_pow_eq_one h.pow_eq_one (Nat.pos_of_ne_zero hn)
  refine' ⟨i, hi, ((is_primitive_root_exp n hn).pow_iff_coprime (Nat.pos_of_ne_zero hn) i).mp h, _⟩
  rw [← exp_nat_mul]
  congr 1
  field_simp [hn0, mul_comm (i : ℂ)]
#align complex.is_primitive_root_iff Complex.isPrimitiveRoot_iff

/-- The complex `n`-th roots of unity are exactly the
complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`. -/
theorem mem_rootsOfUnity (n : ℕ+) (x : Units ℂ) :
    x ∈ rootsOfUnity n ℂ ↔ ∃ i < (n : ℕ), exp (2 * π * I * (i / n)) = x :=
  by
  rw [mem_rootsOfUnity, Units.ext_iff, Units.val_pow_eq_pow_val, Units.val_one]
  have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast n.ne_zero
  constructor
  · intro h
    obtain ⟨i, hi, H⟩ : ∃ i < (n : ℕ), exp (2 * π * I / n) ^ i = x := by
      simpa only using (is_primitive_root_exp n n.ne_zero).eq_pow_of_pow_eq_one h n.pos
    refine' ⟨i, hi, _⟩
    rw [← H, ← exp_nat_mul]
    congr 1
    field_simp [hn0, mul_comm (i : ℂ)]
  · rintro ⟨i, hi, H⟩
    rw [← H, ← exp_nat_mul, exp_eq_one_iff]
    use i
    field_simp [hn0, mul_comm ((n : ℕ) : ℂ), mul_comm (i : ℂ)]
#align complex.mem_roots_of_unity Complex.mem_rootsOfUnity

theorem card_rootsOfUnity (n : ℕ+) : Fintype.card (rootsOfUnity n ℂ) = n :=
  (isPrimitiveRoot_exp n n.NeZero).card_rootsOfUnity
#align complex.card_roots_of_unity Complex.card_rootsOfUnity

theorem card_primitiveRoots (k : ℕ) : (primitiveRoots k ℂ).card = φ k :=
  by
  by_cases h : k = 0
  · simp [h]
  exact (is_primitive_root_exp k h).card_primitiveRoots
#align complex.card_primitive_roots Complex.card_primitiveRoots

end Complex

theorem IsPrimitiveRoot.norm'_eq_one {ζ : ℂ} {n : ℕ} (h : IsPrimitiveRoot ζ n) (hn : n ≠ 0) :
    ‖ζ‖ = 1 :=
  Complex.norm_eq_one_of_pow_eq_one h.pow_eq_one hn
#align is_primitive_root.norm'_eq_one IsPrimitiveRoot.norm'_eq_one

theorem IsPrimitiveRoot.nnnorm_eq_one {ζ : ℂ} {n : ℕ} (h : IsPrimitiveRoot ζ n) (hn : n ≠ 0) :
    ‖ζ‖₊ = 1 :=
  Subtype.ext <| h.norm'_eq_one hn
#align is_primitive_root.nnnorm_eq_one IsPrimitiveRoot.nnnorm_eq_one

theorem IsPrimitiveRoot.arg_ext {n m : ℕ} {ζ μ : ℂ} (hζ : IsPrimitiveRoot ζ n)
    (hμ : IsPrimitiveRoot μ m) (hn : n ≠ 0) (hm : m ≠ 0) (h : ζ.arg = μ.arg) : ζ = μ :=
  Complex.ext_abs_arg ((hζ.norm'_eq_one hn).trans (hμ.norm'_eq_one hm).symm) h
#align is_primitive_root.arg_ext IsPrimitiveRoot.arg_ext

theorem IsPrimitiveRoot.arg_eq_zero_iff {n : ℕ} {ζ : ℂ} (hζ : IsPrimitiveRoot ζ n) (hn : n ≠ 0) :
    ζ.arg = 0 ↔ ζ = 1 :=
  ⟨fun h => hζ.arg_ext IsPrimitiveRoot.one hn one_ne_zero (h.trans Complex.arg_one.symm), fun h =>
    h.symm ▸ Complex.arg_one⟩
#align is_primitive_root.arg_eq_zero_iff IsPrimitiveRoot.arg_eq_zero_iff

theorem IsPrimitiveRoot.arg_eq_pi_iff {n : ℕ} {ζ : ℂ} (hζ : IsPrimitiveRoot ζ n) (hn : n ≠ 0) :
    ζ.arg = Real.pi ↔ ζ = -1 :=
  ⟨fun h =>
    hζ.arg_ext (IsPrimitiveRoot.neg_one 0 two_ne_zero.symm) hn two_ne_zero
      (h.trans Complex.arg_neg_one.symm),
    fun h => h.symm ▸ Complex.arg_neg_one⟩
#align is_primitive_root.arg_eq_pi_iff IsPrimitiveRoot.arg_eq_pi_iff

theorem IsPrimitiveRoot.arg {n : ℕ} {ζ : ℂ} (h : IsPrimitiveRoot ζ n) (hn : n ≠ 0) :
    ∃ i : ℤ, ζ.arg = i / n * (2 * Real.pi) ∧ IsCoprime i n ∧ i.natAbs < n :=
  by
  rw [Complex.isPrimitiveRoot_iff _ _ hn] at h
  obtain ⟨i, h, hin, rfl⟩ := h
  rw [mul_comm, ← mul_assoc, Complex.exp_mul_I]
  refine' ⟨if i * 2 ≤ n then i else i - n, _, _, _⟩
  on_goal 2 =>
    replace hin := nat.is_coprime_iff_coprime.mpr hin
    split_ifs with _
    · exact hin
    · convert hin.add_mul_left_left (-1)
      rw [mul_neg_one, sub_eq_add_neg]
  on_goal 2 =>
    split_ifs with h₂
    · exact_mod_cast h
    suffices (i - n : ℤ).natAbs = n - i by
      rw [this]
      apply tsub_lt_self hn.bot_lt
      contrapose! h₂
      rw [Nat.eq_zero_of_le_zero h₂, MulZeroClass.zero_mul]
      exact zero_le _
    rw [← Int.natAbs_neg, neg_sub, Int.natAbs_eq_iff]
    exact Or.inl (Int.ofNat_sub h.le).symm
  split_ifs with h₂
  · convert Complex.arg_cos_add_sin_mul_i _
    · push_cast
    · push_cast
    field_simp [hn]
    refine' ⟨(neg_lt_neg Real.pi_pos).trans_le _, _⟩
    · rw [neg_zero]
      exact mul_nonneg (mul_nonneg i.cast_nonneg <| by simp [real.pi_pos.le]) (by simp)
    rw [← mul_rotate', mul_div_assoc]
    rw [← mul_one n] at h₂
    exact
      mul_le_of_le_one_right real.pi_pos.le
        ((div_le_iff' <| by exact_mod_cast pos_of_gt h).mpr <| by exact_mod_cast h₂)
  rw [← Complex.cos_sub_two_pi, ← Complex.sin_sub_two_pi]
  convert Complex.arg_cos_add_sin_mul_i _
  · push_cast
    rw [← sub_one_mul, sub_div, div_self]
    exact_mod_cast hn
  · push_cast
    rw [← sub_one_mul, sub_div, div_self]
    exact_mod_cast hn
  field_simp [hn]
  refine' ⟨_, le_trans _ real.pi_pos.le⟩
  on_goal 2 =>
    rw [mul_div_assoc]
    exact
      mul_nonpos_of_nonpos_of_nonneg (sub_nonpos.mpr <| by exact_mod_cast h.le)
        (div_nonneg (by simp [real.pi_pos.le]) <| by simp)
  rw [← mul_rotate', mul_div_assoc, neg_lt, ← mul_neg, mul_lt_iff_lt_one_right Real.pi_pos, ←
    neg_div, ← neg_mul, neg_sub, div_lt_iff, one_mul, sub_mul, sub_lt_comm, ← mul_sub_one]
  norm_num
  exact_mod_cast not_le.mp h₂
  · exact nat.cast_pos.mpr hn.bot_lt
#align is_primitive_root.arg IsPrimitiveRoot.arg