import data.int.modeq
import data.int.parity
import tactic.omega.main
import tactic
import ring_theory.int.basic
import ring_theory.coprime
import tactic.slim_check
import data.real.basic
import tactic.ring_exp

/-
Proof that p ∣ a^2 + b^2 where a b are coprime → p = x^2 + y^2

This is known as descent step, used by Euler proving p ≡ 1 [MOD 4] ↔ p = x^2 + y^2. Descent step
combined with reciprocity step, p ≡ 1 [MOD 4] → p ∣ a^2 + b^2 where a b are coprime, finishes
the proof. This method can be generalise for x^2 + 2y^2 and x^2 + 3y^2. More of this can be found
in "Primes of the Form x^2 + ny^2" by David A. Cox.

The proof is actually elementary, but it took me almost 1k lines because I was not yet familiar
with how lean defines nat, int, divide and mod etc and I was stuck switching between nat and int. I shorten it down to 600 lines. Although I
think I can do better than that, I will advance to other topics rather than spending a lot of time
on redundancy because this method is quite elementary and just solves for n = 1, 2, 3 and I just
do it for practice.

I am not sure if I can formalise the whole book in lean because it requires stuffs like genus
theory, higher reciprocity and class field theory.
-/

open int

--definition of prime in ring theory implies that in natural number
theorem prime_pos_int {n : ℤ} (npos : n > 0) (h : prime n) :
  2 ≤ n ∧ ∀ (m : ℤ), m > 0 → m ∣ n → m = 1 ∨ m = n :=
