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

! This file was ported from Lean 3 source module data.nat.factors
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Prime
import Mathbin.Data.List.Prime
import Mathbin.Data.List.Sort
import Mathbin.Tactic.NthRewrite.Default

/-!
# Prime numbers

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

This file deals with the factors of natural numbers.

## Important declarations

- `nat.factors n`: the prime factorization of `n`
- `nat.factors_unique`: uniqueness of the prime factorisation

-/

open Bool Subtype

open Nat

namespace Nat

#print Nat.factors /-
/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → List ℕ
  | 0 => []
  | 1 => []
  | n@(k + 2) =>
    let m := minFac n
    have : n / m < n := factors_lemma
    m :: factors (n / m)
#align nat.factors Nat.factors
-/

#print Nat.factors_zero /-
@[simp]
theorem factors_zero : factors 0 = [] := by rw [factors]
#align nat.factors_zero Nat.factors_zero
-/

#print Nat.factors_one /-
@[simp]
theorem factors_one : factors 1 = [] := by rw [factors]
#align nat.factors_one Nat.factors_one
-/

#print Nat.prime_of_mem_factors /-
theorem prime_of_mem_factors : ∀ {n p}, p ∈ factors n → Prime p
  | 0 => by simp
  | 1 => by simp
  | n@(k + 2) => fun p h =>
    let m := minFac n
    have : n / m < n := factors_lemma
    have h₁ : p = m ∨ p ∈ factors (n / m) := (List.mem_cons _ _ _).1 (by rwa [factors] at h)
    Or.cases_on h₁ (fun h₂ => h₂.symm ▸ minFac_prime (by decide)) prime_of_mem_factors
#align nat.prime_of_mem_factors Nat.prime_of_mem_factors
-/

#print Nat.pos_of_mem_factors /-
theorem pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p :=
  Prime.pos (prime_of_mem_factors h)
#align nat.pos_of_mem_factors Nat.pos_of_mem_factors
-/

#print Nat.prod_factors /-
theorem prod_factors : ∀ {n}, n ≠ 0 → List.prod (factors n) = n
  | 0 => by simp
  | 1 => by simp
  | n@(k + 2) => fun h =>
    let m := minFac n
    have : n / m < n := factors_lemma
    show (factors n).Prod = n
      by
      have h₁ : n / m ≠ 0 := fun h =>
        by
        have : n = 0 * m := (Nat.div_eq_iff_eq_mul_left (minFac_pos _) (minFac_dvd _)).1 h
        rw [MulZeroClass.zero_mul] at this <;> exact (show k + 2 ≠ 0 by decide) this
      rw [factors, List.prod_cons, prod_factors h₁, Nat.mul_div_cancel' (min_fac_dvd _)]
#align nat.prod_factors Nat.prod_factors
-/

#print Nat.factors_prime /-
theorem factors_prime {p : ℕ} (hp : Nat.Prime p) : p.factors = [p] :=
  by
  have : p = p - 2 + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl
  rw [this, Nat.factors]
  simp only [Eq.symm this]
  have : Nat.minFac p = p := (nat.prime_def_min_fac.mp hp).2
  constructor
  · exact this
  · simp only [this, Nat.factors, Nat.div_self (Nat.Prime.pos hp)]
#align nat.factors_prime Nat.factors_prime
-/

#print Nat.factors_chain /-
theorem factors_chain : ∀ {n a}, (∀ p, Prime p → p ∣ n → a ≤ p) → List.Chain (· ≤ ·) a (factors n)
  | 0 => fun a h => by simp
  | 1 => fun a h => by simp
  | n@(k + 2) => fun a h => by
    let m := minFac n
    have : n / m < n := factors_lemma
    rw [factors]
    refine' List.Chain.cons ((le_min_fac.2 h).resolve_left (by decide)) (factors_chain _)
    exact fun p pp d => min_fac_le_of_dvd pp.two_le (d.trans <| div_dvd_of_dvd <| min_fac_dvd _)
#align nat.factors_chain Nat.factors_chain
-/

#print Nat.factors_chain_2 /-
theorem factors_chain_2 (n) : List.Chain (· ≤ ·) 2 (factors n) :=
  factors_chain fun p pp _ => pp.two_le
#align nat.factors_chain_2 Nat.factors_chain_2
-/

#print Nat.factors_chain' /-
theorem factors_chain' (n) : List.Chain' (· ≤ ·) (factors n) :=
  @List.Chain'.tail _ _ (_ :: _) (factors_chain_2 _)
#align nat.factors_chain' Nat.factors_chain'
-/

#print Nat.factors_sorted /-
theorem factors_sorted (n : ℕ) : List.Sorted (· ≤ ·) (factors n) :=
  List.chain'_iff_pairwise.1 (factors_chain' _)
#align nat.factors_sorted Nat.factors_sorted
-/

#print Nat.factors_add_two /-
/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
theorem factors_add_two (n : ℕ) :
    factors (n + 2) = minFac (n + 2) :: factors ((n + 2) / minFac (n + 2)) := by rw [factors]
#align nat.factors_add_two Nat.factors_add_two
-/

#print Nat.factors_eq_nil /-
@[simp]
theorem factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 :=
  by
  constructor <;> intro h
  · rcases n with (_ | _ | n)
    · exact Or.inl rfl
    · exact Or.inr rfl
    · rw [factors] at h
      injection h
  · rcases h with (rfl | rfl)
    · exact factors_zero
    · exact factors_one
#align nat.factors_eq_nil Nat.factors_eq_nil
-/

#print Nat.eq_of_perm_factors /-
theorem eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) :
    a = b := by simpa [prod_factors ha, prod_factors hb] using List.Perm.prod_eq h
#align nat.eq_of_perm_factors Nat.eq_of_perm_factors
-/

section

open List

#print Nat.mem_factors_iff_dvd /-
theorem mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : Prime p) : p ∈ factors n ↔ p ∣ n :=
  ⟨fun h => prod_factors hn ▸ List.dvd_prod h, fun h =>
    mem_list_primes_of_dvd_prod (prime_iff.mp hp) (fun p h => prime_iff.mp (prime_of_mem_factors h))
      ((prod_factors hn).symm ▸ h)⟩
#align nat.mem_factors_iff_dvd Nat.mem_factors_iff_dvd
-/

#print Nat.dvd_of_mem_factors /-
theorem dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n :=
  by
  rcases n.eq_zero_or_pos with (rfl | hn)
  · exact dvd_zero p
  · rwa [← mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h)]
#align nat.dvd_of_mem_factors Nat.dvd_of_mem_factors
-/

#print Nat.mem_factors /-
theorem mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ Prime p ∧ p ∣ n :=
  ⟨fun h => ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩, fun ⟨hprime, hdvd⟩ =>
    (mem_factors_iff_dvd hn hprime).mpr hdvd⟩
#align nat.mem_factors Nat.mem_factors
-/

#print Nat.le_of_mem_factors /-
theorem le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n :=
  by
  rcases n.eq_zero_or_pos with (rfl | hn)
  · rw [factors_zero] at h
    cases h
  · exact le_of_dvd hn (dvd_of_mem_factors h)
#align nat.le_of_mem_factors Nat.le_of_mem_factors
-/

#print Nat.factors_unique /-
/-- **Fundamental theorem of arithmetic**-/
theorem factors_unique {n : ℕ} {l : List ℕ} (h₁ : Prod l = n) (h₂ : ∀ p ∈ l, Prime p) :
    l ~ factors n := by
  refine' perm_of_prod_eq_prod _ _ _
  · rw [h₁]
    refine' (prod_factors _).symm
    rintro rfl
    rw [prod_eq_zero_iff] at h₁
    exact Prime.ne_zero (h₂ 0 h₁) rfl
  · simp_rw [← prime_iff]
    exact h₂
  · simp_rw [← prime_iff]
    exact fun p => prime_of_mem_factors
#align nat.factors_unique Nat.factors_unique
-/

#print Nat.Prime.factors_pow /-
theorem Prime.factors_pow {p : ℕ} (hp : p.Prime) (n : ℕ) : (p ^ n).factors = List.replicate n p :=
  by
  symm
  rw [← List.replicate_perm]
  apply Nat.factors_unique (List.prod_replicate n p)
  intro q hq
  rwa [eq_of_mem_replicate hq]
#align nat.prime.factors_pow Nat.Prime.factors_pow
-/

#print Nat.eq_prime_pow_of_unique_prime_dvd /-
theorem eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0)
    (h : ∀ {d}, Nat.Prime d → d ∣ n → d = p) : n = p ^ n.factors.length :=
  by
  set k := n.factors.length
  rw [← prod_factors hpos, ← prod_replicate k p,
    eq_replicate_of_mem fun d hd => h (prime_of_mem_factors hd) (dvd_of_mem_factors hd)]
#align nat.eq_prime_pow_of_unique_prime_dvd Nat.eq_prime_pow_of_unique_prime_dvd
-/

#print Nat.perm_factors_mul /-
/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
theorem perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
    (a * b).factors ~ a.factors ++ b.factors :=
  by
  refine' (factors_unique _ _).symm
  · rw [List.prod_append, prod_factors ha, prod_factors hb]
  · intro p hp
    rw [List.mem_append] at hp
    cases hp <;> exact prime_of_mem_factors hp
#align nat.perm_factors_mul Nat.perm_factors_mul
-/

#print Nat.perm_factors_mul_of_coprime /-
/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
theorem perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
    (a * b).factors ~ a.factors ++ b.factors :=
  by
  rcases a.eq_zero_or_pos with (rfl | ha)
  · simp [(coprime_zero_left _).mp hab]
  rcases b.eq_zero_or_pos with (rfl | hb)
  · simp [(coprime_zero_right _).mp hab]
  exact perm_factors_mul ha.ne' hb.ne'
#align nat.perm_factors_mul_of_coprime Nat.perm_factors_mul_of_coprime
-/

#print Nat.factors_sublist_right /-
theorem factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors :=
  by
  cases n
  · rw [MulZeroClass.zero_mul]
  apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _)
  rw [(perm_factors_mul n.succ_ne_zero h).subperm_left]
  exact (sublist_append_left _ _).Subperm
#align nat.factors_sublist_right Nat.factors_sublist_right
-/

#print Nat.factors_sublist_of_dvd /-
theorem factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors :=
  by
  obtain ⟨a, rfl⟩ := h
  exact factors_sublist_right (right_ne_zero_of_mul h')
#align nat.factors_sublist_of_dvd Nat.factors_sublist_of_dvd
-/

#print Nat.factors_subset_right /-
theorem factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors :=
  (factors_sublist_right h).Subset
#align nat.factors_subset_right Nat.factors_subset_right
-/

#print Nat.factors_subset_of_dvd /-
theorem factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors :=
  (factors_sublist_of_dvd h h').Subset
#align nat.factors_subset_of_dvd Nat.factors_subset_of_dvd
-/

#print Nat.dvd_of_factors_subperm /-
theorem dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b :=
  by
  rcases b.eq_zero_or_pos with (rfl | hb)
  · exact dvd_zero _
  rcases a with (_ | _ | a)
  · exact (ha rfl).elim
  · exact one_dvd _
  use (b.factors.diff a.succ.succ.factors).Prod
  nth_rw 1 [← Nat.prod_factors ha]
  rw [← List.prod_append,
    List.Perm.prod_eq <| List.subperm_append_diff_self_of_count_le <| list.subperm_ext_iff.mp h,
    Nat.prod_factors hb.ne']
#align nat.dvd_of_factors_subperm Nat.dvd_of_factors_subperm
-/

end

#print Nat.mem_factors_mul /-
theorem mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} :
    p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors :=
  by
  rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ← and_or_left]
  simpa only [and_congr_right_iff] using prime.dvd_mul
#align nat.mem_factors_mul Nat.mem_factors_mul
-/

#print Nat.coprime_factors_disjoint /-
/-- The sets of factors of coprime `a` and `b` are disjoint -/
theorem coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) :
    List.Disjoint a.factors b.factors := by
  intro q hqa hqb
  apply not_prime_one
  rw [← eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)]
  exact prime_of_mem_factors hqa
#align nat.coprime_factors_disjoint Nat.coprime_factors_disjoint
-/

/- warning: nat.mem_factors_mul_of_coprime -> Nat.mem_factors_mul_of_coprime is a dubious translation:
lean 3 declaration is
  forall {a : Nat} {b : Nat}, (Nat.coprime a b) -> (forall (p : Nat), Iff (Membership.Mem.{0, 0} Nat (List.{0} Nat) (List.hasMem.{0} Nat) p (Nat.factors (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) a b))) (Membership.Mem.{0, 0} Nat (List.{0} Nat) (List.hasMem.{0} Nat) p (Union.union.{0} (List.{0} Nat) (List.hasUnion.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b)) (Nat.factors a) (Nat.factors b))))
but is expected to have type
  forall {a : Nat} {b : Nat}, (Nat.coprime a b) -> (forall (p : Nat), Iff (Membership.mem.{0, 0} Nat (List.{0} Nat) (List.instMembershipList.{0} Nat) p (Nat.factors (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) a b))) (Membership.mem.{0, 0} Nat (List.{0} Nat) (List.instMembershipList.{0} Nat) p (Union.union.{0} (List.{0} Nat) (List.instUnionList.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b)) (Nat.factors a) (Nat.factors b))))
Case conversion may be inaccurate. Consider using '#align nat.mem_factors_mul_of_coprime Nat.mem_factors_mul_of_coprimeₓ'. -/
theorem mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ) :
    p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors :=
  by
  rcases a.eq_zero_or_pos with (rfl | ha)
  · simp [(coprime_zero_left _).mp hab]
  rcases b.eq_zero_or_pos with (rfl | hb)
  · simp [(coprime_zero_right _).mp hab]
  rw [mem_factors_mul ha.ne' hb.ne', List.mem_union]
#align nat.mem_factors_mul_of_coprime Nat.mem_factors_mul_of_coprime

open List

#print Nat.mem_factors_mul_left /-
/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/
theorem mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a * b).factors :=
  by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simpa using hpa
  apply (mem_factors_mul ha hb).2 (Or.inl hpa)
#align nat.mem_factors_mul_left Nat.mem_factors_mul_left
-/

#print Nat.mem_factors_mul_right /-
/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/
theorem mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) :
    p ∈ (a * b).factors := by
  rw [mul_comm]
  exact mem_factors_mul_left hpb ha
#align nat.mem_factors_mul_right Nat.mem_factors_mul_right
-/

