/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.big_operators.basic
import data.nat.prime
import data.zmod.basic
import ring_theory.multiplicity
import data.nat.periodic
import algebra.char_p.two
import number_theory.divisors

/-!
# Euler's totient function

This file defines [Euler's totient function](https://en.wikipedia.org/wiki/Euler's_totient_function)
`nat.totient n` which counts the number of naturals less than `n` that are coprime with `n`.
We prove the divisor sum formula, namely that `n` equals `φ` summed over the divisors of `n`. See
`sum_totient`. We also prove two lemmas to help compute totients, namely `totient_mul` and
`totient_prime_pow`.
-/

open finset
open_locale big_operators

namespace nat

/-- Euler's totient function. This counts the number of naturals strictly less than `n` which are
coprime with `n`. -/
def totient (n : ℕ) : ℕ := ((range n).filter n.coprime).card

localized "notation `φ` := nat.totient" in nat

@[simp] theorem totient_zero : φ 0 = 0 := rfl

@[simp] theorem totient_one : φ 1 = 1 :=
by simp [totient]

lemma totient_eq_card_coprime (n : ℕ) : φ n = ((range n).filter n.coprime).card := rfl

lemma totient_le (n : ℕ) : φ n ≤ n :=
((range n).card_filter_le _).trans_eq (card_range n)