begin
  have hneq : n ≠ 1,
    intro hn, apply h.2.1, rw hn, norm_num,
  split, omega,
  intros m mpos hm,
  cases hm with k hk,
  have hdvd : m * k ∣ m ∨ m * k ∣ k,
    rw ←hk, apply h.2.2, rw hk,
  cases hdvd with hdvd hdvd,
  { right,
    suffices : m*k = m*1,
      replace : k = 1, from (mul_right_inj' (by linarith)).mp this,
      rw [hk, this], simp,
    simp,
    exact dvd_antisymm (by linarith) (by linarith) hdvd ⟨k, by simp⟩ },
  left,
  apply dvd_antisymm; try {linarith},
  { have : k ≠ 0,
      intro hf, rw hf at hk, rw hk at h, simp at h, exact h,
    apply (mul_dvd_mul_iff_right this).mp,
    simp, exact hdvd },
  { exact ⟨m, by simp⟩ }
end

--this helps when we lift a prime number in int
theorem int_prime_eq_nat_prime {a : ℕ} : nat.prime a ↔ prime (a : ℤ) :=
begin
  split; intro hp,
  cases hp with a2 advd,
  split, linarith,
  split,
  { intro hf,
    rw is_unit_iff_exists_inv at hf,
    cases hf with b hf,
    replace hf : (a : ℤ) ∣ 1, from ⟨b, hf.symm⟩,
    norm_cast at hf,
    have hf : a = 1, from nat.dvd_one.mp hf,
    linarith },
  { intros b c hdvd, by_contradiction hf, push_neg at hf,
    cases hf with h₁ h₂,
    have : is_coprime ↑a b,
      rw ←gcd_eq_one_iff_coprime,
      have leftdvd : ↑(int.gcd ↑a b) ∣ (a : ℤ), from (a : ℤ).gcd_dvd_left b,
      norm_cast at leftdvd,
      cases advd ((a : ℤ).gcd b) leftdvd with ht hf,
      exact ht,
      have : ↑(int.gcd ↑a b) ∣ b, from (a : ℤ).gcd_dvd_right b,
      rw hf at this, exact absurd this h₁,
    have hac : ↑a ∣ c, from is_coprime.dvd_of_dvd_mul_left this hdvd,
    exact h₂ hac },
  have apos : (a : ℤ) > 0,
    norm_cast,
    have := hp.1, norm_cast at this,
    exact pos_iff_ne_zero.mpr this,
  cases prime_pos_int (apos) hp with a2 advd,
  split; zify,
  { exact a2 },
  { intros m hm,
    apply advd,
    norm_cast, rw pos_iff_ne_zero,
    intro m0,
    rw [m0, zero_dvd_iff] at hm,
    linarith,
    norm_cast, exact hm}
end

lemma int_dvd_one (x k : ℤ) (h : 1 = k*x) (xnonneg : x ≥ 0) : x = 1 :=
begin
  replace h : x ∣ 1, from ⟨k, by {rw h, ring}⟩,
  lift x to ℕ using xnonneg,
  norm_cast at *,
  exact nat.dvd_one.mp h
end

lemma sq_prime {x : ℤ} (h : prime (x^2)) : false :=
begin
  cases em (x = 0) with hn ht,
    rw hn at h, norm_num at h, exact h,
  replace h := prime_pos_int (pow_bit0_pos ht 1) h,
  rw ←sqr_abs at h,
  cases h with h2 h,
  cases (h (abs x) (abs_pos.2 ht) (by {rw pow_two, exact dvd.intro (abs x) rfl})) with hx hx,
  rw hx at h2, linarith,
  replace hx := eq.trans (mul_one (abs x)) hx, rw [pow_two] at hx,
  replace ht := abs_pos.2 ht,
  have := (mul_right_inj' (by linarith)).1 hx,
  rw ←this at h2, linarith
end

lemma prime_sq_sq (x y : ℤ) (h : prime (x^2 + y^2)) : is_coprime x y :=
begin
  rw ←gcd_eq_one_iff_coprime,
  cases (int.gcd_dvd_left x y) with n hn,
  cases (int.gcd_dvd_right x y) with m hm,
  have cal : x^2 + y^2 = ↑(x.gcd y) * (n * ↑(x.gcd y) * n + m * ↑(x.gcd y) * m),
    have hx2 : x^2 = (↑(x.gcd y) * n)^2, begin conv begin to_lhs, rw hn, end, end,
    have hy2 : y^2 = (↑(x.gcd y) * m)^2, begin conv begin to_lhs, rw hm, end, end,
    rw [hx2, hy2, pow_two, pow_two],
    rw [mul_assoc, mul_assoc, mul_add], ring,
  cases em (x = 0 ∧ y = 0) with hn ht,
  rw [hn.1, hn.2] at h, norm_num at h, exfalso, exact h,
  have sumpos : x^2 + y^2 > 0,
    rw not_and_distrib at ht, cases ht with ht ht;
    have := pow_bit0_pos ht 1; have := pow_two_nonneg x; have := pow_two_nonneg y;
    linarith,
  cases (prime_pos_int sumpos h) with h₁ h₂,
  have gcdpos : ((x.gcd y) : ℤ) > 0,
    have hnonneg : ((x.gcd y) : ℤ) ≥ 0,
      have := zero_le (gcd x y), linarith,
    have hnonzero : ((x.gcd y) : ℤ) ≠ 0,
      simp, intro hn, rw int.gcd_eq_zero_iff at hn, exact ht hn,
    exact (ne.symm hnonzero).le_iff_lt.1 hnonneg,
  specialize h₂ ↑(x.gcd y) gcdpos (dvd.intro _ (eq.symm cal)),
  clear ht,
  cases h₂ with h₂ h₂, linarith,
  cases em (x = 0 ∨ y = 0) with hf ht,
  cases hf with hf hf; rw hf at h; norm_num at h; exfalso; exact sq_prime h,
  replace ht : x ≠ 0 ∧ y ≠ 0, exact not_or_distrib.1 ht,
  replace cal := eq.trans h₂ cal,
  replace cal : 1 = (n * ↑(x.gcd y) * n + m * ↑(x.gcd y) * m),
    replace cal := eq.trans (mul_one ↑(x.gcd y)) cal,
    exact (mul_right_inj' (by linarith)).1 cal,
  rw h₂ at cal,
  rw [mul_assoc, mul_assoc, mul_comm (x ^ 2 + y ^ 2) n, mul_comm (x ^ 2 + y ^ 2) m,
      ←mul_assoc, ←mul_assoc] at cal,
  rw [←add_mul, ←h₂] at cal, have := int_dvd_one _ _ cal (by linarith), linarith
end

lemma sq_sq_zero (x y : ℤ) (h : x^2 + y^2 = 0) : x = 0 ∧ y = 0 :=
begin
  by_contradiction hn,
  cases (not_and_distrib.1 hn) with h0 h0;
  have := pow_bit0_pos h0 1; have := pow_two_nonneg x; have := pow_two_nonneg y;
  linarith
end

lemma neg_coprime {x y : ℤ} (h : is_coprime x y) : is_coprime (-x) y :=
begin
  unfold is_coprime at *,
  rcases h with ⟨a, b, h⟩,
  use (-a), use b,
  simp, exact h
end

lemma abs_coprime {x y : ℤ} (h : is_coprime x y) : is_coprime (abs x) (abs y) :=
begin
  unfold is_coprime at *,
  rcases h with ⟨a, b, h⟩,
  cases em (x ≥ 0) with hx hx;
  cases em (y ≥ 0) with hy hy,
  use a, use b, rw [abs_of_nonneg hx, abs_of_nonneg hy], exact h,
  push_neg at hy, use a, use (-b), rw [abs_of_nonneg hx, abs_of_neg hy], rw ←h, ring,
  push_neg at hx, use (-a), use b, rw [abs_of_neg hx, abs_of_nonneg hy], rw ←h, ring,
  push_neg at hx, push_neg at hy, use (-a), use (-b), rw [abs_of_neg hx, abs_of_neg hy], rw ←h, ring
end

lemma qr_thm_alter (a p : ℤ) (h0 : p > 0) : ∃ q r : ℤ, a = p*q + r ∧ (abs r : ℝ) ≤ (p : ℝ)/2 :=
begin
  have key := (div_add_mod a p).symm,
  cases em ((↑(a % p) : ℝ) ≤ (p/2 : ℝ)) with hl hl,
  use a / p, use a % p, split, exact key,
  rw abs_of_nonneg, exact hl, simp, exact mod_nonneg a (show p ≠ 0, by linarith),
  use ((a / p) + 1), use (a % p - p), split,
  ring, rw mul_comm, exact key,
  push_neg at hl, rw abs_of_neg, simp, linarith,
  simp, exact mod_lt_of_pos a h0
end

theorem sum_of_sq_dvd_sum_of_sq {N q : ℤ}
(hN : ∃ a b : ℤ, (is_coprime a b ∧ N = a^2 + b^2))
(hpd : prime q ∧ q ∣ N) (hq : ∃ x y : ℤ, q = x^2 + y^2) :
∃ c d : ℤ, is_coprime c d ∧ N/q = c^2 + d^2 :=
begin
  rcases hN with ⟨a, b, hab, hN⟩,
  rcases hq with ⟨x, y, hq⟩,
  have h₁ : q ∣ x^2 * N - a^2 * q,
    cases hpd.2 with k hk, use x^2 * k - a^2,
    rw [mul_sub_left_distrib, hk, mul_left_comm (x^2) q k, mul_comm (a^2) q],
  have h₂ : x^2 * N - a^2 * q = (x*b + a*y) * (x*b - a*y),
    calc x^2 * N - a^2 * q = x^2 * (a^2 + b^2) - a^2 * (x^2 + y^2) : by rw [hN, hq]
                       ... = x^2 * b^2 - a^2 * y^2                 : by {rw [mul_add, mul_add, ←sub_sub, mul_comm], simp}
                       ... = (x*b)^2 - (a*y)^2                     : by rw [←(mul_pow x b 2), ←(mul_pow a y 2)]
                       ... = (x*b + a*y) * (x*b - a*y)             : sq_sub_sq _ _,
  rw h₂ at h₁, clear h₂,
  revert a, have key : ∀ (a : ℤ), is_coprime a b → N = a ^ 2 + b ^ 2
                      → q ∣ (x * b + a * y)
                      → (∃ (c d : ℤ), is_coprime c d ∧ N / q = c ^ 2 + d ^ 2),
  intros a hab hN h,
  cases h with d hd,
  have cal : (a - d*y)*y = a*y - d*y^2, by ring,
        rw [(eq_sub_of_add_eq' hd), hq, (add_mul (x^2) (y^2) d), (mul_comm (y^2) d),
            ←add_sub, ←add_sub, sub_sub, (add_comm (x*b) (d * y^2)), ←sub_sub] at cal,
        simp at cal,
        rw [tactic.ring.add_neg_eq_sub, pow_two, mul_assoc, ←mul_sub] at cal,
  have h₃ : x ∣ a - d*y,
    have : x ∣ (a - d*y)*y,
    rw cal, exact dvd.intro (x*d - b) rfl,
  exact is_coprime.dvd_of_dvd_mul_right (prime_sq_sq x y (by {rw ←hq, exact hpd.1})) this,
  cases h₃ with c hc,
  rw hc at cal,
  cases em (x = 0 ∨ y = 0) with hf ht,
  cases hf with hf hf; rw hq at hpd; rw hf at hpd; norm_num at hpd; exfalso; exact sq_prime hpd.1,
  replace ht : x ≠ 0 ∧ y ≠ 0, exact not_or_distrib.1 ht,
  rw mul_assoc at cal, replace cal := (mul_right_inj' ht.1).1 cal,
  have ha : a = x*c + d*y, by linarith, have hb : b = x*d - c*y, by linarith,
  have key : N = q * (c^2 + d^2),
    calc N = a^2 + b^2                             : hN
       ... = (x*c + d*y)^2 + (x*d - c*y)^2         : by rw [ha, hb]
       ... = x^2*c^2 + x^2*d^2 + y^2*c^2 + y^2*d^2 : by ring
       ... = x^2*(c^2 + d^2) + y^2*(c^2 + d^2)     : by ring
       ... = (x^2 + y^2) * (c^2 + d^2)             : by ring
       ... = q * (c^2 + d^2)                       : by rw ←hq,
  use c, use d,
  split,
  cases (int.gcd_dvd_left c d) with n hn,
  cases (int.gcd_dvd_right c d) with m hm,
  rw hn at ha, rw hn at hb,
  have : d * y = ↑(c.gcd d) * m * y, begin conv begin to_lhs, rw hm, end, end, rw this at ha, clear this,
  have : x * d = x * (↑(c.gcd d) * m), begin conv begin to_lhs, rw hm, end, end, rw this at hb, clear this,
  rw [←mul_assoc, mul_comm x _, mul_assoc, mul_assoc, ←mul_add] at ha,
  rw [←mul_assoc, mul_comm x _, mul_assoc, mul_assoc, ←mul_sub] at hb,
  replace ha := dvd.intro _ (eq.symm ha),
  replace hb := dvd.intro _ (eq.symm hb),
  have gcd_dvd := int.dvd_gcd ha hb,
  rw ←gcd_eq_one_iff_coprime,
  rw ←gcd_eq_one_iff_coprime at hab,
  cases gcd_dvd with k hk,
  rw [hab, mul_comm] at hk, have := zero_le (c.gcd d), simp at hk,
  have := int_dvd_one _ _ hk (by linarith), linarith,
  rw key, cases em (q = 0) with hw hr, rw hw at hpd, unfold prime at hpd, exact absurd (rfl) (hpd.1.1),
  rw mul_comm, exact int.mul_div_cancel (c^2 + d^2) hr,
  intros a hab hN h,
  cases (prime.div_or_div hpd.1 h) with h h, exact key a hab hN h,
  apply (key (-a)), exact neg_coprime hab, rw hN, ring, simp, exact h
end

lemma dvd_leq {a b : ℤ} (anonneg : a ≥ 0) (bpos : b > 0)
(hdvd : a ∣ b) : a ≤ b :=
begin
  lift a to ℕ using anonneg,
  lift b to ℕ using (show b ≥ 0, by linarith),
  norm_cast at *,
  exact nat.le_of_dvd bpos hdvd
end

lemma dvd_abs {a b : ℤ} (h : a ∣ b) : a ∣ abs b :=
begin
  cases em (b ≥ 0) with hb hb,
  rw abs_of_nonneg hb, exact h,
  push_neg at hb, rw abs_of_neg hb, exact (dvd_neg a b).2 h
end

--some calculations involving inequality, not really important as it's easy for people
lemma simp_cal {m n p : ℤ} (habsm: ((abs m) : ℝ) ≤ ↑p / 2) (habsn: ((abs n) : ℝ) ≤ ↑p / 2) (ppos : p ≥ 0)
: ((m^2) : ℝ) + ((n^2) : ℝ) ≤ (p^2/2 : ℝ) :=
begin
  rw [pow_two, pow_two, ←abs_mul_abs_self ↑m, ←abs_mul_abs_self ↑n],
  have hm : (abs ↑m) * (abs ↑m ) ≤ ((p / 2) : ℝ) * ((p / 2) : ℝ),
    have absm : ((abs m) : ℝ) ≥ 0, from abs_nonneg ↑m,
    exact mul_self_le_mul_self absm habsm,
  have hn : (abs ↑n) * (abs ↑n) ≤ ((p / 2) : ℝ) * ((p / 2) : ℝ),
    have absn : ((abs n) : ℝ) ≥ 0, from abs_nonneg ↑n,
    exact mul_self_le_mul_self absn habsn,
  have : ((p ^ 2 / 2) : ℝ) = ((p / 2) : ℝ) * ((p / 2) : ℝ) + ((p / 2) : ℝ) * ((p / 2) : ℝ), ring,
  rw this,
  exact add_le_add hm hn
end

lemma largest_divisor {p q N : ℤ} (hdvd: p*q ∣ N) (hp : p > 0) (hq : q > 0) (hN : N > 0)
(hleq : (N : ℝ) ≤ (p^2/2 : ℝ) ) : q < p :=
begin
  cases hdvd with k hdvd,
  rw hdvd at hleq,
  rw pow_two at hleq,
  simp at hleq,
  have ppos : (p : ℝ) > 0,
    simp, linarith,
  rw mul_assoc at hleq,
  have : (q : ℝ) * (k : ℝ) ≤ (p : ℝ) / 2,
    apply (mul_le_mul_left ppos).1, linarith,
  have hk : k > 0,
    have : p*q > 0, exact mul_pos hp hq,
    by_contradiction hk, push_neg at hk,
    have : N ≤ 0, rw hdvd, exact linarith.mul_nonpos hk this,
    linarith,
  have h₁ : (q : ℝ) ≤ (q : ℝ)*(k : ℝ),
    have hk1 : (k : ℝ) ≥ 1, norm_cast, linarith,
    suffices : (q : ℝ)*1 ≤ (q : ℝ)*(k : ℝ), linarith,
    have hq1 : (q : ℝ) > 0, simp, exact hq,
    exact (mul_le_mul_left hq1).2 hk1,
  have h₂ : (p : ℝ)/2 ≤ (p : ℝ),
    linarith,
  have leq : (q : ℝ) ≤ (p : ℝ), by linarith, simp at leq,
  have neq : q ≠ p, intro hf, rw hf at hleq, rw hf at this, rw hf at h₁, linarith,
  exact (ne.le_iff_lt neq).1 leq
end

lemma descent_wlog {p : ℤ} (hp : prime p) (ho : odd p) (ppos : p > 0) :
(∃ a b : ℤ, int.gcd a b = 1 ∧ p ∣ a^2 + b^2)
→ (∃ m n : ℤ, int.gcd m n = 1 ∧ p ∣ m^2 + n^2 ∧ (m^2 + n^2 : ℝ) ≤ (p^2/2 : ℝ)) :=
begin
  intro h,
  rcases h with ⟨a, b, hab, hdvd⟩,
  rcases qr_thm_alter (abs a) p ppos with ⟨q, r, hqr, hr⟩,
  rcases qr_thm_alter (abs b) p ppos with ⟨q', r', hqr', hr'⟩,
  have hdvd : p ∣ r^2 + r'^2,
    cases hdvd with k hk,
    have : a^2 = (abs a)^2, by norm_num, rw this at hk, clear this,
    have : b^2 = (abs b)^2, by norm_num, rw this at hk, clear this,
    rw [hqr, hqr'] at hk,
    have key : p * (k - (q*p*q + 2*q*r + q'*p*q' + 2*q'*r')) = r^2 + r'^2,
      rw [mul_sub, ←hk], ring,
    rw ←key, exact dvd.intro _ rfl,
  cases em (r = 0 ∨ r' = 0) with hl h0,
  cases hl with h0 h0;
  rw h0 at *; norm_num at *,
  have : p ∣ r' → false,
    intro hpr,
    cases hpr with k hpr,
    rw hpr at *,
    rw ←mul_add at hqr',
    have hn : p ∣ int.gcd a b,
      have := gcd_eq_one_iff_coprime.2 (abs_coprime (gcd_eq_one_iff_coprime.1 hab)),
      rw [hab, ←this],
      apply int.dvd_gcd,
      rw hqr, exact dvd.intro q rfl,
      rw hqr', exact dvd.intro (q' + k) rfl,
    rw hab at hn, cases hn with m hn, rw mul_comm at hn, exfalso, simp at hn,
    rw (int_dvd_one p m hn (by linarith)) at hp, simp at hp, exact hp,
  rw pow_two at hdvd,
  cases prime.div_or_div hp hdvd with hpr hpr;
  exact absurd hpr this,
  have : p ∣ r → false,
    intro hpr,
    cases hpr with k hpr,
    rw hpr at *,
    rw ←mul_add at hqr,
    have hn : p ∣ int.gcd a b,
      have := gcd_eq_one_iff_coprime.2 (abs_coprime (gcd_eq_one_iff_coprime.1 hab)),
      rw [hab, ←this],
      apply int.dvd_gcd,
      rw hqr, exact dvd.intro (q + k) rfl,
      rw hqr', exact dvd.intro q' rfl,
    rw hab at hn, cases hn with m hn, rw mul_comm at hn, exfalso, simp at hn,
    rw (int_dvd_one p m hn (by linarith)) at hp, simp at hp, exact hp,
  rw pow_two at hdvd,
  cases prime.div_or_div hp hdvd with hpr hpr;
  exact absurd hpr this,
  push_neg at h0,
  have gcdpos : ((int.gcd r r') : ℤ) > 0,
    have : int.gcd r r' ≠ 0, by {intro hn, rw int.gcd_eq_zero_iff at hn, exact h0.1 hn.1},
    simp, exact pos_iff_ne_zero.2 this,
  have : ¬(p ∣ ↑(int.gcd r r')),
    intro hn,
    have h₁ : (p : ℝ) ≤ (((int.gcd r r') : ℤ) : ℝ),
      have h₁ : p ≤ ↑(int.gcd r r'),
        apply dvd_leq, linarith, exact gcdpos, exact hn,
      simp, norm_cast, exact h₁,
    have h₂ : (((int.gcd r r') : ℤ) : ℝ) ≤ ((abs r) : ℝ),
      have h₂ : ↑(int.gcd r r') ≤ abs r,
        apply dvd_leq, linarith, exact abs_pos.2 h0.1, exact dvd_abs (int.gcd_dvd_left r r'),
      norm_cast, exact h₂,
    have h₃ : (p / 2 : ℝ) < (p : ℝ), from half_lt_self (show (p : ℝ) > 0, by {simp, exact ppos}),
    linarith,
  cases (int.gcd_dvd_left r r') with n hn,
  cases (int.gcd_dvd_right r r') with m hm,
  have cal : r^2 + r'^2 = (↑(r.gcd r'))^2 * (n^2 + m^2),
    calc r^2 + r'^2 = (↑(r.gcd r') * n)^2 + (↑(r.gcd r') * m)^2 : by rw [←hn, ←hm]
                ... = (↑(r.gcd r'))^2 * (n^2 + m^2)             : by ring,
  rw cal at hdvd,
  cases prime.div_or_div hp hdvd with hpdvd hpdvd,
  rw pow_two at hpdvd, cases prime.div_or_div hp hpdvd with hpdvd hpdvd; exact absurd hpdvd this,
  use m, use n, split,
  have hcoprime : ↑(int.gcd m n) = (1 : ℤ),
    cases (int.gcd_dvd_left m n) with k hk,
    cases (int.gcd_dvd_right m n) with l hl,
    rw hk at hm, rw hl at hn,
    rw ←mul_assoc at hm, rw ←mul_assoc at hn,
    have gcddvd : ↑(r.gcd r') * ↑(m.gcd n) ∣ ↑(r.gcd r'),
      apply int.dvd_gcd, use l, exact hn, use k, exact hm,
    cases gcddvd with k hk, rw mul_assoc at hk, replace hk := eq.trans (mul_one _) hk,
    have h1 := (mul_right_inj' (show ↑(r.gcd r') ≠ (0 : ℤ), by linarith)).1 hk,
    rw mul_comm at h1,
    exact int_dvd_one ↑(m.gcd n) k h1 (coe_zero_le _),
  linarith,
  split, rw add_comm, exact hpdvd,
  have habsm : (↑(abs m) : ℝ) ≤ p/2,
    suffices : (↑(abs m) : ℝ) ≤ (↑(abs r') : ℝ), simp at *, linarith,
    rw [hm, abs_mul], simp,
    have : abs (m : ℝ) > 0,
      have : (m : ℝ) ≠ 0, intro m0, simp at m0, rw m0 at hm, exact h0.2 hm,
      exact abs_pos.2 this,
    rw (le_mul_iff_one_le_left this), simp, linarith,
  have habsn : (↑(abs n) : ℝ) ≤ p/2,
    suffices : (↑(abs n) : ℝ) ≤ (↑(abs r) : ℝ), simp at *, linarith,
    rw [hn, abs_mul], simp,
    have : abs (n : ℝ) > 0,
      have : (n : ℝ) ≠ 0, intro n0, simp at n0, rw n0 at hn, exact h0.1 hn,
      exact abs_pos.2 this,
    rw (le_mul_iff_one_le_left this), simp, linarith,
  simp at habsm, simp at habsn,
  exact simp_cal habsm habsn (show p ≥ 0, by linarith)
end

lemma dvd_imp_leq_nat {a m : ℕ} (h : a ∣ m) (hm : m ≠ 0) : a ≤ m :=
begin
  cases h with k hk,
  rw hk,
  suffices : k ≥ 1, have : a*1 ≤ a*k, from (mul_le_mul_left' this a), linarith,
  by_contradiction, push_neg at h, have : k = 0, by linarith,
  rw this at *, simp at *, exact hm hk
end

lemma prime_divisor_nat {a : ℕ} (ha : a ≥ 2) : ∃ p, (nat.prime p) ∧ p ∣ a :=
begin
  induction a using nat.strong_induction_on with a hi,
  dsimp at hi,
  cases em (nat.prime a) with hpri hpri,
  use a, split, exact hpri, simp,
  unfold nat.prime at hpri, push_neg at hpri,
  cases (hpri ha) with m hm,
  have : m < a,
    have : m ≤ a, from dvd_imp_leq_nat (hm.1) (by linarith),
    exact (ne.le_iff_lt hm.2.2).1 this,
  cases em (m = 0) with h0 h0, rw h0 at *, simp at *, exfalso, apply hm.2, symmetry, exact hm.1,
  have : m ≥ 2,
    rcases hm with ⟨h₀, h₁, h₂⟩,
    by_contradiction hf, push_neg at hf, interval_cases m,
  cases (hi m (by linarith) (by linarith)) with p hpdvd, use p, split, exact hpdvd.1,
  exact dvd_trans hpdvd.2 hm.1,
  apply h0, refl, apply h₁, refl
end

lemma prime_divisor_int {a : ℤ} (ha: a ≥ 2) : ∃ p, (prime p) ∧ p ∣ a ∧ p > 0 :=
begin
  lift a to ℕ using (show a ≥ 0, by linarith), norm_cast at ha,
  rcases (prime_divisor_nat ha) with ⟨p, hp, pdvda⟩,
  use (p : ℤ), norm_cast,
  have ppos : p ≠ 0,
    intro hf, rw hf at hp, norm_num at hp,
  exact ⟨int_prime_eq_nat_prime.mp hp, pdvda, nat.prime.pos hp⟩
end

lemma prime_parity {p : ℕ} (hp : nat.prime p) : p = 2 ∨ odd p :=
begin
  by_cases p2 : p = 2,
  left, exact p2,
  right,
  have podd : ¬even p,
    intro hdvd, replace hdvd : 2 ∣ p, from even_iff_two_dvd.mp hdvd,
    cases (hp.2 2 hdvd) with hf hf,
    linarith, apply p2, rw hf,
  exact nat.odd_iff_not_even.mpr podd
end

lemma exists_prime_divisor
{a : ℕ} (leq : 2 ≤ a) : (∃ n : ℕ, a = 2 ^ n) ∨ ∃ p, nat.prime p ∧ p ∣ a ∧ odd p :=
begin
  induction a using nat.strong_induction_on with a hi, dsimp at hi,
  rcases (prime_divisor_nat leq) with ⟨p, hp, k, hk⟩,
  by_cases k2 : k < 2,
  { by_cases kval : k = 0, rw kval at hk, simp at hk, linarith,
    have knonneg : k > 0, exact pos_iff_ne_zero.mpr kval,replace kval : k = 1, by linarith,
    rw kval at hk, simp at hk, rw hk,
    cases (prime_parity hp) with p2 podd,
    { left, use 1, rw p2, simp},
    { right, use p, exact ⟨hp, by simp, podd⟩} },
  push_neg at k2,
  have ka : k < a,
    have ka : k ≤ a, apply dvd_imp_leq_nat, use p, rw hk, ring, linarith,
    have : k ≠ a,
      intro hf, rw hf at hk,
      replace hf : p = 1,
        suffices : 1*a = p*a, from (mul_left_inj' (by linarith)).mp (eq.symm this),
        simp, exact hk,
      rw hf at hp, norm_num at hp,
    exact (ne.le_iff_lt this).mp ka,
  cases (hi k ka k2) with hn hq,
  cases hn with n hn,
  cases (prime_parity hp) with p2 podd,
  left, use (n + 1), rw [hk, hn, p2], ring_exp,
  right, use p, rw hk, exact ⟨hp, dvd.intro k rfl, podd⟩,
  rcases hq with ⟨q, hq, qdvd, qodd⟩, right, use q,
  rw hk, exact ⟨hq, dvd_mul_of_dvd_right qdvd p, qodd⟩
end

lemma sum_sq_zero {a b : ℤ} (h : a^2 + b^2 = 0) : a = 0 ∧ b = 0 :=
begin
  have hal : a^2 ≥ 0, from pow_two_nonneg a,
  have hbl : b^2 ≥ 0, from pow_two_nonneg b,
  have hau : a^2 ≤ a^2 + b^2, linarith,
  have hbu : b^2 ≤ a^2 + b^2, linarith,
  rw h at hau, rw h at hbu,
  split, suffices : a^2 = 0, exact pow_eq_zero this, interval_cases (a^2),
  suffices : b^2 = 0, exact pow_eq_zero this, interval_cases (b^2),
  all_goals{assumption}
end

lemma sub_descent_step {p : ℕ} (hp : nat.prime p) (ho : odd p) :
(∃ a b : ℤ, ∃ n : ℕ, int.gcd a b = 1 ∧ (p : ℤ) * (2^n) = a^2 + b^2) → (∃ x y : ℤ, ↑p = x^2 + y^2) :=
begin
  rintros ⟨a, b, n, gcdab, hpdvd⟩,
  induction n with n hi generalizing a b,
  simp at hpdvd, exact ⟨a, b, hpdvd⟩,
  rw nat.succ_eq_add_one at hpdvd,
  have key : ∃ a b : ℤ, int.gcd a b = 1 ∧ ↑p*2^n = a^2 + b^2,
    have prime_two : prime (2 : ℤ), apply int_prime_eq_nat_prime.mp, norm_num,
    have two_dvd : 2 ∣ (p : ℤ)*2^(n+1), use (↑p*2^n), ring_exp,
    rcases (sum_of_sq_dvd_sum_of_sq ⟨a, b,
      gcd_eq_one_iff_coprime.mp gcdab, hpdvd⟩ ⟨prime_two, two_dvd⟩ ⟨1, 1, by norm_num⟩)
      with ⟨c, d, gcdcd, h⟩,
    use [c, d], split, exact gcd_eq_one_iff_coprime.mpr gcdcd,
    rw ←h, rw [pow_add, ←mul_assoc], simp,
    rw (int.mul_div_cancel (↑p * 2 ^ n) (show (2 : ℤ) ≠ 0, by linarith)),
  rcases key with ⟨c, d, gcdcd, h⟩, exact hi c d gcdcd h
end

theorem descent_step {p : ℤ} (hp : prime p) (ho : odd p) (ppos : p > 0) :
(∃ a b : ℤ, int.gcd a b = 1 ∧ p ∣ a^2 + b^2) → (∃ x y : ℤ, p = x^2 + y^2) :=
begin
  rintros ⟨a, b, gcdab, hpdvd⟩,
  lift p to ℕ using (show p ≥ 0, by linarith),
  induction p using nat.strong_induction_on with p hi generalizing a b, dsimp at hi,
  have : ∃ a b : ℤ, int.gcd a b = 1 ∧ (p : ℤ) ∣ a^2 + b^2,
    use a, use b, exact ⟨gcdab, hpdvd⟩,
  have hmn := (descent_wlog hp ho ppos this), clear this,
  rcases hmn with ⟨a', b', gcdab', hpdvd', ineq⟩,
  have hab : a'^2 + b'^2 > 0,
    have hab : a'^2 + b'^2 ≥ 0,
      have a_sq' := pow_two_nonneg a', have b_sq' := pow_two_nonneg b', linarith,
    have ab0 : a'^2 + b'^2 ≠ 0,
      intro hf, rw (int.gcd_eq_zero_iff.mpr (sum_sq_zero hf)) at gcdab', linarith,
    exact (ne.symm ab0).le_iff_lt.mp hab,
  obtain ⟨N, hN⟩ := hpdvd',
  have Nnonneg : N ≥ 0,
    by_contradiction hf, push_neg at hf,
    have habf : a'^2 + b'^2 < 0, rw hN, exact linarith.mul_neg hf ppos,
    linarith,
  lift N to ℕ using Nnonneg,
  induction N using nat.strong_induction_on with N hii generalizing a' b', dsimp at hii,
  by_cases Nval : N < 2,
  { replace Nval : N = 0 ∨ N = 1, by omega, cases Nval with Nval Nval;
    rw Nval at hN; simp at hN,
    rcases (sum_sq_zero hN) with ⟨rfl, rfl⟩, simp at gcdab', exfalso, exact gcdab',
    use a', use b', rw hN},
  push_neg at Nval,
  rcases (exists_prime_divisor Nval) with ⟨n, hn⟩ | ⟨q, hq, hqdvd, hqodd⟩,
  replace hp : nat.prime p, from int_prime_eq_nat_prime.mpr hp,
  simp at ho, replace ho : odd p, from nat.odd_iff_not_even.mpr ho,
  apply (sub_descent_step hp ho),
  use [a', b', n], exact ⟨gcdab', by {rw [hN, hn], simp}⟩,
  cases hqdvd with k hk, rw mul_comm at hk,
  have kle : k < N,
    have kleq := dvd_imp_leq_nat ⟨q, hk⟩ (show N ≠ 0, by linarith),
    have kneq : k ≠ N, intro hf, rw hf at hk, have equi : N*1 = N*q, simp, rw ←hk,
      have qvalue := (mul_right_inj' (show N ≠ 0, by linarith)).1 equi,
      rw ←qvalue at hq, norm_num at hq,
    exact (ne.le_iff_lt kneq).mp kleq,
  have key : ∃ (a b : ℤ), is_coprime a b ∧ a^2 + b^2 = ↑p*k,
    have qdvd : ↑q ∣ a'^2 + b'^2,
      use ↑p*k, rw [hN, hk], simp, ring,
    have qpos : (q : ℤ) > 0,
      have q0 : q ≠ 0,
        intro hf, rw hf at hk, simp at hk, rw hk at Nval, linarith,
        norm_cast, exact nat.prime.pos hq,
    have q_sq : ∃ a b : ℤ, (q : ℤ) = a^2 + b^2,
      have qle : q < p,
        have qdvd : (p : ℤ)*q ∣ a'^2 + b'^2,
          use k, rw [hN, hk], norm_cast, ring,
        have Npos : a'^2 + b'^2 > 0, from hab,
        have Nleq : (a'^2 + b'^2 : ℝ) ≤ (p^2/2 : ℝ), from ineq,
        zify, exact (largest_divisor qdvd ppos qpos Npos (by {simp, exact Nleq})),
      have hq' : prime ↑q, from int_prime_eq_nat_prime.mp hq,
      have hqodd' : odd (q : ℤ),
        simp, exact nat.odd_iff_not_even.mp hqodd,
      apply (hi q qle hq' hqodd' qpos a' b'),
      exact gcdab', rw [hN, hk], use ↑p*k, simp, ring,
    have key := sum_of_sq_dvd_sum_of_sq ⟨a', b',
      gcd_eq_one_iff_coprime.mp gcdab', show a'^2 + b'^2 = a'^2 + b'^2, by refl⟩
      ⟨int_prime_eq_nat_prime.mp hq, qdvd⟩ q_sq,
    rw [hN, hk] at key, rcases key with ⟨c, d, gcdcd, eq⟩, use [c, d], split,
    exact gcdcd, rw ←eq,
    simp, rw ←mul_assoc, exact ((p : ℤ) * ↑k).mul_div_cancel (by linarith),
  rcases key with ⟨c, d, gcdcd, cd_sq⟩,
  rw ←gcd_eq_one_iff_coprime at gcdcd,
  have sumineq : (c^2 : ℝ) + ↑d^2 ≤ a'^2 + b'^2,
    norm_cast, rw [cd_sq, hN],
    exact (mul_le_mul_left (ppos)).mpr (by linarith),
  have pos : c^2 + d^2 > 0,
    have nonneg : c^2 + d^2 ≥ 0,
      have := pow_two_nonneg c, have := pow_two_nonneg d, linarith,
    have nonzero : c^2 + d^2 ≠ 0,
      intro hf, rw (int.gcd_eq_zero_iff.mpr (sum_sq_zero hf)) at gcdcd, linarith,
    exact (ne.symm nonzero).le_iff_lt.mp nonneg,
  simp at ineq, exact hii k kle c d gcdcd (by linarith) pos cd_sq
end


import Mathlib.Tactic.Slice

open CategoryTheory

variable (C : Type) [Category C] (X Y Z W U : C)
variable (f₁ f₂ : X ⟶ Y) (g g₁ g₂ : Y ⟶ Z) (h : Z ⟶ W) (l : W ⟶ U)

example (hyp : f₁ ≫ g₁ = f₂ ≫ g₂) : f₁ ≫ g₁ ≫ h ≫ l = (f₂ ≫ g₂) ≫ (h ≫ l) := by
  conv =>
    rhs
    slice 2 3
  show f₁ ≫ g₁ ≫ h ≫ l = f₂ ≫ (g₂ ≫ h) ≫ l
  conv =>
    lhs
    slice 1 2
    rw [hyp]
  show ((f₂ ≫ g₂) ≫ h) ≫ l = f₂ ≫ (g₂ ≫ h) ≫ l
  conv =>
    lhs
    slice 2 3

example (hyp : f₁ ≫ g₁ = f₂ ≫ g₂) : f₁ ≫ g₁ ≫ h ≫ l = (f₂ ≫ g₂) ≫ (h ≫ l) := by
  slice_lhs 1 2 => { rw [hyp] }; slice_rhs 1 2 => skip

example (h₁ : f₁ = f₂) : f₁ ≫ g ≫ h ≫ l = ((f₂ ≫ g) ≫ h) ≫ l := by
  slice_lhs 1 1 => rw [h₁]

example (h₁ : f₁ = f₂) : ((f₂ ≫ g) ≫ h) ≫ l = f₁ ≫ g ≫ h ≫ l := by
  slice_rhs 1 1 => rw [h₁]


import data.set.basic

import topology.basic
import algebra.module.basic
import algebra.module.submodule

import order.complete_lattice

import analysis.normed_space.basic

-- Soient F une partie fermée non vide d'un espace normé E et x ∈ E . Montrer
-- d(x, F ) = 0 ⇐⇒ x ∈ F .

theorem exo {R E: Type*} [normed_field R] [normed_group E] [normed_space R E] :
  forall (F: set E) (x: E), (is_closed F) -> (set.nonempty F) ->
    set.mem x F <-> infi (dist x) = 0
:= sorry


/-
Copyright (c) 2022 Jesse Reimann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jesse Reimann, Kalle Kytölä
-/
import topology.continuous_function.bounded
import topology.sets.compacts

/-!
#  Riesz–Markov–Kakutani representation theorem

This file will prove different versions of the Riesz-Markov-Kakutani representation theorem.
The theorem is first proven for compact spaces, from which the statements about linear functionals
on bounded continuous functions or compactly supported functions on locally compact spaces follow.

To make use of the existing API, the measure is constructed from a content `λ` on the
compact subsets of the space X, rather than the usual construction of open sets in the literature.

## References

* [Walter Rudin, Real and Complex Analysis.][Rud87]

-/

noncomputable theory

open_locale bounded_continuous_function nnreal ennreal
open set function topological_space

variables {X : Type*} [topological_space X]
variables (Λ : (X →ᵇ ℝ≥0) →ₗ[ℝ≥0] ℝ≥0)

/-! ### Construction of the content: -/

/-- Given a positive linear functional Λ on X, for `K ⊆ X` compact define
`λ(K) = inf {Λf | 1≤f on K}`. When X is a compact Hausdorff space, this will be shown to be a
content, and will be shown to agree with the Riesz measure on the compact subsets `K ⊆ X`. -/
def riesz_content_aux : (compacts X) → ℝ≥0 :=
λ K, Inf (Λ '' {f : X →ᵇ ℝ≥0 | ∀ x ∈ K, (1 : ℝ≥0) ≤ f x})

section riesz_monotone

/-- For any compact subset `K ⊆ X`, there exist some bounded continuous nonnegative
functions f on X such that `f ≥ 1` on K. -/
lemma riesz_content_aux_image_nonempty (K : compacts X) :
  (Λ '' {f : X →ᵇ ℝ≥0 | ∀ x ∈ K, (1 : ℝ≥0) ≤ f x}).nonempty :=
begin
  rw nonempty_image_iff,
  use (1 : X →ᵇ ℝ≥0),
  intros x x_in_K,
  simp only [bounded_continuous_function.coe_one, pi.one_apply],
end

/-- Riesz content λ (associated with a positive linear functional Λ) is
monotone: if `K₁ ⊆ K₂` are compact subsets in X, then `λ(K₁) ≤ λ(K₂)`. -/
lemma riesz_content_aux_mono {K₁ K₂ : compacts X} (h : K₁ ≤ K₂) :
  riesz_content_aux Λ K₁ ≤ riesz_content_aux Λ K₂ :=
cInf_le_cInf (order_bot.bdd_below _) (riesz_content_aux_image_nonempty Λ K₂)
  (image_subset Λ (set_of_subset_set_of.mpr (λ f f_hyp x x_in_K₁, f_hyp x (h x_in_K₁))))

end riesz_monotone

section riesz_subadditive

/-- Any bounded continuous nonnegative f such that `f ≥ 1` on K gives an upper bound on the
content of K; namely `λ(K) ≤ Λ f`. -/
lemma riesz_content_aux_le {K : compacts X}
  {f : X →ᵇ ℝ≥0} (h : ∀ x ∈ K, (1 : ℝ≥0) ≤ f x) :
  riesz_content_aux Λ K ≤ Λ f := cInf_le (order_bot.bdd_below _) ⟨f, ⟨h, rfl⟩⟩

/-- The Riesz content can be approximated arbitrarily well by evaluating the positive linear
functional on test functions: for any `ε > 0`, there exists a bounded continuous nonnegative
function f on X such that `f ≥ 1` on K and such that `λ(K) ≤ Λ f < λ(K) + ε`. -/
lemma exists_lt_riesz_content_aux_add_pos (K : compacts X)
  {ε : ℝ≥0} (εpos : 0 < ε) :
  ∃ (f : X →ᵇ ℝ≥0), (∀ x ∈ K, (1 : ℝ≥0) ≤ f x) ∧ Λ f < riesz_content_aux Λ K + ε :=
begin
  --choose a test function `f` s.t. `Λf = α < λ(K) + ε`
  obtain ⟨α, ⟨⟨f, f_hyp⟩, α_hyp⟩⟩ :=
    exists_lt_of_cInf_lt (riesz_content_aux_image_nonempty Λ K)
    (lt_add_of_pos_right (riesz_content_aux Λ K) εpos),
  refine ⟨f, f_hyp.left, _ ⟩,
  rw f_hyp.right,
  exact α_hyp,
end

/-- The Riesz content λ associated to a given positive linear functional Λ is
finitely subadditive: `λ(K₁ ∪ K₂) ≤ λ(K₁) + λ(K₂)` for any compact subsets `K₁, K₂ ⊆ X`. -/
lemma riesz_content_aux_sup_le (K1 K2 : compacts X) :
  riesz_content_aux Λ (K1 ⊔ K2) ≤ riesz_content_aux Λ (K1) + riesz_content_aux Λ (K2) :=
begin
  apply nnreal.le_of_forall_pos_le_add,
  intros ε εpos,
  --get test functions s.t. `λ(Ki) ≤ Λfi ≤ λ(Ki) + ε/2, i=1,2`
  obtain ⟨f1, f_test_function_K1⟩ := exists_lt_riesz_content_aux_add_pos Λ K1
    (half_pos εpos),
  obtain ⟨f2, f_test_function_K2⟩ := exists_lt_riesz_content_aux_add_pos Λ K2
    (half_pos εpos),
  --let `f := f1 + f2` test function for the content of `K`
  have f_test_function_union : (∀ x ∈ (K1 ⊔ K2), (1 : ℝ≥0) ≤ (f1 + f2) x),
  { rintros x (x_in_K1 | x_in_K2),
    { exact le_add_right (f_test_function_K1.left x x_in_K1) },
    { exact le_add_left (f_test_function_K2.left x x_in_K2) }},
  --use that `Λf` is an upper bound for `λ(K1⊔K2)`
  apply (riesz_content_aux_le Λ f_test_function_union).trans (le_of_lt _),
  rw map_add,
  --use that `Λfi` are lower bounds for `λ(Ki) + ε/2`
  apply lt_of_lt_of_le (add_lt_add f_test_function_K1.right f_test_function_K2.right) (le_of_eq _),
  rw [add_assoc, add_comm (ε/2), add_assoc, add_halves ε, add_assoc],
end

end riesz_subadditive


/-
Copyright (c) 2020 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.zmod.basic
import Mathlib.data.equiv.mul_add
import Mathlib.tactic.group
import Mathlib.PostPort

universes u l u_1 u_2 u_3

namespace Mathlib

/-!
# Racks and Quandles

This file defines racks and quandles, algebraic structures for sets
that bijectively act on themselves with a self-distributivity
property.  If `R` is a rack and `act : R → (R ≃ R)` is the self-action,
then the self-distributivity is, equivalently, that
```
act (act x y) = act x * act y * (act x)⁻¹
```
where multiplication is composition in `R ≃ R` as a group.
Quandles are racks such that `act x x = x` for all `x`.

One example of a quandle (not yet in mathlib) is the action of a Lie
algebra on itself, defined by `act x y = Ad (exp x) y`.

Quandles and racks were independently developed by multiple
mathematicians.  David Joyce introduced quandles in his thesis
[Joyce1982] to define an algebraic invariant of knot and link
complements that is analogous to the fundamental group of the
exterior, and he showed that the quandle associated to an oriented
knot is invariant up to orientation-reversed mirror image.  Racks were
used by Fenn and Rourke for framed codimension-2 knots and
links.[FennRourke1992]

The name "rack" came from wordplay by Conway and Wraith for the "wrack
and ruin" of forgetting everything but the conjugation operation for a
group.

## Main definitions

* `shelf` is a type with a self-distributive action
* `rack` is a shelf whose action for each element is invertible
* `quandle` is a rack whose action for an element fixes that element
* `quandle.conj` defines a quandle of a group acting on itself by conjugation.
* `shelf_hom` is homomorphisms of shelves, racks, and quandles.
* `rack.envel_group` gives the universal group the rack maps to as a conjugation quandle.
* `rack.opp` gives the rack with the action replaced by its inverse.

## Main statements
* `rack.envel_group` is left adjoint to `quandle.conj` (`to_envel_group.map`).
  The universality statements are `to_envel_group.univ` and `to_envel_group.univ_uniq`.

## Notation

The following notation is localized in `quandles`:

* `x ◃ y` is `shelf.act x y`
* `x ◃⁻¹ y` is `rack.inv_act x y`
* `S →◃ S'` is `shelf_hom S S'`

Use `open_locale quandles` to use these.

## Todo

* If g is the Lie algebra of a Lie group G, then (x ◃ y) = Ad (exp x) x forms a quandle
* If X is a symmetric space, then each point has a corresponding involution that acts on X, forming a quandle.
* Alexander quandle with `a ◃ b = t * b + (1 - t) * b`, with `a` and `b` elements of a module over Z[t,t⁻¹].
* If G is a group, H a subgroup, and z in H, then there is a quandle `(G/H;z)` defined by
  `yH ◃ xH = yzy⁻¹xH`.  Every homogeneous quandle (i.e., a quandle Q whose automorphism group acts
  transitively on Q as a set) is isomorphic to such a quandle.
  There is a generalization to this arbitrary quandles in [Joyce's paper (Theorem 7.2)][Joyce1982].

## Tags

rack, quandle
-/

/--
A *shelf* is a structure with a self-distributive binary operation.
The binary operation is regarded as a left action of the type on itself.
-/
class shelf (α : Type u)
where
  act : α → α → α
  self_distrib : ∀ {x y z : α}, act x (act y z) = act (act x y) (act x z)

/--
The type of homomorphisms between shelves.
This is also the notion of rack and quandle homomorphisms.
-/
structure shelf_hom (S₁ : Type u_1) (S₂ : Type u_2) [shelf S₁] [shelf S₂]
where
  to_fun : S₁ → S₂
  map_act' : ∀ {x y : S₁}, to_fun (shelf.act x y) = shelf.act (to_fun x) (to_fun y)

/--
A *rack* is an automorphic set (a set with an action on itself by
bijections) that is self-distributive.  It is a shelf such that each
element's action is invertible.

The notations `x ◃ y` and `x ◃⁻¹ y` denote the action and the
inverse action, respectively, and they are right associative.
-/
class rack (α : Type u)
extends shelf α
where
  inv_act : α → α → α
  left_inv : ∀ (x : α), function.left_inverse (inv_act x) (shelf.act x)
  right_inv : ∀ (x : α), function.right_inverse (inv_act x) (shelf.act x)

namespace rack

theorem self_distrib {R : Type u_1} [rack R] {x : R} {y : R} {z : R} : shelf.act x (shelf.act y z) = shelf.act (shelf.act x y) (shelf.act x z) :=
  shelf.self_distrib

/--
A rack acts on itself by equivalences.
-/
def act {R : Type u_1} [rack R] (x : R) : R ≃ R :=
  equiv.mk (shelf.act x) (inv_act x) (left_inv x) (right_inv x)

@[simp] theorem act_apply {R : Type u_1} [rack R] (x : R) (y : R) : coe_fn (act x) y = shelf.act x y :=
  rfl

@[simp] theorem act_symm_apply {R : Type u_1} [rack R] (x : R) (y : R) : coe_fn (equiv.symm (act x)) y = inv_act x y :=
  rfl

@[simp] theorem inv_act_apply {R : Type u_1} [rack R] (x : R) (y : R) : coe_fn (act x⁻¹) y = inv_act x y :=
  rfl

@[simp] theorem inv_act_act_eq {R : Type u_1} [rack R] (x : R) (y : R) : inv_act x (shelf.act x y) = y :=
  left_inv x y

@[simp] theorem act_inv_act_eq {R : Type u_1} [rack R] (x : R) (y : R) : shelf.act x (inv_act x y) = y :=
  right_inv x y

theorem left_cancel {R : Type u_1} [rack R] (x : R) {y : R} {y' : R} : shelf.act x y = shelf.act x y' ↔ y = y' :=
  { mp := equiv.injective (act x), mpr := fun (ᾰ : y = y') => Eq._oldrec (Eq.refl (shelf.act x y)) ᾰ }

theorem left_cancel_inv {R : Type u_1} [rack R] (x : R) {y : R} {y' : R} : inv_act x y = inv_act x y' ↔ y = y' :=
  { mp := equiv.injective (equiv.symm (act x)), mpr := fun (ᾰ : y = y') => Eq._oldrec (Eq.refl (inv_act x y)) ᾰ }

theorem self_distrib_inv {R : Type u_1} [rack R] {x : R} {y : R} {z : R} : inv_act x (inv_act y z) = inv_act (inv_act x y) (inv_act x z) := sorry

/--
The *adjoint action* of a rack on itself is `op'`, and the adjoint
action of `x ◃ y` is the conjugate of the action of `y` by the action
of `x`. It is another way to understand the self-distributivity axiom.

This is used in the natural rack homomorphism `to_conj` from `R` to
`conj (R ≃ R)` defined by `op'`.
-/
theorem ad_conj {R : Type u_1} [rack R] (x : R) (y : R) : act (shelf.act x y) = act x * act y * (act x⁻¹) := sorry

/--
The opposite rack, swapping the roles of `◃` and `◃⁻¹`.
-/
protected instance opposite_rack {R : Type u_1} [rack R] : rack (Rᵒᵖ) :=
  mk (fun (x y : Rᵒᵖ) => opposite.op (shelf.act (opposite.unop x) (opposite.unop y))) sorry sorry

@[simp] theorem op_act_op_eq {R : Type u_1} [rack R] {x : R} {y : R} : shelf.act (opposite.op x) (opposite.op y) = opposite.op (inv_act x y) :=
  rfl

@[simp] theorem op_inv_act_op_eq {R : Type u_1} [rack R] {x : R} {y : R} : inv_act (opposite.op x) (opposite.op y) = opposite.op (shelf.act x y) :=
  rfl

@[simp] theorem self_act_act_eq {R : Type u_1} [rack R] {x : R} {y : R} : shelf.act (shelf.act x x) y = shelf.act x y := sorry

@[simp] theorem self_inv_act_inv_act_eq {R : Type u_1} [rack R] {x : R} {y : R} : inv_act (inv_act x x) y = inv_act x y := sorry

@[simp] theorem self_act_inv_act_eq {R : Type u_1} [rack R] {x : R} {y : R} : inv_act (shelf.act x x) y = inv_act x y := sorry

@[simp] theorem self_inv_act_act_eq {R : Type u_1} [rack R] {x : R} {y : R} : shelf.act (inv_act x x) y = shelf.act x y := sorry

theorem self_act_eq_iff_eq {R : Type u_1} [rack R] {x : R} {y : R} : shelf.act x x = shelf.act y y ↔ x = y := sorry

theorem self_inv_act_eq_iff_eq {R : Type u_1} [rack R] {x : R} {y : R} : inv_act x x = inv_act y y ↔ x = y := sorry

/--
The map `x ↦ x ◃ x` is a bijection.  (This has applications for the
regular isotopy version of the Reidemeister I move for knot diagrams.)
-/
def self_apply_equiv (R : Type u_1) [rack R] : R ≃ R :=
  equiv.mk (fun (x : R) => shelf.act x x) (fun (x : R) => inv_act x x) sorry sorry

/--
An involutory rack is one for which `rack.op R x` is an involution for every x.
-/
def is_involutory (R : Type u_1) [rack R] :=
  ∀ (x : R), function.involutive (shelf.act x)

theorem involutory_inv_act_eq_act {R : Type u_1} [rack R] (h : is_involutory R) (x : R) (y : R) : inv_act x y = shelf.act x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (inv_act x y = shelf.act x y)) (Eq.symm (propext (left_cancel x)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (shelf.act x (inv_act x y) = shelf.act x (shelf.act x y))) (right_inv x y)))
      (Eq.symm (function.involutive.left_inverse (h x) y)))

/--
An abelian rack is one for which the mediality axiom holds.
-/
def is_abelian (R : Type u_1) [rack R] :=
  ∀ (x y z w : R), shelf.act (shelf.act x y) (shelf.act z w) = shelf.act (shelf.act x z) (shelf.act y w)

/--
Associative racks are uninteresting.
-/
theorem assoc_iff_id {R : Type u_1} [rack R] {x : R} {y : R} {z : R} : shelf.act x (shelf.act y z) = shelf.act (shelf.act x y) z ↔ shelf.act x z = z := sorry

end rack

namespace shelf_hom

protected instance has_coe_to_fun {S₁ : Type u_1} {S₂ : Type u_2} [shelf S₁] [shelf S₂] : has_coe_to_fun (shelf_hom S₁ S₂) :=
  has_coe_to_fun.mk (fun (x : shelf_hom S₁ S₂) => S₁ → S₂) to_fun

@[simp] theorem to_fun_eq_coe {S₁ : Type u_1} {S₂ : Type u_2} [shelf S₁] [shelf S₂] (f : shelf_hom S₁ S₂) : to_fun f = ⇑f :=
  rfl

@[simp] theorem map_act {S₁ : Type u_1} {S₂ : Type u_2} [shelf S₁] [shelf S₂] (f : shelf_hom S₁ S₂) {x : S₁} {y : S₁} : coe_fn f (shelf.act x y) = shelf.act (coe_fn f x) (coe_fn f y) :=
  map_act' f

/-- The identity homomorphism -/
def id (S : Type u_1) [shelf S] : shelf_hom S S :=
  mk id sorry

protected instance inhabited (S : Type u_1) [shelf S] : Inhabited (shelf_hom S S) :=
  { default := id S }

/-- The composition of shelf homomorphisms -/
def comp {S₁ : Type u_1} {S₂ : Type u_2} {S₃ : Type u_3} [shelf S₁] [shelf S₂] [shelf S₃] (g : shelf_hom S₂ S₃) (f : shelf_hom S₁ S₂) : shelf_hom S₁ S₃ :=
  mk (to_fun g ∘ to_fun f) sorry

@[simp] theorem comp_apply {S₁ : Type u_1} {S₂ : Type u_2} {S₃ : Type u_3} [shelf S₁] [shelf S₂] [shelf S₃] (g : shelf_hom S₂ S₃) (f : shelf_hom S₁ S₂) (x : S₁) : coe_fn (comp g f) x = coe_fn g (coe_fn f x) :=
  rfl

end shelf_hom

/--
A quandle is a rack such that each automorphism fixes its corresponding element.
-/
class quandle (α : Type u_1)
extends rack α
where
  fix : ∀ {x : α}, shelf.act x x = x

namespace quandle

@[simp] theorem fix_inv {Q : Type u_1} [quandle Q] {x : Q} : rack.inv_act x x = x := sorry

protected instance opposite_quandle {Q : Type u_1} [quandle Q] : quandle (Qᵒᵖ) :=
  mk sorry

/--
The conjugation quandle of a group.  Each element of the group acts by
the corresponding inner automorphism.
-/
def conj (G : Type u_1) :=
  G

protected instance conj.quandle (G : Type u_1) [group G] : quandle (conj G) :=
  mk sorry

@[simp] theorem conj_act_eq_conj {G : Type u_1} [group G] (x : conj G) (y : conj G) : shelf.act x y = x * y * (x⁻¹) :=
  rfl

theorem conj_swap {G : Type u_1} [group G] (x : conj G) (y : conj G) : shelf.act x y = y ↔ shelf.act y x = x := sorry

/--
`conj` is functorial
-/
def conj.map {G : Type u_1} {H : Type u_2} [group G] [group H] (f : G →* H) : shelf_hom (conj G) (conj H) :=
  shelf_hom.mk ⇑f sorry

protected instance shelf_hom.has_lift {G : Type u_1} {H : Type u_2} [group G] [group H] : has_lift (G →* H) (shelf_hom (conj G) (conj H)) :=
  has_lift.mk conj.map

/--
The dihedral quandle. This is the conjugation quandle of the dihedral group restrict to flips.

Used for Fox n-colorings of knots.
-/
def dihedral (n : ℕ) :=
  zmod n

/--
The operation for the dihedral quandle.  It does not need to be an equivalence
because it is an involution (see `dihedral_act.inv`).
-/
def dihedral_act (n : ℕ) (a : zmod n) : zmod n → zmod n :=
  fun (b : zmod n) => bit0 1 * a - b

theorem dihedral_act.inv (n : ℕ) (a : zmod n) : function.involutive (dihedral_act n a) := sorry

protected instance dihedral.quandle (n : ℕ) : quandle (dihedral n) :=
  mk sorry

end quandle

namespace rack

/--
This is the natural rack homomorphism to the conjugation quandle of the group `R ≃ R`
that acts on the rack.
-/
def to_conj (R : Type u_1) [rack R] : shelf_hom R (quandle.conj (R ≃ R)) :=
  shelf_hom.mk act ad_conj

/-!
### Universal enveloping group of a rack

The universal enveloping group `envel_group R` of a rack `R` is the
universal group such that every rack homomorphism `R →◃ conj G` is
induced by a unique group homomorphism `envel_group R →* G`.
For quandles, Joyce called this group `AdConj R`.

The `envel_group` functor is left adjoint to the `conj` forgetful
functor, and the way we construct the enveloping group is via a
technique that should work for left adjoints of forgetful functors in
general.  It involves thinking a little about 2-categories, but the
payoff is that the map `envel_group R →* G` has a nice description.

Let's think of a group as being a one-object category.  The first step
is to define `pre_envel_group`, which gives formal expressions for all
the 1-morphisms and includes the unit element, elements of `R`,
multiplication, and inverses.  To introduce relations, the second step
is to define `pre_envel_group_rel'`, which gives formal expressions
for all 2-morphisms between the 1-morphisms.  The 2-morphisms include
associativity, multiplication by the unit, multiplication by inverses,
compatibility with multiplication and inverses (`congr_mul` and
`congr_inv`), the axioms for an equivalence relation, and,
importantly, the relationship between conjugation and the rack action
(see `rack.ad_conj`).

None of this forms a 2-category yet, for example due to lack of
associativity of `trans`.  The `pre_envel_group_rel` relation is a
`Prop`-valued version of `pre_envel_group_rel'`, and making it
`Prop`-valued essentially introduces enough 3-isomorphisms so that
every pair of compatible 2-morphisms is isomorphic.  Now, while
composition in `pre_envel_group` does not strictly satisfy the category
axioms, `pre_envel_group` and `pre_envel_group_rel'` do form a weak
2-category.

Since we just want a 1-category, the last step is to quotient
`pre_envel_group` by `pre_envel_group_rel'`, and the result is the
group `envel_group`.

For a homomorphism `f : R →◃ conj G`, how does
`envel_group.map f : envel_group R →* G` work?  Let's think of `G` as
being a 2-category with one object, a 1-morphism per element of `G`,
and a single 2-morphism called `eq.refl` for each 1-morphism.  We
define the map using a "higher `quotient.lift`" -- not only do we
evaluate elements of `pre_envel_group` as expressions in `G` (this is
`to_envel_group.map_aux`), but we evaluate elements of
`pre_envel_group'` as expressions of 2-morphisms of `G` (this is
`to_envel_group.map_aux.well_def`).  That is to say,
`to_envel_group.map_aux.well_def` recursively evaluates formal
expressions of 2-morphisms as equality proofs in `G`.  Now that all
morphisms are accounted for, the map descends to a homomorphism
`envel_group R →* G`.

Note: `Type`-valued relations are not common.  The fact it is
`Type`-valued is what makes `to_envel_group.map_aux.well_def` have
well-founded recursion.
-/

/--
Free generators of the enveloping group.
-/
inductive pre_envel_group (R : Type u)
where
| unit : pre_envel_group R
| incl : R → pre_envel_group R
| mul : pre_envel_group R → pre_envel_group R → pre_envel_group R
| inv : pre_envel_group R → pre_envel_group R

protected instance pre_envel_group.inhabited (R : Type u) : Inhabited (pre_envel_group R) :=
  { default := pre_envel_group.unit }

/--
Relations for the enveloping group. This is a type-valued relation because
`to_envel_group.map_aux.well_def` inducts on it to show `to_envel_group.map`
is well-defined.  The relation `pre_envel_group_rel` is the `Prop`-valued version,
which is used to define `envel_group` itself.
-/
inductive pre_envel_group_rel' (R : Type u) [rack R] : pre_envel_group R → pre_envel_group R → Type u
where
| refl : {a : pre_envel_group R} → pre_envel_group_rel' R a a
| symm : {a b : pre_envel_group R} → pre_envel_group_rel' R a b → pre_envel_group_rel' R b a
| trans : {a b c : pre_envel_group R} → pre_envel_group_rel' R a b → pre_envel_group_rel' R b c → pre_envel_group_rel' R a c
| congr_mul : {a b a' b' : pre_envel_group R} →
  pre_envel_group_rel' R a a' →
    pre_envel_group_rel' R b b' → pre_envel_group_rel' R (pre_envel_group.mul a b) (pre_envel_group.mul a' b')
| congr_inv : {a a' : pre_envel_group R} →
  pre_envel_group_rel' R a a' → pre_envel_group_rel' R (pre_envel_group.inv a) (pre_envel_group.inv a')
| assoc : (a b c : pre_envel_group R) →
  pre_envel_group_rel' R (pre_envel_group.mul (pre_envel_group.mul a b) c)
    (pre_envel_group.mul a (pre_envel_group.mul b c))
| one_mul : (a : pre_envel_group R) → pre_envel_group_rel' R (pre_envel_group.mul pre_envel_group.unit a) a
| mul_one : (a : pre_envel_group R) → pre_envel_group_rel' R (pre_envel_group.mul a pre_envel_group.unit) a
| mul_left_inv : (a : pre_envel_group R) → pre_envel_group_rel' R (pre_envel_group.mul (pre_envel_group.inv a) a) pre_envel_group.unit
| act_incl : (x y : R) →
  pre_envel_group_rel' R
    (pre_envel_group.mul (pre_envel_group.mul (pre_envel_group.incl x) (pre_envel_group.incl y))
      (pre_envel_group.inv (pre_envel_group.incl x)))
    (pre_envel_group.incl (shelf.act x y))

protected instance pre_envel_group_rel'.inhabited (R : Type u) [rack R] : Inhabited (pre_envel_group_rel' R pre_envel_group.unit pre_envel_group.unit) :=
  { default := pre_envel_group_rel'.refl }

/--
The `pre_envel_group_rel` relation as a `Prop`.  Used as the relation for `pre_envel_group.setoid`.
-/
inductive pre_envel_group_rel (R : Type u) [rack R] : pre_envel_group R → pre_envel_group R → Prop
where
| rel : ∀ {a b : pre_envel_group R}, pre_envel_group_rel' R a b → pre_envel_group_rel R a b

/--
A quick way to convert a `pre_envel_group_rel'` to a `pre_envel_group_rel`.
-/
theorem pre_envel_group_rel'.rel {R : Type u} [rack R] {a : pre_envel_group R} {b : pre_envel_group R} : pre_envel_group_rel' R a b → pre_envel_group_rel R a b :=
  pre_envel_group_rel.rel

theorem pre_envel_group_rel.refl {R : Type u} [rack R] {a : pre_envel_group R} : pre_envel_group_rel R a a :=
  pre_envel_group_rel.rel pre_envel_group_rel'.refl

theorem pre_envel_group_rel.symm {R : Type u} [rack R] {a : pre_envel_group R} {b : pre_envel_group R} : pre_envel_group_rel R a b → pre_envel_group_rel R b a := sorry

theorem pre_envel_group_rel.trans {R : Type u} [rack R] {a : pre_envel_group R} {b : pre_envel_group R} {c : pre_envel_group R} : pre_envel_group_rel R a b → pre_envel_group_rel R b c → pre_envel_group_rel R a c := sorry

protected instance pre_envel_group.setoid (R : Type u_1) [rack R] : setoid (pre_envel_group R) :=
  setoid.mk (pre_envel_group_rel R) sorry

/--
The universal enveloping group for the rack R.
-/
def envel_group (R : Type u_1) [rack R] :=
  quotient (pre_envel_group.setoid R)

-- Define the `group` instances in two steps so `inv` can be inferred correctly.

-- TODO: is there a non-invasive way of defining the instance directly?

protected instance envel_group.div_inv_monoid (R : Type u_1) [rack R] : div_inv_monoid (envel_group R) :=
  div_inv_monoid.mk
    (fun (a b : envel_group R) =>
      quotient.lift_on₂ a b (fun (a b : pre_envel_group R) => quotient.mk (pre_envel_group.mul a b)) sorry)
    sorry (quotient.mk pre_envel_group.unit) sorry sorry
    (fun (a : envel_group R) =>
      quotient.lift_on a (fun (a : pre_envel_group R) => quotient.mk (pre_envel_group.inv a)) sorry)
    fun (a b : envel_group R) =>
      quotient.lift_on₂ a (quotient.lift_on b (fun (a : pre_envel_group R) => quotient.mk (pre_envel_group.inv a)) sorry)
        (fun (a b : pre_envel_group R) => quotient.mk (pre_envel_group.mul a b)) sorry

protected instance envel_group.group (R : Type u_1) [rack R] : group (envel_group R) :=
  group.mk div_inv_monoid.mul sorry div_inv_monoid.one sorry sorry div_inv_monoid.inv div_inv_monoid.div sorry

protected instance envel_group.inhabited (R : Type u_1) [rack R] : Inhabited (envel_group R) :=
  { default := 1 }

/--
The canonical homomorphism from a rack to its enveloping group.
Satisfies universal properties given by `to_envel_group.map` and `to_envel_group.univ`.
-/
def to_envel_group (R : Type u_1) [rack R] : shelf_hom R (quandle.conj (envel_group R)) :=
  shelf_hom.mk (fun (x : R) => quotient.mk (pre_envel_group.incl x)) sorry

/--
The preliminary definition of the induced map from the enveloping group.
See `to_envel_group.map`.
-/
def to_envel_group.map_aux {R : Type u_1} [rack R] {G : Type u_2} [group G] (f : shelf_hom R (quandle.conj G)) : pre_envel_group R → G :=
  sorry

namespace to_envel_group.map_aux

/--
Show that `to_envel_group.map_aux` sends equivalent expressions to equal terms.
-/
theorem well_def {R : Type u_1} [rack R] {G : Type u_2} [group G] (f : shelf_hom R (quandle.conj G)) {a : pre_envel_group R} {b : pre_envel_group R} : pre_envel_group_rel' R a b → map_aux f a = map_aux f b := sorry

end to_envel_group.map_aux

/--
Given a map from a rack to a group, lift it to being a map from the enveloping group.
More precisely, the `envel_group` functor is left adjoint to `quandle.conj`.
-/
def to_envel_group.map {R : Type u_1} [rack R] {G : Type u_2} [group G] : shelf_hom R (quandle.conj G) ≃ (envel_group R →* G) :=
  equiv.mk
    (fun (f : shelf_hom R (quandle.conj G)) =>
      monoid_hom.mk (fun (x : envel_group R) => quotient.lift_on x (to_envel_group.map_aux f) sorry) sorry sorry)
    (fun (F : envel_group R →* G) => shelf_hom.comp (quandle.conj.map F) (to_envel_group R)) sorry sorry

/--
Given a homomorphism from a rack to a group, it factors through the enveloping group.
-/
theorem to_envel_group.univ (R : Type u_1) [rack R] (G : Type u_2) [group G] (f : shelf_hom R (quandle.conj G)) : shelf_hom.comp (quandle.conj.map (coe_fn to_envel_group.map f)) (to_envel_group R) = f :=
  equiv.symm_apply_apply to_envel_group.map f

/--
The homomorphism `to_envel_group.map f` is the unique map that fits into the commutative
triangle in `to_envel_group.univ`.
-/
theorem to_envel_group.univ_uniq (R : Type u_1) [rack R] (G : Type u_2) [group G] (f : shelf_hom R (quandle.conj G)) (g : envel_group R →* G) (h : f = shelf_hom.comp (quandle.conj.map g) (to_envel_group R)) : g = coe_fn to_envel_group.map f :=
  Eq.symm h ▸ Eq.symm (equiv.apply_symm_apply to_envel_group.map g)

/--
The induced group homomorphism from the enveloping group into bijections of the rack,
using `rack.to_conj`. Satisfies the property `envel_action_prop`.

This gives the rack `R` the structure of an augmented rack over `envel_group R`.
-/
def envel_action {R : Type u_1} [rack R] : envel_group R →* R ≃ R :=
  coe_fn to_envel_group.map (to_conj R)

@[simp] theorem envel_action_prop {R : Type u_1} [rack R] (x : R) (y : R) : coe_fn (coe_fn envel_action (coe_fn (to_envel_group R) x)) y = shelf.act x y :=
  rfl


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

Properties of subsets of topological spaces: compact, clopen, irreducible,
connected, totally disconnected, totally separated.
-/

import topology.basic

open set filter lattice classical
local attribute [instance] prop_decidable

universes u v
variables {α : Type u} {β : Type v} [topological_space α]

/- compact sets -/
section compact

/-- A set `s` is compact if for every filter `f` that contains `s`,
    every set of `f` also meets every neighborhood of some `a ∈ s`. -/
def compact (s : set α) := ∀f, f ≠ ⊥ → f ≤ principal s → ∃a∈s, f ⊓ nhds a ≠ ⊥

lemma compact_inter {s t : set α} (hs : compact s) (ht : is_closed t) : compact (s ∩ t) :=
assume f hnf hstf,
let ⟨a, hsa, (ha : f ⊓ nhds a ≠ ⊥)⟩ := hs f hnf (le_trans hstf (le_principal_iff.2 (inter_subset_left _ _))) in
have ∀a, principal t ⊓ nhds a ≠ ⊥ → a ∈ t,
  by intro a; rw [inf_comm]; rw [is_closed_iff_nhds] at ht; exact ht a,
have a ∈ t,
  from this a $ neq_bot_of_le_neq_bot ha $ inf_le_inf (le_trans hstf (le_principal_iff.2 (inter_subset_right _ _))) (le_refl _),
⟨a, ⟨hsa, this⟩, ha⟩

lemma compact_diff {s t : set α} (hs : compact s) (ht : is_open t) : compact (s \ t) :=
compact_inter hs (is_closed_compl_iff.mpr ht)

lemma compact_of_is_closed_subset {s t : set α}
  (hs : compact s) (ht : is_closed t) (h : t ⊆ s) : compact t :=
by convert ← compact_inter hs ht; exact inter_eq_self_of_subset_right h

lemma compact_adherence_nhdset {s t : set α} {f : filter α}
  (hs : compact s) (hf₂ : f ≤ principal s) (ht₁ : is_open t) (ht₂ : ∀a∈s, nhds a ⊓ f ≠ ⊥ → a ∈ t) :
  t ∈ f :=
classical.by_cases mem_sets_of_neq_bot $
  assume : f ⊓ principal (- t) ≠ ⊥,
  let ⟨a, ha, (hfa : f ⊓ principal (-t) ⊓ nhds a ≠ ⊥)⟩ := hs _ this $ inf_le_left_of_le hf₂ in
  have a ∈ t,
    from ht₂ a ha $ neq_bot_of_le_neq_bot hfa $ le_inf inf_le_right $ inf_le_left_of_le inf_le_left,
  have nhds a ⊓ principal (-t) ≠ ⊥,
    from neq_bot_of_le_neq_bot hfa $ le_inf inf_le_right $ inf_le_left_of_le inf_le_right,
  have ∀s∈(nhds a ⊓ principal (-t)).sets, s ≠ ∅,
    from forall_sets_neq_empty_iff_neq_bot.mpr this,
  have false,
    from this _ ⟨t, mem_nhds_sets ht₁ ‹a ∈ t›, -t, subset.refl _, subset.refl _⟩ (inter_compl_self _),
  by contradiction

lemma compact_iff_ultrafilter_le_nhds {s : set α} :
  compact s ↔ (∀f, is_ultrafilter f → f ≤ principal s → ∃a∈s, f ≤ nhds a) :=
⟨assume hs : compact s, assume f hf hfs,
  let ⟨a, ha, h⟩ := hs _ hf.left hfs in
  ⟨a, ha, le_of_ultrafilter hf h⟩,

  assume hs : (∀f, is_ultrafilter f → f ≤ principal s → ∃a∈s, f ≤ nhds a),
  assume f hf hfs,
  let ⟨a, ha, (h : ultrafilter_of f ≤ nhds a)⟩ :=
    hs (ultrafilter_of f) (ultrafilter_ultrafilter_of hf) (le_trans ultrafilter_of_le hfs) in
  have ultrafilter_of f ⊓ nhds a ≠ ⊥,
    by simp only [inf_of_le_left, h]; exact (ultrafilter_ultrafilter_of hf).left,
  ⟨a, ha, neq_bot_of_le_neq_bot this (inf_le_inf ultrafilter_of_le (le_refl _))⟩⟩

lemma compact_elim_finite_subcover {s : set α} {c : set (set α)}
  (hs : compact s) (hc₁ : ∀t∈c, is_open t) (hc₂ : s ⊆ ⋃₀ c) : ∃c'⊆c, finite c' ∧ s ⊆ ⋃₀ c' :=
classical.by_contradiction $ assume h,
  have h : ∀{c'}, c' ⊆ c → finite c' → ¬ s ⊆ ⋃₀ c',
    from assume c' h₁ h₂ h₃, h ⟨c', h₁, h₂, h₃⟩,
  let
    f : filter α := (⨅c':{c' : set (set α) // c' ⊆ c ∧ finite c'}, principal (s - ⋃₀ c')),
    ⟨a, ha⟩ := @exists_mem_of_ne_empty α s
      (assume h', h (empty_subset _) finite_empty $ h'.symm ▸ empty_subset _)
  in
  have f ≠ ⊥, from infi_neq_bot_of_directed ⟨a⟩
    (assume ⟨c₁, hc₁, hc'₁⟩ ⟨c₂, hc₂, hc'₂⟩, ⟨⟨c₁ ∪ c₂, union_subset hc₁ hc₂, finite_union hc'₁ hc'₂⟩,
      principal_mono.mpr $ diff_subset_diff_right $ sUnion_mono $ subset_union_left _ _,
      principal_mono.mpr $ diff_subset_diff_right $ sUnion_mono $ subset_union_right _ _⟩)
    (assume ⟨c', hc'₁, hc'₂⟩, show principal (s \ _) ≠ ⊥, by simp only [ne.def, principal_eq_bot_iff, diff_eq_empty]; exact h hc'₁ hc'₂),
  have f ≤ principal s, from infi_le_of_le ⟨∅, empty_subset _, finite_empty⟩ $
    show principal (s \ ⋃₀∅) ≤ principal s, from le_principal_iff.2 (diff_subset _ _),
  let
    ⟨a, ha, (h : f ⊓ nhds a ≠ ⊥)⟩ := hs f ‹f ≠ ⊥› this,
    ⟨t, ht₁, (ht₂ : a ∈ t)⟩ := hc₂ ha
  in
  have f ≤ principal (-t),
    from infi_le_of_le ⟨{t}, by rwa singleton_subset_iff, finite_insert _ finite_empty⟩ $
      principal_mono.mpr $
        show s - ⋃₀{t} ⊆ - t, begin rw sUnion_singleton; exact assume x ⟨_, hnt⟩, hnt end,
  have is_closed (- t), from is_open_compl_iff.mp $ by rw lattice.neg_neg; exact hc₁ t ht₁,
  have a ∈ - t, from is_closed_iff_nhds.mp this _ $ neq_bot_of_le_neq_bot h $
    le_inf inf_le_right (inf_le_left_of_le ‹f ≤ principal (- t)›),
  this ‹a ∈ t›

lemma compact_elim_finite_subcover_image {s : set α} {b : set β} {c : β → set α}
  (hs : compact s) (hc₁ : ∀i∈b, is_open (c i)) (hc₂ : s ⊆ ⋃i∈b, c i) :
  ∃b'⊆b, finite b' ∧ s ⊆ ⋃i∈b', c i :=
if h : b = ∅ then ⟨∅, empty_subset _, finite_empty, h ▸ hc₂⟩ else
let ⟨i, hi⟩ := exists_mem_of_ne_empty h in
have hc'₁ : ∀i∈c '' b, is_open i, from assume i ⟨j, hj, h⟩, h ▸ hc₁ _ hj,
have hc'₂ : s ⊆ ⋃₀ (c '' b), by rwa set.sUnion_image,
let ⟨d, hd₁, hd₂, hd₃⟩ := compact_elim_finite_subcover hs hc'₁ hc'₂ in
have ∀x : d, ∃i, i ∈ b ∧ c i = x, from assume ⟨x, hx⟩, hd₁ hx,
let ⟨f', hf⟩ := axiom_of_choice this,
    f := λx:set α, (if h : x ∈ d then f' ⟨x, h⟩ else i : β) in
have ∀(x : α) (i : set α), i ∈ d → x ∈ i → (∃ (i : β), i ∈ f '' d ∧ x ∈ c i),
  from assume x i hid hxi, ⟨f i, mem_image_of_mem f hid,
    by simpa only [f, dif_pos hid, (hf ⟨_, hid⟩).2] using hxi⟩,
⟨f '' d,
  assume i ⟨j, hj, h⟩,
  h ▸ by simpa only [f, dif_pos hj] using (hf ⟨_, hj⟩).1,
  finite_image f hd₂,
  subset.trans hd₃ $ by simpa only [subset_def, mem_sUnion, exists_imp_distrib, mem_Union, exists_prop, and_imp]⟩

lemma compact_of_finite_subcover {s : set α}
  (h : ∀c, (∀t∈c, is_open t) → s ⊆ ⋃₀ c → ∃c'⊆c, finite c' ∧ s ⊆ ⋃₀ c') : compact s :=
assume f hfn hfs, classical.by_contradiction $ assume : ¬ (∃x∈s, f ⊓ nhds x ≠ ⊥),
  have hf : ∀x∈s, nhds x ⊓ f = ⊥,
    by simpa only [not_exists, not_not, inf_comm],
  have ¬ ∃x∈s, ∀t∈f.sets, x ∈ closure t,
    from assume ⟨x, hxs, hx⟩,
    have ∅ ∈ nhds x ⊓ f, by rw [empty_in_sets_eq_bot, hf x hxs],
    let ⟨t₁, ht₁, t₂, ht₂, ht⟩ := by rw [mem_inf_sets] at this; exact this in
    have ∅ ∈ nhds x ⊓ principal t₂,
      from (nhds x ⊓ principal t₂).sets_of_superset (inter_mem_inf_sets ht₁ (subset.refl t₂)) ht,
    have nhds x ⊓ principal t₂ = ⊥,
      by rwa [empty_in_sets_eq_bot] at this,
    by simp only [closure_eq_nhds] at hx; exact hx t₂ ht₂ this,
  have ∀x∈s, ∃t∈f.sets, x ∉ closure t, by simpa only [not_exists, not_forall],
  let c := (λt, - closure t) '' f.sets, ⟨c', hcc', hcf, hsc'⟩ := h c
    (assume t ⟨s, hs, h⟩, h ▸ is_closed_closure) (by simpa only [subset_def, sUnion_image, mem_Union]) in
  let ⟨b, hb⟩ := axiom_of_choice $
    show ∀s:c', ∃t, t ∈ f ∧ - closure t = s,
      from assume ⟨x, hx⟩, hcc' hx in
  have (⋂s∈c', if h : s ∈ c' then b ⟨s, h⟩ else univ) ∈ f,
    from Inter_mem_sets hcf $ assume t ht, by rw [dif_pos ht]; exact (hb ⟨t, ht⟩).left,
  have s ∩ (⋂s∈c', if h : s ∈ c' then b ⟨s, h⟩ else univ) ∈ f,
    from inter_mem_sets (le_principal_iff.1 hfs) this,
  have ∅ ∈ f,
    from mem_sets_of_superset this $ assume x ⟨hxs, hxi⟩,
    let ⟨t, htc', hxt⟩ := (show ∃t ∈ c', x ∈ t, from hsc' hxs) in
    have -closure (b ⟨t, htc'⟩) = t, from (hb _).right,
    have x ∈ - t,
      from this ▸ (calc x ∈ b ⟨t, htc'⟩ : by rw mem_bInter_iff at hxi; have h := hxi t htc'; rwa [dif_pos htc'] at h
        ... ⊆ closure (b ⟨t, htc'⟩) : subset_closure
        ... ⊆ - - closure (b ⟨t, htc'⟩) : by rw lattice.neg_neg; exact subset.refl _),
    show false, from this hxt,
  hfn $ by rwa [empty_in_sets_eq_bot] at this

lemma compact_iff_finite_subcover {s : set α} :
  compact s ↔ (∀c, (∀t∈c, is_open t) → s ⊆ ⋃₀ c → ∃c'⊆c, finite c' ∧ s ⊆ ⋃₀ c') :=
⟨assume hc c, compact_elim_finite_subcover hc, compact_of_finite_subcover⟩

lemma compact_empty : compact (∅ : set α) :=
assume f hnf hsf, not.elim hnf $
empty_in_sets_eq_bot.1 $ le_principal_iff.1 hsf

lemma compact_singleton {a : α} : compact ({a} : set α) :=
compact_of_finite_subcover $ assume c hc₁ hc₂,
  let ⟨i, hic, hai⟩ := (show ∃i ∈ c, a ∈ i, from mem_sUnion.1 $ singleton_subset_iff.1 hc₂) in
  ⟨{i}, singleton_subset_iff.2 hic, finite_singleton _, by rwa [sUnion_singleton, singleton_subset_iff]⟩

lemma compact_bUnion_of_compact {s : set β} {f : β → set α} (hs : finite s) :
  (∀i ∈ s, compact (f i)) → compact (⋃i ∈ s, f i) :=
assume hf, compact_of_finite_subcover $ assume c c_open c_cover,
  have ∀i : subtype s, ∃c' ⊆ c, finite c' ∧ f i ⊆ ⋃₀ c', from
    assume ⟨i, hi⟩, compact_elim_finite_subcover (hf i hi) c_open
      (calc f i ⊆ ⋃i ∈ s, f i : subset_bUnion_of_mem hi
            ... ⊆ ⋃₀ c        : c_cover),
  let ⟨finite_subcovers, h⟩ := axiom_of_choice this in
  let c' := ⋃i, finite_subcovers i in
  have c' ⊆ c, from Union_subset (λi, (h i).fst),
  have finite c', from @finite_Union _ _ hs.fintype _ (λi, (h i).snd.1),
  have (⋃i ∈ s, f i) ⊆ ⋃₀ c', from bUnion_subset $ λi hi, calc
    f i ⊆ ⋃₀ finite_subcovers ⟨i,hi⟩ : (h ⟨i,hi⟩).snd.2
    ... ⊆ ⋃₀ c'                      : sUnion_mono (subset_Union _ _),
  ⟨c', ‹c' ⊆ c›, ‹finite c'›, this⟩

lemma compact_Union_of_compact {f : β → set α} [fintype β]
  (h : ∀i, compact (f i)) : compact (⋃i, f i) :=
by rw ← bUnion_univ; exact compact_bUnion_of_compact finite_univ (λ i _, h i)

lemma compact_of_finite {s : set α} (hs : finite s) : compact s :=
let s' : set α := ⋃i ∈ s, {i} in
have e : s' = s, from ext $ λi, by simp only [mem_bUnion_iff, mem_singleton_iff, exists_eq_right'],
have compact s', from compact_bUnion_of_compact hs (λ_ _, compact_singleton),
e ▸ this

lemma compact_union_of_compact {s t : set α} (hs : compact s) (ht : compact t) : compact (s ∪ t) :=
by rw union_eq_Union; exact compact_Union_of_compact (λ b, by cases b; assumption)

/-- Type class for compact spaces. Separation is sometimes included in the definition, especially
in the French literature, but we do not include it here. -/
class compact_space (α : Type*) [topological_space α] : Prop :=
(compact_univ : compact (univ : set α))

lemma compact_univ [topological_space α] [h : compact_space α] : compact (univ : set α) := h.compact_univ

lemma compact_of_closed [topological_space α] [compact_space α] {s : set α} (h : is_closed s) :
  compact s :=
compact_of_is_closed_subset compact_univ h (subset_univ _)

lemma compact_image [topological_space β] {s : set α} {f : α → β} (hs : compact s) (hf : continuous f) : compact (f '' s) :=
compact_of_finite_subcover $ assume c hco hcs,
  have hdo : ∀t∈c, is_open (f ⁻¹' t), from assume t' ht, hf _ $ hco _ ht,
  have hds : s ⊆ ⋃i∈c, f ⁻¹' i,
    by simpa [subset_def, -mem_image] using hcs,
  let ⟨d', hcd', hfd', hd'⟩ := compact_elim_finite_subcover_image hs hdo hds in
  ⟨d', hcd', hfd', by simpa [subset_def, -mem_image, image_subset_iff] using hd'⟩

lemma compact_range [compact_space α] [topological_space β] {f : α → β} (hf : continuous f) : compact (range f) :=
by rw ← image_univ; exact compact_image compact_univ hf

/-- There are various definitions of "locally compact space" in the literature, which agree for
Hausdorff spaces but not in general. This one is the precise condition on X needed for the
evaluation `map C(X, Y) × X → Y` to be continuous for all `Y` when `C(X, Y)` is given the
compact-open topology. -/
class locally_compact_space (α : Type*) [topological_space α] : Prop :=
(local_compact_nhds : ∀ (x : α) (n ∈ nhds x), ∃ s ∈ nhds x, s ⊆ n ∧ compact s)

end compact

section clopen

def is_clopen (s : set α) : Prop :=
is_open s ∧ is_closed s

theorem is_clopen_union {s t : set α} (hs : is_clopen s) (ht : is_clopen t) : is_clopen (s ∪ t) :=
⟨is_open_union hs.1 ht.1, is_closed_union hs.2 ht.2⟩

theorem is_clopen_inter {s t : set α} (hs : is_clopen s) (ht : is_clopen t) : is_clopen (s ∩ t) :=
⟨is_open_inter hs.1 ht.1, is_closed_inter hs.2 ht.2⟩

@[simp] theorem is_clopen_empty : is_clopen (∅ : set α) :=
⟨is_open_empty, is_closed_empty⟩

@[simp] theorem is_clopen_univ : is_clopen (univ : set α) :=
⟨is_open_univ, is_closed_univ⟩

theorem is_clopen_compl {s : set α} (hs : is_clopen s) : is_clopen (-s) :=
⟨hs.2, is_closed_compl_iff.2 hs.1⟩

@[simp] theorem is_clopen_compl_iff {s : set α} : is_clopen (-s) ↔ is_clopen s :=
⟨λ h, compl_compl s ▸ is_clopen_compl h, is_clopen_compl⟩

theorem is_clopen_diff {s t : set α} (hs : is_clopen s) (ht : is_clopen t) : is_clopen (s-t) :=
is_clopen_inter hs (is_clopen_compl ht)

end clopen

section irreducible

/-- A irreducible set is one where there is no non-trivial pair of disjoint opens. -/
def is_irreducible (s : set α) : Prop :=
∀ (u v : set α), is_open u → is_open v →
  (∃ x, x ∈ s ∩ u) → (∃ x, x ∈ s ∩ v) → ∃ x, x ∈ s ∩ (u ∩ v)

theorem is_irreducible_empty : is_irreducible (∅ : set α) :=
λ _ _ _ _ _ ⟨x, h1, h2⟩, h1.elim

theorem is_irreducible_singleton {x} : is_irreducible ({x} : set α) :=
λ u v _ _ ⟨y, h1, h2⟩ ⟨z, h3, h4⟩, by rw mem_singleton_iff at h1 h3;
substs y z; exact ⟨x, or.inl rfl, h2, h4⟩

theorem is_irreducible_closure {s : set α} (H : is_irreducible s) :
  is_irreducible (closure s) :=
λ u v hu hv ⟨y, hycs, hyu⟩ ⟨z, hzcs, hzv⟩,
let ⟨p, hpu, hps⟩ := exists_mem_of_ne_empty (mem_closure_iff.1 hycs u hu hyu) in
let ⟨q, hqv, hqs⟩ := exists_mem_of_ne_empty (mem_closure_iff.1 hzcs v hv hzv) in
let ⟨r, hrs, hruv⟩ := H u v hu hv ⟨p, hps, hpu⟩ ⟨q, hqs, hqv⟩ in
⟨r, subset_closure hrs, hruv⟩

theorem exists_irreducible (s : set α) (H : is_irreducible s) :
  ∃ t : set α, is_irreducible t ∧ s ⊆ t ∧ ∀ u, is_irreducible u → t ⊆ u → u = t :=
let ⟨m, hm, hsm, hmm⟩ := zorn.zorn_subset₀ { t : set α | is_irreducible t }
  (λ c hc hcc hcn, let ⟨t, htc⟩ := exists_mem_of_ne_empty hcn in
    ⟨⋃₀ c, λ u v hu hv ⟨y, hy, hyu⟩ ⟨z, hz, hzv⟩,
      let ⟨p, hpc, hyp⟩ := mem_sUnion.1 hy,
          ⟨q, hqc, hzq⟩ := mem_sUnion.1 hz in
      or.cases_on (zorn.chain.total hcc hpc hqc)
        (assume hpq : p ⊆ q, let ⟨x, hxp, hxuv⟩ := hc hqc u v hu hv
            ⟨y, hpq hyp, hyu⟩ ⟨z, hzq, hzv⟩ in
          ⟨x, mem_sUnion_of_mem hxp hqc, hxuv⟩)
        (assume hqp : q ⊆ p, let ⟨x, hxp, hxuv⟩ := hc hpc u v hu hv
            ⟨y, hyp, hyu⟩ ⟨z, hqp hzq, hzv⟩ in
          ⟨x, mem_sUnion_of_mem hxp hpc, hxuv⟩),
    λ x hxc, set.subset_sUnion_of_mem hxc⟩) s H in
⟨m, hm, hsm, λ u hu hmu, hmm _ hu hmu⟩

def irreducible_component (x : α) : set α :=
classical.some (exists_irreducible {x} is_irreducible_singleton)

theorem is_irreducible_irreducible_component {x : α} : is_irreducible (irreducible_component x) :=
(classical.some_spec (exists_irreducible {x} is_irreducible_singleton)).1

theorem mem_irreducible_component {x : α} : x ∈ irreducible_component x :=
singleton_subset_iff.1
  (classical.some_spec (exists_irreducible {x} is_irreducible_singleton)).2.1

theorem eq_irreducible_component {x : α} :
  ∀ {s : set α}, is_irreducible s → irreducible_component x ⊆ s → s = irreducible_component x :=
(classical.some_spec (exists_irreducible {x} is_irreducible_singleton)).2.2

theorem is_closed_irreducible_component {x : α} :
  is_closed (irreducible_component x) :=
closure_eq_iff_is_closed.1 $ eq_irreducible_component
  (is_irreducible_closure is_irreducible_irreducible_component)
  subset_closure

/-- A irreducible space is one where there is no non-trivial pair of disjoint opens. -/
class irreducible_space (α : Type u) [topological_space α] : Prop :=
(is_irreducible_univ : is_irreducible (univ : set α))

theorem irreducible_exists_mem_inter [irreducible_space α] {s t : set α} :
  is_open s → is_open t → (∃ x, x ∈ s) → (∃ x, x ∈ t) → ∃ x, x ∈ s ∩ t :=
by simpa only [univ_inter, univ_subset_iff] using
  @irreducible_space.is_irreducible_univ α _ _ s t

end irreducible

section connected

/-- A connected set is one where there is no non-trivial open partition. -/
def is_connected (s : set α) : Prop :=
∀ (u v : set α), is_open u → is_open v → s ⊆ u ∪ v →
  (∃ x, x ∈ s ∩ u) → (∃ x, x ∈ s ∩ v) → ∃ x, x ∈ s ∩ (u ∩ v)

theorem is_connected_of_is_irreducible {s : set α} (H : is_irreducible s) : is_connected s :=
λ _ _ hu hv _, H _ _ hu hv

theorem is_connected_empty : is_connected (∅ : set α) :=
is_connected_of_is_irreducible is_irreducible_empty

theorem is_connected_singleton {x} : is_connected ({x} : set α) :=
is_connected_of_is_irreducible is_irreducible_singleton

theorem is_connected_sUnion (x : α) (c : set (set α)) (H1 : ∀ s ∈ c, x ∈ s)
  (H2 : ∀ s ∈ c, is_connected s) : is_connected (⋃₀ c) :=
begin
  rintro u v hu hv hUcuv ⟨y, hyUc, hyu⟩ ⟨z, hzUc, hzv⟩,
  cases classical.em (c = ∅) with hc hc,
  { rw [hc, sUnion_empty] at hyUc, exact hyUc.elim },
  cases ne_empty_iff_exists_mem.1 hc with s hs,
  cases hUcuv (mem_sUnion_of_mem (H1 s hs) hs) with hxu hxv,
  { rcases hzUc with ⟨t, htc, hzt⟩,
    specialize H2 t htc u v hu hv (subset.trans (subset_sUnion_of_mem htc) hUcuv),
    cases H2 ⟨x, H1 t htc, hxu⟩ ⟨z, hzt, hzv⟩ with r hr,
    exact ⟨r, mem_sUnion_of_mem hr.1 htc, hr.2⟩ },
  { rcases hyUc with ⟨t, htc, hyt⟩,
    specialize H2 t htc u v hu hv (subset.trans (subset_sUnion_of_mem htc) hUcuv),
    cases H2 ⟨y, hyt, hyu⟩ ⟨x, H1 t htc, hxv⟩ with r hr,
    exact ⟨r, mem_sUnion_of_mem hr.1 htc, hr.2⟩ }
end

theorem is_connected_union (x : α) {s t : set α} (H1 : x ∈ s) (H2 : x ∈ t)
  (H3 : is_connected s) (H4 : is_connected t) : is_connected (s ∪ t) :=
have _ := is_connected_sUnion x {t,s}
  (by rintro r (rfl | rfl | h); [exact H1, exact H2, exact h.elim])
  (by rintro r (rfl | rfl | h); [exact H3, exact H4, exact h.elim]),
have h2 : ⋃₀ {t, s} = s ∪ t, from (sUnion_insert _ _).trans (by rw sUnion_singleton),
by rwa h2 at this

theorem is_connected_closure {s : set α} (H : is_connected s) :
  is_connected (closure s) :=
λ u v hu hv hcsuv ⟨y, hycs, hyu⟩ ⟨z, hzcs, hzv⟩,
let ⟨p, hpu, hps⟩ := exists_mem_of_ne_empty (mem_closure_iff.1 hycs u hu hyu) in
let ⟨q, hqv, hqs⟩ := exists_mem_of_ne_empty (mem_closure_iff.1 hzcs v hv hzv) in
let ⟨r, hrs, hruv⟩ := H u v hu hv (subset.trans subset_closure hcsuv) ⟨p, hps, hpu⟩ ⟨q, hqs, hqv⟩ in
⟨r, subset_closure hrs, hruv⟩

def connected_component (x : α) : set α :=
⋃₀ { s : set α | is_connected s ∧ x ∈ s }

theorem is_connected_connected_component {x : α} : is_connected (connected_component x) :=
is_connected_sUnion x _ (λ _, and.right) (λ _, and.left)

theorem mem_connected_component {x : α} : x ∈ connected_component x :=
mem_sUnion_of_mem (mem_singleton x) ⟨is_connected_singleton, mem_singleton x⟩

theorem subset_connected_component {x : α} {s : set α} (H1 : is_connected s) (H2 : x ∈ s) :
  s ⊆ connected_component x :=
λ z hz, mem_sUnion_of_mem hz ⟨H1, H2⟩

theorem is_closed_connected_component {x : α} :
  is_closed (connected_component x) :=
closure_eq_iff_is_closed.1 $ subset.antisymm
  (subset_connected_component
    (is_connected_closure is_connected_connected_component)
    (subset_closure mem_connected_component))
  subset_closure

theorem irreducible_component_subset_connected_component {x : α} :
  irreducible_component x ⊆ connected_component x :=
subset_connected_component
  (is_connected_of_is_irreducible is_irreducible_irreducible_component)
  mem_irreducible_component

/-- A connected space is one where there is no non-trivial open partition. -/
class connected_space (α : Type u) [topological_space α] : Prop :=
(is_connected_univ : is_connected (univ : set α))

instance irreducible_space.connected_space (α : Type u) [topological_space α]
  [irreducible_space α] : connected_space α :=
⟨is_connected_of_is_irreducible $ irreducible_space.is_irreducible_univ α⟩

theorem exists_mem_inter [connected_space α] {s t : set α} :
  is_open s → is_open t → s ∪ t = univ →
    (∃ x, x ∈ s) → (∃ x, x ∈ t) → ∃ x, x ∈ s ∩ t :=
by simpa only [univ_inter, univ_subset_iff] using
  @connected_space.is_connected_univ α _ _ s t

theorem is_clopen_iff [connected_space α] {s : set α} : is_clopen s ↔ s = ∅ ∨ s = univ :=
⟨λ hs, classical.by_contradiction $ λ h,
  have h1 : s ≠ ∅ ∧ -s ≠ ∅, from ⟨mt or.inl h,
    mt (λ h2, or.inr $ (by rw [← compl_compl s, h2, compl_empty] : s = univ)) h⟩,
  let ⟨_, h2, h3⟩ := exists_mem_inter hs.1 hs.2 (union_compl_self s)
    (ne_empty_iff_exists_mem.1 h1.1) (ne_empty_iff_exists_mem.1 h1.2) in
  h3 h2,
by rintro (rfl | rfl); [exact is_clopen_empty, exact is_clopen_univ]⟩

end connected

section totally_disconnected

def is_totally_disconnected (s : set α) : Prop :=
∀ t, t ⊆ s → is_connected t → subsingleton t

theorem is_totally_disconnected_empty : is_totally_disconnected (∅ : set α) :=
λ t ht _, ⟨λ ⟨_, h⟩, (ht h).elim⟩

theorem is_totally_disconnected_singleton {x} : is_totally_disconnected ({x} : set α) :=
λ t ht _, ⟨λ ⟨p, hp⟩ ⟨q, hq⟩, subtype.eq $ show p = q,
from (eq_of_mem_singleton (ht hp)).symm ▸ (eq_of_mem_singleton (ht hq)).symm⟩

class totally_disconnected_space (α : Type u) [topological_space α] : Prop :=
(is_totally_disconnected_univ : is_totally_disconnected (univ : set α))

end totally_disconnected

section totally_separated

def is_totally_separated (s : set α) : Prop :=
∀ x ∈ s, ∀ y ∈ s, x ≠ y → ∃ u v : set α, is_open u ∧ is_open v ∧
  x ∈ u ∧ y ∈ v ∧ s ⊆ u ∪ v ∧ u ∩ v = ∅

theorem is_totally_separated_empty : is_totally_separated (∅ : set α) :=
λ x, false.elim

theorem is_totally_separated_singleton {x} : is_totally_separated ({x} : set α) :=
λ p hp q hq hpq, (hpq $ (eq_of_mem_singleton hp).symm ▸ (eq_of_mem_singleton hq).symm).elim

theorem is_totally_disconnected_of_is_totally_separated {s : set α}
  (H : is_totally_separated s) : is_totally_disconnected s :=
λ t hts ht, ⟨λ ⟨x, hxt⟩ ⟨y, hyt⟩, subtype.eq $ classical.by_contradiction $
assume hxy : x ≠ y, let ⟨u, v, hu, hv, hxu, hyv, hsuv, huv⟩ := H x (hts hxt) y (hts hyt) hxy in
let ⟨r, hrt, hruv⟩ := ht u v hu hv (subset.trans hts hsuv) ⟨x, hxt, hxu⟩ ⟨y, hyt, hyv⟩ in
((ext_iff _ _).1 huv r).1 hruv⟩

class totally_separated_space (α : Type u) [topological_space α] : Prop :=
(is_totally_separated_univ : is_totally_separated (univ : set α))

instance totally_separated_space.totally_disconnected_space (α : Type u) [topological_space α]
  [totally_separated_space α] : totally_disconnected_space α :=
⟨is_totally_disconnected_of_is_totally_separated $ totally_separated_space.is_totally_separated_univ α⟩

end totally_separated


theorem forall_to_exists (p : Store → Heap → Heap → Prop) (f : ¬ ∀ s h h', ¬ (p s h h') ) : ∃ s h h', (p s h h') :=
  Classical.byContradiction
    (fun hyp1 : ¬ ∃ s h h', p s h h' =>
      have hyp2 : ∀ s h h', ¬ p s h h' :=
        fun s h h' =>
        fun hyp3 : p s h h' =>
        have hyp4 : ∃ s h h', p s h h' := ⟨ s , ⟨ h , ⟨h', hyp3⟩ ⟩ ⟩
        show False from hyp1 hyp4
      show False from f hyp2)

def dne {p} (hyp : ¬¬p) : p :=
  Classical.byContradiction
    (fun hyp1 : ¬p =>
     show False from hyp hyp1)

def dni {P : Prop} : P → ¬¬P := by {
  intros p np;
  exact np p;
}

theorem dne_equivalence {p}: ¬¬p ↔ p := by
  apply Iff.intro
  case mp =>  intro nnp; exact (dne nnp)
  case mpr => intro p; exact (dni p)

theorem dna_equivalence {p}: p ↔ ¬¬p:= by
  apply Iff.intro
  case mp => intro p; exact (dni p)
  case mpr =>  intro nnp; exact (dne nnp)

theorem exists_n_implies_n_forall {p : α → Prop} : (∃ x , ¬ p x) → (¬ ∀ x , p x) := by
  intro ⟨ x, not_p_x ⟩
  intro for_all
  have p_x := for_all x
  exact not_p_x p_x

theorem exists_implies_n_forall_n {p : α → Prop} : (∃ x , p x) → (¬ ∀ x , ¬ p x) := by
  intro ⟨ x, p_x ⟩
  intro for_all
  have not_p_x := for_all x
  exact not_p_x p_x

theorem forall_implies_n_exists_n {p : α → Prop} : (∀ x , p x) → ¬(∃ x , ¬ p x) := by
  intro for_all
  intro ⟨ x, not_p_x ⟩
  have p_x := for_all x
  exact not_p_x p_x

theorem forall_n_implies_n_exists {p : α → Prop} : (∀ x , ¬ p x) → ¬(∃ x , p x) := by
  intro for_all
  intro ⟨ x, p_x ⟩
  have not_p_x := for_all x
  exact not_p_x p_x

theorem contrapos {A B : Prop} : (A → B) → ((¬B) → (¬A)) := by {
  intro a_to_b not_b a;
  exact not_b (a_to_b a);
}

theorem inverse {A B : Prop} : ((¬B) → (¬A)) → (A → B) := by {
  intro nb_to_na;
  intro a;
  apply Classical.byContradiction;
  apply @contrapos (¬B) (¬A) nb_to_na;
  apply dni;
  exact a;
}

theorem pp_imp_nn {A B : Prop} : (A → B) ↔ ((¬B) → (¬A)) := by
  apply Iff.intro
  case mp  => apply contrapos
  case mpr => apply inverse

theorem np_imp_pn {A B : Prop} : ((¬A) → B) ↔ ((¬B) → A) := by
  apply Iff.intro
  case mp  =>
    conv =>
      lhs
      rw [pp_imp_nn]
    intro nb_to_nna
    intro not_b
    have nna := nb_to_nna not_b
    exact (dne nna)
  case mpr =>
    intro nb_to_a
    intro not_a
    apply Classical.byContradiction (
      λ not_b => by
      have a := nb_to_a not_b
      exact not_a a
    )

theorem pn_imp_np {A B : Prop} : (A → (¬B)) ↔ (B → (¬A)) := by
  apply Iff.intro
  case mp  =>
    conv =>
      lhs
      rw [pp_imp_nn]
    intro nnb_to_na
    intro b
    have nnb := (dni b)
    exact nnb_to_na nnb
  case mpr =>
    intro b_to_na
    intro a
    apply Classical.byContradiction (
      λ nnb => by
      have not_a := b_to_na (dne nnb)
      exact not_a a
    )

theorem n_imp {P Q : Prop} : ((¬ P) → Q) ↔ (P ∨ Q) := by
  apply Iff.intro
  case mp  =>
    intro not_p_imp_q
    have p_or_not_p := Classical.em P
    apply Or.elim p_or_not_p
      (
        λ p => Or.inl p
      )
      (
        λ np => Or.inr (not_p_imp_q np)
      )
  case mpr =>
    intro p_or_q
    cases p_or_q with
    | inl p =>
      intro np
      apply absurd p np
    | inr q => intro; exact q

theorem n_forall_implies_exists_n {p : α → Prop} : ¬(∀ x , p x) → (∃ x , ¬ p x) := by {
  rw [np_imp_pn];
  intro not_exists x;
  cases Classical.em (p x) with
  | inl p_x => exact p_x;
  | inr np_x => {
    apply False.elim;
    apply not_exists;
    apply Exists.intro x;
    exact np_x
  }
}

theorem exists_same_as_forall {p : α → Prop} : (∃ x , ¬ p x) ↔ (¬ ∀ x , p x) := by
  apply Iff.intro
  case mp  => apply exists_n_implies_n_forall
  case mpr => apply n_forall_implies_exists_n

theorem not_imp {A B : Prop} : ¬ (A → B) ↔ A ∧ ¬ B := by
  apply Iff.intro
  case mp  => {
    rw [np_imp_pn];
    rw [n_imp];
    cases Classical.em A with
    | inl a => {
      cases Classical.em B with
      | inl b => apply (Or.intro_right (A ∧ ¬B) (λ _ => b));
      | inr nb => apply (Or.intro_left (A → B) (And.intro a nb));
    }
    | inr na => {
      cases Classical.em B with
      | inl b => apply (Or.intro_right (A ∧ ¬B) (λ _ => b));
      | inr nb => apply (Or.intro_right (A ∧ ¬B) (λ a => absurd a na));
    }
  }
  case mpr => {
    rw [pn_imp_np];
    intro a_imp_b;
    intro a_and_nb;
    have a := a_and_nb.left;
    have nb := a_and_nb.right;
    exact (nb (a_imp_b a));
  }

variable
  {α β γ: Type}
  (x : α)
  (y : β)
  (z : γ)
  (p : α → β → γ → Prop)
  (t : α × β × γ)

def p3 : α × β × γ :=
  (x, y, z)

def p3_app : Prop := p (t.fst) (t.snd.fst) (t.snd.snd)

theorem p3_app_id : p3_app p (p3 x y z) ↔ p x y z := Iff.intro id id

theorem fa3 : (∀ x y z , p x y z) ↔ (∀ t , (p3_app p) t) := by {
  apply Iff.intro;
  case mp  => {
    intro sep;
    intro t;
    have x := t.fst;
    have y := t.snd.fst;
    have z := t.snd.snd;
    simp [p3_app]
    apply sep;
  }
  case mpr => {
    intro comb;
    intro x y z;
    rw [← (p3_app_id x y z p)];
    exact comb (p3 x y z);
  }
}

theorem e3 : (∃ x y z , ¬ p x y z) ↔ (∃ t , ¬ (p3_app p) t) := by {
  apply Iff.intro;
  case mp  => {
    intro ⟨ x , ⟨ y , ⟨ z , not_p ⟩⟩⟩;
    have t := p3 x y z;
    apply Exists.intro (p3 x y z);
    apply not_p;
  }
  case mpr => {
    intro ⟨ t, not_t ⟩;
    apply Exists.intro t.fst;
    apply Exists.intro t.snd.fst;
    apply Exists.intro t.snd.snd;
    apply not_t;
  }
}

theorem exists_same_as_forall_3 : ¬(∀ x y z , p x y z) ↔ (∃ x y z , ¬ p x y z) := by {
  rw [(fa3 p)];
  rw [(e3 p)];
  apply (Iff.symm exists_same_as_forall);
}


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.complex.module
import linear_algebra.determinant

/-!
# Determinants of maps in the complex numbers as a vector space over `ℝ`

This file provides results about the determinants of maps in the complex numbers as a vector
space over `ℝ`.

-/

namespace complex

/-- The determinant of `conj_ae`, as a linear map. -/
@[simp] lemma det_conj_ae : conj_ae.to_linear_map.det = -1 :=
begin
  rw [←linear_map.det_to_matrix basis_one_I, to_matrix_conj_ae, matrix.det_fin_two],
  simp
end

/-- The determinant of `conj_ae`, as a linear equiv. -/
@[simp] lemma linear_equiv_det_conj_ae : conj_ae.to_linear_equiv.det = -1 :=
by rw [←units.eq_iff, linear_equiv.coe_det, ←linear_equiv.to_linear_map_eq_coe,
       alg_equiv.to_linear_equiv_to_linear_map, det_conj_ae, units.coe_neg_one]

end complex