#print Nat.eq_two_pow_or_exists_odd_prime_and_dvd /-
theorem eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) :
    (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, Nat.Prime p ∧ p ∣ n ∧ Odd p :=
  (eq_or_ne n 0).elim (fun hn => Or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩) fun hn =>
    or_iff_not_imp_right.mpr fun H =>
      ⟨n.factors.length,
        eq_prime_pow_of_unique_prime_dvd hn fun p hprime hdvd =>
          hprime.eq_two_or_odd'.resolve_right fun hodd => H ⟨p, hprime, hdvd, hodd⟩⟩
#align nat.eq_two_pow_or_exists_odd_prime_and_dvd Nat.eq_two_pow_or_exists_odd_prime_and_dvd
-/

end Nat

assert_not_exists Multiset


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

Modular equality relation.
-/
import data.int.gcd

namespace nat

/-- Modular equality. `modeq n a b`, or `a ≡ b [MOD n]`, means
  that `a - b` is a multiple of `n`. -/
def modeq (n a b : ℕ) := a % n = b % n

notation a ` ≡ `:50 b ` [MOD `:50 n `]`:0 := modeq n a b

namespace modeq
variables {n m a b c d : ℕ}

@[refl] protected theorem refl (a : ℕ) : a ≡ a [MOD n] := @rfl _ _

@[symm] protected theorem symm : a ≡ b [MOD n] → b ≡ a [MOD n] := eq.symm

@[trans] protected theorem trans : a ≡ b [MOD n] → b ≡ c [MOD n] → a ≡ c [MOD n] := eq.trans

instance : decidable (a ≡ b [MOD n]) := by unfold modeq; apply_instance

theorem modeq_zero_iff : a ≡ 0 [MOD n] ↔ n ∣ a :=
by rw [modeq, zero_mod, dvd_iff_mod_eq_zero]

theorem modeq_iff_dvd : a ≡ b [MOD n] ↔ (n:ℤ) ∣ b - a :=
by rw [modeq, eq_comm, ← int.coe_nat_inj'];
   simp [int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero]

theorem modeq_of_dvd : (n:ℤ) ∣ b - a → a ≡ b [MOD n] := modeq_iff_dvd.2
theorem dvd_of_modeq : a ≡ b [MOD n] → (n:ℤ) ∣ b - a := modeq_iff_dvd.1

theorem mod_modeq (a n) : a % n ≡ a [MOD n] := nat.mod_mod _ _

theorem modeq_of_dvd_of_modeq (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] :=
modeq_of_dvd $ dvd_trans (int.coe_nat_dvd.2 d) (dvd_of_modeq h)

theorem modeq_mul_left' (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD (c * n)] :=
by unfold modeq at *; rw [mul_mod_mul_left, mul_mod_mul_left, h]

theorem modeq_mul_left (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD n] :=
modeq_of_dvd_of_modeq (dvd_mul_left _ _) $ modeq_mul_left' _ h

theorem modeq_mul_right' (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD (n * c)] :=
by rw [mul_comm a, mul_comm b, mul_comm n]; exact modeq_mul_left' c h

theorem modeq_mul_right (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD n] :=
by rw [mul_comm a, mul_comm b]; exact modeq_mul_left c h

theorem modeq_mul (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a * c ≡ b * d [MOD n] :=
(modeq_mul_left _ h₂).trans (modeq_mul_right _ h₁)

theorem modeq_add (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a + c ≡ b + d [MOD n] :=
modeq_of_dvd $ by simpa using dvd_add (dvd_of_modeq h₁) (dvd_of_modeq h₂)

theorem modeq_add_cancel_left (h₁ : a ≡ b [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) : c ≡ d [MOD n] :=
have (n:ℤ) ∣ a + (-a + (d + -c)),
by simpa using _root_.dvd_sub (dvd_of_modeq h₂) (dvd_of_modeq h₁),
modeq_of_dvd $ by rwa add_neg_cancel_left at this

theorem modeq_add_cancel_right (h₁ : c ≡ d [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) : a ≡ b [MOD n] :=
by rw [add_comm a, add_comm b] at h₂; exact modeq_add_cancel_left h₁ h₂

theorem chinese_remainder (co : coprime n m) (a b : ℕ) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
⟨let (c, d) := xgcd n m in int.to_nat ((b * c * n + a * d * m) % (n * m)), begin
  rw xgcd_val, dsimp,
  rw [modeq_iff_dvd, modeq_iff_dvd],
  rw [int.to_nat_of_nonneg], swap,
  { by_cases h₁ : n = 0, {simp [coprime, h₁] at co, substs m n, simp},
    by_cases h₂ : m = 0, {simp [coprime, h₂] at co, substs m n, simp},
    exact int.mod_nonneg _
      (mul_ne_zero (int.coe_nat_ne_zero.2 h₁) (int.coe_nat_ne_zero.2 h₂)) },
  have := gcd_eq_gcd_ab n m, simp [co.gcd_eq_one, mul_comm] at this,
  rw [int.mod_def, ← sub_add, ← sub_add]; split,
  { refine dvd_add _ (dvd_trans (dvd_mul_right _ _) (dvd_mul_right _ _)),
    rw [add_comm, ← sub_sub], refine _root_.dvd_sub _ (dvd_mul_left _ _),
    have := congr_arg ((*) ↑a) this,
    exact ⟨_, by rwa [mul_add, ← mul_assoc, ← mul_assoc, mul_one, mul_comm,
        ← sub_eq_iff_eq_add] at this⟩ },
  { refine dvd_add _ (dvd_trans (dvd_mul_left _ _) (dvd_mul_right _ _)),
    rw [← sub_sub], refine _root_.dvd_sub _ (dvd_mul_left _ _),
    have := congr_arg ((*) ↑b) this,
    exact ⟨_, by rwa [mul_add, ← mul_assoc, ← mul_assoc, mul_one, mul_comm _ ↑m,
        ← sub_eq_iff_eq_add'] at this⟩ }
end⟩

end modeq
end nat


/- ----------------------
   BACKGROUND DEFINITIONS
   ----------------------
-/

-- part 1
inductive Rstar {T : Type} (P : T -> T -> Prop) : T -> T -> Prop :=
| refl : forall a, Rstar P a a
| step : forall a b c, P a b -> Rstar P b c -> Rstar P a c

theorem RTrans {T : Type} {P : T -> T -> Prop} {a b c : T} :
        Rstar P a b -> Rstar P b c -> Rstar P a c :=
  by intros H1
     revert c
     induction H1 <;> intros c H2 <;> simp <;> try assumption
     constructor
     assumption
     rename_i H
     apply H
     assumption

-- part 1
/- ------------------------
   SOURCE, TARGET, COMPILER
   ------------------------
-/
-- part 2

inductive Source :=
| b : Bool -> Source
| and : Source -> Source -> Source
| var : String -> Source
| lam : String -> Source -> Source
| app : Source -> Source -> Source

def Source.sub (e : Source) (x : String) (body : Source) :=
  match body with
  | b _ => body
  | and t1 t2 => and (e.sub x t1) (e.sub x t2)
  | var x' => if x == x' then e else body
  | app t1 t2 => app (e.sub x t1) (e.sub x t2)
  | lam x' body' => if x == x' then body
                    else lam x' (e.sub x body')

inductive SStep : Source -> Source -> Prop :=
| app : forall e e' a, SStep e e' ->
                  SStep (Source.app e a) (Source.app e' a)
| beta : forall x1 body e,
    SStep (Source.app (Source.lam x1 body) e)
        (e.sub x1 body)
| and1 : forall e1 e1' e2, SStep e1 e1' ->
                        SStep (Source.and e1 e2) (Source.and e1' e2)
| and2 : forall b e2 e2', SStep e2 e2' ->
                      SStep (Source.and (Source.b b) e2) (Source.and (Source.b b) e2')
| and : forall b1 b2, SStep (Source.and (Source.b b1) (Source.b b2))
                        (Source.b (b1 && b2))

inductive Target :=
| n : Nat -> Target
| plus : Target -> Target -> Target
| minus : Target -> Target -> Target
| var : String -> Target
| lam : String -> Target -> Target
| app : Target -> Target -> Target

def Target.sub (e : Target) (x : String) (body : Target) :=
  match body with
  | n _ => body
  | plus t1 t2 => plus (e.sub x t1) (e.sub x t2)
  | minus t1 t2 => minus (e.sub x t1) (e.sub x t2)
  | var x' => if x == x' then e else body
  | app t1 t2 => app (e.sub x t1) (e.sub x t2)
  | lam x' body' => if x == x' then body
                      else lam x' (e.sub x body')

inductive TStep : Target -> Target -> Prop :=
| app : forall e e' a, TStep e e' ->
                  TStep (Target.app e a) (Target.app e' a)
| beta : forall x1 body e,
    TStep (Target.app (Target.lam x1 body) e)
          (e.sub x1 body)
| plus1 : forall e1 e1' e2, TStep e1 e1' ->
                        TStep (Target.plus e1 e2) (Target.plus e1' e2)
| plus2 : forall e1 e2 e2', TStep e2 e2' ->
                        TStep (Target.plus e1 e2) (Target.plus e1 e2')
| plus : forall n1 n2, TStep (Target.plus (Target.n n1) (Target.n n2))
                        (Target.n (n1 + n2))
| minus1 : forall e1 e1' e2, TStep e1 e1' ->
                      TStep (Target.minus e1 e2) (Target.minus e1' e2)
| minus2 : forall e1 e2 e2', TStep e2 e2' ->
                      TStep (Target.minus e1 e2) (Target.minus e1 e2')
| minus : forall n1 n2, TStep (Target.minus (Target.n n1) (Target.n n2))
                          (Target.n (n1 - n2))

-- part 2

-- part 3
def Source.compile : Source -> Target
| b true    => Target.n 1
| b false   => Target.n 0
| and b1 b2 => Target.minus (Target.plus (compile b1) (compile b2)) (Target.n 1)
| var x     => Target.var x
| app t1 t2 => Target.app (compile t1) (compile t2)
| lam x bdy => Target.lam x (compile bdy)

-- part 3
/- -------------------
   SIMULATION RELATION
   -------------------
-/
-- part 4
inductive sim : Source -> Target -> Prop :=
| comp : forall e, sim e e.compile
-- part 4

/- PROBLEM 1: Lifting steps to RStar

  These theorems will be necessary when proving `sim_step`. They
  show how even though TStep is not defined in terms of Rstar,
  you can nonetheless lift many steps (using Rstar) into subterms.

  Note that all of these proofs should be very similar! So while it
  looks like a lot, once you do _one_, the rest should be quite easy.
-/

-- part 5
-- 7 lines
theorem app_star : forall e1 e1' e2, Rstar TStep e1 e1' ->
                  Rstar TStep (Target.app e1 e2) (Target.app e1' e2) :=
 by sorry

-- 7 lines
theorem plus_star1 : forall e1 e1' e2, Rstar TStep e1 e1' ->
                  Rstar TStep (Target.plus e1 e2) (Target.plus e1' e2) :=
 by sorry

-- 7 lines
theorem plus_star2 : forall e1 e2 e2', Rstar TStep e2 e2' ->
                  Rstar TStep (Target.plus e1 e2) (Target.plus e1 e2') :=
 by sorry

-- 7 lines
theorem minus_star1 : forall e1 e1' e2, Rstar TStep e1 e1' ->
                  Rstar TStep (Target.minus e1 e2) (Target.minus e1' e2) :=
 by sorry

-- 7 lines
theorem minus_star2 : forall e1 e2 e2', Rstar TStep e2 e2' ->
                  Rstar TStep (Target.minus e1 e2) (Target.minus e1 e2') :=
 by sorry

-- part 5

/- PROBLEM 2: Substitution commutes with compile.

  In this problem, you will prove that substituting and then
  compiling is the same as compiling and then substituting.
  This will be a necessary result in the `beta` case of `sim_step`.

  Think about whether the expression being substituted, or the
  expression substituted into (e or body) make more sense to do
  induction on. Also: in the cases where variable comparison is
  used (var & lam), remember L23 (3/13).
-/
-- part 6

-- 15 lines
theorem compile_sub : forall (e : Source) x (body : Source),
  (e.sub x body).compile = Target.sub e.compile x body.compile :=
 by sorry

-- part 6
/- PROBLEM 3: Show that the simulation respects compiler.

  In some relations, this is involved: in ours, this should be
  trivial! But it is a necessary step, as logically, it is how we
  start our argument: first, we show that the source & target term are
  in the relation. Then we should that at each step, they remain;
  finally, we should that when they terminate, they terminate at related
  values.
-/
-- part 7

-- 1 line
theorem compile_sim : forall t,
  sim t t.compile :=
 by sorry

-- part 7
/- PROBLEM 4: Simulation is preserved over reduction

  This is the heart of the proof. It says that for a single
  step of the source, after any number of steps of the target,
  there is some target term that is related again. i.e., we can
  always get back to a pair of related terms. We will use this
  iteratively in the next proof.

  Be sure to use the theorems you did in Problem 1 & Problem 2,
  and as a hint: you will want to do induction on the SSTep relation.
-/
-- part 8

-- 67 lines
theorem sim_step : forall t1 t1',
  SStep t1 t1' ->
  forall t2,
  sim t1 t2 ->
  exists t2', Rstar TStep t2 t2' /\ sim t1' t2' :=
 by intros t1 t1' stept1
    induction stept1 <;> intros t2 sim1 <;> sorry

-- part 8
/- PROBLEM 5: sim_step lifts to many steps.

  This problem shows that if we take many steps at the source,
  the result from the previous theorem still holds. It is
  much easier, since we can appeal to the single step result
  (where most of the work is done).
-/
-- part 9

-- 15 lines
theorem step_sim_star : forall t1 t1',
  Rstar SStep t1 t1' ->
  forall t2,
  sim t1 t2 ->
  exists t2', Rstar TStep t2 t2' /\ sim t1' t2' :=
 by intros t1 t1' rst1
    induction rst1 <;> intros t2 sim1 <;> sorry

-- part 9
/- PROBLEM 6: The final result!

  While this is the actual result that we care about: that if
  a term runs to a boolean, then the term in compiles to runs to the compiled version of that boolean, it is actually one of the easier proofs, as most of the work is done by the theorems above.

  If you are wondering, why running to a boolean? If our program
  runs forever, there isn't much we can say about the target (we could
  say we want it to run forever, but we often don't). The only other
  value it could run to is a function (lam). But knowing how to equate
  lambdas is tricky (as they contain code, and equivalence of code sort
  of requires running, which is circular). Fortunately, it turns out
  that by showing equivalence of booleans, we essentially get
  equivalence of functions, as if we have a term `t` that should run to
  a function (say, of a single boolean argument), then our theorem,
  since it holds of @italic{all} expressions, will
  tell us that both `t true` and `t false` will run to the same thing.
-/
-- part 10

-- 7 lines
theorem correct : forall t b, Rstar SStep t (Source.b b) ->
                              Rstar TStep t.compile ((Source.b b).compile) :=
 by sorry

-- part 10


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

namespace Mathlib

/-!
# Relating parity to natural numbers mod 2

This module provides lemmas relating `zmod 2` to `even` and `odd`.

## Tags

parity, zmod, even, odd
-/

namespace zmod

theorem eq_zero_iff_even {n : ℕ} : ↑n = 0 ↔ even n :=
  iff.trans (char_p.cast_eq_zero_iff (zmod (bit0 1)) (bit0 1) n) (iff.symm even_iff_two_dvd)

theorem eq_one_iff_odd {n : ℕ} : ↑n = 1 ↔ odd n := sorry

theorem ne_zero_iff_odd {n : ℕ} : ↑n ≠ 0 ↔ odd n := sorry

end Mathlib


import data.real.basic

/- Tactics you may consider
-intro
-rw
-apply
-exact
-cal
-dsimp: definition simplification
-/

variables (f g : ℝ → ℝ)

#check mul_assoc
#check neg_mul_comm
#check neg_mul_neg
#check neg_eq_neg_one_mul

-- BEGIN
def fn_even (f : ℝ → ℝ) : Prop := ∀ x, f x = f (-x)
def fn_odd (f : ℝ → ℝ) : Prop := ∀ x, f x = - f (-x)

example (ef : fn_even f) (og : fn_odd g) : fn_odd (λ x, f x * g x) :=
begin
  intro x,
  dsimp,
  rw [ef, og],
  rw ← neg_mul_comm,
  rw neg_eq_neg_one_mul,
  rw mul_assoc,
  rw ← neg_eq_neg_one_mul,
end

example (ef : fn_even f) (eg : fn_even g) : fn_even (λ x, f x + g x) :=
begin
  intro x,
  calc
    (λ x, f x + g x) x = f x + g x       : rfl
                   ... = f (-x) + g (-x) : by rw [ef, eg]
end

example (of : fn_odd f) (og : fn_odd g) : fn_even (λ x, f x * g x) :=
begin
  intro x,
  calc
    (λ x, f x * g x) x = f x * g x      : rfl
                   ... = - f (-x) * - g(-x) : by rw [of, og]
                   ... = f (-x) * g(-x)     : by rw neg_mul_neg,
end

-- END


import data.polynomial.ring_division
import data.polynomial.field_division
import data.polynomial.inductions
import data.polynomial.coeff
import ring_theory.polynomial.basic
import data.real.sign
import data.quot
import order.hom.basic
import data.fin.tuple.basic
import tactic

noncomputable theory
open_locale classical big_operators

open multiset

variables {R : Type*} [linear_ordered_field R]

def polynomial.positive_roots (f : polynomial R) :=
f.roots.filter (λ x, 0 < x)

def polynomial.number_positive_roots (f : polynomial R) :=
f.positive_roots.card

variables {p q f : polynomial R}

open polynomial

@[simp] lemma smul_eq {a : R} : C a * p = a • p :=
begin
rw smul_eq_C_mul,
end

lemma mem_positive_roots {x : R} :
x ∈ p.positive_roots ↔ x ∈ p.roots ∧ 0 < x :=
by rw [positive_roots, mem_filter]

/--
The set of positive roots of X-a is {a} when 0 < a
-/
lemma positive_roots_X_sub_C_of_zero_lt {a : R} (h : 0 < a) :
(X - C a).positive_roots = {a} :=
begin
  rw positive_roots,
  rw roots_X_sub_C,
  rw filter_eq_self,
  simp [h],
end

lemma positive_roots_X : polynomial.positive_roots (@X R _) = ∅ :=
begin
  rw polynomial.positive_roots,
  rw roots_X,
  simp,
  rw filter_eq_nil,
  intros a ha,
  simp at ha,
  subst ha,
  exact irrefl 0,
end

/--
The positive roots of the monic normalization of f
-/
lemma positive_roots_normalize_eq_positive_roots :
  (normalize f).positive_roots = f.positive_roots :=
begin
  rw [positive_roots, roots_normalize],
  refl,
end

/--
The positive roots of the product of two polinomials
-/
lemma positive_roots_mul {p q : polynomial R}
(hpq : p * q ≠ 0):
  (p * q).positive_roots = p.positive_roots + q.positive_roots :=
begin
  rw [positive_roots, roots_mul hpq, filter_add],
  refl,
end

lemma positive_roots_X_pow (i : ℕ):
polynomial.positive_roots ((@X R _)^i) = ∅ :=
begin
  rw positive_roots,
  rw roots_pow,
  simp [filter_eq_nil],
  intros a ha,
  replace ha := mem_of_mem_nsmul ha,
  simp at ha,
  linarith [ha],
end
/--
The positive roots don't change when multiplying by X
-/
lemma positive_roots_mul_X (hp : p ≠ 0) :
  p.positive_roots = (p * X).positive_roots :=
begin
  have hnz : p * X ≠ 0 := mul_ne_zero hp X_ne_zero,
  rw [positive_roots_mul hnz, positive_roots_X],
  simp only [empty_eq_zero, add_zero],
end

lemma X_pow_ne_zero {i : ℕ} : (X : polynomial R)^i ≠ 0 :=
begin
  induction i with d hd,
  { simp only [pow_zero, ne.def, one_ne_zero, not_false_iff] },
  { apply mul_ne_zero X_ne_zero hd }
end

lemma positive_roots_mul_X_pow {i : ℕ} (hp : p ≠ 0) :
  (p * X^i).positive_roots = p.positive_roots :=
begin
rw positive_roots_mul (mul_ne_zero hp X_pow_ne_zero),
rw positive_roots_X_pow,
simp only [empty_eq_zero, add_zero],
end

-- Proposition 1 of Levin
/--
If all coefficients of p are non-negative, then p has no positive roots.
-/
lemma positive_roots_empty_of_positive_coeffs (h : ∀ n ∈ p.support, 0 < p.coeff n) :
  p.positive_roots = ∅ :=
begin
  by_contra he,
  have hp : p ≠ 0,
  {
    intro hp,
    apply he,
    rw [positive_roots, hp, roots_zero, empty_eq_zero, filter_zero]
  },
  --cases exists_mem_of_ne_zero he with x hx,
  obtain ⟨x, hx⟩ := exists_mem_of_ne_zero he,
  cases mem_positive_roots.mp hx with hxr hxp,
  rw [mem_roots hp, is_root.def, eval_eq_sum] at hxr,
  apply lt_irrefl (0 : R),
  nth_rewrite_rhs 0 ← hxr,
  convert finset.sum_lt_sum_of_nonempty _ _,
  swap,
  exact 0,
  simp only [pi.zero_apply, finset.sum_const_zero],
  exact nonempty_support_iff.mpr hp,
  intros n hn,
  specialize h n hn,
  rw [pi.zero_apply],
  exact mul_pos h (pow_pos hxp n),
end

/--
The list of nonzero coefficients of a polynomial
-/
def polynomial.nonzero_coeff_list
(f : polynomial R) := (f.support.sort (≤)).map f.coeff

open list

lemma list.sorted_of_monotone (l : list R) (hl : sorted (≤) l)
(g : R →o R) : sorted (≤) (map g l) :=
list.pairwise.map g.1 g.2 hl

lemma list.sort_commutes_monotone (S : list ℕ)
(g : ℕ →o ℕ) : (S.merge_sort (≤)).map g = (S.map g).merge_sort (≤)
:=
begin
  apply @eq_of_perm_of_sorted ℕ (≤),
  {
    calc
    map ⇑g (merge_sort has_le.le S) ~ map g.1 S : by {
      apply list.perm.map,
      apply perm_merge_sort,
    }
    ... ~ merge_sort has_le.le (map ⇑g S) : by {
      symmetry,
      apply perm_merge_sort,
    }
  },
  {
    apply pairwise.map g.1 g.2,
    apply sorted_merge_sort,
  },
  apply sorted_merge_sort,
end

lemma multiset.sort_commutes_monotone (S : multiset ℕ)
(g : ℕ ↪o ℕ) : (sort (≤) S).map g = sort (≤)
(multiset.map g S) :=
begin
  set l : list ℕ := S.to_list,
  rw show S = (l : multiset ℕ), by simp only [coe_to_list],
  rw (show (sort has_le.le ↑l) = merge_sort (≤) l, by exact multiset.coe_sort (≤) l),
  rw (show (sort has_le.le (map ⇑g ↑l)) = merge_sort (≤) (map g l), by exact multiset.coe_sort (≤) _),
  apply list.sort_commutes_monotone l g,
end

lemma finset.sort_commutes_monotone (S : finset ℕ)
(g : ℕ ↪o ℕ) : (finset.sort (≤) S).map g = finset.sort (≤) (finset.map g.1 S) :=
begin
  repeat {rw finset.sort},
  apply multiset.sort_commutes_monotone,
end

/--
The support doesn't change when scaling by a nonzero constant
-/
lemma polynomial.support_smul_of_ne_zero (f : polynomial R) {a : R} (h : a ≠ 0) : (a • f).support = f.support :=
begin
  ext,
  simp [h],
end

lemma polynomial.nonzero_coeff_list_smul (f : polynomial R) {a : R} (hc : a ≠ 0) :
(a • f).nonzero_coeff_list = f.nonzero_coeff_list.map (λ x, a * x) :=
begin
  simp only [polynomial.nonzero_coeff_list],
  rw polynomial.support_smul_of_ne_zero f hc,
  have : (a• f).coeff = λ n, a * (f.coeff n),
  {
    ext n,
    simp [coeff_smul],
  },
  simp [this],
end

/--
The number of sign changes in a list
-/
@[simp]
noncomputable def list.num_sign_changes : list R → ℕ
| [] := 0
| [a] := 0
| (a :: b :: tail) :=
ite (b = 0) (list.num_sign_changes (a :: tail))
(bool.to_nat (a * b < 0) + list.num_sign_changes (b :: tail))

@[simp]
lemma list.num_sign_changes_zero {a : R} (ha : a = 0) (l : list R) :
list.num_sign_changes (a :: l) = list.num_sign_changes l :=
begin
  rw ha,
  induction l with b tail,
  {
    simp,
  },
  by_cases hb : b = 0;
  {
    simp [hb],
    try {refl},
  },
end

@[simp]
lemma list.num_sign_changes_zero' {a b : R} (ha : b = 0) (l : list R) :
list.num_sign_changes (a :: b :: l) = list.num_sign_changes (a :: l) :=
begin
  sorry
end

@[simp]
lemma list.num_sign_changes_of_eq_signs {a b : R} (h : 0 < a * b) (l : list R) :
list.num_sign_changes (a :: b :: l) = list.num_sign_changes (b :: l) :=
begin
  sorry
end

@[simp]
lemma list.num_sign_changes_of_neq_signs {a b : R} (h : a * b < 0) (l : list R) :
list.num_sign_changes (a :: b :: l) = 1 + list.num_sign_changes (b :: l) :=
begin
  sorry
end

notation `V` := list.num_sign_changes

lemma list.num_sign_changes_smul (l : list R) (c : R) (hc : c ≠ 0) :
l.num_sign_changes = (l.map (λ x, c * x)).num_sign_changes :=
begin
induction l with a tail HI,
{
  refl,
},
{
  induction tail with b tail HI2,
  {
    simp,
  },
  {
    have hc : (a * b < 0) = (c * a * (c * b) < 0), by
    {
      ext,
      rw show (c * a * ( c * b) = c^2 * (a * b)), by ring,
      have hc' : 0 < c^2 := pow_two_pos_of_ne_zero c hc,
      split;
      {
        intro H,
        nlinarith [H],
      },
    },
    simp at *,
    rw HI,
    by_cases b = 0;
      simp [*] at *,
  }
}
end

/--
The number of sign changes of a  polynomial
-/
def polynomial.num_sign_changes (f : polynomial R) :=
f.nonzero_coeff_list.num_sign_changes

lemma polynomial.num_sign_changes_smul (f : polynomial R) {c : R} (hc : c ≠ 0) :
(c • f).num_sign_changes = f.num_sign_changes :=
begin
  rw [polynomial.num_sign_changes, polynomial.num_sign_changes,
  f.nonzero_coeff_list_smul hc,←list.num_sign_changes_smul _  _ hc],
end

lemma polynomial.support_mul_X (f : polynomial R) :
(f * X).support = f.support.map ⟨nat.succ, nat.succ_injective⟩ :=
begin
  ext i,
  cases i with i i,
  {
    simp only [mem_support_iff, mul_coeff_zero, coeff_X_zero, mul_zero,
    ne.def, eq_self_iff_true, not_true, finset.mem_map,
    function.embedding.coe_fn_mk, exists_false],
  },
  split;
  {
    intro hi,
    simpa using hi,
  },
end

lemma polynomial.support_mul_X_pow {i : ℕ} (f : polynomial R) :
(f * X^i).support = f.support.map ⟨nat.add i, add_right_injective i⟩ :=
begin
  induction i with i hi,
  {
    ext,
    simp,
  },
  {
    rw pow_succ,
    rw [show f * (X * X^i) = (f*X^i) * X, by ring],
    rw [polynomial.support_mul_X, hi, finset.map_map],
    ext r,
    simp only [finset.mem_map, mem_support_iff,
    ne.def, function.embedding.trans_apply, function.embedding.coe_fn_mk,
    nat.add_def, exists_prop],
    simp_rw show ∀ (a : ℕ), (i+a).succ = i.succ + a,
    by {intro a, rw nat.succ_eq_add_one, rw nat.succ_eq_add_one, ring_nf},
  }
end

lemma polynomial.nonzero_coeff_list_mul_X_pow (f : polynomial R) (i : ℕ) :
  (f * X^i).nonzero_coeff_list = f.nonzero_coeff_list :=
begin
  repeat {rw polynomial.nonzero_coeff_list},
  rw polynomial.support_mul_X_pow,
  set addi : ℕ ↪o ℕ := ⟨⟨i.add, λ a b hab, (add_right_inj i).mp hab⟩, λ a b, by simp⟩ with haddi,
  rw (show function.embedding.mk i.add (add_right_injective i)  = addi.to_embedding, by refl),
  rw ←finset.sort_commutes_monotone f.support addi,
  simp only [function.embedding.coe_fn_mk, rel_embedding.coe_fn_mk, list.map_map],
  rw show (f * X^i).coeff ∘ i.add = f.coeff, by {ext,
  simp,
  rw [add_comm , coeff_mul_X_pow],
  },
end

lemma polynomial.nonzero_coeff_list_mul_X (f : polynomial R) :
  (f * X).nonzero_coeff_list = f.nonzero_coeff_list :=
begin
  rw [←pow_one X, polynomial.nonzero_coeff_list_mul_X_pow f 1],
end

lemma polynomial.num_sign_changes_mul_X (f : polynomial R):
(f * X).num_sign_changes = f.num_sign_changes :=
begin
  rw polynomial.num_sign_changes,
  rw polynomial.num_sign_changes,
  congr' 1,
  apply polynomial.nonzero_coeff_list_mul_X,
end

lemma polynomial.num_sign_changes_mul_X_pow (f : polynomial R) (i : ℕ):
(f * X^i).num_sign_changes = f.num_sign_changes :=
begin
  induction i with n hn,
  {
    simp only [pow_zero, mul_one],
  },
  {
    rw show f * X ^ n.succ = (f * X^n) * X, by ring_nf,
    rw polynomial.num_sign_changes_mul_X,
    exact hn,
  }
end

/--
The number of sign changes can be computed on the monic normalization
-/
lemma num_sign_changes_normalize_eq_num_sign_changes :
  (normalize p).num_sign_changes = p.num_sign_changes :=
begin
  have hnz := (norm_unit (leading_coeff p)).ne_zero,
  simp only [coe_norm_unit, coeff_mul_C, normalize_apply],
  rw ← p.num_sign_changes_smul  hnz,
  congr' 1,
  rw smul_eq_C_mul,
  ring,
end

lemma coeff_mul_X_sub_C' {p : polynomial R} {r : R} {a : ℕ} :
  coeff (p * (X - C r)) a = (if 0 < a then coeff p (a - 1) else 0) - coeff p a * r :=
begin
  split_ifs,
  { have : a = (a - 1) + 1 := by omega,
    rw [this, coeff_mul_X_sub_C],
    simp, },
  { have : a = 0 := by omega, simp [this], },
end

lemma finset.range_succ_succ (i : ℕ) :
finset.range i.succ.succ = insert 0  (insert 1 (finset.filter (λ j, 1 < j) (finset.range i.succ.succ))):=
begin
  ext,
  simp,
  cases a,
  {finish},
  cases a,
  {finish},
  finish,
end

lemma aux_lemma (a : ℕ) (f : ℕ → R): ite (1 < a)  ((ite (0 = a) (1 : R) 0 - ite (1 = a) 1 0) * f a) (0 : R) = 0 :=
begin
  cases a with a a,
  { simp },
  cases a with a a,
  { simp },
  have h0 : ¬ 0 = a.succ.succ,
  {
    exact ne_zero.ne' (nat.succ a).succ,
  },
  have h1 : ¬ 1 = a.succ.succ,
  {
    intro hc,
    have hh : 0 = a.succ := nat.succ.inj hc,
    finish,
  },
  simp [h0, h1],
end

lemma coeff_X_sub_C_mul (i : ℕ):
  p.coeff i = ∑ j in finset.range (i+1), ((C (1 : R) - X) * p).coeff j :=
begin
  induction i with i hi,
    { simp },
  rw finset.range_succ,
  rw finset.sum_insert finset.not_mem_range_self,
  rw ← hi,
  rw coeff_mul,
  rw finset.nat.sum_antidiagonal_eq_sum_range_succ (λ x y, (C (1:R)- X).coeff x * p.coeff y) (i.succ),
  simp,
  rw finset.range_succ_succ,
  rw finset.sum_insert,
  {
    rw finset.sum_insert,
    {
      repeat {simp_rw coeff_one},
      repeat {simp_rw coeff_X},
      simp_rw [finset.sum_filter, aux_lemma],
      simp,
    },
    {
      simp,
    }
  },
  {
    simp,
  }
end

-- Arthan's version
lemma arthan (hp : coeff p 0 ≠ 0) :
 ∃ (m : ℕ), ((X - C 1 : polynomial R) * p).num_sign_changes  =
 p.num_sign_changes + 2*m + 1:=
begin
sorry
end

@[simp]
lemma num_sign_changes_cX {c : R} (hc : 0 < c) : (p.comp (c • X)).num_sign_changes = p.num_sign_changes :=
begin
sorry
end

lemma num_sign_changes_X_sub_C_mul'' {a : R} (ha: 0 < a) (hp : coeff p 0 ≠ 0) :
 ∃ (m : ℕ), ((X - C a : polynomial R) * p).num_sign_changes  = p.num_sign_changes + 2*m + 1:=
begin
have hp' : coeff (p.comp (a•X)) 0 ≠ 0, by sorry,
obtain ⟨m, hm⟩ := arthan hp',
have ha' : a ≠ 0 := ne_of_gt ha,
have ha'' : a⁻¹ ≠ 0 := inv_ne_zero ha',
use m,
-- reduce to Arthan's lemma by using that p(cx) has the same number of sign changes as p(x)
calc
((X - C a) * p).num_sign_changes  = (C a⁻¹ * ((X - C a) * p)).num_sign_changes : by {
  rw show C a⁻¹ * ((X - C a) * p) = C a⁻¹ • ((X - C a) * p), by simp,
  rw ← polynomial.num_sign_changes_smul _ ha'',
  simp,
}
... = (C a⁻¹ * ((C a * X - C a) * p.comp(a•X))).num_sign_changes : by {rw ← num_sign_changes_cX ha, simp}
... = ((C a⁻¹ * (C a * X - C a)) * p.comp(a•X)).num_sign_changes : by {simp}
... = ((X - C 1) * p.comp(a•X)).num_sign_changes : by {
  rw show C a * X - C a = C a * (X - C 1), by ring_nf,
  simp [ha'],
  }
... = (p.comp (a•X)).num_sign_changes + 2 * m + 1 : hm
... = p.num_sign_changes + 2 * m + 1 : by {rw num_sign_changes_cX ha}
end

-- Lemma 2 of Levin
/--
For all α > 0, the polynomial (X-α) * p has at least one more sign change than p
-/
lemma num_sign_changes_X_sub_C_mul' {x : R} (hx : 0 < x) (hp : coeff p 0 ≠ 0) :
  p.num_sign_changes + 1 ≤ ((X - C x : polynomial R) * p).num_sign_changes :=
begin
  obtain ⟨m,hm⟩ := num_sign_changes_X_sub_C_mul'' hx hp,
  rw hm,
  linarith,
end

lemma polynomial.root_iff_divides_X_sub_C {p : polynomial R} (hp : p ≠ 0) (α : R) :
∃ (q : polynomial R), p = (X-C α)^(p.root_multiplicity α) * q ∧ q.eval α ≠ 0 :=
begin
have H1 := @le_root_multiplicity_iff  _ _ _ hp α (p.root_multiplicity α),
simp at H1,
have H2 := @root_multiplicity_le_iff  _ _ _ hp α (p.root_multiplicity α),
simp at H2,
obtain ⟨q, hq⟩ := H1,
use q,
split,
  { exact hq },
intro hc,
replace hc : is_root q α := is_root.def.mpr hc,
obtain ⟨r, hr⟩ := dvd_iff_is_root.mpr hc,
apply H2,
rw hr at hq,
use r,
generalize hj : root_multiplicity α p = j,
rw hj at hq,
rw hq,
ring_exp,
end

lemma polynomial.root_zero_iff_divides_X  {p : polynomial R} (hp : p ≠ 0)  :
∃ q,  p = X^(p.root_multiplicity 0)  * q ∧ (q.coeff 0 ≠ 0) :=
begin
  obtain ⟨q, hq⟩ := polynomial.root_iff_divides_X_sub_C hp 0,
  use q,
  simp at hq,
  have H : q.coeff 0 = q.eval 0,
  { simp only [eval, eval₂_at_zero, ring_hom.id_apply] },
  rw H,
  exact hq,
end

lemma num_sign_changes_X_sub_C_mul (hp : p ≠ 0) {x : R} (hx : 0 < x) :
  p.num_sign_changes + 1 ≤ ((X - C x : polynomial R) * p).num_sign_changes :=
begin
  obtain ⟨q, ⟨h, hnz⟩⟩ := polynomial.root_zero_iff_divides_X hp,
  have h' : (X - C x) * (q * X^(p.root_multiplicity 0)) = ((X - C x) * q) * X^(p.root_multiplicity 0),
  { ring },
  rw [h, mul_comm, polynomial.num_sign_changes_mul_X_pow, h', polynomial.num_sign_changes_mul_X_pow],
  exact num_sign_changes_X_sub_C_mul' hx hnz,
end

theorem descartes_sign_rule_1'  (hp : p ≠ 0) : p.number_positive_roots ≤ p.num_sign_changes :=
begin
  rw number_positive_roots,
  induction h : p.positive_roots.card generalizing p hp,
  { exact zero_le (p.num_sign_changes), },
  { obtain ⟨x, hx⟩ := card_pos_iff_exists_mem.mp (by rw h; exact nat.succ_pos n),
    rw mem_positive_roots at hx,
    rw ← h,
    have := mul_div_eq_iff_is_root.mpr ((mem_roots hp).mp hx.1),
    rw ← this at hp,
    have hkey : (p / (X - C x)).positive_roots.card = n,
    {
      rw [← this, positive_roots_mul hp] at h,
      simp [card_add, positive_roots_X_sub_C_of_zero_lt hx.2] at h,
      exact nat.succ.inj h
    },
    have hp' : p / (X - C x) ≠ 0,
    {
      intro hc,
      apply hp,
      rw hc,
      ring,
    },
    rw [← this, positive_roots_mul, card_add],
    {
    calc (X - C x).positive_roots.card + (p / (X - C x)).positive_roots.card = 1 + (p / (X - C x)).positive_roots.card : by simp [positive_roots_X_sub_C_of_zero_lt hx.2]
      ... ≤ 1 + (p / (X - C x)).num_sign_changes : nat.add_le_add_left _ 1
      ... = (p / (X - C x)).num_sign_changes + 1 : add_comm _ _
      ... ≤ ((X - C x) * (p / (X - C x))).num_sign_changes : num_sign_changes_X_sub_C_mul hp' hx.2,
      rw hkey,
      apply ih (right_ne_zero_of_mul hp),
      exact hkey,
    },
    exact hp,
  },
end

theorem descartes_sign_rule_1 (hp : p ≠ 0) : p.number_positive_roots ≤ p.num_sign_changes :=
begin
  by_cases hp0 :  p.coeff 0 = 0,
  {
    sorry
  },
  {
    exact descartes_sign_rule_1' hp,
  }
end

lemma list.parity_sign (S : list ℝ) (h: S ≠ []) : even (S.num_sign_changes - bool.to_nat (S.head * (S.last h) < 0)) :=
begin
  sorry
end

theorem descartes_sign_rule_2' {f : polynomial R} (hf : f.monic) : even (f.num_sign_changes - f.number_positive_roots) :=
begin
  sorry
end

theorem descartes_sign_rule_2 {f : polynomial R} (hf : f ≠ 0) : even (f.num_sign_changes - f.number_positive_roots) :=
begin
  rw ← num_sign_changes_normalize_eq_num_sign_changes,
  rw number_positive_roots,
  rw ←positive_roots_normalize_eq_positive_roots,
  exact descartes_sign_rule_2' (polynomial.monic_normalize hf),
end


import game.sets.sets_level01 -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type -- hide

/-
# Chapter 1 : Sets

## Level 2 : union (∪)
-/

/-
Working with sets is very similar to working with propositions.
Let's now prove that any set $A$ is included in its union with
any other set $B$, or $A ⊆ A ∪ B$. To work with unions you will
need to know the property which classifies them:

```
mem_union_iff : x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B
```

You need to get yourself into a situation where the left hand side
of `mem_union_iff` is in your goal; that way, you can `rw mem_union_iff`
and make progress.
-/

/- Axiom : mem_union_iff :
x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B
-/

/- Hint : Tactic tip : intros
`intros` is like `intro` but can be used to introduce more than one
thing at once. For example if your goal is `⊢ ∀ (x : X), x ∈ A → x ∈ A ∪ B`
then `intros x hx` will do the same as `intro x, intro hx`.
-/

/- Hint : Stuck?
We start with a rewrite (see level 1).
Then, after introducing your terms, you'll be able to pull off
the second rewrite. Finally, you'll need to prove the `left`
side of an `or` goal.
-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \subseteq A\cup B.$$
-/
theorem subset_union_left (A B : set X) : A ⊆ A ∪ B :=
begin
  rw subset_iff,
  intro h,
  intro f,
  left,
  exact f,

end

end xena --hide


import limits Bolzano_Weierstrass

noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable

-- the maths starts here.

-- We introduce the usual mathematical notation for absolute value
local notation `|` x `|` := abs x

def is_cauchy (a : ℕ → ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ m ≥ N, ∀ n ≥ N, |a m - a n| < ε

/- TODO: merge with monotone.lean
-- is_subsequence b a means b is a subsequence of a
def is_subsequence (b : ℕ → ℝ) (a : ℕ → ℝ) : Prop :=
∃ s : ℕ → ℕ, b = a ∘ s ∧ ∀ m : ℕ, s m < s (m + 1)

def is_monotone (b : ℕ → ℝ) : Prop :=
(∀ m, b m ≤ b (m + 1)) ∨ ∀ m, b (m + 1) ≤ b m

theorem exists_monotone (a : ℕ → ℝ) :
∃ b : ℕ → ℝ, is_subsequence b a ∧ is_monotone b := sorry -/

theorem bounded_of_bounded_shift (a : ℕ → ℝ) (N : ℕ) :
  M1P1.is_bounded (λ k, a (N + k)) → M1P1.is_bounded a :=
nat.rec_on N (by simp only [zero_add, imp_self]) $ λ N ih ha, ih $
let ⟨M, HM⟩ := ha in ⟨max M ( |a N| ), λ y,
nat.cases_on y (le_max_right _ _) $ λ y,
le_trans (by convert HM y; simp only [nat.succ_add]) (le_max_left _ _)⟩

theorem bounded_of_cauchy (a : ℕ → ℝ) : is_cauchy a → M1P1.is_bounded a :=
λ ha, let ⟨N, hn⟩ := ha 1 zero_lt_one in bounded_of_bounded_shift a N ⟨|a N| + 1, λ k,
calc  |a (N + k)|
    ≤ |a N + (a (N + k) - a N)| : by rw add_sub_cancel'_right
... ≤ |a N| + |a (N + k) - a N| : abs_add_le_abs_add_abs _ _
... ≤ |a N| + 1 : add_le_add_left (le_of_lt $ hn _ (nat.le_add_right _ _) _ (le_refl _)) _⟩

theorem cauchy_implies_convergent (a : ℕ → ℝ) : is_cauchy a → M1P1.has_limit a :=
λ ha, let ⟨s, hsi, L, hsL⟩ := bolzano_weierstrass a (bounded_of_cauchy a ha) in ⟨L, λ ε Hε,
let ⟨N1, HN1⟩ := ha (ε/2) (half_pos Hε) in
let ⟨N2, HN2⟩ := hsL (ε/2) (half_pos Hε) in
⟨max N1 N2, λ n hn,
have hn1 : N1 ≤ n, from le_trans (le_max_left _ _) hn,
have hn2 : N2 ≤ n, from le_trans (le_max_right _ _) hn,
calc  |a n - L|
    ≤ |a n - a (s n)| + |a (s n) - L| : abs_sub_le _ _ _
... < ε/2 + ε/2 : add_lt_add (HN1 _ hn1 _ $ le_trans hn1 $ n.le_of_strictly_increasing s hsi) (HN2 _ hn2)
... = ε : add_halves ε⟩⟩


import data.set.basic -- hide
import set_theory_world.image_tutorial
import tactic -- hide

/-

## The image of a union

In this level we prove that the image of a union of two sets if the union of their images.

In Lean, `x ∈ A ∪ B` is the same as `x ∈ A ∨ x ∈ B`, so the `left/right` tactics work in the goal, as well
as the `cases` one in a hypothesis.
-/

open set -- hide
variables{X Y: Type} -- hide

/- Lemma
$ f(A ∪ B) = f(A) ∪ f(B) $
-/
lemma image_union (f : X → Y) (A B : set X) : f '' (A ∪ B) = f '' A ∪ f '' B :=
begin
  ext y,
  split,
  {
    intro h1,
    cases h1,
    cases h1_h,
    cases h1_h_left,
    {
      left,
      rw ← h1_h_right,
      use [h1_w, h1_h_left],
    },
    {
      right,
      rw  ← h1_h_right,
      use [h1_w, h1_h_left],
    },
  },
  {
    intro h1,
    cases h1,
    {
      cases h1,
      cases h1_h,
      rw ← h1_h_right,
      use h1_w,
      split,
      {
        left,
        assumption,
      },
      refl,
    },
    {
      cases h1,
      cases h1_h,
      rw ← h1_h_right,
      use h1_w,
      split,
      {
        right,
        assumption,
      },
      refl,
    },
  },

end


import galois.tactic
       galois.nat.simplify_le

def nat_to_fin_option (k n : ℕ) : option (fin k)
  := if H : n < k then some ⟨ _, H ⟩ else none

namespace fin

lemma fin_0_empty (x : fin 0) : false :=
begin
induction x,
apply nat.lt_irrefl,
apply lt_of_le_of_lt, tactic.swap,
assumption, apply nat.zero_le,
end

lemma val_inj {n : ℕ} (i j : fin n)
  (H : i.val = j.val) : i = j
:= begin
induction i, induction j, dsimp at H, induction H,
reflexivity,
end

lemma succ_pred_id {k : ℕ} (i : fin k.succ)
  (H : i ≠ 0)
  : fin.succ (fin.pred i H) = i
:= begin
induction i,
dsimp [fin.pred, fin.succ],
cases val, exfalso, apply H, unfold has_zero.zero,
dsimp [nat.pred], reflexivity,
end

lemma succ_pred_equiv {k : ℕ} (i : fin k.succ)
  (H : i ≠ 0)
  (n : ℕ)
 : (i.val = nat.succ n) ↔ ((fin.pred i H).val = n)
:= begin
induction i, dsimp [fin.pred],
cases val, exfalso, apply H,
unfold has_zero.zero,
dsimp [nat.pred], split; intros H',
injection H', subst H',
end

end fin

lemma nat_to_fin_option_pred_none {n i : ℕ}
  : nat_to_fin_option n.succ i.succ = none
  → nat_to_fin_option n i = none
:= begin
unfold nat_to_fin_option,
apply (if Hlt : i.succ < n.succ then _ else _),
{ rw (dif_pos Hlt), intros H,
  contradiction,
},
{ rw (dif_neg Hlt), intros H', clear H',
  have H : ¬ (i < n),
  intros contra, apply Hlt,
  apply nat.succ_lt_succ, assumption,
  rw (dif_neg H),
}
end

lemma nat_to_fin_option_succ_nz {n k : ℕ} {i : fin n.succ}
  : nat_to_fin_option n.succ k.succ = some i
  → i ≠ 0
:= begin
dsimp [nat_to_fin_option],
apply (if H : (nat.succ k < nat.succ n) then _ else _),
{ rw (dif_pos H), intros H', injection H' with H'', clear H',
  intros contra, subst i, injection contra,
  injection h_1,
},
{ rw (dif_neg H), intros contra, contradiction, }
end

lemma nat_to_fin_option_pred_some {n k : ℕ} (i : fin n.succ)
  : ∀ H : nat_to_fin_option n.succ k.succ = some i
  , nat_to_fin_option n k = some (i.pred (nat_to_fin_option_succ_nz H))
:= begin
dsimp [nat_to_fin_option],
intros H,
apply (if H' : (nat.succ k < nat.succ n) then _ else _),
{ rw (dif_pos H') at H, injection H with H2, clear H,
  rw nat.succ_lt_succ_iff at H',
  rename H' H'1,
  rw (dif_pos H'1), f_equal, subst i,
  dsimp [fin.pred], reflexivity,
},
{ rw (dif_neg H') at H, contradiction, }
end

lemma nat_to_fin_option_val {n k : ℕ} {i : fin n}
  (H : nat_to_fin_option n k = some i)
  : i.val = k
:= begin
dsimp [nat_to_fin_option] at H,
apply (if H' : k < n then _ else _),
{ rw (dif_pos H') at H, injection H with H2,
  clear H, subst i,
},
{ rw (dif_neg H') at H, contradiction }
end


notation "ℤ" => Int

section
  variable (x y : Nat)

  def double := x + x

  #check double y
  #check double (2 * x)

  attribute [local simp] Nat.add_assoc Nat.add_comm Nat.add_left_comm

  theorem t1 : double (x + y) = double x + double y := by
    simp [double]

  #check t1 y
  #check t1 (2 * x)

  theorem t2 : double (x * y) = double x * y := by
    simp [double, Nat.add_mul]
end

theorem eight_equals_twice_four : 8 = 2 * 4 := by
  simp

def twice (f : Nat → Nat) (a : Nat) :=
  f (f a)

def foo (x : Nat) := x + 2
def goo (x : Nat) : Nat := x + 2
#check foo
#check goo

-- The `where` syntax.

structure IntWithParity where
  value : ℤ
  even  : Bool
  deriving Repr

def increment_int_with_parity (x : IntWithParity) : IntWithParity where
  value := x.value + 1
  even  := ¬x.even

#eval increment_int_with_parity (IntWithParity.mk 0 true)
#eval increment_int_with_parity <| increment_int_with_parity <| (IntWithParity.mk 0 true)

universe u

-- Playing with records.
structure Point (α : Type u) where
  x : α
  y : α
  deriving Repr

#check Point.mk
#check Point.mk 0 0

def eight := 8
#eval s!"The cube of two is {eight}"

def p₁ : Point Int := Point.mk 0 0

-- When can we use `let`?
def fn :=
  let a := 2
  a
-- let a := 0 (This doesn't work, because `let` must be in a local scope?)

#eval fn

#check p₁
#eval p₁

-- Checking multiple things at the same time (you can't).
#check 0 -- This works!
-- #check 0 0 (This doesn't work.)

-- Can we use string literals on the left-hand side of a lambda `=>` definition? No.
#check_failure λ "a" => "a"

-- Pipelining.
def add1 x := x + 1
def times2 x := x * 2

#eval times2 (add1 100)
#eval 100 |> add1 |> times2
#eval times2 <| add1 <| 100

-- Two different ways of defining a function.
def identity : Nat → Nat := λ x => x
def identity2 (x : Nat) : Nat := x

#check identity

#eval identity 5
#eval identity2 6

-- Multiple parameters of the same type declared within the same declaration.

def add_two_naturals (a b : Nat) : Nat := a + b

#check add_two_naturals
#eval add_two_naturals 4 5

def multiply (a b : Int) : Int := a * b
#eval multiply 7 (-8)

-- Array literal declaration and subscripts.
#eval #['a', 'b', 'c'][4]
#eval #['b', 'c', 'd'][4]
#eval #[1, 2, 3][4]
#eval #["a", "aa", "aaa"][4]

def add_two_naturals_with_shorthand_notation_for_integers (a b : ℤ) : ℤ := a + b
#eval add_two_naturals_with_shorthand_notation_for_integers 8 9

inductive Tree (β : Type v) where
 | leaf : Tree β
 | node (left : Tree β) (key : Nat) (value : β) (right : Tree β) : Tree β
deriving Repr

 def walk [ToString β] : Tree β → String
   | .leaf          => "leaf"
   | .node l k v r  => s!"node: {k} {v}\n{walk l}\n{walk r}"

/-
def construct_tree : IO Unit := do
  let tree : Tree String ← Tree.node (Tree.leaf) 0 "value" (Tree.leaf)
-/

-- Exploring `do` notation.
def main : IO UInt32 := do
  IO.println "hello"
  IO.println "world"
  return 0

-- What does the notation used above in `main` do?
-- The below is the same function *without* `do` notation.
-- Let's look at the type of `bind`, as in https://leanprover.github.io/lean4/doc/do.html
#check bind

-- It's `{m : Type u_1 → Type u_2} → [self : Bind m] → {α β : Type u_1} → m α → (α → m β) → m β`
-- And ignoring all the implicit arguments, we have `m α → (α → m β) → m β`.
-- Well, what are `m α` and `(α → m β)` in the below?
def mainInt : IO UInt32 :=
  bind (IO.println "hello") fun _ =>
  bind (IO.println "world") fun _ =>
  pure 0

-- Let's rewrite `mainInt` to find out:
def mainIntExpanded : IO UInt32 :=
  bind (IO.println "hello") (fun _ => bind (IO.println "world") (fun _ => pure 0))

-- So we see the second argument to the first `bind` call is actually
-- everything from `fun` (which you should recall defines an anonymous lambda
-- function) in the first line, all the way to the end. This might be obvious
-- to someone coming from e.g. Haskell, but it was not to me. The hanging
-- lambda function definition looked like it might be a syntax error. But of
-- course it isn't because it typechecks.

-- Let's cut out the second bind call to make things easier to look at:
def mainIntSimplified : IO UInt32 :=
  bind (IO.println "hello world") (λ _ => pure 0)

-- So   `(IO.println "hello world")`  is our `m α` ...
-- And  `(λ _ => pure 0)`             is our `(α → m β)`.

-- What are `α` and `β` in this example?
-- Let's `#check` the arguments to find out.
def m_α := IO.println "hello world"
#check m_α

-- We must explicitly set the type we expect below, or we get an `instance
-- problem stuck` error.
def α_to_m_β : Unit → IO UInt32 := (λ _ => pure 0)
#check α_to_m_β

-- Investigating the `<|>` operator.
#check true
#check false
#check true <|> false

variable (a b c d e : Nat)
variable (h1 : a = b)
variable (h2 : b = c + 1)
variable (h3 : c = d)
variable (h4 : e = 1 + d)

theorem T : a = e :=
  calc
    a = b      := h1
    _ = c + 1  := h2
    _ = d + 1  := congrArg Nat.succ h3
    _ = 1 + d  := Nat.add_comm d 1
    _ = e      := Eq.symm h4

def isEmpty {α : Type u} : List α → Bool
  | [] => true
  | _ :: _ => false


import data.real.basic

import analysis.special_functions.pow

/-- Let <math>\mathbb{R}</math> be the set of real numbers. Determine all functions <math>f</math>:<math>\mathbb{R}\rightarrow\mathbb{R}</math> satisfying the equation

<math></math>

for all real numbers <math>x</math> and <math>y</math>.

--/

theorem exo (f: real -> real):
  (forall x y, f(x+f(x+y))+f(x*y) = x+f(x+y)+y*f(x))
  -> ((forall x, f x = x) \/ (forall x, f x = 2-x))
:= sorry


/-
Copyright (c) 2022 Antoine Labelle. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle
-/
import representation_theory.basic
import representation_theory.Rep

/-!
# Subspace of invariants a group representation

This file introduces the subspace of invariants of a group representation
and proves basic results about it.
The main tool used is the average of all elements of the group, seen as an element of
`monoid_algebra k G`. The action of this special element gives a projection onto the
subspace of invariants.
In order for the definition of the average element to make sense, we need to assume for most of the
results that the order of `G` is invertible in `k` (e. g. `k` has characteristic `0`).
-/

open_locale big_operators
open monoid_algebra
open representation

namespace group_algebra

variables (k G : Type*) [comm_semiring k] [group G]
variables [fintype G] [invertible (fintype.card G : k)]

/--
The average of all elements of the group `G`, considered as an element of `monoid_algebra k G`.
-/
noncomputable def average : monoid_algebra k G :=
  ⅟(fintype.card G : k) • ∑ g : G, of k G g

lemma average_def : average k G = ⅟(fintype.card G : k) • ∑ g : G, of k G g := rfl

/--
`average k G` is invariant under left multiplication by elements of `G`.
-/
@[simp]
theorem mul_average_left (g : G) :
  (finsupp.single g 1 * average k G : monoid_algebra k G) = average k G :=
begin
  simp only [mul_one, finset.mul_sum, algebra.mul_smul_comm, average_def, monoid_algebra.of_apply,
    finset.sum_congr, monoid_algebra.single_mul_single],
  set f : G → monoid_algebra k G := λ x, finsupp.single x 1,
  show ⅟ ↑(fintype.card G) • ∑ (x : G), f (g * x) = ⅟ ↑(fintype.card G) • ∑ (x : G), f x,
  rw function.bijective.sum_comp (group.mul_left_bijective g) _,
end

/--
`average k G` is invariant under right multiplication by elements of `G`.
-/
@[simp]
theorem mul_average_right (g : G) :
  average k G * finsupp.single g 1 = average k G :=
begin
  simp only [mul_one, finset.sum_mul, algebra.smul_mul_assoc, average_def, monoid_algebra.of_apply,
    finset.sum_congr, monoid_algebra.single_mul_single],
  set f : G → monoid_algebra k G := λ x, finsupp.single x 1,
  show ⅟ ↑(fintype.card G) • ∑ (x : G), f (x * g) = ⅟ ↑(fintype.card G) • ∑ (x : G), f x,
  rw function.bijective.sum_comp (group.mul_right_bijective g) _,
end

end group_algebra

namespace representation

section invariants

open group_algebra

variables {k G V : Type*} [comm_semiring k] [group G] [add_comm_monoid V] [module k V]
variables (ρ : representation k G V)

/--
The subspace of invariants, consisting of the vectors fixed by all elements of `G`.
-/
def invariants : submodule k V :=
{ carrier := set_of (λ v, ∀ (g : G), ρ g v = v),
  zero_mem' := λ g, by simp only [map_zero],
  add_mem' := λ v w hv hw g, by simp only [hv g, hw g, map_add],
  smul_mem' := λ r v hv g, by simp only [hv g, linear_map.map_smulₛₗ, ring_hom.id_apply]}

@[simp]
lemma mem_invariants (v : V) : v ∈ invariants ρ ↔ ∀ (g: G), ρ g v = v := by refl

lemma invariants_eq_inter :
  (invariants ρ).carrier = ⋂ g : G, function.fixed_points (ρ g) :=
by {ext, simp [function.is_fixed_pt]}

variables [fintype G] [invertible (fintype.card G : k)]

/--
The action of `average k G` gives a projection map onto the subspace of invariants.
-/
@[simp]
noncomputable def average_map : V →ₗ[k] V := as_algebra_hom ρ (average k G)

/--
The `average_map` sends elements of `V` to the subspace of invariants.
-/
theorem average_map_invariant (v : V) : average_map ρ v ∈ invariants ρ :=
λ g, by rw [average_map, ←as_algebra_hom_single, ←linear_map.mul_apply, ←map_mul (as_algebra_hom ρ),
            mul_average_left]

/--
The `average_map` acts as the identity on the subspace of invariants.
-/
theorem average_map_id (v : V) (hv : v ∈ invariants ρ) : average_map ρ v = v :=
begin
  rw mem_invariants at hv,
  simp [average_def, map_sum, hv, finset.card_univ, nsmul_eq_smul_cast k _ v, smul_smul],
end

theorem is_proj_average_map : linear_map.is_proj ρ.invariants ρ.average_map :=
⟨ρ.average_map_invariant, ρ.average_map_id⟩

end invariants

namespace lin_hom

universes u

open category_theory Action

variables {k : Type u} [comm_ring k] {G : Group.{u}}

lemma mem_invariants_iff_comm {X Y : Rep k G} (f : X.V →ₗ[k] Y.V) (g : G) :
  (lin_hom X.ρ Y.ρ) g f = f ↔ X.ρ g ≫ f = f ≫ Y.ρ g :=
begin
  rw [lin_hom_apply, ←ρ_Aut_apply_inv, ←linear_map.comp_assoc, ←Module.comp_def, ←Module.comp_def,
  iso.inv_comp_eq, ρ_Aut_apply_hom], exact comm,
end

/-- The invariants of the representation `lin_hom X.ρ Y.ρ` correspond to the the representation
homomorphisms from `X` to `Y` -/
@[simps]
def invariants_equiv_Rep_hom (X Y : Rep k G) : (lin_hom X.ρ Y.ρ).invariants ≃ₗ[k] (X ⟶ Y) :=
{ to_fun := λ f, ⟨f.val, λ g, (mem_invariants_iff_comm _ g).1 (f.property g)⟩,
  map_add' := λ _ _, rfl,
  map_smul' := λ _ _, rfl,
  inv_fun := λ f, ⟨f.hom, λ g, (mem_invariants_iff_comm _ g).2 (f.comm g)⟩,
  left_inv := λ _, by { ext, refl },
  right_inv := λ _, by { ext, refl } }

end lin_hom

end representation


import linear_algebra.basic
import data.sum
import linear_algebra.finite_dimensional
universes  u v w w' w''
set_option pp.beta true
notation `Σ` := finset.sum finset.univ
/-!
    Goals : sudying familly of projector.
    We start  by sudy i little projector.
-/
namespace Projector
open linear_map
variables {R : Type u}[comm_ring R]{M : Type v}[add_comm_group M] [module R M]
/-!
    A linear map `p : M →ₗ[R] M)` is a projector when `p * p = p`.
-/
def  is_projector (p : M →ₗ[R] M) := p * p = p

lemma is_projector_ext {p : M →ₗ[R]M} (hyp : is_projector p) : p * p = p :=
begin unfold is_projector at hyp,exact hyp, end
/--
    if `p² = p` then `(1-p)² = 1 - p - p +p² = ... = 1-p`
-/
lemma Complementary (p : M →ₗ[R]M) (hyp : is_projector p) : is_projector (id - p) := begin
    change linear_map.id - p with 1 -p,
    have R : ( 1- p) * (1 -p) = 1 - p -(p - p * p),
        exact mul_sub (1 - p) 1 p,
    unfold is_projector,
    rw R,
    rw is_projector_ext hyp,
    simp,
end
variables (p : M→ₗ[R]M)

lemma Projector_apply (x : M) :  p ∘ p =  ⇑(p * p) := rfl

lemma image_in_range (x : M) : p x ∈ range p := by apply mem_range.mpr; use x

lemma ker_eq_im_comp (hyp : is_projector p) : range p = ker (id-p) := begin
    apply submodule.ext,intros x,split,rintros ⟨y,hyp  ⟩, rw mem_ker, change x- p x = 0, rw ← hyp.2,
    change (p - p * p) y = 0, rw is_projector_ext, rw sub_self, exact rfl,assumption,
    intros hyp, rw mem_ker at hyp, change x-p x = 0 at hyp, rw mem_range, use x,
    have R : x - p x + p x = p x,
        rw hyp_1,
        rw zero_add,
    rw ← R,simp,
  end

def has_projector (P : submodule R M) :=
        ∃ p : M →ₗ[R]M, is_projector p ∧ linear_map.range (p : M→ₗ[R]M)  = P

lemma proj_ker (p : M →ₗ[R]M) (hyp : is_projector p) : ∀ m : M, p m ∈ ker (id - p) :=
begin
    rw ← ker_eq_im_comp, exact image_in_range p,assumption,
end
lemma  calcul : linear_map.id - (id - p) = p := begin exact sub_sub_self id p, end

lemma proj_im(p : M →ₗ[R]M) (hyp : is_projector p) : ∀ m : M, m - p m ∈ ker (p) :=
begin
    let H := proj_ker (id-p) (Complementary p hyp),
    -- let H := specialize (proj_ker (id - p)) (Complementary p hyp)  -- unknown identifier 'specialize'
    rw calcul at H,
    exact H,
end
lemma projector_decomp (p : M →ₗ[R]M) (hyp : is_projector p) :
    ∀ m : M,∃ m_im ∈ range p, ∃ m_ker ∈ ker p, m = m_ker+ m_im  := begin
        intros m,
        use p m,
        split, refine image_in_range _ m ,
        use m - p m,
        split,
        apply proj_im,
        assumption,simp,
     end
lemma Unicity (hyp : is_projector p) : (range p)  ⊓ (ker p)= ⊥ :=  begin
    rw eq_bot_iff,
    rw submodule.le_def', intros x, rw submodule.mem_bot, intros,
    rw submodule.mem_inf at H,
    rcases H with ⟨  IM, KER ⟩ ,
    rw mem_ker at KER, rw mem_range at IM, rcases IM with ⟨ y,hyp_y⟩ ,
    rw ← hyp_y at KER, change (p * p) y = 0 at KER, rw is_projector_ext at KER, rw hyp_y at KER,
assumption, assumption,
end
lemma projector.mem_range (x : M)(hyp : is_projector p) : x ∈ range p ↔  p x = x := begin
    split,
        intro hyp, rw mem_range at hyp, rcases hyp with ⟨y,hyp_y ⟩,
        rw ← hyp_y,
        change p( p y) with (p *p) y,
        rw (is_projector_ext hyp),
        intro hyp,
        rw ← hyp,
        apply image_in_range,
end

lemma projector_im_eq (p q : M→ₗ[R] M) (hyp_p : is_projector p) (hyp_q : is_projector q) :
            range  p =  range q ↔  ( p * q = q) ∧  (q * p = p) := begin
        split,
        intro hyp,
            split,
                {ext,rw mul_app, rw ← projector.mem_range, rw hyp,refine image_in_range q _, assumption},
                {ext, rw mul_app,rw ← projector.mem_range,rw ← hyp,refine image_in_range p _, assumption},
            intro,
            apply submodule.ext,
            intro x, split,
                {intro,rw ←  a.2 at a_1,rw mem_range at *,rcases a_1,use p a_1_w, exact a_1_h,},
                {intro,rw ←  a.1 at a_1,rw mem_range at *,rcases a_1,use q a_1_w, exact a_1_h,},
end

theorem projector.caract_image (p : M→ₗ[R]M) : (∀ x : range p, p x = x ) → is_projector p := begin
    intro hyp, unfold is_projector,
    ext,rw mul_app,
    exact hyp ⟨p x,image_in_range p x ⟩,
end
lemma range_le_submodule (p : M→ₗ[R]M) (W : submodule R M) : range p ≤ W ↔  ∀ x : M,  p x ∈ W := begin
    split, intros hyp, intro x, let R := image_in_range p x,
    rw submodule.le_def' at hyp,
    exact hyp (p x) R,
    intro,
    rw submodule.le_def', intro x, intro hyp_range, rw mem_range at hyp_range, rcases hyp_range,
    rw ← hyp_range_h, exact a hyp_range_w,
end
theorem projector.caract_image' (p : M→ₗ[R]M) (W : submodule R M) : (range p ≤ W ∧ ∀ w ∈ W, p w = w) → (is_projector p
∧ range p = W) :=
begin
    intros hyp,
    split,
        apply projector.caract_image,
        intro y,
        apply hyp.2 y,
        rw submodule.le_def' at hyp,
        apply hyp.1 y,
        exact y.property,
        apply le_antisymm ,
            exact hyp.1,
            rintros w,
            intro hyp_w,
            change w ∈ range p,
            change w ∈ W at hyp_w,
            rw mem_range,
            use w,
            rw hyp.2,assumption,
end
lemma projector.right_mul (p f : M →ₗ[R] M) [is_projector p] :
    p * f = f  ↔ ∀ x : M, (x ∈ range f →  p x = x) :=
begin
    split, intro hyp, intro x, rw mem_range, rintros ⟨a,b⟩,
    rw ← b, change (p * f) a = f a,
    rw hyp,
    intro hyp,
    ext, exact hyp _  (image_in_range f x),
end

lemma range_bot_iff {R : Type u} [ comm_ring R]{M : Type v}[add_comm_group M][module R M] (f: M →ₗ[R] M)
: (f = 0) ↔   linear_map.range f = ⊥   :=
begin  rw eq_bot_iff, rw linear_map.range_le_bot_iff f,
 end
lemma linear_map.range_sub_ker (R : Type u) [ comm_ring R](M : Type v)[add_comm_group M][module R M] (f g : M →ₗ[R] M) :
                f * g = 0  ↔ range g ≤ ker f :=
begin
    rw range_bot_iff (f * g),
    rw linear_map.le_ker_iff_map,
    erw ← submodule.map_comp, exact iff.rfl,
end

lemma range_le_iff {p q : M →ₗ[R] M} (hyp : is_projector p)(hypq : is_projector q) : p * q = q ↔ range q ≤ range p :=
begin
    split,
    {intros hyp, rw ← hyp, erw range_comp,apply submodule.map_mono, exact le_top,},
    {intros hyp, ext x,
        change p ( q x ) = q x,
        have r : q x ∈ range p,
            apply hyp,
            exact image_in_range q x ,
        rw  (projector.mem_range p _ _).mp r, assumption,
        },
end

lemma range_cap {p q : M →ₗ[R] M} (hypp : is_projector p)(hypq : is_projector q) : p * q = 0 →  range p ⊓ range q = ⊥ :=
begin
     intros hyp,rw eq_bot_iff,rw submodule.le_def',
    intros x, intro hyp, rw submodule.mem_bot,rcases hyp, erw projector.mem_range at hyp_left hyp_right,
    rw ← hyp_left, rw ← hyp_right, change ( p * q ) x = 0, rw hyp,exact rfl, assumption, assumption,
end

end Projector

open Projector

def δ {X : Type w''}[decidable_eq X] (x y : X) := if  x = y then 1 else 0

structure orthogonal_familly_of_projector
(R : Type u)[comm_ring R](M : Type v)[add_comm_group M] [module R M] (X : Type w)[fintype X][decidable_eq X]  :=
(π :  X → M →ₗ[R]M)
(ortho : ∀ x y : X, π x * π y = (δ x y) •  π x)

namespace orthogonal_familly_of_projector
variables {R : Type u}[comm_ring R]{M : Type v}[add_comm_group M] [module R M]
          {X : Type w}[fintype X][decidable_eq X]
          ( P : orthogonal_familly_of_projector R M X)
--instance : has_coe_to_fun(orthogonal_familly_of_projector R M X) := ⟨_, λ P, P.π ⟩
@[simp]lemma ortho_ite (x y : X ) : P.π x * P.π y = if x = y then P.π x else 0 := begin
    rw P.ortho,
    unfold δ,
    split_ifs,
    rw one_smul,
    rw zero_smul,
end
lemma single_is_projector (x : X) : is_projector (P.π x) := begin
    unfold is_projector, erw ortho_ite, simp,
end
def Total : M→ₗ[R]M := Σ P.π

@[simp]lemma Fact : (λ (x : X), Σ P.π * P.π x)  = λ x, P.π  x := begin
    funext,erw finset.sum_mul,
    simp,
end
lemma Fact1 (x : X) : P.π x * Total P = P.π x := begin
    unfold Total,erw  finset.mul_sum, simp,
end
@[simp]theorem Total_is_projector : (Total P) * (Total P) = Total P := begin
    unfold Total, erw finset.mul_sum, rw Fact,
end
lemma Fact2 (x : X) :  Total P * P.π x = P.π x := begin
    unfold Total, erw finset.sum_mul,simp,
end

def Range : submodule R M :=  linear_map.range (Σ  P.π)

@[simp] lemma Total_range : linear_map.range (Total P) = Range P := rfl

lemma single_range_sub_total_( x: X ) : linear_map.range (P.π x) ≤ Range P := begin
    apply (range_le_iff (Total_is_projector P) (single_is_projector P x) ).mp,
    unfold Total,erw finset.sum_mul,
    simp,
end

end orthogonal_familly_of_projector
namespace Ortho_of_familly
open orthogonal_familly_of_projector
variables {R : Type u}[comm_ring R]{M : Type v}[add_comm_group M] [module R M]
          {X : Type w}[fintype X][decidable_eq X]
          ( P : orthogonal_familly_of_projector R M X)
variables  {Y : Type w'}[fintype Y][decidable_eq Y]
          (Q : orthogonal_familly_of_projector R M Y)

def ortho  := ∀ x : X, ∀ y : Y,  P.π x  *  Q.π y = 0
@[simp]lemma ortho_simp (x : X) (y : Y) : ortho P Q  → P.π  x * Q.π y = 0 :=
begin
    intros hyp, exact hyp x y,
end
@[simp]lemma ortho_simp'  (y : Y) (hyp : ortho P Q) : (λ x : X,  P.π  x * Q.π y) = (λ x, 0) :=
begin
    funext, exact hyp x y,
end
@[simp]lemma ortho_mul_right (hyp : ortho P Q) : (λ y :Y, (Total P) * Q.π y) = 0 :=
begin funext,
    erw finset.sum_mul,
    erw ortho_simp',
    simp, assumption,
end
@[simp]lemma ortho_mul_total_eq_zero  : ortho P Q ↔  (Total P ) * (Total Q) = 0 :=
begin split,
    intros hyp, erw finset.mul_sum, erw (ortho_mul_right P Q hyp), simp,
    intros,unfold ortho,
    intros x y,erw ← Fact1, erw ← Fact2 Q y, rw  mul_assoc, rw ←  mul_assoc (Total P) _  _,rw a,
    rw zero_mul, rw mul_zero,
end
/--
    Faire attention ici
    theoreme du rang ? n = range(p) + ker(p) ...   dim (range p + range q) = dim range p + dim range q
-/
theorem ortho_iff : ortho P Q →   Range P  ⊓ Range Q = ⊥ :=
begin
    rw ortho_mul_total_eq_zero, apply range_cap, exact Total_is_projector P,
    exact Total_is_projector Q,

end
#check X ⊕ Y
namespace Test
variables
(P1 : orthogonal_familly_of_projector R  M X)  (P2 : orthogonal_familly_of_projector R  M Y)
/--
    Faire mieux avec les complementaires !
-/
theorem add :   ortho P1 P2 ∧  ortho P2 P1 → orthogonal_familly_of_projector R M (X ⊕ Y) := λ certif,
 { π := sum.elim P1.π P2.π,
  ortho :=
begin
        intros, rcases x,rcases y,unfold δ,simp,split_ifs,rw one_smul,rw zero_smul,unfold δ,simp,
        exact certif.1 x y,
        rcases y,unfold δ, simp, exact certif.2 x y,
        unfold δ, simp, -- ite smul ?
        split_ifs,rw one_smul, rw zero_smul,
  end }
end Test

end Ortho_of_familly
structure complete_orthogonal_familly_of_projector
(R : Type u)[comm_ring R](M : Type v)[add_comm_group M] [module R M] (X : Type w)[fintype X][decidable_eq X]
extends orthogonal_familly_of_projector R M X :=
(complete : Σ π = 1)

/-!
    vector space of finite dimension
-/
namespace vector_space
variables {K : Type u}[field K]{V : Type v}[add_comm_group V] [vector_space K V] {ι : Type w}
[fintype ι] {b : ι → V} (h : is_basis K b)[W : submodule K V ]
#check exists_is_basis K W

#check exists_subset_is_basis
#check (@zero_ne_one K _)

example {K : Type u}[field K]{V : Type v}[add_comm_group V] [vector_space K V] {ι : Type w}
[fintype ι] {b : ι → V} (h : is_basis K b)[W : submodule K V ] : true := begin
    let F := exists_is_basis K W,
    rcases F with ⟨B,hyp⟩,
    have  f : linear_independent K (λ (i : B), submodule.subtype W i.val ),
    let f :=  linear_independent.image_subtype hyp.1,

    --- linear_independant image injective avec l'injection canonique !

    --let H := @exists_subset_is_basis K  V _ _ _  _, --- probleme de convertion de set

end
end vector_space


variables A B P Q R S : Prop.

lemma exL (H1 : P → Q)
          (H2 :  R → S) : (P ∨ R) → (Q ∨ S) :=

          assume H3 : (P ∨ R),

          (or.elim H3
                   (assume H : P, show Q ∨ S, from (or.intro_left S (H1 (show P, from (H)))))
                   (assume H : R, show Q ∨ S, from (or.intro_right Q (H2 (show R, from (H)))))).

lemma exM (H1 : Q → R) : (P → Q) → (P → R) :=

          assume H2 : (P → Q),
          assume H3 : P,
          show R, from (H1 (show Q, from (H2 (show P, from (H3))))).

lemma exA (H1 : ¬(A ∨ B)) : ¬A ∧ ¬B :=

          and.intro (assume H2 : A, (show false, from (H1 (or.intro_left B H2))))

                    (assume H3 : B, show false, from (H1(or.intro_right A H3))).

lemma exB (H1 : (¬A) ∧ (¬B)) : ¬ (A ∨ B) :=

assume H2 : A ∨ B,
     show false,
     from ( (and.elim_left H1)

            (or.elim H2
                      (assume H3 : A, H3)
                      (assume H4 : B, false.elim (and.elim_right H1 H4)))).


-- Suma_de_progresion_aritmetica.lean
-- Suma de progresión aritmética
-- José A. Alonso Jiménez
-- Sevilla, 19 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la suma de los términos de la progresión aritmética
--    a + (a + d) + (a + 2 × d) + ··· + (a + n × d)
-- es (n + 1) × (2 × a + n × d) / 2.
-- ---------------------------------------------------------------------

import data.real.basic
open nat

variable  (n : ℕ)
variables (a d : ℝ)

set_option pp.structure_projections false

@[simp]
def sumaPA : ℝ → ℝ → ℕ → ℝ
| a d 0       := a
| a d (n + 1) := sumaPA a d n + (a + (n + 1) * d)

example :
  2 * sumaPA a d n = (n + 1) * (2 * a + n * d) :=
begin
  induction n with n HI,
  { simp, },
  { calc 2 * sumaPA a d (succ n)
         = 2 * (sumaPA a d n + (a + (n + 1) * d))
           : rfl
     ... = 2 * sumaPA a d n + 2 * (a + (n + 1) * d)
           : by ring_nf
     ... = ((n + 1) * (2 * a + n * d)) + 2 * (a + (n + 1) * d)
           : by {congr; rw HI}
     ... = (n + 2) * (2 * a + (n + 1) * d)
           : by ring_nf
     ... = (succ n + 1) * (2 * a + succ n * d)
           : by norm_cast, },
end


notation:65 "ℕ" => Nat
open Nat
def fact : ℕ → ℕ
| zero => 1
| succ n' => fact n' * succ n'

inductive fact_state :=
| AnswerIs (answer : ℕ)
| WithAccumulator (input accumulator : ℕ)

inductive fact_init (original_input : ℕ) : fact_state → Prop :=
| FactInit : fact_init original_input (fact_state.WithAccumulator original_input 1)
inductive fact_final : fact_state → Prop :=
| FactFinal : ∀ ans, fact_final (fact_state.AnswerIs ans)
inductive fact_step : fact_state → fact_state → Prop :=
| FactDone : ∀ acc,
  fact_step (fact_state.WithAccumulator zero acc) (fact_state.AnswerIs acc)
| FactStep : ∀ n acc,
  fact_step (fact_state.WithAccumulator (succ n) acc) (fact_state.WithAccumulator n (acc * succ n))

-- -------------- Transition Relation ---------------------
inductive trc {A} (R : A → A → Prop) : A → A → Prop :=
| TrcRefl : ∀ x, trc R x x
| TrcFront : ∀ x y z, R x y → trc R y z → trc R x z

theorem trc_transitive : ∀ {A} (R : A → A → Prop) x y,
  trc R x y → ∀ z, trc R y z → trc R x z := by
  intros A R x y TR
  induction TR with
  | TrcRefl a =>
    intros z TR
    assumption
  | TrcFront _ _ _ _ _ ih =>
    intros
    apply trc.TrcFront
    assumption
    apply ih
    assumption

  postfix:max "^*" => trc

-- -------------- Transition Relation ---------------------

theorem succ12 : ∀ n, succ n = n + 1 := by
  intro
  simp
 theorem x : (succ 2 * succ 1) = 6 := by
    simp

open trc
open fact_step
example : fact_step^* (fact_state.WithAccumulator 3 1) (fact_state.AnswerIs 6) :=
  by
    apply TrcFront
    apply FactStep
    simp
    apply TrcFront
    apply FactStep
    simp [x]
    apply TrcFront
    apply FactStep
    simp
    apply TrcFront
    apply FactDone
    apply TrcRefl

example : fact_step^* (fact_state.WithAccumulator 3 1) (fact_state.AnswerIs 6) :=
  by
    repeat
      apply TrcFront
      apply FactStep
      simp [x]
    apply TrcFront
    apply FactDone
    apply TrcRefl
    done

example : fact_step^* (fact_state.WithAccumulator 3 1) (fact_state.AnswerIs 6) :=
  by
    repeat constructor
    done

  example : 2 + 3 = 5 := by simp

-- -------------- Transition Relation ---------------------
structure trsys (state) :=
    (initial : state → Prop)
    (step : state → state → Prop)
-- -------------- Transition Relation ---------------------

def factorial_sys (original_input : ℕ) : trsys fact_state := {
    initial := fact_init original_input,
    step := fact_step
  }

-- -------------- Transition Relation ---------------------
inductive reachable {state} (sys : trsys state) (st : state) : Prop :=
  | Reachable : ∀ st0, sys.initial st0 -> sys.step^* st0 st -> reachable sys st

def invariantFor {state} (sys : trsys state) (invariant : state → Prop) :=
  ∀ s, sys.initial s → ∀ s', sys.step^* s s' → invariant s'

theorem use_invariant' : ∀ {state} (sys : trsys state)
  (invariant : state → Prop) s s',
  invariantFor sys invariant
  → sys.initial s
  → sys.step^* s s'
  → invariant s' := by
  -- intros state trsys inv s s'
  simp [invariantFor]
  intros _ _ _ _ _ H _ _
  apply H
  assumption
  assumption

theorem use_invariant : ∀ {state} (sys : trsys state)
  (invariant : state → Prop) s,
  invariantFor sys invariant → reachable sys s → invariant s := by
  intros _ _ _ _ _ H0
  cases H0
  apply use_invariant'
  repeat assumption

theorem invariant_induction' : ∀ {state} (sys : trsys state)
  (invariant : state → Prop),
  (∀ s, invariant s → ∀ s', sys.step s s' → invariant s')
  → ∀ s s', sys.step^* s s'
    → invariant s
    → invariant s' := by
  intros _ _ _ H₀ _ _ H₁
  induction H₁ with
  | TrcRefl a =>
    intro
    assumption
  | TrcFront _ _ _ _ _ iH =>
    intros
    apply iH
    apply H₀
    repeat assumption
    done

theorem invariant_induction : ∀ {state} (sys : trsys state)
  (invariant : state → Prop),
  (∀ s, sys.initial s → invariant s)
  → (∀ s, invariant s → ∀ s', sys.step s s' → invariant s')
  → invariantFor sys invariant := by
  simp [invariantFor]; intros _ _ _ H _ _ _ _ _
  apply invariant_induction'
  assumption
  assumption
  apply H
  assumption

-- -------------- Transition Relation ---------------------
open fact_state
def fact_invariant (original_input : ℕ) (st : fact_state) : Prop :=
  match st with
  | AnswerIs ans => fact original_input = ans
  | WithAccumulator n acc => fact original_input = fact n * acc

theorem fact_invariant_ok : ∀ original_input,
  invariantFor (factorial_sys original_input) (fact_invariant original_input) := by
  intros oi
  apply invariant_induction
  intros s
  simp [factorial_sys]
  intro H
  cases H
  simp [fact_invariant]
  intros s
  simp [factorial_sys]
  intros H _ H0
  cases H0

  simp [fact_invariant, fact] at *
  assumption

  simp [fact_invariant, fact] at *
  rw [H, Nat.mul_assoc]
  simp [Nat.mul_comm]
  done

theorem fact_invariant_always : ∀ original_input s,
  reachable (factorial_sys original_input) s
  → fact_invariant original_input s := by
  intros
  apply use_invariant
  apply fact_invariant_ok
  assumption

--  Therefore, any final state has the right answer!
theorem fact_ok' : ∀ original_input s,
  fact_final s
  -> fact_invariant original_input s
  -> s = AnswerIs (fact original_input)
:= by
  intros oi s
  simp [fact_invariant] at *
  cases s with
  | AnswerIs x =>
    simp
    intros a b
    rw [b]
    done
  | WithAccumulator =>
    simp
    intros H
    cases H
    done

theorem fact_ok : ∀ original_input s,
  reachable (factorial_sys original_input) s
  → fact_final s
  → s = AnswerIs (fact original_input) := by
  intros
  apply fact_ok'
  assumption
  apply fact_invariant_always
  assumption
  done

def main : IO Unit :=
  IO.println  (fact 4)


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

In classical mathematics, if we prove that there is a unique element
x with a certain property p x, then we can treat that as a valid
definition of x and use x as a known entity in further developments.
This does not work in quite the same way in Lean (unless we import
classical logic.)  The point is basically that Lean implements proof
irrelevance, and so erases all details of the proof of unique
existence of x, making the definition of x inaccessible to
computation.  However, if we have strong enough assumptions about
finiteness and decidability, then these issues go away.  The point
of this file is to set up a framework for dealing with this kind of
thing.

In more detail, at the bottom of this file we will define a function
fintype.witness.  This accepts a decidable predicate p defined on a
finite type α with decidable equality, together with a proof of
(∃! x : α, p x), and it returns the relevant value of x, packaged
together with a proof that it has the expected property.

In building up to the definition of fintype.witness, we will define
a number of other functions that play similar roles in various other
contexts.
-/

import data.nat.basic
import data.list data.multiset data.finset data.fintype.basic logic.encodable.basic

universe u

variables {α : Type u}

namespace option

/-
 Recall that a term xo of type (option α) is either (none), or
 (some x) for some x in α.  This function accepts xo together
 with a proof that xo ≠ none.  It returns the value x such that
 xo = (some x), packaged together with a proof of that property.

 Note that we have defined this function in the option namespace,
 so its full global name is option.unique_element.  Later in this
 file we will define several other functions called unique_element,
 but they will all be in different namespaces, so their full global
 names will be list.unique_element, multiset.unique_element and so
 on.
-/
def unique_element (xo : option α) (xo_some : xo ≠ none) :
 { x : α // xo = some x } :=
begin
 rcases xo with _ | x,
 exact false.elim (xo_some rfl),
 exact ⟨ x, rfl ⟩
end

end option

/- -------------------------------------------------------- -/

namespace list

/-
 This function accepts a list xs of elements of α.  If the list
 has length one, so it contains a unique element x, then this
 function returns the term (some x) of type (option α).  In all
 other cases, it returns the term (none) of type (option α).
-/
def maybe_unique_element (xs : list α) : (option α) :=
begin
 rcases xs with _ | ⟨ x , _ | ⟨ y, zs ⟩⟩,
 exact none,
 exact some x,
 exact none
end

/-
 A basic lemma saying that maybe_unique_element behaves as expected.
-/
lemma maybe_unique_element_prop (xs : list α) (a : α)
 (e : maybe_unique_element xs = some a) : xs = [a] :=
begin
 rcases xs with _ | ⟨ x , _ | ⟨ y, zs ⟩⟩;
  try {dsimp[maybe_unique_element]};
  try {dsimp[maybe_unique_element] at e};
  injection e with e1;
  simp[e1]
end

/-
 Given that a list has length one, return its unique element,
 packaged with a proof of a key property.
-/
def unique_element (xs : list α) (xs_length : xs.length = 1) :
 { x : α // xs = [x]} :=
begin
 rcases xs with _ | ⟨ x,ys ⟩,
 {simp at xs_length,exact false.elim xs_length},
 { change ys.length.succ = 1 at xs_length,
  have ys_length : ys.length = 0 := nat.succ_inj'.mp xs_length,
  have ys_nil : ys = [] := list.length_eq_zero.mp ys_length,
  simp[ys_nil],
  exact ⟨ x, rfl ⟩
 }
end

/-
 Another basic lemma saying that maybe_unique_element behaves as expected.
-/
lemma some_unique_element (xs : list α) :
 maybe_unique_element xs = none ↔ xs.length ≠ 1 :=
begin
 rcases xs with _ | ⟨ x , _ | ⟨ y, zs ⟩⟩; simp; dsimp[maybe_unique_element],
 refl,
 {intro h,injection h}, refl
end

/-
 A list with no duplicates and a unique element has length one.
-/
lemma length_one_of_prop (xs : list α) (nd : nodup xs) (u : ∃! a, a ∈ xs) :
 xs.length = 1 :=
begin
 rcases u with ⟨ a , a_in_xs , a_unique ⟩,
 rcases xs with _ | ⟨ x , _ | ⟨y , zs⟩⟩,
 {exact false.elim (list.ne_nil_of_mem a_in_xs rfl)},
 {simp},
 {
   have x_mem : x ∈ list.cons x (list.cons y zs) := or.inl rfl,
   have y_mem : y ∈ list.cons x (list.cons y zs) := or.inr (or.inl rfl),
   have x_eq_a : x = a := a_unique x x_mem,
   have y_eq_a : y = a := a_unique y y_mem,
   have x_eq_y : x = y := x_eq_a.trans y_eq_a.symm,
   have x_in_y_zs : x ∈ list.cons y zs := eq.subst x_eq_y (or.inl rfl),
   exact false.elim ((list.nodup_cons.mp nd).1 x_in_y_zs)
 }
end

/-
 Let as and bs be lists of elements of type α.  The proposition
 (perm as bs) is defined inductively in mathlib in data.list.perm.lean;
 it means that bs is a permutation of as.  If so, then
 maybe_unique_element takes the same values on as and bs, as we
 prove here.
-/
lemma maybe_unique_element_perm (as bs : list α) (p : perm as bs) :
 (maybe_unique_element as) = (maybe_unique_element bs) :=
begin
 induction p,
 case list.perm.nil : {simp},
 case list.perm.cons : x as1 bs1 q ih {
   rcases as1 with _ | ⟨ a1, as2 ⟩ ,
   {have bs1_nil : bs1 = [] := q.nil_eq.symm,
   rw[bs1_nil]},{
    rcases bs1 with _ | ⟨ b1, bs2 ⟩ ,
    rcases q.eq_nil.symm,
    dsimp[maybe_unique_element],
    refl
   }
  },
 case list.perm.swap : x y cs {
  dsimp[maybe_unique_element],refl
 },
 case list.perm.trans : cs ds es p_cd p_de ih_cd ih_de {
   exact eq.trans ih_cd ih_de
 }
end

end list

/- -------------------------------------------------------- -/

namespace multiset

/-
 A multiset is (by definition) a permutation-equivalence class of lists.
 Above we defined a function maybe_unique_element in the list namespace.
 We have now closed that namespace, so we need to use the name
 list.maybe_unique_element.  We proved that that function is permutation
 invariant, so now we can define an induced function on multisets.
 We call the new function maybe_unique_element again, but now we are
 in the multiset namespace, so the full global name will be
 multiset.maybe_unique_element.
-/
def maybe_unique_element : (multiset α) → (option α) :=
 quotient.lift list.maybe_unique_element
  (@list.maybe_unique_element_perm α)

/-
 We now prove compatibility with list.maybe_unique_element
-/
lemma maybe_unique_element_of_list (l : list α) :
 maybe_unique_element ↑l = list.maybe_unique_element l :=
 @quotient.lift_mk (list α) _ _
  list.maybe_unique_element
   (@list.maybe_unique_element_perm α) l

/-
 We now have two basic lemmas saying that the multiset version of
 maybe_unique_element behaves as expected.
-/
lemma maybe_unique_element_prop (m : multiset α) (a : α)
 (e : maybe_unique_element m = some a) : m = [a] :=
begin
 rcases quotient.exists_rep m with ⟨ xs, xs_eq_m ⟩,
 have h : maybe_unique_element ⟦xs⟧ = list.maybe_unique_element xs :=
  maybe_unique_element_of_list xs,
 rw[xs_eq_m,e] at h,
 have xs_eq_a : xs = [a] := list.maybe_unique_element_prop xs a h.symm,
 simp[xs_eq_a.symm],
 exact xs_eq_m.symm
end

lemma some_unique_element (m : multiset α) :
 maybe_unique_element m = none ↔ card m ≠ 1 :=
begin
 rcases quotient.exists_rep m with ⟨ as,e ⟩,
 rw[← e],
 simp[maybe_unique_element_of_list as],
 exact as.some_unique_element
end

/-
 Recall that the cardinality of any multiset is by definition the length
 of any representing list.  Thus, we have the following obvious fact
 about multisets of cardinality one.
-/
lemma eq_singleton (m : multiset α) (x : α) :
 m = [x] ↔ (m.card = 1 ∧ x ∈ m) :=
begin
 split,
 {intro m_eq_x,simp[m_eq_x]},
 {intro e,
  rcases (exists_cons_of_mem e.2) with ⟨ t, m_eq_xt⟩ ,
  have h : 1 = t.card + 1 := calc
   1 = m.card : e.1.symm
   ... = (x ::ₘ t).card : by rw[m_eq_xt]
   ... = t.card + 1 : by simp,
  have t_eq_0 : t = 0 := card_eq_zero.mp (nat.succ_inj'.mp h).symm,
  simp[t_eq_0] at m_eq_xt,
  exact m_eq_xt
 }
end

/-
 This function extracts the unique element of any multiset of cardinality
 one, packaged together with a proof of its key property.
-/
def unique_element (m : multiset α) (m_card : m.card = 1) :
 {x : α // m = [x]} :=
begin
 let xo := maybe_unique_element m,
 have xo_some : xo ≠ none :=
 begin
  intro xo_none,
  exact (some_unique_element m).mp xo_none m_card
 end,
 rcases option.unique_element xo xo_some with ⟨ x, xox ⟩,
 have mx : m = [x] :=
  maybe_unique_element_prop m x xox,
 exact ⟨ x , mx ⟩
end

/-
 A multiset has cardinality one iff it has no duplicates and a unique element.
-/
lemma card_one_of_prop (m : multiset α) (nd : nodup m) (u : ∃! a, a ∈ m) :
 m.card = 1 :=
begin
 rcases u with ⟨ a , a_in_m , a_unique_in_m ⟩,
 rcases quotient.exists_rep m with ⟨ xs, xs_eq_m ⟩,
 rw[← xs_eq_m] at a_in_m a_unique_in_m nd ⊢,
 simp,
 have xs_nd : list.nodup xs := coe_nodup.mp nd,
 have a_in_xs : a ∈ xs := mem_coe.mpr a_in_m,
 have a_unique_in_xs :
   ∀ x : α, ∀ (x_in_xs : x ∈ xs), x = a :=
 begin
  intros,
  exact a_unique_in_m x (mem_coe.mp x_in_xs)
 end,
 exact list.length_one_of_prop xs xs_nd ⟨ a , a_in_xs , a_unique_in_xs ⟩
end

end multiset

/- -------------------------------------------------------- -/

namespace finset

/-
 A finset is a multiset with no duplicates.  We can restrict all our definitions
 and results for multisets, to get versions for finsets.
-/
def maybe_unique_element (s : finset α) : (option α) :=
 multiset.maybe_unique_element s.val

lemma maybe_unique_element_prop (s : finset α) (a : α)
 (e : maybe_unique_element s = some a) : s = singleton a :=
begin
 apply finset.eq_of_veq,
 simp,dsimp[maybe_unique_element] at e,
 exact multiset.maybe_unique_element_prop s.val a e
end

lemma some_unique_element (s : finset α) :
 maybe_unique_element s = none ↔ s.card ≠ 1 :=
begin
 dsimp[maybe_unique_element,card],
 apply multiset.some_unique_element
end

lemma eq_singleton (s : finset α) (a : α) :
 s = singleton a ↔ (s.card = 1 ∧ a ∈ s) :=
begin
 split;intro e,
 {dsimp[card],
  let e1 := congr_arg finset.val e,
  simp at e1,
  simp[e1,e]
 },{
  dsimp[card] at e,
  apply eq_of_veq,
  exact (multiset.eq_singleton s.val a).mpr ⟨ e.1 , finset.mem_def.mp e.2⟩,
 }
end

def unique_element (s : finset α) (s_card : s.card = 1) :
 {x : α // s = singleton x} :=
begin
 dsimp[card] at s_card,
 rcases (multiset.unique_element s.val s_card) with ⟨ x , e ⟩,
 have e1 : s = singleton x := eq_of_veq e,
 exact ⟨ x , e1 ⟩
end

lemma card_one_of_prop (s : finset α) (h : ∃! x, x ∈ s) : s.card = 1 :=
begin
 dsimp[card],
 exact multiset.card_one_of_prop s.val s.nodup h
end

/-
 Suppose that we have a finset s and a decidable predicate p; we can then
 define a finset (s.filter p) consisting of elements of s where p is
 satisfied.  The following function just applies our previous constructions
 to a finset of the form (s.filter p) and does a little associated
 bookkeeping.
-/
def witness (s : finset α) (p : α → Prop) [decidable_pred p]
 (h : ∃! x, x ∈ s ∧ p x) :
  { a : α // s.filter p = singleton a} :=
begin
 let s1 := s.filter p,
 have h1 : ∃! x, x ∈ s1 :=
 begin
  rcases h with ⟨ x , ⟨ x_in_s , p_x ⟩ , x_unique⟩,
  have x_in_s1 : x ∈ s1 :=
   mem_filter.mpr ⟨ x_in_s , p_x ⟩,
  have x_unique_alt : ∀ y, y ∈ s1 → y = x :=
  begin
   intros y y_in_s1,
   exact x_unique y (mem_filter.mp y_in_s1),
  end,
  exact ⟨ x , x_in_s1, x_unique_alt⟩
 end,
 have s1_card : s1.card = 1 := card_one_of_prop s1 h1,
 exact unique_element s1 s1_card
end

end finset

/- -------------------------------------------------------- -/

namespace fintype
/-
 Recall that a fintype structure on α is a finset containing every element
 of α, and thus proving that α is finite.  In this section we do some
 obvious adaptation of our results for general finsets, to put them in a
 more convenient form for use with fintypes.
-/
open finset fintype

variables (α) [fintype α]

def maybe_unique_element : (option α) :=
 finset.maybe_unique_element univ

lemma maybe_unique_element_prop (a : α)
 (e : maybe_unique_element α = some a) :
  univ = ({a} : finset α) :=
  maybe_unique_element_prop univ a e

lemma some_unique_element :
 maybe_unique_element α = none ↔ card α ≠ 1 :=
finset.some_unique_element univ

lemma eq_singleton (a : α) :
 univ = ({a} : finset α) ↔ (card α = 1) :=
begin
 dsimp[card],
 let e := finset.eq_singleton univ a,
 split,
 {intro u,exact (e.mp u).1},
 {intro v,exact e.mpr ⟨ v , mem_univ a ⟩}
end

lemma card_one_of_prop (h : ∃ x : α, ∀ y : α, y = x) : card α = 1 :=
begin
 dsimp[card],
 have h1 : (∃! x : α , x ∈ (@univ α _)) := begin
  rcases h with ⟨ x , x_unique ⟩,
  let x_in_univ := @mem_univ α _ x,
  have x_unique_alt : ∀ y : α, y ∈ (@univ α _) → y = x :=
  begin
   intros y y_in_univ,
   exact x_unique y
  end,
  exact ⟨ x , x_in_univ , x_unique_alt ⟩
 end,
 exact finset.card_one_of_prop univ h1
end

def witness (p : α → Prop) [decidable_pred p]
 (h : ∃! x, p x) :
  { a : α // univ.filter p = singleton a} :=
begin
 have h1 : ∃! x, x ∈ (@univ α _) ∧ p x :=
 begin
  rcases h with ⟨ x , p_x , x_unique⟩,
  have x_prop : x ∈ univ ∧ p x := ⟨ mem_univ x , p_x ⟩,
  have x_unique_alt : ∀ y, y ∈ univ ∧ p y → y = x :=
   λ y y_prop, x_unique y y_prop.2,
  exact ⟨ x , x_prop , x_unique_alt ⟩
 end,
 exact finset.witness univ p h1,
end

end fintype


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

open_locale nat rat real big_operators topological_space

theorem induction_seq_mul2pnp1
  (n : ℕ)
  (u : ℕ → ℕ)
  (h₀ : u 0 = 0)
  (h₁ : ∀ n, u (n + 1) = 2 * u n + (n + 1)) :
  u n = 2^(n + 1) - (n + 2) :=
begin
  apply eq_tsub_of_add_eq,
  simp [pow_succ],
  induction n with a ih,
  { simp [h₀, h₁] },
  norm_num [h₀, h₁],
  simp [nat.succ_eq_add_one],
  rw [add_left_comm, ← add_assoc],
  simp only [pow_succ'],
  rw [mul_two],
  linarith,
end


-- Distributiva_de_la_interseccion_respecto_de_la_union_general.lean
-- Distributiva de la intersección respecto de la unión general
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 28-abril-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s)
-- ----------------------------------------------------------------------

import data.set.basic
import data.set.lattice
import tactic

open set

variable {α : Type}
variable s : set α
variable A : ℕ → set α

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

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
begin
  ext x,
  split,
  { intro h,
    rw mem_Union,
    cases h with xs xUAi,
    rw mem_Union at xUAi,
    cases xUAi with i xAi,
    use i,
    split,
    { exact xAi, },
    { exact xs, }},
  { intro h,
    rw mem_Union at h,
    cases h with i hi,
    cases hi with xAi xs,
    split,
    { exact xs, },
    { rw mem_Union,
      use i,
      exact xAi, }},
end

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

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
begin
  ext x,
  simp,
  split,
  { rintros ⟨xs, ⟨i, xAi⟩⟩,
    exact ⟨⟨i, xAi⟩, xs⟩, },
  { rintros ⟨⟨i, xAi⟩, xs⟩,
    exact ⟨xs, ⟨i, xAi⟩⟩, },
end

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

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
begin
  ext,
  finish,
end

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

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
by ext; finish

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

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
by finish [ext_iff]

-- 6ª demostración
-- ===============

example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
by tidy