lemma totient_lt (n : ℕ) (hn : 1 < n) : φ n < n :=
(card_lt_card (filter_ssubset.2 ⟨0, by simp [hn.ne', pos_of_gt hn]⟩)).trans_eq (card_range n)

lemma totient_pos : ∀ {n : ℕ}, 0 < n → 0 < φ n
| 0 := dec_trivial
| 1 := by simp [totient]
| (n+2) := λ h, card_pos.2 ⟨1, mem_filter.2 ⟨mem_range.2 dec_trivial, coprime_one_right _⟩⟩

lemma filter_coprime_Ico_eq_totient (a n : ℕ) :
  ((Ico n (n+a)).filter (coprime a)).card = totient a :=
begin
  rw [totient, filter_Ico_card_eq_of_periodic, count_eq_card_filter_range],
  exact periodic_coprime a,
end

lemma Ico_filter_coprime_le {a : ℕ} (k n : ℕ) (a_pos : 0 < a) :
  ((Ico k (k + n)).filter (coprime a)).card ≤ totient a * (n / a + 1) :=
begin
  conv_lhs { rw ←nat.mod_add_div n a },
  induction n / a with i ih,
  { rw ←filter_coprime_Ico_eq_totient a k,
    simp only [add_zero, mul_one, mul_zero, le_of_lt (mod_lt n a_pos)],
    mono,
    refine monotone_filter_left a.coprime _,
    simp only [finset.le_eq_subset],
    exact Ico_subset_Ico rfl.le (add_le_add_left (le_of_lt (mod_lt n a_pos)) k), },
  simp only [mul_succ],
  simp_rw ←add_assoc at ih ⊢,
  calc (filter a.coprime (Ico k (k + n % a + a * i + a))).card
      = (filter a.coprime (Ico k (k + n % a + a * i)
                            ∪ Ico (k + n % a + a * i) (k + n % a + a * i + a))).card :
        begin
          congr,
          rw Ico_union_Ico_eq_Ico,
          rw add_assoc,
          exact le_self_add,
          exact le_self_add,
        end
  ... ≤ (filter a.coprime (Ico k (k + n % a + a * i))).card + a.totient :
        begin
          rw [filter_union, ←filter_coprime_Ico_eq_totient a (k + n % a + a * i)],
          apply card_union_le,
        end
  ... ≤ a.totient * i + a.totient + a.totient : add_le_add_right ih (totient a),
end

open zmod

/-- Note this takes an explicit `fintype ((zmod n)ˣ)` argument to avoid trouble with instance
diamonds. -/
@[simp] lemma _root_.zmod.card_units_eq_totient (n : ℕ) [h : fact (0 < n)] [fintype ((zmod n)ˣ)] :
  fintype.card ((zmod n)ˣ) = φ n :=
calc fintype.card ((zmod n)ˣ) = fintype.card {x : zmod n // x.val.coprime n} :
  fintype.card_congr zmod.units_equiv_coprime
... = φ n :
begin
  unfreezingI { obtain ⟨m, rfl⟩ : ∃ m, n = m + 1 := exists_eq_succ_of_ne_zero h.out.ne' },
  simp only [totient, finset.card_eq_sum_ones, fintype.card_subtype, finset.sum_filter,
    ← fin.sum_univ_eq_sum_range, @nat.coprime_comm (m + 1)],
  refl
end

lemma totient_even {n : ℕ} (hn : 2 < n) : even n.totient :=
begin
  haveI : fact (1 < n) := ⟨one_lt_two.trans hn⟩,
  suffices : 2 = order_of (-1 : (zmod n)ˣ),
  { rw [← zmod.card_units_eq_totient, even_iff_two_dvd, this], exact order_of_dvd_card_univ },
  rw [←order_of_units, units.coe_neg_one, order_of_neg_one, ring_char.eq (zmod n) n, if_neg hn.ne'],
end

lemma totient_mul {m n : ℕ} (h : m.coprime n) : φ (m * n) = φ m * φ n :=
if hmn0 : m * n = 0
  then by cases nat.mul_eq_zero.1 hmn0 with h h;
    simp only [totient_zero, mul_zero, zero_mul, h]
  else
  begin
    haveI : fact (0 < (m * n)) := ⟨nat.pos_of_ne_zero hmn0⟩,
    haveI : fact (0 < m) := ⟨nat.pos_of_ne_zero $ left_ne_zero_of_mul hmn0⟩,
    haveI : fact (0 < n) := ⟨nat.pos_of_ne_zero $ right_ne_zero_of_mul hmn0⟩,
    simp only [← zmod.card_units_eq_totient],
    rw [fintype.card_congr (units.map_equiv (zmod.chinese_remainder h).to_mul_equiv).to_equiv,
      fintype.card_congr (@mul_equiv.prod_units (zmod m) (zmod n) _ _).to_equiv,
      fintype.card_prod]
  end

/-- For `d ∣ n`, the totient of `n/d` equals the number of values `k < n` such that `gcd n k = d` -/
lemma totient_div_of_dvd {n d : ℕ} (hnd : d ∣ n) :
  φ (n/d) = (filter (λ (k : ℕ), n.gcd k = d) (range n)).card :=
begin
  rcases d.eq_zero_or_pos with rfl | hd0, { simp [eq_zero_of_zero_dvd hnd] },
  rcases hnd with ⟨x, rfl⟩,
  rw nat.mul_div_cancel_left x hd0,
  apply finset.card_congr (λ k _, d * k),
  { simp only [mem_filter, mem_range, and_imp, coprime],
    refine λ a ha1 ha2, ⟨(mul_lt_mul_left hd0).2 ha1, _⟩,
    rw [gcd_mul_left, ha2, mul_one] },
  { simp [hd0.ne'] },
  { simp only [mem_filter, mem_range, exists_prop, and_imp],
    refine λ b hb1 hb2, _,
    have : d ∣ b, { rw ←hb2, apply gcd_dvd_right },
    rcases this with ⟨q, rfl⟩,
    refine ⟨q, ⟨⟨(mul_lt_mul_left hd0).1 hb1, _⟩, rfl⟩⟩,
    rwa [gcd_mul_left, mul_right_eq_self_iff hd0] at hb2 },
end

lemma sum_totient' (n : ℕ) : ∑ m in (range n.succ).filter (∣ n), φ m = n :=
begin
  convert sum_totient _ using 1,
  simp only [nat.divisors, sum_filter, range_eq_Ico],
  rw sum_eq_sum_Ico_succ_bot; simp
end

/-- When `p` is prime, then the totient of `p ^ (n + 1)` is `p ^ n * (p - 1)` -/
lemma totient_prime_pow_succ {p : ℕ} (hp : p.prime) (n : ℕ) :
  φ (p ^ (n + 1)) = p ^ n * (p - 1) :=
calc φ (p ^ (n + 1))
    = ((range (p ^ (n + 1))).filter (coprime (p ^ (n + 1)))).card :
  totient_eq_card_coprime _
... = (range (p ^ (n + 1)) \ ((range (p ^ n)).image (* p))).card :
  congr_arg card begin
    rw [sdiff_eq_filter],
    apply filter_congr,
    simp only [mem_range, mem_filter, coprime_pow_left_iff n.succ_pos,
      mem_image, not_exists, hp.coprime_iff_not_dvd],
    intros a ha,
    split,
    { rintros hap b _ rfl,
      exact hap (dvd_mul_left _ _) },
    { rintros h ⟨b, rfl⟩,
      rw [pow_succ] at ha,
      exact h b (lt_of_mul_lt_mul_left ha (zero_le _)) (mul_comm _ _) }
  end
... = _ :
have h1 : set.inj_on (* p) (range (p ^ n)),
  from λ x _ y _, (nat.mul_left_inj hp.pos).1,
have h2 : (range (p ^ n)).image (* p) ⊆ range (p ^ (n + 1)),
  from λ a, begin
    simp only [mem_image, mem_range, exists_imp_distrib],
    rintros b h rfl,
    rw [pow_succ'],
    exact (mul_lt_mul_right hp.pos).2 h
  end,
begin
  rw [card_sdiff h2, card_image_of_inj_on h1, card_range,
    card_range, ← one_mul (p ^ n), pow_succ, ← tsub_mul,
    one_mul, mul_comm]
end

/-- When `p` is prime, then the totient of `p ^ n` is `p ^ (n - 1) * (p - 1)` -/
lemma totient_prime_pow {p : ℕ} (hp : p.prime) {n : ℕ} (hn : 0 < n) :
  φ (p ^ n) = p ^ (n - 1) * (p - 1) :=
by rcases exists_eq_succ_of_ne_zero (pos_iff_ne_zero.1 hn) with ⟨m, rfl⟩;
  exact totient_prime_pow_succ hp _

lemma totient_prime {p : ℕ} (hp : p.prime) : φ p = p - 1 :=
by rw [← pow_one p, totient_prime_pow hp]; simp

lemma totient_mul_of_prime_of_dvd {p n : ℕ} (hp : p.prime) (h : p ∣ n) :
  (p * n).totient = p * n.totient :=
begin
  by_cases hzero : n = 0,
  { simp [hzero] },
  { have hfin := (multiplicity.finite_nat_iff.2 ⟨hp.ne_one, zero_lt_iff.2 hzero⟩),
    have h0 : 0 < (multiplicity p n).get hfin := multiplicity.pos_of_dvd hfin h,
    obtain ⟨m, hm, hndiv⟩ := multiplicity.exists_eq_pow_mul_and_not_dvd hfin,
    rw [hm, ← mul_assoc, ← pow_succ, nat.totient_mul (coprime_comm.mp (hp.coprime_pow_of_not_dvd
      hndiv)), nat.totient_mul (coprime_comm.mp (hp.coprime_pow_of_not_dvd hndiv)), ← mul_assoc],
    congr,
    rw [ ← succ_pred_eq_of_pos h0, totient_prime_pow_succ hp, totient_prime_pow_succ hp,
      succ_pred_eq_of_pos h0, ← mul_assoc p, ← pow_succ, ← succ_pred_eq_of_pos h0, nat.pred_succ] }
end

lemma totient_eq_iff_prime {p : ℕ} (hp : 0 < p) : p.totient = p - 1 ↔ p.prime :=
begin
  refine ⟨λ h, _, totient_prime⟩,
  replace hp : 1 < p,
  { apply lt_of_le_of_ne,
    { rwa succ_le_iff },
    { rintro rfl,
      rw [totient_one, tsub_self] at h,
      exact one_ne_zero h } },
  rw [totient_eq_card_coprime, range_eq_Ico, ←Ico_insert_succ_left hp.le, finset.filter_insert,
      if_neg (not_coprime_of_dvd_of_dvd hp (dvd_refl p) (dvd_zero p)), ←nat.card_Ico 1 p] at h,
  refine p.prime_of_coprime hp (λ n hn hnz, finset.filter_card_eq h n $ finset.mem_Ico.mpr ⟨_, hn⟩),
  rwa [succ_le_iff, pos_iff_ne_zero],
end

lemma card_units_zmod_lt_sub_one {p : ℕ} (hp : 1 < p) [fintype ((zmod p)ˣ)] :
  fintype.card ((zmod p)ˣ) ≤ p - 1 :=
begin
  haveI : fact (0 < p) := ⟨zero_lt_one.trans hp⟩,
  rw zmod.card_units_eq_totient p,
  exact nat.le_pred_of_lt (nat.totient_lt p hp),
end

lemma prime_iff_card_units (p : ℕ) [fintype ((zmod p)ˣ)] :
  p.prime ↔ fintype.card ((zmod p)ˣ) = p - 1 :=
begin
  by_cases hp : p = 0,
  { substI hp,
    simp only [zmod, not_prime_zero, false_iff, zero_tsub],
    -- the substI created an non-defeq but subsingleton instance diamond; resolve it
    suffices : fintype.card ℤˣ ≠ 0, { convert this },
    simp },
  haveI : fact (0 < p) := ⟨nat.pos_of_ne_zero hp⟩,
  rw [zmod.card_units_eq_totient, nat.totient_eq_iff_prime (fact.out (0 < p))],
end

@[simp] lemma totient_two : φ 2 = 1 :=
(totient_prime prime_two).trans rfl

lemma totient_eq_one_iff : ∀ {n : ℕ}, n.totient = 1 ↔ n = 1 ∨ n = 2
| 0 := by simp
| 1 := by simp
| 2 := by simp
| (n+3) :=
begin
  have : 3 ≤ n + 3 := le_add_self,
  simp only [succ_succ_ne_one, false_or],
  exact ⟨λ h, not_even_one.elim $ h ▸ totient_even this, by rintro ⟨⟩⟩,
end

/-! ### Euler's product formula for the totient function

We prove several different statements of this formula. -/

/-- Euler's product formula for the totient function. -/
theorem totient_eq_prod_factorization {n : ℕ} (hn : n ≠ 0) :
  φ n = n.factorization.prod (λ p k, p ^ (k - 1) * (p - 1)) :=
begin
  rw multiplicative_factorization φ @totient_mul totient_one hn,
  apply finsupp.prod_congr (λ p hp, _),
  have h := zero_lt_iff.mpr (finsupp.mem_support_iff.mp hp),
  rw [totient_prime_pow (prime_of_mem_factorization hp) h],
end

/-- Euler's product formula for the totient function. -/
theorem totient_mul_prod_factors (n : ℕ) :
  φ n * ∏ p in n.factors.to_finset, p = n * ∏ p in n.factors.to_finset, (p - 1) :=
begin
  by_cases hn : n = 0, { simp [hn] },
  rw totient_eq_prod_factorization hn,
  nth_rewrite 2 ←factorization_prod_pow_eq_self hn,
  simp only [←prod_factorization_eq_prod_factors, ←finsupp.prod_mul],
  refine finsupp.prod_congr (λ p hp, _),
  rw [finsupp.mem_support_iff, ← zero_lt_iff] at hp,
  rw [mul_comm, ←mul_assoc, ←pow_succ, nat.sub_add_cancel hp],
end

/-- Euler's product formula for the totient function. -/
theorem totient_eq_div_factors_mul (n : ℕ) :
  φ n = n / (∏ p in n.factors.to_finset, p) * (∏ p in n.factors.to_finset, (p - 1)) :=
begin
  rw [← mul_div_left n.totient, totient_mul_prod_factors, mul_comm,
      nat.mul_div_assoc _ (prod_prime_factors_dvd n), mul_comm],
  simpa [prod_factorization_eq_prod_factors] using prod_pos (λ p, pos_of_mem_factorization),
end

/-- Euler's product formula for the totient function. -/
theorem totient_eq_mul_prod_factors (n : ℕ) :
  (φ n : ℚ) = n * ∏ p in n.factors.to_finset, (1 - p⁻¹) :=
begin
  by_cases hn : n = 0, { simp [hn] },
  have hn' : (n : ℚ) ≠ 0, { simp [hn] },
  have hpQ : ∏ p in n.factors.to_finset, (p : ℚ) ≠ 0,
  { rw [←cast_prod, cast_ne_zero, ←zero_lt_iff, ←prod_factorization_eq_prod_factors],
    exact prod_pos (λ p hp, pos_of_mem_factorization hp) },
  simp only [totient_eq_div_factors_mul n, prod_prime_factors_dvd n, cast_mul, cast_prod,
      cast_div_char_zero, mul_comm_div, mul_right_inj' hn', div_eq_iff hpQ, ←prod_mul_distrib],
  refine prod_congr rfl (λ p hp, _),
  have hp := pos_of_mem_factors (list.mem_to_finset.mp hp),
  have hp' : (p : ℚ) ≠ 0 := cast_ne_zero.mpr hp.ne.symm,
  rw [sub_mul, one_mul, mul_comm, mul_inv_cancel hp', cast_pred hp],
end

lemma totient_gcd_mul_totient_mul (a b : ℕ) : φ (a.gcd b) * φ (a * b) = φ a * φ b * (a.gcd b) :=
begin
  have shuffle : ∀ a1 a2 b1 b2 c1 c2 : ℕ, b1 ∣ a1 → b2 ∣ a2 →
    (a1/b1 * c1) * (a2/b2 * c2) = (a1*a2)/(b1*b2) * (c1*c2),
  { intros a1 a2 b1 b2 c1 c2 h1 h2,
    calc
      (a1/b1 * c1) * (a2/b2 * c2) = ((a1/b1) * (a2/b2)) * (c1*c2) : by apply mul_mul_mul_comm
      ... = (a1*a2)/(b1*b2) * (c1*c2) : by { congr' 1, exact div_mul_div_comm h1 h2 } },
  simp only [totient_eq_div_factors_mul],
  rw [shuffle, shuffle],
  rotate, repeat { apply prod_prime_factors_dvd },
  { simp only [prod_factors_gcd_mul_prod_factors_mul],
    rw [eq_comm, mul_comm, ←mul_assoc, ←nat.mul_div_assoc],
    exact mul_dvd_mul (prod_prime_factors_dvd a) (prod_prime_factors_dvd b) }
end

lemma totient_super_multiplicative (a b : ℕ) : φ a * φ b ≤ φ (a * b) :=
begin
  let d := a.gcd b,
  rcases (zero_le a).eq_or_lt with rfl | ha0, { simp },
  have hd0 : 0 < d, from nat.gcd_pos_of_pos_left _ ha0,
  rw [←mul_le_mul_right hd0, ←totient_gcd_mul_totient_mul a b, mul_comm],
  apply mul_le_mul_left' (nat.totient_le d),
end

end nat


/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Yury G. Kudryashov
-/
import order.basic
import logic.is_empty

/-!
# Unbundled relation classes

In this file we prove some properties of `is_*` classes defined in `init.algebra.classes`. The main
difference between these classes and the usual order classes (`preorder` etc) is that usual classes
extend `has_le` and/or `has_lt` while these classes take a relation as an explicit argument.

-/

universes u v

variables {α : Type u} {β : Type v} {r : α → α → Prop} {s : β → β → Prop}

open function

lemma of_eq [is_refl α r] : ∀ {a b}, a = b → r a b | _ _ ⟨h⟩ := refl _

lemma comm [is_symm α r] {a b : α} : r a b ↔ r b a := ⟨symm, symm⟩
lemma antisymm' [is_antisymm α r] {a b : α} : r a b → r b a → b = a := λ h h', antisymm h' h

lemma antisymm_iff [is_refl α r] [is_antisymm α r] {a b : α} : r a b ∧ r b a ↔ a = b :=
⟨λ h, antisymm h.1 h.2, by { rintro rfl, exact ⟨refl _, refl _⟩ }⟩

/-- A version of `antisymm` with `r` explicit.

This lemma matches the lemmas from lean core in `init.algebra.classes`, but is missing there.  -/
@[elab_simple]
lemma antisymm_of (r : α → α → Prop) [is_antisymm α r] {a b : α} : r a b → r b a → a = b := antisymm

/-- A version of `antisymm'` with `r` explicit.

This lemma matches the lemmas from lean core in `init.algebra.classes`, but is missing there.  -/
@[elab_simple]
lemma antisymm_of' (r : α → α → Prop) [is_antisymm α r] {a b : α} : r a b → r b a → b = a :=
antisymm'

/-- A version of `comm` with `r` explicit.

This lemma matches the lemmas from lean core in `init.algebra.classes`, but is missing there.  -/
lemma comm_of (r : α → α → Prop) [is_symm α r] {a b : α} : r a b ↔ r b a := comm

theorem is_refl.swap (r) [is_refl α r] : is_refl α (swap r) := ⟨refl_of r⟩
theorem is_irrefl.swap (r) [is_irrefl α r] : is_irrefl α (swap r) := ⟨irrefl_of r⟩
theorem is_trans.swap (r) [is_trans α r] : is_trans α (swap r) :=
⟨λ a b c h₁ h₂, trans_of r h₂ h₁⟩
theorem is_antisymm.swap (r) [is_antisymm α r] : is_antisymm α (swap r) :=
⟨λ a b h₁ h₂, antisymm h₂ h₁⟩
theorem is_asymm.swap (r) [is_asymm α r] : is_asymm α (swap r) :=
⟨λ a b h₁ h₂, asymm_of r h₂ h₁⟩
theorem is_total.swap (r) [is_total α r] : is_total α (swap r) :=
⟨λ a b, (total_of r a b).swap⟩
theorem is_trichotomous.swap (r) [is_trichotomous α r] : is_trichotomous α (swap r) :=
⟨λ a b, by simpa [swap, or.comm, or.left_comm] using trichotomous_of r a b⟩
theorem is_preorder.swap (r) [is_preorder α r] : is_preorder α (swap r) :=
{..@is_refl.swap α r _, ..@is_trans.swap α r _}
theorem is_strict_order.swap (r) [is_strict_order α r] : is_strict_order α (swap r) :=
{..@is_irrefl.swap α r _, ..@is_trans.swap α r _}
theorem is_partial_order.swap (r) [is_partial_order α r] : is_partial_order α (swap r) :=
{..@is_preorder.swap α r _, ..@is_antisymm.swap α r _}
theorem is_total_preorder.swap (r) [is_total_preorder α r] : is_total_preorder α (swap r) :=
{..@is_preorder.swap α r _, ..@is_total.swap α r _}
theorem is_linear_order.swap (r) [is_linear_order α r] : is_linear_order α (swap r) :=
{..@is_partial_order.swap α r _, ..@is_total.swap α r _}

protected theorem is_asymm.is_antisymm (r) [is_asymm α r] : is_antisymm α r :=
⟨λ x y h₁ h₂, (asymm h₁ h₂).elim⟩
protected theorem is_asymm.is_irrefl [is_asymm α r] : is_irrefl α r :=
⟨λ a h, asymm h h⟩
protected theorem is_total.is_trichotomous (r) [is_total α r] : is_trichotomous α r :=
⟨λ a b, or.left_comm.1 (or.inr $ total_of r a b)⟩

@[priority 100]  -- see Note [lower instance priority]
instance is_total.to_is_refl (r) [is_total α r] : is_refl α r :=
⟨λ a, (or_self _).1 $ total_of r a a⟩

lemma ne_of_irrefl {r} [is_irrefl α r] : ∀ {x y : α}, r x y → x ≠ y | _ _ h rfl := irrefl _ h
lemma ne_of_irrefl' {r} [is_irrefl α r] : ∀ {x y : α}, r x y → y ≠ x | _ _ h rfl := irrefl _ h

lemma not_rel (r) [is_irrefl α r] [subsingleton α] (x y) : ¬ r x y :=
subsingleton.elim x y ▸ irrefl x

@[simp] lemma empty_relation_apply (a b : α) : empty_relation a b ↔ false := iff.rfl

lemma eq_empty_relation (r) [is_irrefl α r] [subsingleton α] : r = empty_relation :=
funext₂ $ by simpa using not_rel r

instance : is_irrefl α empty_relation := ⟨λ a, id⟩

lemma trans_trichotomous_left [is_trans α r] [is_trichotomous α r] {a b c : α} :
  ¬r b a → r b c → r a c :=
begin
  intros h₁ h₂, rcases trichotomous_of r a b with h₃|h₃|h₃,
  exact trans h₃ h₂, rw h₃, exact h₂, exfalso, exact h₁ h₃
end

lemma trans_trichotomous_right [is_trans α r] [is_trichotomous α r] {a b c : α} :
  r a b → ¬r c b → r a c :=
begin
  intros h₁ h₂, rcases trichotomous_of r b c with h₃|h₃|h₃,
  exact trans h₁ h₃, rw ←h₃, exact h₁, exfalso, exact h₂ h₃
end

lemma transitive_of_trans (r : α → α → Prop) [is_trans α r] : transitive r := λ _ _ _, trans

/-- Construct a partial order from a `is_strict_order` relation.

See note [reducible non-instances]. -/
@[reducible] def partial_order_of_SO (r) [is_strict_order α r] : partial_order α :=
{ le := λ x y, x = y ∨ r x y,
  lt := r,
  le_refl := λ x, or.inl rfl,
  le_trans := λ x y z h₁ h₂,
    match y, z, h₁, h₂ with
    | _, _, or.inl rfl, h₂ := h₂
    | _, _, h₁, or.inl rfl := h₁
    | _, _, or.inr h₁, or.inr h₂ := or.inr (trans h₁ h₂)
    end,
  le_antisymm := λ x y h₁ h₂,
    match y, h₁, h₂ with
    | _, or.inl rfl, h₂ := rfl
    | _, h₁, or.inl rfl := rfl
    | _, or.inr h₁, or.inr h₂ := (asymm h₁ h₂).elim
    end,
  lt_iff_le_not_le := λ x y,
    ⟨λ h, ⟨or.inr h, not_or
      (λ e, by rw e at h; exact irrefl _ h)
      (asymm h)⟩,
    λ ⟨h₁, h₂⟩, h₁.resolve_left (λ e, h₂ $ e ▸ or.inl rfl)⟩ }

/-- This is basically the same as `is_strict_total_order`, but that definition has a redundant
assumption `is_incomp_trans α lt`. -/
@[algebra] class is_strict_total_order' (α : Type u) (lt : α → α → Prop)
  extends is_trichotomous α lt, is_strict_order α lt : Prop.

/-- Construct a linear order from an `is_strict_total_order'` relation.

See note [reducible non-instances]. -/
@[reducible]
def linear_order_of_STO' (r) [is_strict_total_order' α r] [Π x y, decidable (¬ r x y)] :
  linear_order α :=
{ le_total := λ x y,
    match y, trichotomous_of r x y with
    | y, or.inl h := or.inl (or.inr h)
    | _, or.inr (or.inl rfl) := or.inl (or.inl rfl)
    | _, or.inr (or.inr h) := or.inr (or.inr h)
    end,
  decidable_le := λ x y, decidable_of_iff (¬ r y x)
    ⟨λ h, ((trichotomous_of r y x).resolve_left h).imp eq.symm id,
      λ h, h.elim (λ h, h ▸ irrefl_of _ _) (asymm_of r)⟩,
  ..partial_order_of_SO r }

theorem is_strict_total_order'.swap (r) [is_strict_total_order' α r] :
  is_strict_total_order' α (swap r) :=
{..is_trichotomous.swap r, ..is_strict_order.swap r}

/-! ### Order connection -/

/-- A connected order is one satisfying the condition `a < c → a < b ∨ b < c`.
  This is recognizable as an intuitionistic substitute for `a ≤ b ∨ b ≤ a` on
  the constructive reals, and is also known as negative transitivity,
  since the contrapositive asserts transitivity of the relation `¬ a < b`.  -/
@[algebra] class is_order_connected (α : Type u) (lt : α → α → Prop) : Prop :=
(conn : ∀ a b c, lt a c → lt a b ∨ lt b c)

theorem is_order_connected.neg_trans {r : α → α → Prop} [is_order_connected α r]
  {a b c} (h₁ : ¬ r a b) (h₂ : ¬ r b c) : ¬ r a c :=
mt (is_order_connected.conn a b c) $ by simp [h₁, h₂]

theorem is_strict_weak_order_of_is_order_connected [is_asymm α r]
  [is_order_connected α r] : is_strict_weak_order α r :=
{ trans := λ a b c h₁ h₂, (is_order_connected.conn _ c _ h₁).resolve_right (asymm h₂),
  incomp_trans := λ a b c ⟨h₁, h₂⟩ ⟨h₃, h₄⟩,
    ⟨is_order_connected.neg_trans h₁ h₃, is_order_connected.neg_trans h₄ h₂⟩,
  ..@is_asymm.is_irrefl α r _ }

@[priority 100] -- see Note [lower instance priority]
instance is_order_connected_of_is_strict_total_order'
  [is_strict_total_order' α r] : is_order_connected α r :=
⟨λ a b c h, (trichotomous _ _).imp_right (λ o,
  o.elim (λ e, e ▸ h) (λ h', trans h' h))⟩

@[priority 100] -- see Note [lower instance priority]
instance is_strict_total_order_of_is_strict_total_order'
  [is_strict_total_order' α r] : is_strict_total_order α r :=
{..is_strict_weak_order_of_is_order_connected}

/-! ### Extensional relation -/

/-- An extensional relation is one in which an element is determined by its set
  of predecessors. It is named for the `x ∈ y` relation in set theory, whose
  extensionality is one of the first axioms of ZFC. -/
@[algebra] class is_extensional (α : Type u) (r : α → α → Prop) : Prop :=
(ext : ∀ a b, (∀ x, r x a ↔ r x b) → a = b)

@[priority 100] -- see Note [lower instance priority]
instance is_extensional_of_is_strict_total_order'
  [is_strict_total_order' α r] : is_extensional α r :=
⟨λ a b H, ((@trichotomous _ r _ a b)
  .resolve_left $ mt (H _).2 (irrefl a))
  .resolve_right $ mt (H _).1 (irrefl b)⟩

/-! ### Well-order -/

/-- A well order is a well-founded linear order. -/
@[algebra] class is_well_order (α : Type u) (r : α → α → Prop)
  extends is_strict_total_order' α r : Prop :=
(wf : well_founded r)

@[priority 100] -- see Note [lower instance priority]
instance is_well_order.is_strict_total_order {α} (r : α → α → Prop) [is_well_order α r] :
  is_strict_total_order α r := by apply_instance
@[priority 100] -- see Note [lower instance priority]
instance is_well_order.is_extensional {α} (r : α → α → Prop) [is_well_order α r] :
  is_extensional α r := by apply_instance
@[priority 100] -- see Note [lower instance priority]
instance is_well_order.is_trichotomous {α} (r : α → α → Prop) [is_well_order α r] :
  is_trichotomous α r := by apply_instance
@[priority 100] -- see Note [lower instance priority]
instance is_well_order.is_trans {α} (r : α → α → Prop) [is_well_order α r] :
  is_trans α r := by apply_instance
@[priority 100] -- see Note [lower instance priority]
instance is_well_order.is_irrefl {α} (r : α → α → Prop) [is_well_order α r] :
  is_irrefl α r := by apply_instance
@[priority 100] -- see Note [lower instance priority]
instance is_well_order.is_asymm {α} (r : α → α → Prop) [is_well_order α r] :
  is_asymm α r := by apply_instance

/-- Construct a decidable linear order from a well-founded linear order. -/
noncomputable def is_well_order.linear_order (r : α → α → Prop) [is_well_order α r] :
  linear_order α :=
by { letI := λ x y, classical.dec (¬r x y), exact linear_order_of_STO' r }

/-- Derive a `has_well_founded` instance from a `is_well_order` instance. -/
def is_well_order.to_has_well_founded [has_lt α] [hwo : is_well_order α (<)] :
  has_well_founded α := { r := (<), wf := hwo.wf }

-- This isn't made into an instance as it loops with `is_irrefl α r`.
theorem subsingleton.is_well_order [subsingleton α] (r : α → α → Prop) [hr : is_irrefl α r] :
  is_well_order α r :=
{ trichotomous := λ a b, or.inr $ or.inl $ subsingleton.elim a b,
  trans        := λ a b c h, (not_rel r a b h).elim,
  wf           := ⟨λ a, ⟨_, λ y h, (not_rel r y a h).elim⟩⟩,
  ..hr }

instance empty_relation.is_well_order [subsingleton α] : is_well_order α empty_relation :=
subsingleton.is_well_order _

@[priority 100]
instance is_empty.is_well_order [is_empty α] (r : α → α → Prop) : is_well_order α r :=
{ trichotomous := is_empty_elim,
  irrefl       := is_empty_elim,
  trans        := is_empty_elim,
  wf           := well_founded_of_empty r }

instance prod.lex.is_well_order [is_well_order α r] [is_well_order β s] :
  is_well_order (α × β) (prod.lex r s) :=
{ trichotomous := λ ⟨a₁, a₂⟩ ⟨b₁, b₂⟩,
    match @trichotomous _ r _ a₁ b₁ with
    | or.inl h₁ := or.inl $ prod.lex.left _ _ h₁
    | or.inr (or.inr h₁) := or.inr $ or.inr $ prod.lex.left _ _ h₁
    | or.inr (or.inl e) := e ▸  match @trichotomous _ s _ a₂ b₂ with
      | or.inl h := or.inl $ prod.lex.right _ h
      | or.inr (or.inr h) := or.inr $ or.inr $ prod.lex.right _ h
      | or.inr (or.inl e) := e ▸ or.inr $ or.inl rfl
      end
    end,
  irrefl := λ ⟨a₁, a₂⟩ h, by cases h with _ _ _ _ h _ _ _ h;
     [exact irrefl _ h, exact irrefl _ h],
  trans := λ a b c h₁ h₂, begin
    cases h₁ with a₁ a₂ b₁ b₂ ab a₁ b₁ b₂ ab;
    cases h₂ with _ _ c₁ c₂ bc _ _ c₂ bc,
    { exact prod.lex.left _ _ (trans ab bc) },
    { exact prod.lex.left _ _ ab },
    { exact prod.lex.left _ _ bc },
    { exact prod.lex.right _ (trans ab bc) }
  end,
  wf := prod.lex_wf is_well_order.wf is_well_order.wf }

namespace set

/-- An unbounded or cofinal set. -/
def unbounded (r : α → α → Prop) (s : set α) : Prop := ∀ a, ∃ b ∈ s, ¬ r b a
/-- A bounded or final set. Not to be confused with `metric.bounded`. -/
def bounded (r : α → α → Prop) (s : set α) : Prop := ∃ a, ∀ b ∈ s, r b a

@[simp] lemma not_bounded_iff {r : α → α → Prop} (s : set α) : ¬bounded r s ↔ unbounded r s :=
by simp only [bounded, unbounded, not_forall, not_exists, exists_prop, not_and, not_not]

@[simp] lemma not_unbounded_iff {r : α → α → Prop} (s : set α) : ¬unbounded r s ↔ bounded r s :=
by rw [not_iff_comm, not_bounded_iff]

lemma unbounded_of_is_empty [is_empty α] {r : α → α → Prop} (s : set α) : unbounded r s :=
is_empty_elim

end set

namespace prod

instance is_refl_preimage_fst {r : α → α → Prop} [h : is_refl α r] :
  is_refl (α × α) (prod.fst ⁻¹'o r) := ⟨λ a, refl_of r a.1⟩

instance is_refl_preimage_snd {r : α → α → Prop} [h : is_refl α r] :
  is_refl (α × α) (prod.snd ⁻¹'o r) := ⟨λ a, refl_of r a.2⟩

instance is_trans_preimage_fst {r : α → α → Prop} [h : is_trans α r] :
  is_trans (α × α) (prod.fst ⁻¹'o r) := ⟨λ _ _ _, trans_of r⟩

instance is_trans_preimage_snd {r : α → α → Prop} [h : is_trans α r] :
  is_trans (α × α) (prod.snd ⁻¹'o r) := ⟨λ _ _ _, trans_of r⟩

end prod

/-! ### Strict-non strict relations -/

/-- An unbundled relation class stating that `r` is the nonstrict relation corresponding to the
strict relation `s`. Compare `preorder.lt_iff_le_not_le`. This is mostly meant to provide dot
notation on `(⊆)` and `(⊂)`. -/
class is_nonstrict_strict_order (α : Type*) (r s : α → α → Prop) :=
(right_iff_left_not_left (a b : α) : s a b ↔ r a b ∧ ¬ r b a)

lemma right_iff_left_not_left {r s : α → α → Prop} [is_nonstrict_strict_order α r s] {a b : α} :
  s a b ↔ r a b ∧ ¬ r b a :=
is_nonstrict_strict_order.right_iff_left_not_left _ _

/-- A version of `right_iff_left_not_left` with explicit `r` and `s`. -/
lemma right_iff_left_not_left_of (r s : α → α → Prop) [is_nonstrict_strict_order α r s] {a b : α} :
  s a b ↔ r a b ∧ ¬ r b a :=
right_iff_left_not_left

-- The free parameter `r` is strictly speaking not uniquely determined by `s`, but in practice it
-- always has a unique instance, so this is not dangerous.
@[priority 100, nolint dangerous_instance] -- see Note [lower instance priority]
instance is_nonstrict_strict_order.to_is_irrefl {r : α → α → Prop} {s : α → α → Prop}
  [is_nonstrict_strict_order α r s] :
  is_irrefl α s :=
⟨λ a h, ((right_iff_left_not_left_of r s).1 h).2 ((right_iff_left_not_left_of r s).1 h).1⟩

/-! #### `⊆` and `⊂` -/

section subset
variables [has_subset α] {a b c : α}

@[refl] lemma subset_refl [is_refl α (⊆)] (a : α) : a ⊆ a := refl _
lemma subset_rfl [is_refl α (⊆)] : a ⊆ a := refl _
lemma subset_of_eq [is_refl α (⊆)] : a = b → a ⊆ b := λ h, h ▸ subset_rfl
lemma superset_of_eq [is_refl α (⊆)] : a = b → b ⊆ a := λ h, h ▸ subset_rfl
lemma ne_of_not_subset [is_refl α (⊆)] : ¬ a ⊆ b → a ≠ b := mt subset_of_eq
lemma ne_of_not_superset [is_refl α (⊆)] : ¬ a ⊆ b → b ≠ a := mt superset_of_eq
@[trans] lemma subset_trans [is_trans α (⊆)] {a b c : α} : a ⊆ b → b ⊆ c → a ⊆ c := trans

lemma subset_antisymm [is_antisymm α (⊆)] (h : a ⊆ b) (h' : b ⊆ a) : a = b :=
antisymm h h'

lemma superset_antisymm [is_antisymm α (⊆)] (h : a ⊆ b) (h' : b ⊆ a) : b = a :=
antisymm' h h'

alias subset_of_eq ← eq.subset' --TODO: Fix it and kill `eq.subset`
alias superset_of_eq ← eq.superset
alias subset_trans      ← has_subset.subset.trans
alias subset_antisymm   ← has_subset.subset.antisymm
alias superset_antisymm ← has_subset.subset.antisymm'

lemma subset_antisymm_iff [is_refl α (⊆)] [is_antisymm α (⊆)] : a = b ↔ a ⊆ b ∧ b ⊆ a :=
⟨λ h, ⟨h.subset', h.superset⟩, λ h, h.1.antisymm h.2⟩

lemma superset_antisymm_iff [is_refl α (⊆)] [is_antisymm α (⊆)] : a = b ↔ b ⊆ a ∧ a ⊆ b :=
⟨λ h, ⟨h.superset, h.subset'⟩, λ h, h.1.antisymm' h.2⟩

end subset

section ssubset
variables [has_ssubset α]

lemma ssubset_irrefl [is_irrefl α (⊂)] (a : α) : ¬ a ⊂ a := irrefl _
lemma ssubset_irrfl [is_irrefl α (⊂)] {a : α} : ¬ a ⊂ a := irrefl _
lemma ne_of_ssubset [is_irrefl α (⊂)] {a b : α} : a ⊂ b → a ≠ b := ne_of_irrefl
lemma ne_of_ssuperset [is_irrefl α (⊂)] {a b : α} : a ⊂ b → b ≠ a := ne_of_irrefl'
@[trans] lemma ssubset_trans [is_trans α (⊂)] {a b c : α} : a ⊂ b → b ⊂ c → a ⊂ c := trans
lemma ssubset_asymm [is_asymm α (⊂)] {a b : α} (h : a ⊂ b) : ¬ b ⊂ a := asymm h

alias ssubset_irrfl   ← has_ssubset.ssubset.false
alias ne_of_ssubset   ← has_ssubset.ssubset.ne
alias ne_of_ssuperset ← has_ssubset.ssubset.ne'
alias ssubset_trans   ← has_ssubset.ssubset.trans
alias ssubset_asymm   ← has_ssubset.ssubset.asymm

end ssubset

section subset_ssubset
variables [has_subset α] [has_ssubset α] [is_nonstrict_strict_order α (⊆) (⊂)] {a b c : α}

lemma ssubset_iff_subset_not_subset : a ⊂ b ↔ a ⊆ b ∧ ¬ b ⊆ a := right_iff_left_not_left
lemma subset_of_ssubset (h : a ⊂ b) : a ⊆ b := (ssubset_iff_subset_not_subset.1 h).1
lemma not_subset_of_ssubset (h : a ⊂ b) : ¬ b ⊆ a := (ssubset_iff_subset_not_subset.1 h).2
lemma not_ssubset_of_subset (h : a ⊆ b) : ¬ b ⊂ a := λ h', not_subset_of_ssubset h' h

lemma ssubset_of_subset_not_subset (h₁ : a ⊆ b) (h₂ : ¬ b ⊆ a) : a ⊂ b :=
ssubset_iff_subset_not_subset.2 ⟨h₁, h₂⟩

alias subset_of_ssubset            ← has_ssubset.ssubset.subset
alias not_subset_of_ssubset        ← has_ssubset.ssubset.not_subset
alias not_ssubset_of_subset        ← has_subset.subset.not_ssubset
alias ssubset_of_subset_not_subset ← has_subset.subset.ssubset_of_not_subset

lemma ssubset_of_subset_of_ssubset [is_trans α (⊆)] (h₁ : a ⊆ b) (h₂ : b ⊂ c) : a ⊂ c :=
(h₁.trans h₂.subset).ssubset_of_not_subset $ λ h, h₂.not_subset $ h.trans h₁

lemma ssubset_of_ssubset_of_subset [is_trans α (⊆)] (h₁ : a ⊂ b) (h₂ : b ⊆ c) : a ⊂ c :=
(h₁.subset.trans h₂).ssubset_of_not_subset $ λ h, h₁.not_subset $ h₂.trans h

lemma ssubset_of_subset_of_ne [is_antisymm α (⊆)] (h₁ : a ⊆ b) (h₂ : a ≠ b) : a ⊂ b :=
h₁.ssubset_of_not_subset $ mt h₁.antisymm h₂

lemma ssubset_of_ne_of_subset [is_antisymm α (⊆)] (h₁ : a ≠ b) (h₂ : a ⊆ b) : a ⊂ b :=
ssubset_of_subset_of_ne h₂ h₁

lemma eq_or_ssubset_of_subset [is_antisymm α (⊆)] (h : a ⊆ b) : a = b ∨ a ⊂ b :=
(em (b ⊆ a)).imp h.antisymm h.ssubset_of_not_subset

lemma ssubset_or_eq_of_subset [is_antisymm α (⊆)] (h : a ⊆ b) : a ⊂ b ∨ a = b :=
(eq_or_ssubset_of_subset h).swap

alias ssubset_of_subset_of_ssubset ← has_subset.subset.trans_ssubset
alias ssubset_of_ssubset_of_subset ← has_ssubset.ssubset.trans_subset
alias ssubset_of_subset_of_ne      ← has_subset.subset.ssubset_of_ne
alias ssubset_of_ne_of_subset      ← ne.ssubset_of_subset
alias eq_or_ssubset_of_subset      ← has_subset.subset.eq_or_ssubset
alias ssubset_or_eq_of_subset      ← has_subset.subset.ssubset_or_eq

lemma ssubset_iff_subset_ne [is_antisymm α (⊆)] : a ⊂ b ↔ a ⊆ b ∧ a ≠ b :=
⟨λ h, ⟨h.subset, h.ne⟩, λ h, h.1.ssubset_of_ne h.2⟩

lemma subset_iff_ssubset_or_eq [is_refl α (⊆)] [is_antisymm α (⊆)] : a ⊆ b ↔ a ⊂ b ∨ a = b :=
⟨λ h, h.ssubset_or_eq, λ h, h.elim subset_of_ssubset subset_of_eq⟩

end subset_ssubset

/-! ### Conversion of bundled order typeclasses to unbundled relation typeclasses -/

instance [preorder α] : is_refl α (≤) := ⟨le_refl⟩
instance [preorder α] : is_refl α (≥) := is_refl.swap _
instance [preorder α] : is_trans α (≤) := ⟨@le_trans _ _⟩
instance [preorder α] : is_trans α (≥) := is_trans.swap _
instance [preorder α] : is_preorder α (≤) := {}
instance [preorder α] : is_preorder α (≥) := {}
instance [preorder α] : is_irrefl α (<) := ⟨lt_irrefl⟩
instance [preorder α] : is_irrefl α (>) := is_irrefl.swap _
instance [preorder α] : is_trans α (<) := ⟨@lt_trans _ _⟩
instance [preorder α] : is_trans α (>) := is_trans.swap _
instance [preorder α] : is_asymm α (<) := ⟨@lt_asymm _ _⟩
instance [preorder α] : is_asymm α (>) := is_asymm.swap _
instance [preorder α] : is_antisymm α (<) := is_asymm.is_antisymm _
instance [preorder α] : is_antisymm α (>) := is_asymm.is_antisymm _
instance [preorder α] : is_strict_order α (<) := {}
instance [preorder α] : is_strict_order α (>) := {}
instance [preorder α] : is_nonstrict_strict_order α (≤) (<) := ⟨@lt_iff_le_not_le _ _⟩
instance [partial_order α] : is_antisymm α (≤) := ⟨@le_antisymm _ _⟩
instance [partial_order α] : is_antisymm α (≥) := is_antisymm.swap _
instance [partial_order α] : is_partial_order α (≤) := {}
instance [partial_order α] : is_partial_order α (≥) := {}
instance [linear_order α] : is_total α (≤) := ⟨le_total⟩
instance [linear_order α] : is_total α (≥) := is_total.swap _
instance linear_order.is_total_preorder [linear_order α] : is_total_preorder α (≤) :=
  by apply_instance
instance [linear_order α] : is_total_preorder α (≥) := {}
instance [linear_order α] : is_linear_order α (≤) := {}
instance [linear_order α] : is_linear_order α (≥) := {}
instance [linear_order α] : is_trichotomous α (<) := ⟨lt_trichotomy⟩
instance [linear_order α] : is_trichotomous α (>) := is_trichotomous.swap _
instance [linear_order α] : is_trichotomous α (≤) := is_total.is_trichotomous _
instance [linear_order α] : is_trichotomous α (≥) := is_total.is_trichotomous _
instance [linear_order α] : is_strict_total_order α (<) := by apply_instance
instance [linear_order α] : is_strict_total_order' α (<) := {}
instance [linear_order α] : is_order_connected α (<) := by apply_instance
instance [linear_order α] : is_incomp_trans α (<) := by apply_instance
instance [linear_order α] : is_strict_weak_order α (<) := by apply_instance

lemma transitive_le [preorder α] : transitive (@has_le.le α _) := transitive_of_trans _
lemma transitive_lt [preorder α] : transitive (@has_lt.lt α _) := transitive_of_trans _
lemma transitive_ge [preorder α] : transitive (@ge α _) := transitive_of_trans _
lemma transitive_gt [preorder α] : transitive (@gt α _) := transitive_of_trans _

instance order_dual.is_total_le [has_le α] [is_total α (≤)] : is_total αᵒᵈ (≤) :=
@is_total.swap α _ _

instance nat.lt.is_well_order : is_well_order ℕ (<) := ⟨nat.lt_wf⟩

instance [linear_order α] [h : is_well_order α (<)] : is_well_order αᵒᵈ (>) := h
instance [linear_order α] [h : is_well_order α (>)] : is_well_order αᵒᵈ (<) := h


import data.real.basic
import data.set
import analysis.normed_space.basic

set_option pp.implicit true
-- Make simp display the steps used.
set_option trace.simplify.rewrite true

-- Q0. Notation for absolute. Should I reuse this from somewhere in Lean or mathlib?
local notation `|`x`|` := abs x

def is_adherent (x : ℝ) (X : set ℝ) : Prop :=
∀ ε > 0, ∃y ∈ X, |x - y| ≤ ε

infix `is_adherent_to` :55 := is_adherent

def closure' (X : set ℝ) : set ℝ :=
{x : ℝ | x is_adherent_to X }

-- closure_mono term proof

/-- If $$X\subseteq Y$$ then $$\overline{X}\subseteq\overline{Y}$$ -/
theorem closure'_mono {X Y : set ℝ} (hXY : X ⊆ Y) : closure' X ⊆ closure' Y :=
λ a haX ε hε, let ⟨x, haX', h⟩ := haX ε hε in ⟨x, hXY haX', h⟩

-- closure_mono tactic proof
example {X Y : set ℝ} (hXY : X ⊆ Y) : closure' X ⊆ closure' Y :=
begin
  -- Say a is in the closure of X. We want to show a is in the closure of Y.
  -- So say ε > 0. We want to find y ∈ Y such that |a - y| ≤ ε.
  intros a haX ε hε,
  -- By definition of closure of X, there's x ∈ X with |a - x| ≤ ε.
  rcases haX ε hε with ⟨x, haX', h⟩,
  -- So let y be x.
  use x,
  -- Remark:
  split,
  { -- x is in Y because it's in X and X ⊆ Y
    exact hXY haX', -- hXY is actually a function!
  },
  -- oh but now one of our assumptions is the conclusion
  assumption
end

-- subset_closure term proof

/-- For all subsets $$X$$ of $$\mathbb{R}$$, we have $$X\subseteq\overline{X}$$ -/
lemma subset_closure' {X : set ℝ} : X ⊆ closure' X :=
λ x hx ε hε, ⟨x, hx, le_of_lt (by rwa [sub_self, abs_zero])⟩

-- tactic proof

example {X : set ℝ} : X ⊆ closure' X :=
begin
  -- Say x ∈ X and ε > 0.
  intros x hx ε hε,
  -- We need to find y ∈ X with |x - y| ≤ ε. Just use x.
  use x,
  -- Remark: x ∈ X
  split, exact hx,
  -- Note also that |x - x| is obviously zero
  simp,
  -- and because ε > 0 we're done
  exact le_of_lt hε
  -- Note that that last bit would have been better if your definition of closure'
  -- had used < and not ≤
end

-- closure_closure

-- Note: for some reason this is not formalaised as `closure ∘ closure = closure`
-- I don't know why we have this convention

-- tactic mode proof

/-- The closure of $$\overline{X}$$ is $$\overline{X}$$ again -/
lemma closure'_closure' (X : set ℝ) : closure' (closure' X) = closure' X := --
begin
  -- We prove inclusions in both directions
  ext a,
  split,
  --
  { -- ⊆ : say $$a$$ is in the closure of $$\overline{X}$$.
    intro ha,
    -- We want to show it's in $$\overline{X}$$ so say ε > 0, and we want x with |x-a| ≤ ε
    intros ε hε,
    -- By definition of a, there's some elements $$b\in\overline{X}$$
    -- with |a - b| ≤ ε/2
    rcases ha (ε/2) (by linarith) with ⟨b, hb, hab⟩,
    -- and by definition of b there's some x ∈ X with |b - x| ≤ ε/2
    rcases hb (ε/2) (by linarith) with ⟨x, hx, hbx⟩,
    -- Let's use this x
    use x,
    -- Note it's obviously in X
    split, exact hx,
    -- and now |a - x| = |(a - b) + (b - x)|
    calc |a - x| = |(a - b) + (b - x)| : by ring
                   -- ≤ ε/2 + ε/2 = ε
    ...          ≤ |a - b| + |b - x|   : by apply abs_add
    ...          ≤ ε : by linarith
  },
  { -- ⊇ : follows immediately from subset_closure'
    intro h, apply subset_closure' h,
  }
end

-- closure_squeeze term mode proof
lemma closure'_squeeze {X Y : set ℝ} (h₁ : X ⊆ Y) (h₂ : Y ⊆ closure'(X)) :
  closure'(X) = closure'(Y) :=
set.subset.antisymm (closure'_mono h₁) $ by rw ←closure'_closure' X; apply closure'_mono h₂

-- tactic mode proof
example {X Y : set ℝ} (h₁ : X ⊆ Y) (h₂ : Y ⊆ closure'(X)) :
  closure'(X) = closure'(Y) :=
begin
  -- We prove inclusions in both directions
  apply set.subset.antisymm,
  { -- ⊆ is just closure'_mono
    apply closure'_mono h₁},
  { -- ⊇ -- first use closure'_closure'
    rw ←closure'_closure' X,
    -- and then it follows from closure'_mono
    apply closure'_mono h₂},
end


import data.nat.prime data.nat.gcd data.nat.modeq data.nat.gcd algebra.group chris_hughes_various.zmod group_theory.order_of_element M3P14.order_zmodn_kmb M3P14.Arithmetic_functions.phi

open zmod nat

@[simp] lemma units.coe_pow {α : Type*} [monoid α] (u : units α) (n : ℕ) : (↑(u ^ n) : α) = u ^ n :=
by induction n; simp [*, _root_.pow_succ]

-- Thanks Chris
lemma order_of_dvd_of_pow_eq_one {d n : ℕ} [pos_nat n]  (a : units (zmod n)) (h : a ^ d = 1) : order_of a ∣ d :=
by_contradiction
(λ h₁, nat.find_min _ (show d % order_of a < order_of a,
from nat.mod_lt _ (nat.pos_of_ne_zero (order_of_ne_zero _)))
⟨mt nat.dvd_of_mod_eq_zero h₁, by rwa ← pow_eq_mod_order_of⟩)

/- DEFINITIONS -/
def units_zmod_mk (a n : ℕ ) (h : nat.coprime a n) [pos_nat n] : units (zmod n) :=
{
    val := a,
    inv := a⁻¹,
    val_inv := by rw [mul_inv_eq_gcd n a, coprime.gcd_eq_one h];dsimp;rw zero_add,
    inv_val := by rw [mul_comm, mul_inv_eq_gcd n a, coprime.gcd_eq_one h];dsimp;rw zero_add,
}

def order_of_zmod (a n : ℕ) [pos_nat n] : ℕ := if h : nat.coprime a n then @order_of (units (zmod n)) _ _ _ (units_zmod_mk a n h) else 0

def primitive_root (a n : ℕ) [pos_nat n] := coprime a n ∧ order_of_zmod a n = phi n

/- THEOREMS -/
theorem not_coprime_pow_mod (a d n : ℕ) (h1 : a ^ d ≡ 1 [MOD n]) (h2 : ¬coprime a n) : d = 0 := sorry

-- is that true?
theorem zmod_card_pow (a n d : ℕ) (h : coprime a n) [pos_nat n] : a^fintype.card (units (zmod n)) ≡ 1 [MOD n] := sorry

theorem order_zmod_div (a n d : ℕ) [pos_nat n] : a^d ≡ 1 [MOD n] → order_of_zmod a n ∣ d :=
begin
    cases (classical.em (nat.coprime a n)),
    intro h2,
    unfold order_of_zmod,
    cases (classical.em (nat.coprime a n)),
    {
        rw dif_pos h,
        rw eq_iff_modeq_nat.symm at h2,

        have pow : (units_zmod_mk a n h) ^ d  = 1,
        { apply units.ext,
          suffices : (↑(units_zmod_mk a n h ^ d) : zmod n) = 1,
            simp [this],
          have h2' : (↑(a ^ d) : zmod n) = 1,
            rw h2,
            simp,
            rw ←h2',simp,refl,
        },
        exact order_of_dvd_of_pow_eq_one (units_zmod_mk a n h) pow,
    },
    exact absurd h h_1,
    intro pow,
    rw [order_of_zmod, dif_neg h],
    suffices : d = 0, simp [this],
    exact not_coprime_pow_mod a d n pow h,
end

theorem order_zmod_div_phi_n (a n : ℕ) (h : coprime a n) [pos_nat n] : order_of_zmod a n ∣ phi n :=
begin
    have : a ^ (phi n) ≡ 1 [MOD n], from euler_phi_thm a n h,
    exact order_zmod_div a n (phi n) this,
end

theorem pow_order_units_zmod_eq_one (a n : ℕ) [pos_nat n] (h : coprime a n) : (units_zmod_mk a n h) ^ order_of (units_zmod_mk a n h) = 1 :=
pow_order_of_eq_one (units_zmod_mk a n h)

theorem pow_order_zmod_eq_one (a n : ℕ) [pos_nat n] : (a : zmod n) ^ order_of_zmod a n = (1 : zmod n) :=
begin
    have em : nat.coprime a n ∨ ¬ nat.coprime a n, from (classical.em (nat.coprime a n)),
    unfold order_of_zmod,
    cases em,
    have one_eq : (1 : zmod n) = (1 : units (zmod n)), by simp,
    rw [dif_pos em,units_zmod_mk, one_eq,←(pow_order_units_zmod_eq_one a n em)],
    show ↑(units_zmod_mk a n em) ^ order_of (units_zmod_mk a n em) = ↑(units_zmod_mk a n em ^ order_of (units_zmod_mk a n em)),
    simp,
    rw dif_neg em,
    refl,
end

theorem primitive_root_existence (n : ℕ) [pos_nat n] : ∃ a : ℕ, (primitive_root a n) ↔ n = 1 ∨ n = 2 ∨ n = 4 ∨ ∃ p r : ℕ, prime p ∧ r > 0 → (n = p^r ∨ n = 2*p^r) := sorry


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.algebra_map
import data.polynomial.degree.lemmas
import data.polynomial.monic

/-!
# Theory of monic polynomials

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

We define `integral_normalization`, which relate arbitrary polynomials to monic ones.
-/

open_locale big_operators polynomial

namespace polynomial
universes u v y
variables {R : Type u} {S : Type v} {a b : R} {m n : ℕ} {ι : Type y}

section integral_normalization

section semiring
variables [semiring R]

/-- If `f : R[X]` is a nonzero polynomial with root `z`, `integral_normalization f` is
a monic polynomial with root `leading_coeff f * z`.

Moreover, `integral_normalization 0 = 0`.
-/
noncomputable def integral_normalization (f : R[X]) : R[X] :=
∑ i in f.support, monomial i (if f.degree = i then 1 else
  coeff f i * f.leading_coeff ^ (f.nat_degree - 1 - i))

@[simp] lemma integral_normalization_zero :
  integral_normalization (0 : R[X]) = 0 :=
by simp [integral_normalization]

lemma integral_normalization_coeff {f : R[X]} {i : ℕ} :
  (integral_normalization f).coeff i =
    if f.degree = i then 1 else coeff f i * f.leading_coeff ^ (f.nat_degree - 1 - i) :=
have f.coeff i = 0 → f.degree ≠ i, from λ hc hd, coeff_ne_zero_of_eq_degree hd hc,
by simp [integral_normalization, coeff_monomial, this, mem_support_iff] {contextual := tt}

lemma integral_normalization_support {f : R[X]} :
  (integral_normalization f).support ⊆ f.support :=
by { intro, simp [integral_normalization, coeff_monomial, mem_support_iff] {contextual := tt} }

lemma integral_normalization_coeff_degree {f : R[X]} {i : ℕ} (hi : f.degree = i) :
  (integral_normalization f).coeff i = 1 :=
by rw [integral_normalization_coeff, if_pos hi]

lemma integral_normalization_coeff_nat_degree {f : R[X]} (hf : f ≠ 0) :
  (integral_normalization f).coeff (nat_degree f) = 1 :=
integral_normalization_coeff_degree (degree_eq_nat_degree hf)

lemma integral_normalization_coeff_ne_degree {f : R[X]} {i : ℕ} (hi : f.degree ≠ i) :
  coeff (integral_normalization f) i = coeff f i * f.leading_coeff ^ (f.nat_degree - 1 - i) :=
by rw [integral_normalization_coeff, if_neg hi]

lemma integral_normalization_coeff_ne_nat_degree
  {f : R[X]} {i : ℕ} (hi : i ≠ nat_degree f) :
  coeff (integral_normalization f) i = coeff f i * f.leading_coeff ^ (f.nat_degree - 1 - i) :=
integral_normalization_coeff_ne_degree (degree_ne_of_nat_degree_ne hi.symm)

lemma monic_integral_normalization {f : R[X]} (hf : f ≠ 0) :
  monic (integral_normalization f) :=
monic_of_degree_le f.nat_degree
  (finset.sup_le $ λ i h, with_bot.coe_le_coe.2 $
    le_nat_degree_of_mem_supp i $ integral_normalization_support h)
  (integral_normalization_coeff_nat_degree hf)

end semiring

section is_domain
variables [ring R] [is_domain R]

@[simp] lemma support_integral_normalization {f : R[X]} :
  (integral_normalization f).support = f.support :=
begin
  by_cases hf : f = 0, { simp [hf] },
  ext i,
  refine ⟨λ h, integral_normalization_support h, _⟩,
  simp only [integral_normalization_coeff, mem_support_iff],
  intro hfi,
  split_ifs with hi; simp [hfi, hi, pow_ne_zero _ (leading_coeff_ne_zero.mpr hf)]
end
end is_domain

section is_domain
variables [comm_ring R] [is_domain R]
variables [comm_semiring S]

lemma integral_normalization_eval₂_eq_zero {p : R[X]} (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  eval₂ f (z * f p.leading_coeff) (integral_normalization p) = 0 :=
calc eval₂ f (z * f p.leading_coeff) (integral_normalization p)
    = p.support.attach.sum
        (λ i, f (coeff (integral_normalization p) i.1 * p.leading_coeff ^ i.1) * z ^ i.1) :
      by { rw [eval₂, sum_def, support_integral_normalization],
           simp only [mul_comm z, mul_pow, mul_assoc, ring_hom.map_pow, ring_hom.map_mul],
           exact finset.sum_attach.symm }
... = p.support.attach.sum
        (λ i, f (coeff p i.1 * p.leading_coeff ^ (nat_degree p - 1)) * z ^ i.1) :
      begin
        by_cases hp : p = 0, { simp [hp] },
        have one_le_deg : 1 ≤ nat_degree p :=
          nat.succ_le_of_lt (nat_degree_pos_of_eval₂_root hp f hz inj),
        congr' with i,
        congr' 2,
        by_cases hi : i.1 = nat_degree p,
        { rw [hi, integral_normalization_coeff_degree, one_mul, leading_coeff, ←pow_succ,
              tsub_add_cancel_of_le one_le_deg],
          exact degree_eq_nat_degree hp },
        { have : i.1 ≤ p.nat_degree - 1 := nat.le_pred_of_lt (lt_of_le_of_ne
            (le_nat_degree_of_ne_zero (mem_support_iff.mp i.2)) hi),
          rw [integral_normalization_coeff_ne_nat_degree hi, mul_assoc, ←pow_add,
              tsub_add_cancel_of_le this] }
      end
... = f p.leading_coeff ^ (nat_degree p - 1) * eval₂ f z p :
      by { simp_rw [eval₂, sum_def, λ i, mul_comm (coeff p i), ring_hom.map_mul,
                    ring_hom.map_pow, mul_assoc, ←finset.mul_sum],
           congr' 1,
           exact @finset.sum_attach _ _ p.support _ (λ i, f (p.coeff i) * z ^ i) }
... = 0 : by rw [hz, _root_.mul_zero]

end is_domain

end integral_normalization

end polynomial


import linear_algebra.basic
import data.fintype.basic
import algebra.big_operators
import data.finset algebra.big_operators
import linear_algebra.basic linear_algebra.finite_dimensional
import algebra.module
import data.equiv.basic
universes u v w w'
infix ` * ` := linear_map.comp   ----  his there a standart notation ?
open linear_map
namespace TEST
variables {G : Type u } [group G][fintype G]  {R : Type v}[comm_ring R]
{M : Type w}  [add_comm_group M] [module R M]
          {M' : Type w'} [add_comm_group M'] [module R M']
          (φ : G → (M →ₗ[R]M'))
          (f : M' →ₗ[R]M')
          (g : M →ₗ[R]M)
variables (a : M →ₗ[R]M') (x : M)

@[simp]lemma Sum_map (x: M) :  f(finset.univ.sum (λ g, φ g x)) = finset.univ.sum (λ g, (f (φ g x))) := begin
    erw map_sum,
    --rw @map_sum R M' M' G _ _ _ _ _ f _  (λ g, φ g x),
end
@[simp]lemma Sum_apply (x : M) : (finset.sum finset.univ φ) x = (finset.sum finset.univ (λ g, φ g x)) := begin
    erw  sum_apply, --finset.univ φ x,
end
@[simp]lemma Sum_comp_left : f * (finset.univ.sum φ) = finset.univ.sum (λ g, (f * (φ g ))) := begin
    ext,rw linear_map.comp_apply, rw Sum_apply, rw Sum_apply, rw Sum_map, exact rfl,
end

lemma Sum_comp_right  :  (finset.univ.sum φ) * g = finset.univ.sum (λ s, ((φ s)  * g)) := begin
    ext, rw linear_map.comp_apply, erw sum_apply,erw sum_apply,exact rfl,
end
notation `Σ ` := finset.sum finset.univ
#check (@finset.univ G)
#check @map_sum R M' M' G _ _ _ _ _ f _  (λ g, φ g x)
/-
map_sum :
  ∀ {R : Type u_1} {M : Type u_2} {M₂ : Type u_3} {ι : Type u_4} [_inst_1 : ring R] [_inst_2 : add_comm_group M]
  [_inst_3 : add_comm_group M₂] [_inst_5 : module R M] [_inst_6 : module R M₂] (f : M →ₗ[R] M₂)
  {t : finset ι} {g : ι → M}, ⇑f (finset.sum t g) = finset.sum t (λ (i : ι), ⇑f (g i))
-/
end TEST

namespace TEST2
def Sum {R : Type u}[add_comm_monoid R]{X : Type v}[fintype X](g : X → R) : R  := finset.sum (finset.univ) g
notation `Σ` := finset.sum (finset.univ)
variables {G : Type u } [group G][fintype G]  {R : Type v}[comm_ring R]
{M : Type w}  [add_comm_group M] [module R M]
          {M' : Type w'} [add_comm_group M'] [module R M']
          (φ : G → (M →ₗ[R]M'))
          (f : M' →ₗ[R]M')
lemma Sum_comp_left : f * (Σ φ) = Σ  (λ g, (f * (φ g ))) := begin
    rw TEST.Sum_comp_left,
end
end TEST2


/-
Algebraic geometry lecture 1:

The union of two algebraic sets is an algebraic set.

Kevin Buzzard
-/

import affine_algebraic_set.basic -- the basic theory of affine algebraic sets.

/-!
# The union of two affine algebraic sets is affine.

Let k be a field and let n be a natural number. We prove the following
theorem in this file:

Theorem. If V and W are two affine algebraic subsets of kⁿ
then their union V ∪ W is also an affine algebraic subset of kⁿ.

Lean version:

`def union (V W : affine_algebraic_set k n) : affine_algebraic_set k n`

Maths proof: if V is cut out by the set S ⊆ k[X_1,X_2,…,X_n]
and W is cut out by T, then we claim V ∪ W is cut out by the set ST := { s*t | s ∈ S and t ∈ T}.
To prove that the set cut out by ST equals V ∪ W, we prove both inclusions separately.

One inclusion is very easy. If x ∈ V ∪ W then either every element of S vanishes at x or every
element of T vanishes on x, and either way every element of ST vanishes at x.

Conversely, if x vanishes at every element of ST, then we want to prove that x ∈ V ∪ W. If x is
in V then we're done. If not, then this means that there exists some s ∈ S with s(x) ≠ 0.
Then for every t ∈ T, we have s(x)t(x)=st(x)=0, and hence t(x)=0, which implies that x is in W.

## Implementation notes

I defined an affine algebraic set to be the zeros of an arbitrary
set of functions, as opposed to just a finite set. We will see later
on that these definitions are equivalent.

If V is an affine algebraic set, then V is a pair. The first
element of the pair is a subset V.carrier ⊆ kⁿ, but we will call this set V as well (there is
a coercion from affine algebraic sets to subsets of kⁿ).
The second element of the pair is the proof that there exists a subset S of k[X_1,X_2,...,X_n]
such that V is cut out by S, by which I mean that V is the set of x ∈ k^n which vanish
at each element of S.

## References

Martin Orr's lecture notes at https://homepages.warwick.ac.uk/staff/Martin.Orr/2017-8/alg-geom/

## Tags

algebraic geometry, algebraic variety
-/

-- end of docstring; code starts here.

-- We're proving theorems about affine algebraic sets so the names of the theorems
-- should start with "affine_algebraic_set".
namespace affine_algebraic_set

-- let k be a field
variables {k : Type*} [discrete_field k]

-- and let σ be any set e.g. {1,2,3,...,n}
variable {σ : Type*}

-- We're working with multivariable polynomials, so let's get access to their notation
open mv_polynomial

-- Now here's a basic fact about affine algebraic sets.

/-- The union of two algebraic subsets of kⁿ is an algebraic subset-/
def union (V W : affine_algebraic_set k σ) : affine_algebraic_set k σ :=
{ carrier := V ∪ W, -- the underlying set is the union of the two sets defining V and W
  is_algebraic' :=
  -- We now need to prove that the union of V and W is cut out by some set of polynomials.
  begin
    -- Now here's the bad news.

    -- Lean notation for kⁿ is `σ → k`.
    -- Lean notation for k[X₁, X₂, ..., Xₙ] is `mv_polynomial σ k`.
    -- Lean notation for the subsets of X is `set X`

    -- Let's state what we're trying to prove, using Lean's notation.
    show
    ∃ (U : set (mv_polynomial σ k)),
      -- such that
      (V : set _) ∪ W = 𝕍 U,
    -- say S is the set that defines V
    cases V.is_algebraic with S hS,
    -- and T is the set that defines W
    -- (slightly fancier way)
    rcases W.is_algebraic with ⟨T, hT⟩,
    -- Now reduce to an unwieldy precise statement about zeros of polynomials
    rw [hS, hT],
    -- Our goal is now to come up with a set U such that
    -- the zeros of U are exactly the union of the zeros of S and of T.
    -- Here's how to do it.
    use {u | ∃ (s ∈ S) (t ∈ T), u = s * t},
    -- The goal in maths is now
    -- ⋂ (s ∈ S) zeros(s) ∪ ⋂ (t ∈ T) zeros(t) = ⋂ (u ∈ ST) zeros(u).
    -- Lean manages to make quite a mess of its display of this.

    -- To prove that the affine algebraic set cut out by this collection of polynomials
    -- is precisely the set V ∪ W, we check both inclusions.
    apply set.subset.antisymm,
    { -- Here's the easier of the two inclusions.
      -- say x ∈ V ∪ W,
      intros x hx, rw mem_𝕍_iff,
      -- it's either in V or W.
      cases hx with hxV hxW,
      { -- Say x ∈ V
        -- We know that x vanishes at every element of S.
        rw mem_𝕍_iff at hxV,
        -- We want to prove x vanishes at every polynomial of the form s * t
        -- with s ∈ S and t ∈ T.
        -- so let's take an element u of the form s * t
        rintro u,
        -- Let's now notice that the goal has got completely out of hand, and
        -- simplify it back to ∀ s ∈ S and ∀ t ∈ T, (s * t)(x) = 0.
        suffices : ∀ s ∈ S, ∀ t ∈ T, u = s * t → u.eval x = 0,
        {rintros ⟨s, hsS, t, htT, rfl⟩, exact this s hsS t htT rfl},
        rintro s hs t ht rfl,
        -- we need to show st(x)=0.
        -- Because x ∈ V, we have s(x)=0.
        have hx := (hxV s) hs,
        change s.eval x = 0 at hx,
        -- It suffices to show s(x)*t(x)=0
        rw eval_mul,
        -- but s(x) = 0,
        rw hx,
        -- and now it's obvious
        apply zero_mul,
      },
      { -- This is the case x ∈ W and it's essentially completely the same as the x ∈ V argument so I won't
        -- comment it. Some sort of argument with the `wlog` tactic might be able to do this.
        rw mem_𝕍_iff at hxW,
        rintro u,
          suffices : ∀ s ∈ S, ∀ t ∈ T, u = s * t → u.eval x = 0,
          { rintros ⟨s, hsS, t, htT, rfl⟩, exact this s hsS t htT rfl},
        rintro s hs t ht rfl,
        have hx := hxW t,
        replace hx : eval x t = 0 := hx ht,
        rw eval_mul,
        rw hx, simp,
      }
    },
    { -- This is the harder way; we need to check that if x vanishes on every element of S*T,
      -- then x ∈ V or x ∈ W.
      intros x hx, rw mem_𝕍_iff at hx,
      have hx' : ∀ u s : mv_polynomial σ k, s ∈ S → ∀ t ∈ T, u = s * t → u.eval x = 0,
        simpa using hx,
      classical, -- We now proudly assume the law of the excluded middle.
      -- If x ∈ V then the result is easy...
      by_cases hx2 : x ∈ (V : set _),
        left, rwa ←hS,
      -- ...so we can assume assume x ∉ V,
      -- and hence that there's s ∈ S such that s(x) ≠ 0
      rw [hS, mem_𝕍_iff, not_forall] at hx2,
      cases hx2 with s hs,
      have hs2 : s ∈ S ∧ ¬eval x s = 0,
        simpa using hs,
      cases hs2 with hsS hns,
      -- we now show x ∈ W
      right,
      rw mem_𝕍_iff,
      -- Say t ∈ T
      intro t,
      -- We want to prove that t(x) = 0.
      suffices : t ∈ T → eval x t = 0,
        simpa,
      intro ht,
      -- Now by assumption, x vanishes on s * t.
      replace hx' := hx' (s * t) s hsS t ht rfl,
      -- so s(x) * t(x) = 0
      rw eval_mul at hx',
      -- so either s(x) or t(x) = 0, but we chose s such that s(x) ≠ 0.
      cases mul_eq_zero.1 hx' with hxs hxt,
        -- So the case s(x) = 0 is a contradiction
        contradiction,
      -- and t(x) = 0 is what we wanted to prove
      assumption
    }
  end
}
end affine_algebraic_set


import game.world7.level6 -- hide
/-
# Advanced proposition world.

## Level 7: `or_symm`

Proving that $(P\lor Q)\implies(Q\lor P)$ involves an element of danger.
`intro h,` is the obvious start. But now,
even though the goal is an `∨` statement, both `left` and `right` put
you in a situation with an impossible goal. Fortunately, after `intro h,`
you can do `cases h with p q`. Then something new happens: because
there are two ways to prove `P ∨ Q` (namely, proving `P` or proving `Q`),
the `cases` tactic turns one goal into two, one for each case. You should
be able to make it home from there.
-/

/- Lemma
If $P$ and $Q$ are true/false statements, then
$$P\lor Q\implies Q\lor P.$$
-/
lemma or_symm (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
  intro h,
  cases h with p q,
    right,
    exact p,
  left,
  exact q,

end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.uniform_space.completion
import topology.metric_space.isometry
import topology.instances.real

/-!
# The completion of a metric space

Completion of uniform spaces are already defined in `topology.uniform_space.completion`. We show
here that the uniform space completion of a metric space inherits a metric space structure,
by extending the distance to the completion and checking that it is indeed a distance, and that
it defines the same uniformity as the already defined uniform structure on the completion
-/

open set filter uniform_space metric
open_locale filter topological_space uniformity
noncomputable theory

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

namespace uniform_space.completion

/-- The distance on the completion is obtained by extending the distance on the original space,
by uniform continuity. -/
instance : has_dist (completion α) :=
⟨completion.extension₂ dist⟩

/-- The new distance is uniformly continuous. -/
protected lemma uniform_continuous_dist :
  uniform_continuous (λp:completion α × completion α, dist p.1 p.2) :=
uniform_continuous_extension₂ dist

/-- The new distance is continuous. -/
protected lemma continuous_dist [topological_space β] {f g : β → completion α} (hf : continuous f)
  (hg : continuous g) :
  continuous (λ x, dist (f x) (g x)) :=
completion.uniform_continuous_dist.continuous.comp (hf.prod_mk hg : _)

/-- The new distance is an extension of the original distance. -/
@[simp] protected lemma dist_eq (x y : α) : dist (x : completion α) y = dist x y :=
completion.extension₂_coe_coe uniform_continuous_dist _ _

/- Let us check that the new distance satisfies the axioms of a distance, by starting from the
properties on α and extending them to `completion α` by continuity. -/
protected lemma dist_self (x : completion α) : dist x x = 0 :=
begin
  apply induction_on x,
  { refine is_closed_eq _ continuous_const,
    exact completion.continuous_dist continuous_id continuous_id },
  { assume a,
    rw [completion.dist_eq, dist_self] }
end

protected lemma dist_comm (x y : completion α) : dist x y = dist y x :=
begin
  apply induction_on₂ x y,
  { exact is_closed_eq (completion.continuous_dist continuous_fst continuous_snd)
      (completion.continuous_dist continuous_snd continuous_fst) },
  { assume a b,
    rw [completion.dist_eq, completion.dist_eq, dist_comm] }
end

protected lemma dist_triangle (x y z : completion α) : dist x z ≤ dist x y + dist y z :=
begin
  apply induction_on₃ x y z,
  { refine is_closed_le _ (continuous.add _ _);
      apply_rules [completion.continuous_dist, continuous.fst, continuous.snd, continuous_id] },
  { assume a b c,
    rw [completion.dist_eq, completion.dist_eq, completion.dist_eq],
    exact dist_triangle a b c }
end

/-- Elements of the uniformity (defined generally for completions) can be characterized in terms
of the distance. -/
protected lemma mem_uniformity_dist (s : set (completion α × completion α)) :
  s ∈ 𝓤 (completion α) ↔ (∃ε>0, ∀{a b}, dist a b < ε → (a, b) ∈ s) :=
begin
  split,
  { /- Start from an entourage `s`. It contains a closed entourage `t`. Its pullback in `α` is an
    entourage, so it contains an `ε`-neighborhood of the diagonal by definition of the entourages
    in metric spaces. Then `t` contains an `ε`-neighborhood of the diagonal in `completion α`, as
    closed properties pass to the completion. -/
    assume hs,
    rcases mem_uniformity_is_closed hs with ⟨t, ht, ⟨tclosed, ts⟩⟩,
    have A : {x : α × α | (coe (x.1), coe (x.2)) ∈ t} ∈ uniformity α :=
      uniform_continuous_def.1 (uniform_continuous_coe α) t ht,
    rcases mem_uniformity_dist.1 A with ⟨ε, εpos, hε⟩,
    refine ⟨ε, εpos, λx y hxy, _⟩,
    have : ε ≤ dist x y ∨ (x, y) ∈ t,
    { apply induction_on₂ x y,
      { have : {x : completion α × completion α | ε ≤ dist (x.fst) (x.snd) ∨ (x.fst, x.snd) ∈ t}
               = {p : completion α × completion α | ε ≤ dist p.1 p.2} ∪ t, by ext; simp,
        rw this,
        apply is_closed.union _ tclosed,
        exact is_closed_le continuous_const completion.uniform_continuous_dist.continuous },
      { assume x y,
        rw completion.dist_eq,
        by_cases h : ε ≤ dist x y,
        { exact or.inl h },
        { have Z := hε (not_le.1 h),
          simp only [set.mem_set_of_eq] at Z,
          exact or.inr Z }}},
    simp only [not_le.mpr hxy, false_or, not_le] at this,
    exact ts this },
  { /- Start from a set `s` containing an ε-neighborhood of the diagonal in `completion α`. To show
    that it is an entourage, we use the fact that `dist` is uniformly continuous on
    `completion α × completion α` (this is a general property of the extension of uniformly
    continuous functions). Therefore, the preimage of the ε-neighborhood of the diagonal in ℝ
    is an entourage in `completion α × completion α`. Massaging this property, it follows that
    the ε-neighborhood of the diagonal is an entourage in `completion α`, and therefore this is
    also the case of `s`. -/
    rintros ⟨ε, εpos, hε⟩,
    let r : set (ℝ × ℝ) := {p | dist p.1 p.2 < ε},
    have : r ∈ uniformity ℝ := metric.dist_mem_uniformity εpos,
    have T := uniform_continuous_def.1 (@completion.uniform_continuous_dist α _) r this,
    simp only [uniformity_prod_eq_prod, mem_prod_iff, exists_prop,
               filter.mem_map, set.mem_set_of_eq] at T,
    rcases T with ⟨t1, ht1, t2, ht2, ht⟩,
    refine mem_of_superset ht1 _,
    have A : ∀a b : completion α, (a, b) ∈ t1 → dist a b < ε,
    { assume a b hab,
      have : ((a, b), (a, a)) ∈ t1 ×ˢ t2 := ⟨hab, refl_mem_uniformity ht2⟩,
      have I := ht this,
      simp [completion.dist_self, real.dist_eq, completion.dist_comm] at I,
      exact lt_of_le_of_lt (le_abs_self _) I },
    show t1 ⊆ s,
    { rintros ⟨a, b⟩ hp,
      have : dist a b < ε := A a b hp,
      exact hε this }}
end

/-- If two points are at distance 0, then they coincide. -/
protected lemma eq_of_dist_eq_zero (x y : completion α) (h : dist x y = 0) : x = y :=
begin
  /- This follows from the separation of `completion α` and from the description of
  entourages in terms of the distance. -/
  have : separated_space (completion α) := by apply_instance,
  refine separated_def.1 this x y (λs hs, _),
  rcases (completion.mem_uniformity_dist s).1 hs with ⟨ε, εpos, hε⟩,
  rw ← h at εpos,
  exact hε εpos
end

/-- Reformulate `completion.mem_uniformity_dist` in terms that are suitable for the definition
of the metric space structure. -/
protected lemma uniformity_dist' :
  𝓤 (completion α) = (⨅ε:{ε : ℝ // 0 < ε}, 𝓟 {p | dist p.1 p.2 < ε.val}) :=
begin
  ext s, rw mem_infi_of_directed,
  { simp [completion.mem_uniformity_dist, subset_def] },
  { rintro ⟨r, hr⟩ ⟨p, hp⟩, use ⟨min r p, lt_min hr hp⟩,
    simp [lt_min_iff, (≥)] {contextual := tt} }
end

protected lemma uniformity_dist :
  𝓤 (completion α) = (⨅ ε>0, 𝓟 {p | dist p.1 p.2 < ε}) :=
by simpa [infi_subtype] using @completion.uniformity_dist' α _

/-- Metric space structure on the completion of a pseudo_metric space. -/
instance : metric_space (completion α) :=
{ dist_self          := completion.dist_self,
  eq_of_dist_eq_zero := completion.eq_of_dist_eq_zero,
  dist_comm          := completion.dist_comm,
  dist_triangle      := completion.dist_triangle,
  to_uniform_space   := by apply_instance,
  uniformity_dist    := completion.uniformity_dist }

/-- The embedding of a metric space in its completion is an isometry. -/
lemma coe_isometry : isometry (coe : α → completion α) :=
isometry_emetric_iff_metric.2 completion.dist_eq

@[simp] protected lemma edist_eq (x y : α) : edist (x : completion α) y = edist x y :=
coe_isometry x y

end uniform_space.completion


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import data.stream.basic
import tactic
import data.nat.gcd
/-!
# The Fibonacci Sequence

## Summary

Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`.

## Main Definitions

- `fib` returns the stream of Fibonacci numbers.

## Main Statements

- `fib_succ_succ` : shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.`.
- `fib_gcd`       : `fib n` is a strong divisibility sequence.

## Implementation Notes

For efficiency purposes, the sequence is defined using `stream.iterate`.

## Tags

fib, fibonacci
-/

namespace nat

/-- Auxiliary function used in the definition of `fib_aux_stream`. -/
private def fib_aux_step : (ℕ × ℕ) → (ℕ × ℕ) := λ p, ⟨p.snd, p.fst + p.snd⟩

/-- Auxiliary stream creating Fibonacci pairs `⟨Fₙ, Fₙ₊₁⟩`. -/
private def fib_aux_stream : stream (ℕ × ℕ) := stream.iterate fib_aux_step ⟨0, 1⟩

/--
Implementation of the fibonacci sequence satisfying
`fib 0 = 0, fib 1 = 1, fib (n + 2) = fib n + fib (n + 1)`.

*Note:* We use a stream iterator for better performance when compared to the naive recursive
implementation.
-/
@[pp_nodot]
def fib (n : ℕ) : ℕ := (fib_aux_stream n).fst

@[simp] lemma fib_zero : fib 0 = 0 := rfl
@[simp] lemma fib_one : fib 1 = 1 := rfl
@[simp] lemma fib_two : fib 2 = 1 := rfl

private lemma fib_aux_stream_succ {n : ℕ} :
    fib_aux_stream (n + 1) = fib_aux_step (fib_aux_stream n) :=
begin
  change (stream.nth (n + 1) $ stream.iterate fib_aux_step ⟨0, 1⟩) =
      fib_aux_step (stream.nth n $ stream.iterate fib_aux_step ⟨0, 1⟩),
  rw [stream.nth_succ_iterate, stream.map_iterate, stream.nth_map]
end

/-- Shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.` -/
lemma fib_succ_succ {n : ℕ} : fib (n + 2) = fib n + fib (n + 1) :=
by simp only [fib, fib_aux_stream_succ, fib_aux_step]

lemma fib_pos {n : ℕ} (n_pos : 0 < n) : 0 < fib n :=
begin
  induction n with n IH,
  case nat.zero { norm_num at n_pos },
  case nat.succ
  { cases n,
    case nat.zero { simp [fib_succ_succ, zero_lt_one] },
    case nat.succ
    { have : 0 ≤ fib n, by simp,
      exact (lt_add_of_nonneg_of_lt this $ IH n.succ_pos) }}
end

lemma fib_le_fib_succ {n : ℕ} : fib n ≤ fib (n + 1) := by { cases n; simp [fib_succ_succ] }

@[mono] lemma fib_mono : monotone fib :=
monotone_of_monotone_nat $ λ _, fib_le_fib_succ

/-- `fib (n + 2)` is strictly monotone. -/
lemma fib_add_two_strict_mono : strict_mono (λ n, fib (n + 2)) :=
strict_mono.nat $ λ n, lt_add_of_pos_left _ $ fib_pos succ_pos'

lemma le_fib_self {n : ℕ} (five_le_n : 5 ≤ n) : n ≤ fib n :=
begin
  induction five_le_n with n five_le_n IH,
  { have : 5 = fib 5, by refl,  -- 5 ≤ fib 5
    exact le_of_eq this },
  { -- n + 1 ≤ fib (n + 1) for 5 ≤ n
    cases n with n', -- rewrite n = succ n' to use fib.succ_succ
    { have : 5 = 0, from nat.le_zero_iff.elim_left five_le_n, contradiction },
    rw fib_succ_succ,
    suffices : 1 + (n' + 1) ≤ fib n' + fib (n' + 1), by rwa [nat.succ_eq_add_one, add_comm],
    have : n' ≠ 0, by { intro h, have : 5 ≤ 1, by rwa h at five_le_n, norm_num at this },
    have : 1 ≤ fib n', from nat.succ_le_of_lt (fib_pos $ pos_iff_ne_zero.mpr this),
    mono }
end

/-- Subsequent Fibonacci numbers are coprime,
  see https://proofwiki.org/wiki/Consecutive_Fibonacci_Numbers_are_Coprime -/
lemma fib_coprime_fib_succ (n : ℕ) : nat.coprime (fib n) (fib (n + 1)) :=
begin
  unfold coprime,
  induction n with n ih,
  { simp },
  { convert ih using 1,
    rw [fib_succ_succ, succ_eq_add_one, gcd_rec, add_mod_right, gcd_comm (fib n),
      gcd_rec (fib (n + 1))], }
end

/-- See https://proofwiki.org/wiki/Fibonacci_Number_in_terms_of_Smaller_Fibonacci_Numbers -/
lemma fib_add (m n : ℕ) :
  fib m * fib n + fib (m + 1) * fib (n + 1) = fib (m + n + 1) :=
begin
  induction n with n ih generalizing m,
  { simp },
  { intros,
    specialize ih (m + 1),
    rw [add_assoc m 1 n, add_comm 1 n] at ih,
    simp only [fib_succ_succ, ← ih],
    ring, }
end

lemma gcd_fib_add_self (m n : ℕ) : gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n) :=
begin
  cases eq_zero_or_pos n,
  { rw h, simp },
  replace h := nat.succ_pred_eq_of_pos h, rw [← h, succ_eq_add_one],
  calc gcd (fib m) (fib (n.pred + 1 + m))
        = gcd (fib m) (fib (n.pred) * (fib m) + fib (n.pred + 1) * fib (m + 1)) :
    by { rw fib_add n.pred _, ring_nf }
    ... = gcd (fib m) (fib (n.pred + 1) * fib (m + 1)) :
    by rw [add_comm, gcd_add_mul_self (fib m) _ (fib (n.pred))]
    ... = gcd (fib m) (fib (n.pred + 1)) :
    coprime.gcd_mul_right_cancel_right
      (fib (n.pred + 1)) (coprime.symm (fib_coprime_fib_succ m))
end

lemma gcd_fib_add_mul_self (m n : ℕ) : ∀ k, gcd (fib m) (fib (n + k * m)) = gcd (fib m) (fib n)
| 0     := by simp
| (k+1) := by rw [← gcd_fib_add_mul_self k, add_mul, ← add_assoc, one_mul, gcd_fib_add_self _ _]

/-- `fib n` is a strong divisibility sequence,
  see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/

lemma fib_dvd (m n : ℕ) (h : m ∣ n) : fib m ∣ fib n :=
by rwa [gcd_eq_left_iff_dvd, ← fib_gcd, gcd_eq_left_iff_dvd.mp]

end nat


import tactic
import data.real.irrational

def rational (x : ℝ) :=
  ∃ (a b : ℤ), x = a / b

/-- For a, b rational and x irrational, if (x+a)/(x+b) is rational, then a = b. -/
lemma part_a (a : ℚ) (b : ℚ) (x : ℝ) (hx : irrational x) : rational ((x + a) / (x + b)) → a = b :=
begin
  sorry
end

/-- For x, y rational such that (x^2 + x + √2)/(y^2 + y + √2) is rational, either x = y or x + y = -1. -/
lemma part_b (x : ℚ) (y : ℚ) (h : rational ((x^2 + x + real.sqrt 2)/(y^2 + y + real.sqrt 2))) : x = y ∨ x + y = -1 :=
begin
  sorry
end


namespace TBA

-- Let's work with some inductive types other than `Nat`!

-- Here is our very own definition of `List`:
inductive List (α : Type) where
  | nil : List α
  | cons (head : α) (tail : List α) : List α

notation  (priority := high) "[" "]" => List.nil   -- `[]`
infixr:67 (priority := high) " :: "  => List.cons  -- `a :: as`

-- as a warmup exercise, let's define concatenation of two lists
def append (as bs : List α) : List α := _

infixl:65 (priority := high) " ++ " => append

example : 1::2::[] ++ 3::4::[] = 1::2::3::4::[] := rfl

-- as with associativity on `Nat`, think twice about what induction variable to use!
theorem append_assoc {as bs cs : List α} : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by

open Decidable

/-
One important special case of `Decidable` is decidability of equalities:
```
abbrev DecidableEq (α : Type) :=
  (a b : α) → Decidable (a = b)

def decEq [s : DecidableEq α] (a b : α) : Decidable (a = b) :=
  s a b
```
Note: `DecidableEq` is defined using `abbrev` instead of `def` because typeclass resolution only
unfolds the former for performance reasons.

Let's try to prove that `List` equality is decidable!
-/
-- hint: Something is still missing. Do we need to assume anything about `α`?
-- hint: Apply `match` case distinctions until the the appropriate `Decidable` constructor is clear,
--   then fill in its proof argument with `by`.
--   We could also do everything in a `by` block, but it's nicer to reserve tactics for proofs so we have
--   more control about the code of programs, i.e. the part that is actually executed
def ldecEq  (as bs : List α) : Decidable (as = bs) := _

-- Let's declare the instance:
instance  : DecidableEq (List α) := _

-- This should now work:
#eval decEq (1::2::[]) (1::3::[])

/-
`DecidabePred` is another convenient abbreviation of `Decidable`
```
abbrev DecidablePred (r : α → Prop) :=
  (a : α) → Decidable (r a)
```
If we have `[DecidablePred p]`, we can e.g. use `if p a then ...` for some `a : α`.

`filter p as` is a simple list function that should remove all elements `a` for which `p a` does not hold.
-/
def filter (p : α → Prop) [DecidablePred p] (as : List α) : List α := _

example : filter (fun x => x % 2 = 0) (1::2::3::4::[]) = 2::4::[] := rfl

variable {p : α → Prop} [DecidablePred p] {as bs : List α}

-- These helper theorems can be useful, also for manual rewriting
@[simp] theorem filter_cons_true (h : p a) : filter p (a :: as) = a :: filter p as :=
  by simp [filter, h]
@[simp] theorem filter_cons_false (h : ¬ p a) : filter p (a :: as) = filter p as :=
  by simp [filter, h]
-- It's worthwhile thinking about what's actually happening here:
-- * first, `filter p (a :: as)` is unfolded to `if p a then a :: filter p as else filter p as`
--   (note that the second `filter` cannot be unfolded)
-- * then `if p a then ...` is rewritten to `if True then ...` using `h`
-- * finally, `if True then a :: filter p as else ...` is rewritten to `a :: filter p as` using
--   the built-in simp theorem `Lean.Simp.ite_True`

-- useful tactic: `byCases h : q` for a decidable proposition `q`
theorem filter_idem : filter p (filter p as) = filter p as := by

theorem filter_append : filter p (as ++ bs) = filter p as ++ filter p bs := by

-- list membership as an inductive predicate:
inductive Mem (a : α) : List α → Prop where
  -- either it's the first element...
  | head {as} : Mem a (a::as)
  -- or it's in the remainder list
  | tail {as} : Mem a as → Mem a (a'::as)

infix:50 " ∈ " => Mem

-- recall that `a ≠ b` is the same as `a = b → False`
theorem mem_of_nonempty_filter (h : ∀ a, p a → a = x) : filter p as ≠ [] → x ∈ as := by

-- This proof is pretty long! Some hints:
-- * If you have an assumption `h : a ∈ []`, you can solve the current goal by `cases h`:
--   since there is no constructor that could possibly match `[]`, there is nothing left to prove!
--   This exclusion of cases, and case analysis on inductive predicates in general,
--   is also called *rule inversion* since we (try to) apply the introduction rules (constructors)
--   "in reverse".
-- * On the other hand, if you try to do case analysis on a proof of e.g. `a ∈ filter p as`,
--   Lean will complain with "dependent elimination failed" since it *doesn't* know yet if
--   the argument `filter p as` is of the form `_ :: _` as demanded by the `Mem` constructors.
--   You need to get the assumption into the shape `_ ∈ []` or `_ ∈ _ :: _` before applying
--   `(no)match/cases` to it.
theorem mem_filter : a ∈ filter p as ↔ a ∈ as ∧ p a := _

-- Here is an alternative definition of list membership via `append`
inductive Mem' (a : α) : List α → Prop where
  | intro (as bs) : Mem' a (as ++ (a :: bs))

infix:50 " ∈' " => Mem'

-- Let's prove that they are equivalent!
theorem mem_mem' : a ∈ as ↔ a ∈' as := _

end TBA


import ..lovelib
import ..lectures.love01_definitions_and_statements_demo
import .love06_hw_support_file

/-! # LoVe Homework 6: Operational and Denotational Semantics

Homework must be done individually.

This homework corresponds to chapters 8 and 10 of the HHG. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (4 points): Semantics of the REPEAT Language

We again consider the REPEAT language from the previous homework sheet: -/

inductive stmt : Type
| skip   : stmt
| assign : string → (state → ℕ) → stmt
| seq    : stmt → stmt → stmt
| unless : (state → Prop) → stmt → stmt
| repeat : ℕ → stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/-! Recall the following intuitive description of its semantics:

The `skip`, `assign`, and `S ;; T` statements have the same syntax and
semantics as in the WHILE language.

The `unless b S` statement executes `S` unless `b` is true—i.e., it executes `S`
if `b` is false. Otherwise, `unless b S` does nothing. This construct is
inspired by the Perl language.

The `repeat n S` statement executes `S` exactly `n` times. Thus, `repeat 5 S`
has the same effect as `S ;; S ;; S ;; S ;; S` (as far as the big-step semantics
is concerned), and `repeat 0 S` has the same effect as `skip`.

1.1 (2 points). Complete the following definition of a small-step semantics for
REPEAT: -/

inductive small_step : stmt × state → stmt × state → Prop
| assign {x a s} :
  small_step (stmt.assign x a, s) (stmt.skip, s{x ↦ a s})
-- enter the missing cases here

infixr (name := small_step_hw) ` ⇒ ` := small_step
infixr ` ⇒* ` : 100 := star small_step

/-! 1.2 (1 point). We will now attempt to prove termination of the REPEAT
language. More precisely, we will show that there cannot be infinite chains of
the form

    `(S₀, s₀) ⇒ (S₁, s₁) ⇒ (S₂, s₂) ⇒ ⋯`

Towards this goal, you are asked to define a __measure__ function: a function
`mess` that takes a statement `S` and that returns a natural number indicating
how "big" the statement is. The measure should be defined so that it strictly
decreases with each small-step transition. -/

def mess : stmt → ℕ
| stmt.skip         := 0
-- enter the missing cases here

/-! 1.3 (1 point). Prove that the measure decreases with each small-step
transition. If necessary, revise your answer to question 1.3. -/

lemma small_step_mess_decreases {Ss Tt : stmt × state} (h : Ss ⇒ Tt) :
  mess (prod.fst Ss) > mess (prod.fst Tt) :=
sorry

/-! ## Question 2 (6 points): Denotational Semantics of DOWHILE -/

namespace do_while

/-! Consider the following DOWHILE language: -/

inductive stmt : Type
| skip     : stmt
| assign   : string → (state → ℕ) → stmt
| seq      : stmt → stmt → stmt
| unless   : stmt → (state → Prop) → stmt
| while    : (state → Prop) → stmt → stmt
| do_while : stmt → (state → Prop) → stmt

infixr (name := dowhile_seq) ` ;; ` : 90 := stmt.seq

/-! The `skip`, `assign`, `seq`, and `while` constructs are as for the WHILE
language.

`unless S b` executes `S` if `b` is false in the current state; otherwise, it
does nothing. This statement is inspired by Perl's `unless` conditional.

`do_while S b` first executes `S`. Then, if `b` is true in the resulting state,
it re-enters the loop and executes `S` again, and continues executing `S` until
`b` becomes `false`. The semantics is almost the same as `while b S`, except
that `p` is always executed at least once, even if the condition is not true
initially. This statement is inspired by C's and Java's `do { … } while (…)`
loop.

2.1 (1 point). Give a denotational semantics of DOWHILE.

Hint: Your definition should make it easy to prove lemma `do_while_while` in
question 1.2. -/

def denote : stmt → set (state × state)
| stmt.skip           := Id
| (stmt.assign x a) :=
  {st | prod.snd st = (prod.fst st){x ↦ a (prod.fst st)}}
| (stmt.seq S T)    := denote S ◯ denote T
| (stmt.while b S)    :=
  lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s)))
-- enter the missing cases here

notation (name := denote_hw) `⟦` S `⟧`:= denote S

/-! 2.2 (1 point). Prove the following correspondence between `do_while` and
`while`. -/

lemma do_while_while (S : stmt) (b : state → Prop) :
  ⟦stmt.do_while S b⟧ = ⟦S⟧ ◯ ⟦stmt.while b S⟧ :=
sorry

/-! 2.3 (4 points). Prove the following lemmas.

Hint: For all of these, short proofs are possible. It may help, however, to
know what basic expressions such as `p ⇃ (λx, false)` and `p ⇃ (λx, true)` mean.
Make sure to simplify the expressions involving `⇃` before trying to figure out
what to do about `lfp`. -/

lemma lfp_const {α : Type} [complete_lattice α] (a : α) :
  lfp (λX, a) = a :=
sorry

lemma while_false (S : stmt) :
  ⟦stmt.while (λ_, false) S⟧ = Id :=
sorry

lemma comp_Id {α : Type} (r : set (α × α)) :
  r ◯ Id = r :=
sorry

lemma do_while_false (S : stmt) :
  ⟦stmt.do_while S (λ_, false)⟧ = ⟦S⟧ :=
sorry

end do_while

/-! **Note: Everything below this line in this file is entirely optional.**

Since this homework sheet spans three chapters' worth of material, there's a lot
we weren't able to cover in the questions above. So, for those who are
interested and have the time, we provide below two optional questions that
address some interesting extensions of this content.

Question 4 explores another way of viewing fixpoints using iterated function
application. This is a deeper dive into some of the more mathematical topics we
discussed with regard to denotational semantics.

Question 5 explores how we formally represent a functional programming language
with a strong type system. This problem offers a look at some new ideas about,
and properties of, small-step semantics, and it connects to concepts about
typing judgments from the beginning of the semester.

All of these questions are optional, but we encourage you to try some problems
that pique your interest! -/

/-! ## Question 3: Kleene's Theorem

We can compute the fixpoint by iteration by taking the union of all finite
iterations of `f`:

    `lfp f = ⋃i, (f ^^ i) ∅`

where

    `f ^^ i = f ∘ ⋯ ∘ f`

iterates the function `f` `i` times. However, the above characterization of
`lfp` only holds for continuous functions, a concept we will introduce below. -/

def iterate {α : Type} (f : α → α) : ℕ → α → α
| 0       a := a
| (n + 1) a := f (iterate n a)

notation f`^^`n := iterate f n

/-! 3.1. Fill in the missing proofs below.

Hint: Bear in mind that `≤` works on lattices in general, including sets. On
sets, it can be unfolded to `⊆` using `simp [(≤)]`. Moreover, when you see
`h : A ⊆ B` in a goal, you can imagine that you have `?a ∈ A → ?a ∈ B` by
definition, or unfold the definition using `simp [(⊆), set.subset]`. -/

def Union {α : Type} (s : ℕ → set α) : set α :=
{a | ∃n, a ∈ s n}

lemma Union_le {α : Type} {s : ℕ → set α} (A : set α) (h : ∀i, s i ≤ A) :
  Union s ≤ A :=
sorry

/-! A continuous function `f` is a function that commutes with the union of any
monotone sequence `s`: -/

def continuous {α : Type} (f : set α → set α) : Prop :=
∀s : ℕ → set α, monotone s → f (Union s) = Union (λi, f (s i))

/-! We need to prove that each continuous function is monotone. To achieve this,
we will need the following sequence: -/

def bi_seq {α : Type} (A B : set α) : ℕ → set α
| 0       := A
| (n + 1) := B

/-! For example, `bi_seq A B` is the sequence A, B, B, B, …. -/

lemma monotone_bi_seq {α : Type} (A B : set α) (h : A ≤ B) :
  monotone (bi_seq A B)
| 0       0       _ := le_refl _
| 0       (n + 1) _ := h
| (n + 1) (m + 1) _ := le_refl _

lemma Union_bi_seq {α : Type} (A B : set α) (ha : A ≤ B) :
  Union (bi_seq A B) = B :=
begin
  apply le_antisymm,
  { sorry },
  { sorry }
end

lemma monotone_of_continuous {α : Type} (f : set α → set α)
    (hf : continuous f) :
  monotone f :=
sorry

/-! 3.2. Provide the following proof, using a similar case
distinction as for `monotone_bi_seq` above. -/

lemma monotone_iterate {α : Type} (f : set α → set α) (hf : monotone f) :
  monotone (λi, (f ^^ i) ∅) :=
sorry

/-! 3.3. Prove the main theorem. A proof sketch is given below.

We break the proof into two proofs of inclusion.

Case 1. `lfp f ≤ Union (λi, (f ^^ i) ∅)`: The key is to use the lemma `lfp_le`
together with continuity of `f`.

Case 2. `Union (λi, (f ^^ i) ∅) ≤ lfp f`: The lemma `Union_le` gives us a
natural number `i`, on which you can perform induction. We also need the lemma
`lfp_eq` to unfold one iteration of `lfp f`. -/

lemma lfp_Kleene {α : Type} (f : set α → set α) (hf : continuous f) :
  lfp f = Union (λi, (f ^^ i) ∅) :=
sorry

/- ## Question 4 (optional): A Typed, Functional Language

Up to this point, we've considered imperative languages without explicit type
systems. In this problem, we'll look at a simple example of a strongly typed
functional language and the strong guarantees we can make about its correctness.

When specifying a typed language, we are concerned with two core elements: its
*statics* and its *dynamics*. (This terminology is due to Robert Harper.) The
statics of a language are the specification of the language components that are
processed "at compile-time," prior to the execution of code. In particular, this
includes the assignment of types to terms. The dynamics of a language specify
how the language behaves at runtime; in the case of our functional language,
this will comprise a small-step operational semantics. Crucially, the statics
and dynamics must *cohere* -- be "compatible" in an appropriate sense -- to
ensure that our language is *type-safe*. (For instance, our language shouldn't
allow us to write an expression of type `τ` only for it to evaluate to an
expression of type `τ'`.) We will see two key properties for ensuring coherence:
*progress* and *preservation*.

Below, we define the abstract syntax of a simple language of *b*inary and
*n*umerical *exp*ressions (`bnexp`). It consists of two boolean constructors
(`true` and `false`), two natural-number constructors (`zero` and `succ`), two
function values (`isZero` and `double`, which behave as their names suggest),
and function application (`app`).

Some possible expressions in our language, rendered in our Lean representation,
are:
- `true` (a boolean value)
- `isZero` (a function value)
- `app double zero` (applying the function `double` to the value `zero`; in a
  standard concrete syntax, this would usually look like `double zero`)
- `app isZero (app succ zero)` (applying the function `isZero` to the result of
  applying `succ` to `zero`; this would usually be written `isZero (succ zero)`
  in standard functional syntax) -/

inductive bnexp
| true : bnexp
| false : bnexp
| zero : bnexp
| succ : bnexp
| isZero : bnexp
| double : bnexp
| app : bnexp → bnexp → bnexp

/-! We will first consider our language's statics: that is, how do we assign
types to (valid) terms in our language?

To start, we need to define the types we're working with. We define below
the types in our language's type system, of which there are three: a type of
`number`s, a type of `boolean`s, and the type `arrow τ₁ τ₂` (for any types `τ₁`
and `τ₂`) representing functions from `τ₁` to `τ₂` (akin to the Lean type
`τ₁ → τ₂`). Notice that our types are represented by an inductive (Lean) type,
just like our syntax. -/

inductive bntp
| number : bntp
| boolean : bntp
| arrow : bntp → bntp → bntp

namespace bnexp

open bntp

/-! Now that we've defined our types, we need to assign them to terms. That is,
we must define our language's statics by defining the *typing judgment* for our
language, represented by the `has_type` predicate. The constructors of
`has_type` are known as *rules* and specify different ways to assign types to
terms. (Recall that we saw some typing rules for Lean, like `Cst` and `App`,
back in Chapter 1!) Any expression assigned a type by these rules is considered
*well-typed*; we call *ill-typed* any expression `e` for which there exists no
type `τ` such that `has_type e τ` holds.

5.1. Complete the definition of `has_type` by filling in the `sorry`s below.

Note: The rest of this problem depends on the correctness of your answer.
Because of this, we provide the correct solution as a comment below. We
nevertheless encourage you to try this problem on your own before checking your
work! -/

inductive has_type : bnexp → bntp → Prop
| true : has_type true boolean
| false : has_type false sorry
| zero : has_type zero sorry
| succ : has_type succ (arrow number number)
| isZero : has_type isZero sorry
| double : has_type double sorry
| app {f x τ'} (τ) :
  has_type f (arrow τ τ') → has_type x sorry → has_type (app f x) sorry

-- Solution to 4.1:
--------------------------------------------------------------------------------
-- inductive has_type : bnexp → bntp → Prop
-- | true : has_type true boolean
-- | false : has_type false boolean
-- | zero : has_type zero number
-- | succ : has_type succ (arrow number number)
-- | isZero : has_type isZero (arrow number boolean)
-- | double : has_type double (arrow number number)
-- | app {f x τ'} (τ) :
--   has_type f (arrow τ τ') → has_type x τ → has_type (app f x) τ'
--------------------------------------------------------------------------------

-- We define notational shorthand for typing judgments: we can write `e :: τ`
-- instead of `has_type e τ`
local notation (name := bnexp_has_tp) e ` :: ` τ := has_type e τ

/-! Now that we have defined how to assign types to terms, we can identify the
types of various expressions in our language.

5.2. Provide a **forward proof** (either structured or a proof term) of the fact
that the expression `isZero (succ zero)`, as represented in our `bnexp` type,
has type `boolean`. -/

lemma type_isZero_succ_zero : app isZero (app succ zero) :: boolean :=
sorry

/-! 4.3. Prove that, given any expression `e` of type `number`, the expression
`succ (succ (double e))` has type `number`. (Feel free to use tactic mode in
this and subsequent parts.) -/

lemma type_succ_succ_double :
  ∀ (e : bnexp), e :: number → app succ (app succ (app double e)) :: number :=
sorry

/-! Next, we define our language's dynamics -- that is, how we evalute it.
Because we are defining a functional language, our small-step semantics
specifies transitions between *expressions*, not states. As an example, consider
the following example in a simple lambda calculus-like language:

  (λ x f, f x) 0 (λ y, y)
  ⇒ (λ f, f 0) (λ y, y)
  ⇒ (λ y, y) 0
  ⇒ 0

The `⇒` predicate simply indicates what reduction step to take next in order to
evaluate a given expression. The same will apply to our language of `bnexp`s.

5.4. Complete the definition of `step`, the small-step semantics for our
language of `bnexp`s, below.

Note: as with `has_type`, the rest of this question will depend on the
correctness of `step`. Therefore, we once again provide a reference solution
below. Make sure to check your work before proceeding!

Hint: for the last case, you may need to step to another expression involving
`double` -- just make sure that your recursion will terminate! -/

inductive step : bnexp → bnexp → Prop
| app_arg {f e e'} :
  step e e' → step (app f e) (app f e')
| app_isZero_zero :
  step (app isZero zero) sorry
| app_isZero_succ {e} :
  step (app isZero (app succ e)) sorry
| app_double_zero :
  step (app double zero) sorry
| app_double_succ {e} :
  step (app double (app succ e)) sorry

-- Solution to 4.4:
--------------------------------------------------------------------------------
-- inductive step : bnexp → bnexp → Prop
-- | app_arg {f e e'} :
--   step e e' → step (app f e) (app f e')
-- | app_isZero_zero :
--   step (app isZero zero) true
-- | app_isZero_succ {e} :
--   step (app isZero (app succ e)) false
-- | app_double_zero :
--   step (app double zero) zero
-- | app_double_succ {e} :
--   step (app double (app succ e)) (app succ (app succ (app double e)))
--------------------------------------------------------------------------------

-- We define our usual notation for the small-step semantics: we write `e ⇒ e'`
-- for `step e e'`.
local notation (name := bnexp_step) e ` ⇒ ` e' := step e e'

/-! Now that we have defined a statics and dynamics for our language, we must
ensure that they are mutually coherent. This is done by showing two key
properties that guarantee our language's *type safety*: progress and
preservation.

Intuitvely, progress guarantees that no well-typed expression gets "stuck"
during evaluation. More explicitly, every well-typed expression is either a
fully-evaluated value (like `3` or `true` or `[]` in Lean) or can take some step
according to our semantics. This connects our type system and our semantics in
the sense that it guarantees that, in our semantics, we've "accounted for" every
well-typed expression.

Preservation, on the other hand, says that a term preserves its original type
throughout evaluation. More formally, if an expression `e` has type `τ`, and `e`
steps to `e'`, then `e'` must also have type `τ`. (For instance, in Lean, if we
write an expression of type `ℕ`, we don't want it to evaluate to a `string`!)

Together, these properties ensure that every well-typed term can be evaluated in
a well-typed manner. (There are, of course, further properties of the `bnexp`
language we could prove, such as *termination*: the property that every
expression will eventually evaluate to a value. Feel free to think about and
even try to prove some of these other properties if you're so inclined!)

We now prove the type safety of our `bnexp` language.

5.5. Prove that preservation holds for the `bnexp` language.

Hint 1: We recommend proceeding by rule induction on the step judgment.

Hint 2: You will probably find `type_succ_succ_double` useful at some point. -/

theorem preservation {e e' : bnexp} {τ : bntp} :
  e :: τ → e ⇒ e' → e' :: τ :=
sorry

/-! **Warning**: This final problem is especially challenging and involves a
very lengthy proof! We recommend trying a few cases to get a feel for how proofs
of progress operate, but especially as this is an optional problem, please don't
sink too much time into it if you're stuck.

Lastly, we prove progress. In order to do so, we need to define what a
"fully-evaluated expression" is in our language. For this purpose, we define a
predicate that specifies *values* in the `bnexp` language. Values are
expressions that are maximally reduced; they are the "final answers" we obtain
from our computations. (In Lean, for instance, `4`, `[]`, and `(λ x, x)` are all
values.) This definition enables us to state our progress theorem.

We also supply a helper lemma, `no_hofs`, which will be of use in eliminating an
impossible case in your progress proof.

5.6. Prove that progress holds for the `bnexp` language. -/

inductive value : bnexp → Prop
| true       : value true
| false      : value false
| zero       : value zero
| succ       : value succ
| succ_n {n} : value n → value (app succ n)
| isZero     : value isZero
| double     : value double

lemma no_hofs {τ τ' τ'' : bntp} :
  ¬ ∃ e, e :: bntp.arrow τ (bntp.arrow τ' τ'') :=
begin
  intros hneg,
  cases' hneg,
  induction' h,
  assumption
end

theorem progress {e τ} : e :: τ → value e ∨ ∃ e', e ⇒ e' :=
sorry

end bnexp

end LoVe


import tactic --hide

-- Level name : Distributive laws 2

/-
This level proves the distributivity of `∨` over `∧`.
-/

/-Lemma
If $P,Q,R$ are logical statements then $P ∨ (Q ∧ R)$ is true iff $(P ∨ Q) ∧ (P ∨ R)$ is true.
-/
lemma distributivity_two (P Q R : Prop) : P ∨ (Q ∧ R) ↔ (P ∨ Q) ∧ (P ∨ R) :=
begin
  split,
  intro h,
  cases h,
  split,
  left,
  exact h,
  left,
  exact h,
  split,
  right,
  exact h.1,
  right,
  exact h.2,
  intro h,
  cases h,
  cases h_left with h1 h2,
  left,
  exact h1,
  cases h_right with h4 h5,
  left,
  exact h4,
  right,
  split,
  exact h2,
  exact h5,

end


import data.fintype.basic
import algebra.big_operators
import data.set.function
import data.equiv.basic
open finset
open equiv function fintype finset
universes u v
variables {α : Type u} {β : Type v}

lemma finset.prod_univ_perm_ [fintype α] [comm_monoid β] {f : α → β} (σ : perm α) :
  (univ : finset α).prod f = univ.prod (λ z, f (σ z)) :=
eq.symm $ prod_bij (λ z _, σ z) (λ _ _, mem_univ _) (λ _ _, rfl)
  (λ _ _ _ _ H, σ.injective H) (λ b _, ⟨σ⁻¹ b, mem_univ _, by simp⟩)

lemma Sum_permutation  {R :Type u}[add_comm_monoid R]{X : Type v}[fintype X](g : X → R)(σ : equiv.perm X )
: finset.sum (finset.univ) g =   finset.sum (finset.univ) (λ z, g (σ z))  :=   @finset.prod_univ_perm_ _ (multiplicative R) _ _ g σ