-- Prueba por induccion 7: (∀ n ∈ ℕ) n ≠ 0 → succ (pred n) = n
-- ===========================================================

import data.nat.basic
open nat

variable (n : ℕ)

-- ?ª demostración
example : n ≠ 0 → succ (pred n) = n :=
begin
  cases n,
  { intro h,
    contradiction, },
  { intro h,
    rw pred_succ, },
end

-- ?ª demostración
example : n ≠ 0 → succ (pred n) = n :=
by cases n; simp

-- ?ª demostración
example : n ≠ 0 → succ (pred n) = n :=
nat.cases_on n
  (assume h : 0 ≠ 0,
    show succ (pred 0) = 0,
      from absurd rfl h)
  (assume n,
    assume h : succ n ≠ 0,
    show succ (pred (succ n)) = succ n,
      by rw pred_succ)

-- ?ª demostración
example : n ≠ 0 → succ (pred n) = n :=
nat.cases_on n
  (λ h, absurd rfl h)
  (λ n h, by rw pred_succ)


/-
M1F 2017-18 Sheet 1 Question 2 to 4 solutions.
Author : Kevin Buzzard
This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/
-/
-- We probably need the "law of the excluded middle" for this question -- every
-- proposition is either true or false! Don't even ask me to explain what the
-- other options are, but Lean does not come with this axiom by default (blame
-- the computer scientists) and mathematicians have to add it themselves.
-- It's easy to add though. "em" for excluded middle.

axiom em (X : Prop) : X ∨ ¬ X

variables P Q R S : Prop -- A "Prop" is a proposition, that is, a true/false statement.

-- Sheet 1 Q3. Prove one result and delete the other.

-- theorem m1f_sheet01_q03_is_T (HP : P) (HnQ : ¬ Q) (HnR : ¬ R) (HS : S) : (R → S) → (P → Q) :=

theorem m1f_sheet01_q03_is_F (HP : P) (HnQ : ¬ Q) (HnR : ¬ R) (HS : S) : ¬ ((R → S) → (P → Q)) :=
begin
intro H,
have HRS : R → S,
  intro HR,
  contradiction,
have HPQ : P → Q,
  exact H HRS,
have HQ : Q,
  exact HPQ HP,
-- now we have Q and not Q
contradiction,
end


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import topology.metric_space.hausdorff_distance

/-!
# Riesz's lemma

Riesz's lemma, stated for a normed space over a normed field: for any
closed proper subspace F of E, there is a nonzero x such that ∥x - F∥
is at least r * ∥x∥ for any r < 1.
-/

variables {𝕜 : Type*} [normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]

/-- Riesz's lemma, which usually states that it is possible to find a
vector with norm 1 whose distance to a closed proper subspace is
arbitrarily close to 1. The statement here is in terms of multiples of
norms, since in general the existence of an element of norm exactly 1
is not guaranteed. -/
lemma riesz_lemma {F : subspace 𝕜 E} (hFc : is_closed (F : set E))
  (hF : ∃ x : E, x ∉ F) {r : ℝ} (hr : r < 1) :
  ∃ x₀ : E, x₀ ∉ F ∧ ∀ y ∈ F, r * ∥x₀∥ ≤ ∥x₀ - y∥ :=
begin
  classical,
  obtain ⟨x, hx⟩ : ∃ x : E, x ∉ F := hF,
  let d := metric.inf_dist x F,
  have hFn : (F : set E).nonempty, from ⟨_, F.zero_mem⟩,
  have hdp : 0 < d,
    from lt_of_le_of_ne metric.inf_dist_nonneg (λ heq, hx
    ((metric.mem_iff_inf_dist_zero_of_closed hFc hFn).2 heq.symm)),
  let r' := max r 2⁻¹,
  have hr' : r' < 1, by { simp [r', hr], norm_num },
  have hlt : 0 < r' := lt_of_lt_of_le (by norm_num) (le_max_right r 2⁻¹),
  have hdlt : d < d / r', from (lt_div_iff hlt).mpr ((mul_lt_iff_lt_one_right hdp).2 hr'),
  obtain ⟨y₀, hy₀F, hxy₀⟩ : ∃ y ∈ F, dist x y < d / r' :=
    metric.exists_dist_lt_of_inf_dist_lt hdlt hFn,
  have x_ne_y₀ : x - y₀ ∉ F,
  { by_contradiction h,
    have : (x - y₀) + y₀ ∈ F, from F.add_mem h hy₀F,
    simp only [neg_add_cancel_right, sub_eq_add_neg] at this,
    exact hx this },
  refine ⟨x - y₀, x_ne_y₀, λy hy, le_of_lt _⟩,
  have hy₀y : y₀ + y ∈ F, from F.add_mem hy₀F hy,
  calc
    r * ∥x - y₀∥ ≤ r' * ∥x - y₀∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _)
    ... < d : by { rw ←dist_eq_norm, exact (lt_div_iff' hlt).1 hxy₀ }
    ... ≤ dist x (y₀ + y) : metric.inf_dist_le_dist_of_mem hy₀y
    ... = ∥x - y₀ - y∥ : by { rw [sub_sub, dist_eq_norm] }
end


import game.world8.level7 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 8: `eq_zero_of_add_right_eq_self`

The lemma you're about to prove will be useful when we want to prove that $\leq$ is antisymmetric.
There are some wrong paths that you can take with this one.
-/

/- Lemma
If $a$ and $b$ are natural numbers such that
$$ a + b = a, $$
then $b = 0$.
-/

lemma eq_zero_of_add_right_eq_self {a b : mynat} : a + b = a → b = 0 :=
begin [nat_num_game]
  intro h,
  apply add_left_cancel a,
  rw h,
  rw add_zero,
  refl,

end

end mynat -- hide


import .group_representation
import .sub_module
import linear_algebra.determinant
import linear_algebra.matrix
import group_theory.group_action
import init.algebra.functions
universes u v  w w'
variables {G : Type u} (R : Type v) (X : Type w) [group G] [ring R]  [mul_action G X]

/--
    Permutation representation : let `•` an action of `G` on `X`. Let `R` be a ring,
    let `M = R → X` be the free-module over `M` of base `X`. For `v : R → X` and `g ∈ G` the formula
    `ρ g v := g⁻¹ • v` define a permutation de representation.
 -/

def rho  (g : G)  : (X → R) → (X → R)  := λ  v x,  v (g⁻¹ •  x)

def rho_linear (g : G) : (X → R) →ₗ[R] (X → R) := { to_fun := rho R X g,
  add := by { intros, exact rfl},
  smul := by {intros, exact rfl}
  }

lemma rho_apply (g : G)(v : X → R)(x : X) : rho R  X g v x  = v (g⁻¹ • x) := rfl

lemma rho_mul (σ τ  : G) : rho R X (σ * τ) = rho R X σ  ∘  rho R X τ := begin
        ext v x, rw rho_apply, rw  mul_inv_rev, rw  mul_smul, exact rfl,
end
lemma rho_one  : rho R X (1 : G) = id := begin
   ext x v, rw rho_apply, rw one_inv, rw one_smul, exact rfl,
end
lemma rho_right_inv (g : G) : (rho R X g : (X → R) →  (X → R)) ∘  (rho R X g⁻¹) = id  := begin
    rw ← rho_mul, rw mul_inv_self, rw rho_one,
end

lemma rho_left_inv  (g : G) : (  rho R X (g⁻¹ )  :
(X → R) → (X → R) ) ∘    (rho R X g : (X → R) → (X → R))  = id  :=
begin
    rw ← rho_mul, rw inv_mul_self, rw rho_one,
end

/--
    a linear equivalence is a structure that formalize `M ≃ₗ[R]M` : group of invertible
    linear morphism  `f : M →ₗ M`
-/
def rho_equiv (g : G) : (X → R) ≃ (X → R) := { to_fun := rho R X g,
  inv_fun := rho R X g⁻¹ ,
  left_inv :=  begin intros x,ext, change (rho R X g⁻¹ ∘ rho R X g ) x x_1 = x x_1, rw rho_left_inv , exact rfl,   end,
  right_inv := begin intros x,ext, erw ← function.comp_apply (rho R X g)  _, rw rho_right_inv, exact rfl, end }

def rho_equiv_lin (g : G) : (X → R) ≃ₗ[R] (X → R) := {
   .. rho_linear R X g,   .. rho_equiv R X g
}

lemma rho_equiv_lin_ext ( g : G): ((rho_equiv_lin R X g) : (X → R) → (X → R) ) =  rho R X g  := rfl

def Perm : group_representation G R (X → R) := {
  to_fun :=  rho_equiv_lin R X ,
  map_one' := begin  ext,rw rho_equiv_lin_ext, rw rho_one, exact rfl, end,
  map_mul' := begin  intros,ext,rw rho_equiv_lin_ext, rw rho_mul, exact rfl, end }
variables (g : G) (x y : X → R)
#check Perm R X

example (g : G) (x y : X → R) (r : R) : true := begin
        let ρ := @Perm G R X,
        have f : ρ 1 = 1,
            rw ρ.map_one,
        have : ρ g (x+y) = ρ g x +ρ g y,
            rw (ρ g).map_add,

        trivial,
        end


#eval 1+1

constant m : nat
#check m

def sum_of_first_n_nat : ℕ → ℕ
| 0 := 0
| (nat.succ n) := (nat.succ n) + sum_of_first_n_nat n

#eval sum_of_first_n_nat 5

theorem closed_eq_sum_of_first_n_nat (n : ℕ) :
    2 * (sum_of_first_n_nat n) = n * (nat.succ n) :=
begin

induction n with d hd,
rw sum_of_first_n_nat,
rw nat.mul_zero,
rw nat.zero_mul,

rw sum_of_first_n_nat,
rw nat.left_distrib,
rw hd,

--rewrites nat.succ n to n + 1:
rw nat.succ_eq_add_one,
--rewrites nat.succ (n + m) to n + nat.succ m (from defn of addition)
--note rw usually rewrites from left to right over an equality; ← (\l) does right to left
rw ← nat.add_succ,
--rewrites nat.succ 1 to 2 (for clarity)
rw (show nat.succ 1 = 2, by refl),
--multiplies out d + 1
rw left_distrib (d + 1) d 2,
--moving things around with commutativity
rw mul_comm 2 (d + 1),
rw mul_comm d (d + 1),
rw add_comm,

end


import data.real.basic
open function

/-
# Chapter 6 : Functions

## Level 2

A classical result in composition of functions.
-/

/- Lemma
If $f : X \to Y$ and $g : Y \to Z$ are both surjective functions, then
the function resulting from their composition is also surjective.
-/
theorem both_surjective
    (X Y Z : set ℝ) (f : X → Y) (g : Y → Z) :
    surjective f ∧ surjective g → surjective (g ∘ f) :=
begin
    intros H z,
    cases H with sf sg,
    have hy : ∃ y : Y, g y = z, from sg z,
    cases hy with y gy,
    have hx : ∃ x : X, f x = y, from sf y,
    cases hx with x fx,
    use x, rw ← gy, rw ← fx, done
end


import data.real.basic

variables a b c : ℝ

#check mul_comm b a
#check mul_assoc c b a

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  /- mul_comm a b refers to the commutative law for multiplication
  on a and b: a * b = b * a. 'rw mul_comm a b' tells Lean to replace
  a * b with b * a in the goal. Now the goal becomes (b * a) * c =
  b * (a * c). -/

  rw mul_assoc b a c,
  /- mul_assoc b a c refers to the associative law for multiplication
  on b, a, and c: b * a * c = b * (a * c). Note that Lean leaves out
  parentheses when possible. Since multiplication is left-associative,
  the left-hand side of mul_assoc b * a * c refers to (b * a) * c.
  'rw mul_assoc b a c' solves the goal b * a * c = b * (a * c), and hence,
  completes the proof. -/
end


import data.real.basic
import tactic

namespace vilnius

local notation `|` x `|` := abs x

/-- `l` is the limit of the sequence `a` of reals -/
definition is_limit (a : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

/-- The limit of a constant sequence is the constant. -/
theorem is_limit_const (c : ℝ) : is_limit (λ n, c) c :=
begin
  intros e se,
  use 0,
  intros n sn,
  simp,
  exact se,
end

-- We will chose ε later...
theorem is_limit_add {a b : ℕ → ℝ} {l m : ℝ}
  (h1 : is_limit a l) (h2 : is_limit b m) :
  is_limit (a + b) (l + m) :=
begin
  sorry,
end

-- Helpful things:
-- `abs_pos : 0 < |a| ↔ a ≠ 0`
-- `div_pos : 0 < a → 0 < b → 0 < a / b`
-- `abs_mul x y : |x * y| = |x| * |y|`
-- `lt_div_iff' : 0 < c → (a < b / c ↔ c * a < b)`
-- I typically find these things myself with a combination of
-- the "guess the name of the lemma" game (and ctrl-space).

-- A hint for starting:
-- It might be worth dealing with `c = 0` as a special case. You
-- can start with
-- `by_cases hc : c = 0`

theorem is_limit_mul_const_left {a : ℕ → ℝ} {l c : ℝ} (h : is_limit a l) :
  is_limit (λ n, c * (a n)) (c * l) :=
begin
  sorry,
end

theorem sandwich (a b c : ℕ → ℝ)
  (l : ℝ) (ha : is_limit a l) (hc : is_limit c l)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) : is_limit b l :=
begin
  sorry,
end

end vilnius


namespace hidden

-- BEGIN
inductive nat : Type
| zero : nat
| succ : nat → nat
-- END

@[pattern]
def Z := nat.zero
@[pattern]
def S := nat.succ

def K₁ := S Z
def K₂ := S K₁
def K₃ := S K₂
def K₄ := S K₃
def K₅ := S K₄

def pred: nat -> nat
| Z := Z
| (S n) := n
.
theorem pr₀ : pred Z = Z := rfl.
theorem pr₁ : pred K₁ = Z := rfl.
theorem pr₂ : pred K₂ = K₁ := rfl.

theorem pred_succ_zero (n: nat): pred (S n) = n := rfl.

def sub: nat -> nat -> nat
| n Z := n
| n (S m) := pred (sub n m)
.
#reduce sub Z K₂
#reduce sub K₅ K₂

example: sub Z K₅ = Z := rfl.
theorem sub_n_0: ∀(n: nat), sub n Z = n
| Z := rfl
| (S n) := rfl

theorem sub_0_m: ∀ (m:nat), sub Z m = Z
| Z := rfl
| (S m) := by rw[sub, sub_0_m]; reflexivity.

lemma sub_succ (n m: nat): sub (S n) (S m) = sub n m := begin
induction m,
case nat.zero: {
  reflexivity
},
case nat.succ: m ih {
  have: sub (S n) (S (S m)) = pred (sub (S n) (S m)), from rfl,
  have: sub (S n) (S (S m)) = pred (sub n m), by rw[this, ih],
  have: pred (sub n m) = sub n (S m), by reflexivity,
  assumption
}
end

theorem sub_n_n: ∀(n: nat), sub n n = Z
| Z := rfl
| (S n) := by rw[sub_succ, sub_n_n]
.

def add: nat -> nat -> nat
| m Z := m
| m (S n) := S (add m n)
.

lemma add_n_succ (m n: nat): add m (S n) = S (add m n) := rfl.
lemma add_m_succ (m: nat): ∀ (n: nat), add (S m) n = S (add m n)
| Z := rfl
| (S n) := begin
  simp [add_n_succ],
  rw add_m_succ,
end

lemma add_m_0 (m: nat): add m Z = m := rfl.
lemma add_0_n: ∀ (n: nat), add Z n = n
| Z := rfl
| (S n) := by simp [add_n_succ, add_0_n n]
.

theorem add_assoc (a b: nat): ∀(c: nat), add (add a b) c = add a (add b c)
| Z := rfl
| (S c) := by simp[add_n_succ, add_assoc c]
.

theorem add_comm (m: nat): ∀(n: nat), add m n = add n m
| Z := by simp[add_m_0, add_0_n]
| (S n) := by simp[add_n_succ, add_m_succ, add_comm n]
.

#reduce add K₁ K₂

def mul: nat -> nat -> nat
| _ Z := Z
| m (S n) := add m (mul m n)
.
#reduce mul Z K₂
#reduce mul K₂ Z
#reduce mul K₁ K₂
#reduce mul K₂ K₂
#reduce mul K₅ K₂

lemma mul_succ_n (m n: nat): mul m (S n) = add m (mul m n) := rfl.
lemma mul_succ_m (m: nat): ∀ (n: nat), mul (S m) n = add (mul m n) n
| Z := rfl
| (S n) := by simp[mul_succ_n, mul_succ_m n, add_n_succ, add_m_succ, add_assoc]
.

theorem mul_m_0 (m: nat): mul m Z = Z := rfl.
theorem mul_0_n: ∀ (n: nat), mul Z n = Z
| Z := rfl
| (S n) := by simp[mul_succ_n, mul_0_n n]; reflexivity
.

theorem mul_m_1 (m: nat): mul m K₁ = m := rfl
theorem mul_1_n (n: nat): mul K₁ n = n := begin
  rw [K₁],
  simp [mul_succ_m, mul_0_n, add_0_n],
end

theorem mul_comm (m: nat): ∀(n: nat), mul m n = mul n m
| Z := by simp[mul_m_0, mul_0_n]
| (S n) := by simp [mul_succ_n, mul_succ_m, mul_comm n, add_comm]
.

theorem mul_dist (b c: nat): ∀ (a: nat), mul a (add b c) = add (mul a b) (mul a c)
| Z := by simp [mul_0_n]; reflexivity
| (S a) := begin
  simp[mul_succ_m, add_assoc, mul_dist a],
  rw [<-add_assoc (mul a c), add_comm (mul a c), <-add_assoc b],
end

theorem mul_assoc (a b: nat): ∀(c: nat), mul (mul a b) c = mul a (mul b c)
| Z := rfl
| (S c) := by simp[mul_succ_n, mul_assoc c, mul_dist]
.

theorem succ_nonzero (n: nat): S n ≠ Z := by trivial.
def nonzero := {n: nat // n ≠ Z}
def nonzero.mk (n: nat) (h: n ≠ Z): nonzero := ⟨n,h⟩
def nz := nonzero.mk.
#check nz K₂ (by apply succ_nonzero)

def pow: nonzero -> nat -> nat
| _ Z := K₁
| m (S n) := mul m.val (pow m n)

def nzK₁ := nz (S Z) (by apply succ_nonzero)
def nzK₂ := nz (S K₁) (by apply succ_nonzero)
def nzK₃ := nz (S K₂) (by apply succ_nonzero)
def nzK₄ := nz (S K₃) (by apply succ_nonzero)
def nzK₅ := nz (S K₄) (by apply succ_nonzero)

#reduce pow nzK₂ Z
#reduce pow nzK₁ K₂
#reduce pow nzK₂ K₂
#reduce pow nzK₃ K₂

theorem pow_by_0 (m: nonzero): pow m Z = K₁ := rfl.
theorem pow_by_1 (m: nonzero): pow m K₁ = m.val := rfl.
theorem pow_by_succ (m: nonzero) (n: nat): pow m (S n) = mul m.val (pow m n) := rfl.
theorem pow_of_1: ∀ (n: nat), pow nzK₁ n = K₁
| Z := rfl
| (S n) := begin
  have o: nzK₁.val = K₁, from rfl,
  have: pow nzK₁ (S n) = mul nzK₁.val (pow nzK₁ n), by rw [pow_by_succ],
  simp [o, mul_1_n] at this,
  simp [pow_of_1 n] at this, assumption
end

theorem pow_by_add (m: nonzero) (a: nat): ∀(b: nat), pow m (add a b) = mul (pow m a) (pow m b)
| Z := rfl
| (S b) := by simp [add_n_succ, pow_by_succ, pow_by_add b, mul_comm, mul_assoc].

end hidden


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

/-!
# Theory of univariate polynomials

The theorems include formulas for computing coefficients, such as
`coeff_add`, `coeff_sum`, `coeff_mul`

-/

noncomputable theory

open finsupp finset add_monoid_algebra
open_locale big_operators

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

variables [semiring R] {p q r : polynomial R}

section coeff

lemma coeff_one (n : ℕ) : coeff (1 : polynomial R) n = if 0 = n then 1 else 0 :=
coeff_monomial

@[simp]
lemma coeff_add (p q : polynomial R) (n : ℕ) : coeff (p + q) n = coeff p n + coeff q n := rfl

lemma coeff_sum [semiring S] (n : ℕ) (f : ℕ → R → polynomial S) :
  coeff (p.sum f) n = p.sum (λ a b, coeff (f a b) n) := finsupp.sum_apply

lemma sum_def [add_comm_monoid S] (f : ℕ → R → S) :
  p.sum f = ∑ n in p.support, f n (p.coeff n) :=
rfl

@[simp] lemma coeff_smul (p : polynomial R) (r : R) (n : ℕ) :
coeff (r • p) n = r * coeff p n := finsupp.smul_apply _ _ _

@[simp] lemma mem_support_iff : n ∈ p.support ↔ p.coeff n ≠ 0 :=
by simp [support, coeff]

lemma not_mem_support_iff : n ∉ p.support ↔ p.coeff n = 0 :=
by simp

variable (R)
/-- The nth coefficient, as a linear map. -/
def lcoeff (n : ℕ) : polynomial R →ₗ[R] R :=
finsupp.lapply n
variable {R}

@[simp] lemma lcoeff_apply (n : ℕ) (f : polynomial R) : lcoeff R n f = coeff f n := rfl

@[simp] lemma finset_sum_coeff {ι : Type*} (s : finset ι) (f : ι → polynomial R) (n : ℕ) :
  coeff (∑ b in s, f b) n = ∑ b in s, coeff (f b) n :=
(s.sum_hom (λ q : polynomial R, lcoeff R n q)).symm

/-- Decomposes the coefficient of the product `p * q` as a sum
over `nat.antidiagonal`. A version which sums over `range (n + 1)` can be obtained
by using `finset.nat.sum_antidiagonal_eq_sum_range_succ`. -/
lemma coeff_mul (p q : polynomial R) (n : ℕ) :
  coeff (p * q) n = ∑ x in nat.antidiagonal n, coeff p x.1 * coeff q x.2 :=
add_monoid_algebra.mul_apply_antidiagonal p q n _ (λ x, nat.mem_antidiagonal)

@[simp] lemma mul_coeff_zero (p q : polynomial R) : coeff (p * q) 0 = coeff p 0 * coeff q 0 :=
by simp [coeff_mul]

lemma coeff_mul_X_zero (p : polynomial R) : coeff (p * X) 0 = 0 :=
by simp

lemma coeff_X_mul_zero (p : polynomial R) : coeff (X * p) 0 = 0 :=
by simp

lemma coeff_C_mul_X (x : R) (k n : ℕ) :
  coeff (C x * X^k : polynomial R) n = if n = k then x else 0 :=
by rw [← single_eq_C_mul_X]; simp [monomial, single, eq_comm, coeff]; congr

@[simp] lemma coeff_C_mul (p : polynomial R) : coeff (C a * p) n = a * coeff p n :=
add_monoid_algebra.single_zero_mul_apply p a n

lemma C_mul' (a : R) (f : polynomial R) : C a * f = a • f :=
ext $ λ n, coeff_C_mul f

@[simp] lemma coeff_mul_C (p : polynomial R) (n : ℕ) (a : R) :
  coeff (p * C a) n = coeff p n * a :=
add_monoid_algebra.mul_single_zero_apply p a n

lemma coeff_X_pow (k n : ℕ) :
  coeff (X^k : polynomial R) n = if n = k then 1 else 0 :=
by { simp only [X_pow_eq_monomial, monomial, single, eq_comm], congr }

@[simp]
lemma coeff_X_pow_self (n : ℕ) :
  coeff (X^n : polynomial R) n = 1 :=
by simp [coeff_X_pow]

theorem coeff_mul_X_pow (p : polynomial R) (n d : ℕ) :
  coeff (p * polynomial.X ^ n) (d + n) = coeff p d :=
begin
  rw [coeff_mul, sum_eq_single (d,n), coeff_X_pow, if_pos rfl, mul_one],
  { rintros ⟨i,j⟩ h1 h2, rw [coeff_X_pow, if_neg, mul_zero], rintro rfl, apply h2,
    rw [nat.mem_antidiagonal, add_right_cancel_iff] at h1, subst h1 },
  { exact λ h1, (h1 (nat.mem_antidiagonal.2 rfl)).elim }
end

lemma coeff_mul_X_pow' (p : polynomial R) (n d : ℕ) :
  (p * X ^ n).coeff d = ite (n ≤ d) (p.coeff (d - n)) 0 :=
begin
  split_ifs,
  { rw [←@nat.sub_add_cancel d n h, coeff_mul_X_pow, nat.add_sub_cancel] },
  { refine (coeff_mul _ _ _).trans (finset.sum_eq_zero (λ x hx, _)),
    rw [coeff_X_pow, if_neg, mul_zero],
    exact ne_of_lt (lt_of_le_of_lt (nat.le_of_add_le_right
      (le_of_eq (finset.nat.mem_antidiagonal.mp hx))) (not_le.mp h)) },
end

@[simp] theorem coeff_mul_X (p : polynomial R) (n : ℕ) :
  coeff (p * X) (n + 1) = coeff p n :=
by simpa only [pow_one] using coeff_mul_X_pow p 1 n

theorem mul_X_pow_eq_zero {p : polynomial R} {n : ℕ}
  (H : p * X ^ n = 0) : p = 0 :=
ext $ λ k, (coeff_mul_X_pow p n k).symm.trans $ ext_iff.1 H (k+n)

lemma C_mul_X_pow_eq_monomial (c : R) (n : ℕ) : C c * X^n = monomial n c :=
by { ext1, rw [monomial_eq_smul_X, coeff_smul, coeff_C_mul] }

lemma support_mul_X_pow (c : R) (n : ℕ) (H : c ≠ 0) : (C c * X^n).support = singleton n :=
by rw [C_mul_X_pow_eq_monomial, support_monomial n c H]

lemma support_C_mul_X_pow' {c : R} {n : ℕ} : (C c * X^n).support ⊆ singleton n :=
by { rw [C_mul_X_pow_eq_monomial], exact support_monomial' n c }

lemma C_dvd_iff_dvd_coeff (r : R) (φ : polynomial R) :
  C r ∣ φ ↔ ∀ i, r ∣ φ.coeff i :=
begin
  split,
  { rintros ⟨φ, rfl⟩ c, rw coeff_C_mul, apply dvd_mul_right },
  { intro h,
    choose c hc using h,
    classical,
    let c' : ℕ → R := λ i, if i ∈ φ.support then c i else 0,
    let ψ : polynomial R := ∑ i in φ.support, monomial i (c' i),
    use ψ,
    ext i,
    simp only [ψ, c', coeff_C_mul, mem_support_iff, coeff_monomial,
               finset_sum_coeff, finset.sum_ite_eq'],
    split_ifs with hi hi,
    { rw hc },
    { rw [not_not] at hi, rwa mul_zero } },
end

end coeff

open submodule polynomial set

variables {f : polynomial R} {I : submodule (polynomial R) (polynomial R)}

/--  If the coefficients of a polynomial belong to n ideal contains the submodule span of the
coefficients of a polynomial. -/
lemma span_le_of_coeff_mem_C_inverse (cf : ∀ (i : ℕ), f.coeff i ∈ (C ⁻¹' I.carrier)) :
  (span (polynomial R) {g | ∃ i, g = C (f.coeff i)}) ≤ I :=
begin
  refine bInter_subset_of_mem _,
  rintros _ ⟨i, rfl⟩,
  exact set_like.mem_coe.mpr (cf i),
end

lemma mem_span_C_coeff :
  f ∈ span (polynomial R) {g : polynomial R | ∃ i : ℕ, g = (C (coeff f i))} :=
begin
  rw [← f.sum_single] {occs := occurrences.pos [1]},
  refine sum_mem _ (λ i hi, _),
  change monomial i _ ∈ span _ _,
  rw [← C_mul_X_pow_eq_monomial, ← X_pow_mul, ← smul_eq_mul],
  exact smul_mem _ _ (subset_span ⟨i, rfl⟩),
end

lemma exists_coeff_not_mem_C_inverse :
  f ∉ I → ∃ i : ℕ , coeff f i ∉ (C ⁻¹'  I.carrier) :=
imp_of_not_imp_not _ _
  (λ cf, not_not.mpr ((span_le_of_coeff_mem_C_inverse (not_exists_not.mp cf)) mem_span_C_coeff))

section cast

@[simp] lemma nat_cast_coeff_zero {n : ℕ} {R : Type*} [semiring R] :
  (n : polynomial R).coeff 0 = n :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih], },
end

@[simp, norm_cast] theorem nat_cast_inj
  {m n : ℕ} {R : Type*} [semiring R] [char_zero R] : (↑m : polynomial R) = ↑n ↔ m = n :=
begin
  fsplit,
  { intro h,
    apply_fun (λ p, p.coeff 0) at h,
    simpa using h, },
  { rintro rfl, refl, },
end

@[simp] lemma int_cast_coeff_zero {i : ℤ} {R : Type*} [ring R] :
  (i : polynomial R).coeff 0 = i :=
by cases i; simp

@[simp, norm_cast] theorem int_cast_inj
  {m n : ℤ} {R : Type*} [ring R] [char_zero R] : (↑m : polynomial R) = ↑n ↔ m = n :=
begin
  fsplit,
  { intro h,
    apply_fun (λ p, p.coeff 0) at h,
    simpa using h, },
  { rintro rfl, refl, },
end

end cast

end polynomial


/-
COMP2009-ACE

Exercise 02 (Propositional logic)

    This exercise has 2 parts. In the 1st part you are supposed to
    formally define what certain relation bewteen humans are (like
    Father, brother-in-law etc). Here we use Lean only as a syntax  and type checker.
    In the 2nd part we play logic poker again :-) but this time for
    predicate logic.

    You are only allowed to use the tactics introduced in the lecture
    (i.e. assume, exact, apply, constructor, cases, left, right, have,
    trivial, existsi, reflexivity, rewrite)

    Please only use the tactics in the way indicated in the script,
    otherwise you may lose upto 2 style points.

-/

namespace family

-- Given the following type, predicates and relations:

constant People : Type
constants Male Female : People → Prop
-- Male x means x is male
-- Female x means x is fmeale
constant Parent : People → People → Prop
-- Parent x y means x is a parent of y
constant Married : People → People → Prop
-- Married x y means x is married to y

/-
Define the following relations (People → People → Prop)
using the predicates and relations above:

- Father x y = x is the father of y
- Brother x y = x is the brother of y
- Grandmother x y = x is the grandmother of y
- FatherInLaw x y = x is the father-in-law of y
- SisterInLaw x y = x is the sister in law of y
- Uncle x y = x is the uncle in t

If you are not sure about the definition of these terms, check them
in wikipedia. If there is more than one option choose one.
-/

/- As an example: here is the definition of Father: -/

def Father (x y : People) : Prop
  := Parent x y ∧ Male x

-- insert your definitions here
def Sibling (x y :People) :Prop
  := (x ≠ y) ∧ ( ∃ h : People, Parent h x ∧ Parent h y )

def Brother (x y : People) : Prop
--two person have same parent
  := Male x ∧ Sibling  x y

def Mother (x y : People) : Prop
  := Parent x y ∧ Female x

def Grandmother (x y : People) : Prop
--the mother of one's father or mother.
  := ∃ z : People, Mother x z ∧ Parent z y

def FatherInLaw (x y : People) : Prop
--the father of one's husband or wife.
  := ∃ h : People, Father x h ∧  Married y h

def SisterInLaw (x y : People) : Prop
--the wife of one's brother or sister
  := Female x ∧ (∃ z : People, Married x z ∧ Sibling z y )

def Uncle (x y : People) : Prop
--the brother of one's father or mother
  := ∃ z : People, Brother x z ∧ Parent z y

end family

namespace poker
/-
   We play the game of logic poker - but this time with predicate logic :-)

    You have to classify the propositions into
    a) provable intuitionistically (i.e. in plain lean)
    b) provable classically (using em : P ∨ ¬ P or raa : ¬¬ P → P).
    c) not provable classically.
    and then you have to prove the propositions in a) and b) accordingly.

    Here is how you score:
    We start with 10 points :-)
    For any proposition which you didn't classify correctly (or not at all)
    you loose 1 point. :-(
    For any proposition which is provable but you didn't prove you loose
    1 point. :-(
    We stop subtracting points at 0. :-)

    Write the classification as a comment using -- after the proposition.

    You are only allowed to use the tactics introduced in the lecture
    (i.e. assume, exact, apply, constructor, cases, left, right, have,
    trivial, existsi, reflexivity, rewrite)

    Please only use the tactics in the way indicated in the script,
    otherwise you may lose upto 2 style points.

    For propositions classified into c) just keep "sorry," as the proof.
-/

variable A : Type
variables PP QQ : A → Prop
variables RR : A → A → Prop
variables P Q R : Prop

open classical

theorem raa : ¬ ¬ P → P :=
begin
  assume nnp,
  cases (em P) with p np,
    exact p,
    have f : false,
      apply nnp,
      exact np,
    cases f,
end

theorem ex01 : (∀ x:A, ∃ y : A , RR x y) → (∃ y : A, ∀ x : A, RR x y) :=
begin-- c)  not provable classically
  sorry,
end

theorem ex02 :  (∃ y : A, ∀ x : A, RR x y) → (∀ x:A, ∃ y : A , RR x y) :=
begin --a) provable intuitionistically
  assume h,
  assume x,
  cases h with y rr,
  existsi y,
  apply rr,
end

theorem ex03 : ∀ x y : A, x = y → RR x y → RR x x :=
begin --b) provable classically
  assume a b pp,
  assume hab,
  apply raa,
  assume h,
  have h1: ¬ RR a b,
  rewrite ← pp,
  exact h,
  apply h1,
  exact hab,
end

theorem ex04 : ∀ x y z : A, x ≠ y → x ≠ z → y ≠ z :=
begin -- c) not provable classically
  sorry,
end

theorem ex05 : ∀ x y z : A, x = y → x ≠ z → y ≠ z :=
begin --a) provable intuitionistically
  assume x y z pp,
  assume xz,
  rewrite ← pp,
  exact xz,
end

theorem ex06 : ∀ x y z : A, x ≠ y → (x ≠ z ∨ y ≠ z) :=
begin --b) provable classically
  assume x y z xy,
  cases(em (y=z)) with xz nxz,
  left,
  rewrite ← xz,
  exact xy,
  right,
  assume yz,
  apply nxz,
  exact yz,
end

theorem ex07 : ¬ ¬ (∀ x : A, PP x) → ∀ x : A, ¬ ¬ PP x :=
begin --a) provable intuitionistically
  assume h,
  assume a npp,
  apply h,
  assume pp,
  apply npp,
  apply pp,
end

theorem ex08 : (∀ x : A, ¬ ¬ PP x) → ¬ ¬ ∀ x : A, PP x :=
begin --b) provable classically
  assume nnpp,
  assume npp,
  apply npp,
  assume a,
  apply raa,
  assume nppa,
  apply nnpp,
  exact nppa,
end

theorem ex09 : (∃ x : A, true) → (∃ x:A, PP x) → ∀ x : A,PP x :=
begin ---c) not provable classically
  sorry
end

theorem aux_thm: (¬ ∀ (x : A), PP x) →   ∃ x : A, ¬ PP x :=
begin
    assume h,
    apply raa,
    assume ng,
    apply h,
    assume x,
    apply raa,
    assume np,
    apply ng,
    existsi x,
    exact np,
end

theorem ex10 : (∃ x : A,  true) → (∃ x:A, (PP x → ∀ x : A,PP x)) :=
begin ---b) provable classically
  assume atr,
  cases atr with a tr,
  cases em (∀ x : A, PP x) with app napp,
  existsi a,
  assume ppa,
  exact app,

  have h :(∃ x: A, ¬ PP x),
  apply aux_thm,
  exact napp,

  cases h with a1 npp,
  existsi a1,
  assume ppa1,
  have f: false,
  apply npp,
  exact ppa1,
  cases f,
end

end poker


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Extensional equality for functions, and a proof of function extensionality from quotients.
-/
prelude
import init.quot init.logic

namespace function
  variables {A : Type} {B : A → Type}

  protected definition equiv (f₁ f₂ : Πx : A, B x) : Prop := ∀x, f₁ x = f₂ x

  namespace equiv_notation
    infix `~` := function.equiv
  end equiv_notation
  open equiv_notation

  protected theorem equiv.refl (f : Πx : A, B x) : f ~ f := take x, rfl

  protected theorem equiv.symm {f₁ f₂ : Πx: A, B x} : f₁ ~ f₂ → f₂ ~ f₁ :=
  λH x, eq.symm (H x)

  protected theorem equiv.trans {f₁ f₂ f₃ : Πx: A, B x} : f₁ ~ f₂ → f₂ ~ f₃ → f₁ ~ f₃ :=
  λH₁ H₂ x, eq.trans (H₁ x) (H₂ x)

  protected theorem equiv.is_equivalence (A : Type) (B : A → Type) : equivalence (@function.equiv A B) :=
  mk_equivalence (@function.equiv A B) (@equiv.refl A B) (@equiv.symm A B) (@equiv.trans A B)
end function

section
  open quot
  variables {A : Type} {B : A → Type}

  private definition fun_setoid [instance] (A : Type) (B : A → Type) : setoid (Πx : A, B x) :=
  setoid.mk (@function.equiv A B) (function.equiv.is_equivalence A B)

  private definition extfun (A : Type) (B : A → Type) : Type :=
  quot (fun_setoid A B)

  private definition fun_to_extfun (f : Πx : A, B x) : extfun A B :=
  ⟦f⟧

  private definition extfun_app (f : extfun A B) : Πx : A, B x :=
  take x,
  quot.lift_on f
    (λf : Πx : A, B x, f x)
    (λf₁ f₂ H, H x)

  theorem funext {f₁ f₂ : Πx : A, B x} : (∀x, f₁ x = f₂ x) → f₁ = f₂ :=
  assume H, calc
     f₁ = extfun_app ⟦f₁⟧ : rfl
    ... = extfun_app ⟦f₂⟧ : {sound H}
    ... = f₂              : rfl
end

attribute funext [intro!]

open function.equiv_notation

definition subsingleton_pi [instance] {A : Type} {B : A → Type} (H : ∀ a, subsingleton (B a)) :
  subsingleton (Π a, B a) :=
subsingleton.intro (take f₁ f₂,
  have eqv : f₁ ~ f₂, from
    take a, subsingleton.elim (f₁ a) (f₂ a),
  funext eqv)


namespace hidden

inductive nat : Type
| zero : nat
| succ : nat → nat

namespace nat

def add (m n : nat) : nat :=
nat.rec_on n m (fun n add_m_n, succ add_m_n)

instance : has_zero nat := has_zero.mk zero
instance : has_add nat := has_add.mk add

theorem add_zero (m : nat) : m + nat.zero = m := rfl
theorem add_succ (m n : nat) : m + succ n = succ (m + n) := rfl

theorem zero_add (n : nat) : nat.zero + n = n :=
nat.rec_on n rfl (λ n ih, by rw [add_succ, ih])

theorem add_assoc (m n k : nat) : m + n + k = m + (n + k) :=
nat.rec_on k rfl (λ k ih, by simp only [add_succ, ih])

theorem succ_add (m n : nat) : succ m + n = succ (m + n) :=
nat.rec_on n rfl (λ n ih, by simp only [add_succ, ih])

theorem add_comm (m n : nat) : m + n = n + m :=
nat.rec_on n
  (begin
    simp only [zero_add, add_zero]
  end)
  (λ n ih, by simp only [add_succ, ih, succ_add])

-- Exercise

def mul (m n : nat) : nat :=
nat.rec_on n 0 (λ n mul_m_n, mul_m_n + m)

def pred (n : nat) : nat :=
nat.rec_on n 0 (λ n x, n)

def sub (m n : nat) : nat :=
nat.rec_on n m (λ n sub_m_n, pred sub_m_n)

instance : has_mul nat := has_mul.mk mul
instance : has_sub nat := has_sub.mk sub
instance : has_one nat := has_one.mk (succ zero)

def pow (m n : nat) : nat :=
nat.rec_on n (succ zero) (λ n pow_m_n, pow_m_n * m)

theorem mul_zero (n : nat) : n * zero = zero := rfl
theorem mul_succ (n m : nat) : n * (succ m) = (n * m) + n := rfl

theorem zero_mul (n : nat) : zero * n = zero :=
begin
    induction n,
        refl,
    show zero * succ n_a = zero, from
    calc zero * succ n_a
        = (zero * n_a) + zero : by rw mul_succ
    ... = zero * n_a : by rw add_zero
    ... = zero : n_ih
end

theorem one_mul (n : nat) : (succ zero) * n = n :=
begin
    induction n,
        refl,
    rw mul_succ,
    rw n_ih,
    refl
end

theorem mul_one (n : nat) : n * (succ zero) = n :=
begin
    induction n,
        rw zero_mul,
    rw mul_succ,
    rw [mul_zero, zero_add]
end

theorem mul_dist (m n k : nat) : m * n + m * k = m * (n + k) :=
begin
    induction k,
        simp [add_zero, mul_zero],
    simp [mul_succ],
    rw [←add_assoc],
    rw k_ih,
    rw ←mul_succ,
    rw add_succ
end

theorem mul_assoc (m n k : nat) : (m * n) * k = m * (n * k) :=
begin
    induction k,
        simp [mul_zero],
    simp [mul_succ, k_ih],
    simp [mul_dist]
end

theorem succ_mul (n m : nat) : (succ n) * m = (n * m) + m :=
begin
    induction m,
        simp [mul_zero, add_zero],
    simp [mul_succ, m_ih],
    simp [add_succ],
    simp [add_assoc, add_comm m_a n]
end

theorem mul_comm (m n : nat) : m * n = n * m :=
begin
    induction n,
        simp [mul_zero, zero_mul],
    simp [mul_succ],
    rw [n_ih],
    simp [succ_mul]
end

theorem dist_mul (m n k : nat) : m * k + n * k = (m + n) * k :=
begin
    simp [mul_comm],
    rw ←mul_dist,
    simp [mul_comm]
end

instance : has_pow nat nat := has_pow.mk pow

theorem pow_succ (m n : nat) : m ^ (succ n) = m ^ n * m := rfl
theorem pow_zero (m : nat) : m ^ zero = (succ zero) := rfl

theorem pow_mul (m n k : nat) : m ^ n * m ^ k = m ^ (n + k) :=
begin
    induction k,
        simp [add_zero, pow_zero, mul_one],
    rw [pow_succ, ←mul_assoc],
    rw k_ih,
    rw [←pow_succ],
    rw [add_succ]
end

theorem pow_pow (m n k : nat) : (m ^ n) ^ k = m ^ (n * k) :=
begin
    induction k,
        simp [mul_zero, pow_zero],
    simp [pow_succ],
    rw k_ih,
    simp [pow_mul, mul_succ]
end

end nat

end hidden


import Mathlib
import LeanCodePrompts.CheckParse

/-
If every proper closed set of a topological space is compact, then the space itself is compact.
-/
theorem compact_if_all_proper_compact {α : Type _} [TopologicalSpace α] : (∀ (s : Set α), (s ≠ Set.univ) → IsCompact s) → CompactSpace α := sorry

/-
Every prime that is one greater than a multiple of four can be expressed as the sum of two squares.
-/
theorem fermat_two_square : ∀ p : ℕ, Nat.Prime p → (p % 4 = 1) → ∃ a b : ℕ, a ^ 2 + b ^ 2 = p := sorry

/-
For every subset of the Euclidean plane, there is a line segment of unit length whose endpoints are either both inside the subset or both outside it.
-/
-- theorem unit_line_in_or_out_of_euclidean_plane_subset : ∀ (S : Set $ EuclideanSpace ℝ (Finₓ 2)), ∃ (x y : EuclideanSpace ℝ (Finₓ 2)), (∥x - y∥ = (1 : ℝ)) → (x ∈ S ∧ y ∈ S) ∨ (x ∉ S ∧ y ∉ S) := sorry

/-
The product of two numbers, each of which is the sum of four squares, is itself a sum of four squares.
-/
theorem euler_four_square_identity : let is_sum_of_four_squares : ℕ → Prop := λ n : ℕ => ∃ (a b c d : ℕ), n = a^2 + b^2 + c^2 + d^2;
  ∀ (x y : ℕ), is_sum_of_four_squares x → is_sum_of_four_squares y → is_sum_of_four_squares (x * y) := sorry

/-
A ring with all elements idempotent is commutative.
-/
theorem all_idempotent_implies_commutative {R : Type _} [Ring R] : (∀ x : R, HMul.hMul x x = 1) → CommRing R := sorry

/-
There are infinitely many pairs of primes that differ exactly by two.
-/
theorem twin_prime_conjecture : ∀ n : ℕ, ∃ p : ℕ, p > n → Nat.Prime p → Nat.Prime (p + 2) := sorry

/-
If `I` is a collection of intervals of real numbers with lengths that sum to less than one, then the union of the intervals cannot be all of the unit interval.
-/

/-
Every finite division ring is a field.
-/
--ERROR-- theorem fin_div_ring_is_field {R : Type _} [Finite R] [DivisionRing R] : Field R := sorry

/-
The product of two positive numbers is at most the square of their average.
-/
-- theorem am_gm_ineq : ∀ (a b : ℝ), a > 0 → b > 0 → a * b ≤ ((a + b)/(1 + 1))^2 := sorry

/-
In any configuration of points on the plane, not all on a line, there is a line which contains exactly two of the points.
-/
-- theorem sylvester_gallai {P L : Type _} [HasMem P L] [Membership P L] [Configuration.Nondegenerate P L] : ∃ (l : L) (p q : P), p ∈ l → q ∈ l → (∀ r : P, r ∈ l → r = p ∨ r = q) := sorry

/-
If each of two types can be mapped injectively into the other, then there is a bijection between them.
-/
theorem cantor_schroeder_bernstein {α β : Type _} (f : α → β) (g : β → α) : Function.Injective f → Function.Injective g → (∃ h : α → β, Function.Bijective h) := sorry

/-
A finite graph in which every two vertices have precisely one common neighbour contains a vertex that is adjacent to all other vertices.
-/
theorem graph_unique_common_neighbour_implies_universal_adjacent_vertex {V : Type _} [Finite V] (G : SimpleGraph V) : (∀ v w : V, ∃! x : V, G.Adj v x ∧ G.Adj w x) → (∃ c : V, ∀ v : V, G.Adj c v) := sorry

/-
The number of partitions with odd parts is equal to the number of partitions with distinct parts.
-/
theorem partition_odd_distincts : ∀ n : ℕ, Finset.card (Nat.Partition.odds n) = Finset.card (Nat.Partition.distincts n) := sorry

/-
Every non-empty poset in which every chain has an upper bound contains a maximal element.
-/
lemma zorn {α : Type _} [PartialOrder α] [Nonempty α] : (∀ c : Set α, IsChain LE.le c → (∃ b : α, ∀ a ∈ c, a ≤ b)) → (∃ m : α, ∀ a : α, m ≤ a → a = m) := sorry

/-
A group whose automorphism group is cyclic is Abelian.
-/
theorem aut_group_cyclic_implies_abelian {G : Type _} [Group G] : IsCyclic (G → G) → CommGroup G := sorry

/-
A uniformly continuous function of a uniformly continuous function is uniformly continuous.
* This translation may be incorrect
-/
theorem uniformcts_of_uniformcts {α β γ : Type _} [UniformSpace α] [UniformSpace β] [UniformSpace γ] (f : α → β) (g : β → γ) : UniformContinuous f → UniformContinuous g → UniformContinuous (g ∘ f) := sorry

/-
The image of a union of sets is the union of the images.
-/
theorem image_union (f : α → β) (S : Set (Set α)) : (f <$> (⋃₀ S)) = (⋃₀ ((Functor.map f) <$> S)) := sorry

/-
A topological space is normal if and only if any two disjoint closed subsets can be separated by a continuous function.
-/
--ERROR-- lemma urysohn {X : Type _} [TopologicalSpace X] [TopologicalSpace ℝ] : NormalSpace X ↔ ( ∀ {S T : Set X}, IsClosed S → IsClosed T → Disjoint S T → (∃ f : X → ℝ, Continuous f → (∀ x ∈ S, f x = 0) ∧ (∀ x ∈ T, f x = 1)) ) := sorry

/-
The only field automorphism of the reals is the identity.
-/
-- theorem real_field_aut_trivial : ∀ (f : ℝ ≃+* ℝ), (∀ x : ℝ, f x = x) := sorry

/-
If a function from the unit interval to itself has a point of period three, then it has points of all positive periods.
-/
theorem period_three_implies_chaos : ∀ f : Set.IccCat 0 1 → Set.IccCat 0 1, (∃ x : Set.IccCat 0 1, Function.IsPeriodicPt f 3 x) → (∀ n : ℕ, n > 0 → ∃ y : Set.IccCat 0 1, Function.IsPeriodicPt f n y) := sorry

/-
A terminal object in a category is unique up to unique isomorphism.
-/
theorem terminal_unique_iso {C : Type _} [CategoryTheory.Category C] : ∀ T₁ T₂ : C, CategoryTheory.Limits.IsTerminal T₁ → CategoryTheory.Limits.IsTerminal T₂ → (∃ ι : CategoryTheory.Iso T₁ T₂, ∀ ι' : CategoryTheory.Iso T₁ T₂, ι = ι') := sorry

/-
A finitely-presented group containing a torsion element is finite.
-/
theorem torsion_in_fg_group_implies_finite {G : Type _} [Group G] : Group.Fg G → Finite G := sorry

/-
The complement of the union of two sets is the intersection of their complements.
-/
theorem compl_union {α : Type _} (S T : Set α) : (S ∪ T).compl = S.compl ∩ T.compl := sorry

/-
The sum of the cubes of two positive integers is never equal to the cube of a third integer.
-/
theorem flt_3 : ∀ a b c : ℕ, a > 0 → b > 0 → ¬(a^3 + b^3 = c^3) := sorry

/-
If every element of a group `G` has order two, then every pair of elements of `G` commutes.
-/
theorem elems_order_two_implies_commutative {G: Type _}[Group G] : (∀ x y : G, HMul.hMul x x = 1) → (∀ x y : G, Commute x y) := sorry

/-
Every prime number is either `2` or odd.
-/
theorem prime_eq_two_or_odd {n: Nat} : Nat.Prime n → n = 2 ∨ Odd n := sorry

/-
Every odd degree polynomial over `ℝ` has a zero
-/
theorem poly_odd_degree_has_zero (p : Polynomial ℝ) : Odd (WithBot.unbot' 0 p.degree) → ∃ x, p.IsRoot x := sorry

/-
The product of two consequitive natural numbers is even.
-/
theorem product_conseq_odd (n: Nat): Even <| n * (n + 1) := sorry

/-
Every constant function `f x = c` from real numbers to real numbers is differentiable.
-/
-- theorem constant_is_differentiable  {f: ℝ → ℝ}: ∃ c: ℝ, (∀ x : ℝ, f x = c) → Differentiable ℝ f := sorry

/-
Every index 2 subgroup of a group is normal
-/
theorem index_two_subgroup {G : Type _} [Group G] (H : Subgroup G):
      H.index = 2 → Subgroup.Normal H := sorry

/-
Every subgroup of a free group is free
-/
-- theorem subgpFree {G : Type _} [Groupₓ G] :       (K : Subgroup G) → Σ β, FreeGroup β ≃* ↥K := sorry

/-
Every free group is torsion free
-/
theorem free_group_torsion_free {α : Type} :
  Monoid.IsTorsionFree (FreeGroup α) := sorry

/-
Every non-empty subgroup of `ℤ` is isomorphic to `ℤ`
-/
-- theorem integer_subgroups (H : AddSubgroup ℤ) : H.Carrier.Nonempty  →   ↥H ≃+ ℤ := sorry

/- If the coefficients of a polynomial over rationals are integral, every rational root is integral.-/
-- theorem int_poly_rat_zeros_int (p: Polynomial ℚ) :
--   ∀ n: ℕ, IsIntegral ℚ (p.coeff n) →
--   ∀ x: ℚ, p.IsRoot x →  IsIntegral ℚ x := sorry

/-
Every natural number greater than `1` is divisible by a prime number.
-/
theorem has_prime_factor(n: ℕ) :
  n > 1 → ∃ p: ℕ, Nat.Prime p ∧ (∃ d: ℕ, HMul.hMul p d = n) := sorry

/-
Six is not the sum of two prime numbers.
-/
theorem six_not_prime_sum :
  ¬ (∃ n m: Nat, Nat.Prime n ∧ Nat.Prime m ∧ n ≠ m ∧ 6 = n + m) := sorry

/-
A finite torsion-free group is trivial
-/
theorem fin_torsionfree {G: Type _}[Group G][Finite G] :
  Monoid.IsTorsionFree G → IsSubgroup.Trivial G := sorry

/-
Any homomorphism from the additive group of rational numbers to `ℤ` is trivial
-/
-- theorem hom_rat_Z_trivial (f : ℚ → ℤ) :
--   IsAddGroupHom f →  ∀ x: ℚ, f x = 0 := sorry

/-
Every finite division ring is a field.
-/
--ERROR--theorem fin_int_domain_ring_is_field {R : Type _} [Ring R] : IsDomain R → Finite R → Field R := sorry

/-
Every finite topological space is compact
-/
theorem finite_space_compact{X : Type _}[TopologicalSpace X][Finite X] :
  CompactSpace X := sorry

/-
Every surjective homomorphism from a finitely generated free group to itself is injective
-/
theorem freegroup_hopfian {α : Type _} [Finite α]: (f: FreeGroup α → FreeGroup α) → (IsGroupHom f) → f.Surjective → f.Injective := sorry

/-
Every polynomial of positive degree over reals is unbounded.
-/
theorem polys_unbounded(p: Polynomial ℝ) : p.degree > 0 →
    ∀ m: ℝ, ∃ x: ℝ, p.eval x  > m ∨ p.eval x < -m  := sorry

/-
A homomorphism between fields is either injective or trivial.
-/
-- theorem field_hom_inj_or_trivial {F F' : Type _} [Field F] [Field F'] : ∀ ϕ : F →+* F', ϕ.toFun.Injective ∨ (∀ x : F, ϕ x = 0) := sorry

/-
Any homomorphism from a group $G$ to an Abelian group factors through the Abelianisation of $G$.
-/
-- typeclass difficulties
--theorem abelianisation_factor {G : Type _} [Groupₓ G] [NonAssocSemiringₓ G] {A : Type _} [CommGroup A] [NonAssocSemiringₓ A] [NonAssocSemiringₓ (Abelianization G)] : ∀ ϕ : G →+* A, ∃! (ϕ' : Abelianization G →+* A), ϕ = ϕ' ∘ (@Abelianization.of G _) := sorry

/-
Every ascending chain of sub-modules of a Noetherian module eventually stabilises.
-/
-- theorem noetherian_implies_ascending_chain_condition {R M : Type _} [Ringₓ R] [AddCommMonoidₓ M] [Module R M] : IsNoetherian R M → ∀ (f : ℕ →o Submodule R M), ∃ n : ℕ, ∀ m : ℕ, n < m → f n = f m := sorry

/-
Differentiability implies continuity.
-/
-- theorem differentiability_implies_continuity [TopologicalSpace ℝ] : ∀ f : ℝ → ℝ, Differentiable ℝ f → Continuous f := sorry

/-
Left adjoint functors preserve colimits.
-/
-- open CategoryTheory in
-- theorem left_adjoints_preserve_colimits {C D J : Type _} [Category C] [Category D] [Category J] (F : Functor C D) [IsLeftAdjoint F] (K : Functor J C) :
-- ∀ c : Limits.Cocone K, Limits.IsColimit c → ( Limits.IsColimit $ Functor.mapCocone F c) := sorry

/-
The angles of a triangle add up to two right angles.
-/
-- theorem angle_sum_pi {p q r : EuclideanSpace ℝ (Finₓ 2)} : EuclideanGeometry.angle p q r + EuclideanGeometry.angle q r p + EuclideanGeometry.angle r p q = Real.pi := sorry

/-
Every Lebesgue measurable function is equal almost everywhere to a Borel measurable function.
-/

/-
For any prime divisor $p$ of the order of a finite group $G$, there is a subgroup of $G$ whose order is $p$.
-/
-- theorem cauchy {G : Type _} [Groupₓ G] [Fintype G] : ∀ p : ℕ, Prime p → (Fintype.card G % p = 0) → ∃ H : Subgroup G, Monoidₓ.exponent (↥H) = p := sorry

/-
Any locally-small category $C$ can be embedded into the category of contravariant functors from $C$ to $Set$.
-/

/-
Every positive even integer can be written as the sum of two primes.
-/
theorem goldbach : ∀ n : ℕ, n > 0 → Even n → ∃ p q : ℕ, Nat.Prime p → Nat.Prime q → n = p + q := sorry

/-
A complex function that is once differentiable is infinitely differentiable.
-/

/-
The elements of any finite distributive lattice can be represented as finite sets, in such a way that the meet and join lattice operations correspond to unions and intersections of sets.
-/

/-
Every matrix satisfies its own characteristic polynomial.
-/
--ERROR-- theorem cayley_hamilton {R : Type _} [CommRing R] {n : Type _} [DecidableEq n] [Fintype n] (M : Matrix n n R) : Polynomial.aeval M M.charpoly = 0 := sorry

/-
The square root of an irrational number is irrational.
-/
theorem sqrt_of_irrat_irrat (x : ℝ) : Irrational x → Irrational (Real.sqrt x) := sorry

/-
Among all rectangles of a given area $A$, the square of side √A has the smallest perimeter.
-/

/-
If each strongly-connected component of a graph is contracted to a single vertex, the resulting graph is a directed acyclic graph.
-/

/-
If $n$ infinitely long straight lines are lying on a plane such that no two lines are parallel and no three lines intersect at a single point, then the lines divide the plane into $(n^2 + n + 2)/2$ regions.
-/

/-
The tangent bundle of the circle is trivial.
-/

/-
The number of binary strings of length $n$ with no consecutive zeros is equal to the $n+2$th Fibonacci number.
-/

/-
If a sub-sequence of a Cauchy sequence in a metric space converges to a point, then the full sequence also converges to the same point.
-/

/-
Every finite Abelian group is isomorphic to the product of cyclic groups.
-/

/-
If the square of a number is even, the number itself is even.
-/
theorem sq_even_implies_num_even : ∀ n : ℕ, Even (n^2) → Even n := sorry

/-
In a finite commutative ring, all prime ideals are maximal.
-/
theorem finite_ring_prime_implies_maximal {R : Type _} [CommRing R] [Fintype R] : ∀ (Idl : Ideal R), Idl.IsPrime → Idl.IsMaximal := sorry

/-
An integer polynomial with a root in the integers has a root modulo every prime.
-/

/-
The number of Sylow-2 subgroups of a dihedral group is equal to the largest odd number dividing the order of the group.
-/

/-
A topological space $X$ is Hausdorff if and only if the diagonal is a closed set in $X × X$.
-/
--ERROR-- theorem hausdorff_iff_diag_closed {X : Type _} [TopologicalSpace X] : T2Space X ↔ IsClosed (Set.Diagonal X) := sorry

/-
If every point of a subset of a topological space is contained in some open set, the subset itself is open.
-/
theorem open_iff_open_nhd_all_pt {X : Type _} [TopologicalSpace X] (S : Set X) : (∀ x ∈ S, ∃ U : Set X, IsOpen U) → IsOpen S := sorry

/-
The product of a complex number with its conjugate is a real number.
-/
-- theorem complex_conj_prod_real : ∀ z : ℂ, ∃ r : ℝ, z * (starRingEnd ℂ $ z) = (r : ℂ) := sorry

/-
Every non-identity element of a free group is of infinite order.
-/
theorem non_id_implies_infinite_order {G : Type _} [Group G] : FreeGroup G → (∀ g : G, g ≠ 1 → orderOf g = 0) := sorry

/-
Any sub-ring of a field that contains the identity is an integral domain.
-/
-- theorem sub_ring_field_with_id_is_int_domain {F : Type _} [Field F] : ∀ R : Subring F, 1 ∈ R.Carrier → IsDomain ↥R := sorry

/-
An element of a discrete valuation ring is a unit if and only if it has a valuation of zero.
-/
--ERROR--theorem dvr_unit_iff_val_zero {R : Type _} [CommRing R] : IsDomain R → DiscreteValuationRing R → ∀ r : R, IsUnit r → DiscreteValuationRing.addVal R r = 0 := sorry

/-
Every automorphism of a tree fixes a vertex or an edge.
-/

/-
If $e$ is an idempotent in a commutative ring $R$ with identity, the $R$ is isomorphic to the product of the ideals generated by $e$ and $1-e$.
-/

/-
The number of leaves in any tree is at least the maximum degree.
-/

/-
The exponential function is convex.
-/
theorem exp_convex : ConvexOn ℝ Set.univ Real.exp := sorry

/-
For every natural number $k$, there is a natural number $n$ such that any partition of the first $n$ natural numbers into $k$ sets has a set containing numbers $x, y, z$ such that $x + y = z$.
-/

/-
No non-constant polynomial of a complex variable can take imaginary values only.
-/

/-
For any two relatively prime positive integers $a$ and $b$, every sufficiently large natural number $N$ can be written as a linear combination $ax + by$ of $a$ and $b$, where both $x$ and $y$ are natural numbers.
-/
theorem coprime_integer_span_sylvester_coin : ∀ a b : ℕ, a > 0 → b > 0 → Nat.coprime a b → ∃ m : ℕ, ∀ N : ℕ, N > m → ∃ x y : ℕ, N = HMul.hMul a x + HMul.hMul b y := sorry

/-
An integer-valued polynomial need not have all integer coefficients.
-/

/-
For a module $M$, if a sub-module $N$ and the quotient $M/N$ are both finitely generated, then so is $M$.
-/
-- theorem module_fg_if_sub_and_quot_fg {M R : Type _} [Ringₓ R] [AddCommGroupₓ M] [Module R M] : ∀ N : Submodule R M, N.Fg → (N.Quotient.Module.Fg) → M.Fg := sorry

/-
If $ϕ$ is a linear transformation from a finite dimensional vector space to itself, there is an integer $m$ such that the intersection of the image of $ϕ^m$ with the kernel of $ϕ^m$ is trivial.
-/

/-
The eigenvalues of an orthogonal matrix have absolute value $1$.
-/

/-
In a commutative ring with prime characteristic $p$, the $p$th power of the sum of two elements is equal to the sum of the $p$th powers of the elements.
-/
-- theorem frobenius_pow_sum_eq_sum_pow {R : Type _} [CommRingₓ R] : (p : ℕ) → Prime p → CharP R p → ∀ a b : R, (a + b)^p = a^p + b^p := sorry

/-
Every alternating $n$ tensor over a vector space of dimension $n$ is a scalar multiple of the determinant.
-/

/-
An absolutely convergent sequence is convergent.
-/

/-
The combinator (S K K) is equal to the identity combinator.
-/
-- Library/Init/Core.lean not yet ported
-- theorem combinator_I_derivable_from_S_K : Combinator.S Combinator.K Combinator.K = Combinator.I := sorry


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.polynomial.ring_division
import data.mv_polynomial.rename
import ring_theory.polynomial.basic

/-!
## Function extensionality for multivariate polynomials

In this file we show that two multivariate polynomials over an infinite integral domain are equal
if they are equal upon evaluating them on an arbitrary assignment of the variables.

# Main declaration

* `mv_polynomial.funext`: two polynomials `φ ψ : mv_polynomial σ R`
  over an infinite integral domain `R` are equal if `eval x φ = eval x ψ` for all `x : σ → R`.

-/

namespace mv_polynomial

variables {R : Type*} [integral_domain R] [infinite R]

private lemma funext_fin {n : ℕ} {p : mv_polynomial (fin n) R}
  (h : ∀ x : fin n → R, eval x p = 0) : p = 0 :=
begin
  unfreezingI { revert R },
  induction n with n ih,
  { introsI R _ _ p h,
    let e := (rename_equiv R fin_zero_equiv').to_ring_equiv.trans
      (mv_polynomial.pempty_ring_equiv R),
    apply e.injective,
    rw ring_equiv.map_zero,
    convert h fin_zero_elim,
    suffices : (eval₂_hom (ring_hom.id _) pempty.elim) (rename fin_zero_equiv' p) =
      (eval fin_zero_elim : mv_polynomial (fin 0) R →+* R) p,
    { rw [← this],
      simp only [coe_eval₂_hom, pempty_ring_equiv_apply,
        ring_equiv.trans_apply],
      erw alg_equiv.coe_ring_equiv, },
    rw [eval₂_hom_rename],
    exact eval₂_hom_congr rfl (subsingleton.elim _ _) rfl },
  { introsI R _ _ p h,
    let e := (fin_succ_equiv R n).to_ring_equiv,
    apply e.injective,
    simp only [ring_equiv.map_zero],
    apply polynomial.funext,
    intro q,
    rw [polynomial.eval_zero],
    apply ih, swap, { apply_instance },
    intro x,
    dsimp [e],
    rw [fin_succ_equiv_apply],
    calc _ = eval _ p : _
       ... = 0 : h _,
    { intro i, exact fin.cases (eval x q) x i },
    apply induction_on p,
    { intro r,
      simp only [eval_C, polynomial.eval_C, ring_hom.coe_comp, eval₂_hom_C], },
    { intros, simp only [*, ring_hom.map_add, polynomial.eval_add] },
    { intros φ i hφ, simp only [*, eval_X, polynomial.eval_mul, ring_hom.map_mul, eval₂_hom_X'],
      congr' 1,
      by_cases hi : i = 0,
      { subst hi, simp only [polynomial.eval_X, fin.cases_zero] },
      { rw [← fin.succ_pred i hi], simp only [eval_X, polynomial.eval_C, fin.cases_succ] } } }
end

/-- Two multivariate polynomials over an infinite integral domain are equal
if they are equal upon evaluating them on an arbitrary assignment of the variables. -/
lemma funext {σ : Type*} {p q : mv_polynomial σ R}
  (h : ∀ x : σ → R, eval x p = eval x q) : p = q :=
begin
  suffices : ∀ p, (∀ (x : σ → R), eval x p = 0) → p = 0,
  { rw [← sub_eq_zero, this (p - q)], simp only [h, ring_hom.map_sub, forall_const, sub_self] },
  clear h p q,
  intros p h,
  obtain ⟨n, f, hf, p, rfl⟩ := exists_fin_rename p,
  suffices : p = 0, { rw [this, alg_hom.map_zero] },
  apply funext_fin,
  intro x,
  classical,
  convert h (function.extend f x 0),
  simp only [eval, eval₂_hom_rename, function.extend_comp hf]
end

lemma funext_iff {σ : Type*} {p q : mv_polynomial σ R} :
  p = q ↔ (∀ x : σ → R, eval x p = eval x q) :=
⟨by rintro rfl; simp only [forall_const, eq_self_iff_true], funext⟩

end mv_polynomial


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

import ..prooflab
import lectures.lec11_type_classes

/-! # Homework 8: ...
Homework must be done individually.
Replace the placeholders (e.g., `:= sorry`) with your solutions.

You are allowed to use all the tactics we have learned so far.
-/

variables {X Y : Type} {f : X → Y} {p : Y → X}

open PROOFS
open PROOFS.STR
open PROOFS.type_classes

local notation `𝟙` := unit -- type as \b1
local notation `⋆` := unit.star

lemma unit_unique (x : 𝟙) :
   x = ⋆ :=
begin
  exact unit.ext,
end

/-
A map is __constant__ if it maps all points in the domain to the same point in the codomain.
-/
def is_constant (f : X → Y) := ∀ x x' : X, f x = f x'

/-
A map `f : X → Y` is __constant at a point__ `y` of `Y` if `f` maps all points in `X` to `y`.
-/
def is_constant_at (f : X → Y) (y : Y) := ∀ x : X, f x = y

/-! ## Question 1 (20 pts):
Show that if a function is constant at a point then it is constant.
-/
lemma constant_at_point_implies_constant {f : X → Y} :
   (∃ y : Y,  is_constant_at f y)  → is_constant f :=
begin
  sorry,
end

/-! ## Question 2 (20 pts):
Prove that a function which factors through a type which is equivalent to the one-point type is constant.

Feel free to use the lemma `ptwise.left_inv`
-/

#check @ptwise.left_inv

theorem constant_of_factor_unit  {f : X → Y} {Φ : fun_fact f} {α : fun_equiv Φ.node 𝟙} :
   is_constant f :=
begin
   unfold is_constant,
end

/- For every type `X` there is a unique function
from `X` to `𝟙` which takes all points of `X` to `⋆`.
-/
@[simp]
def to_terminal (X : Type) : X → 𝟙 := λ x, ⋆

notation ` ! ` := to_terminal
infix ` ≅ `:35 := fun_equiv

/-! ## Question 3 (20 pts):
Prove that the unique function `X → 𝟙` is surjective iff `X` is pointed by filling the `sorry` placeholder.
-/

def is_surj_of_pointed_type {X : pointed_type} :
  is_surjective (! X.type) :=
begin
   sorry,
end

/-
**Formalize the converse**, that is if `! X : X → 𝟙` is surjective then `X` is pointed (i.e. it admits the structure of a pointed type). Then **prove** the converse statement.
-/

#check classical.some
noncomputable
def is_pointed_of_surj {X : Type} {h : is_surjective (! X)} : pointed_type :=
{
   type := X,
   point := let h' : (∃ x : X, true) := by {unfold is_surjective at h,
      simp at *, assumption} in classical.some h' ,
}

/-! ## Question 4 (20 pts):
Prove that the image of the unique function `X → 𝟙` is equivalent to to `𝟙` if `X` is pointed.

Feel free to use the lemma `ptwise.left_inv`
-/

def truncation_of_pointed_type {X : pointed_type} :
  𝟙  ≅ (fun_image (! X.type)) :=
{
  to_fun := sorry,
  inv_fun := sorry,
  left_inv := by {sorry},
  right_inv := by {sorry},
}

/-
We say a type is __inhabited__ if there is some element in it.
-/

@[simp]
def is_inhabited (X : Type) :=  ∃ x : X, true

/-
The __fibre at a point__ `x : X` of a function  `p : Y → X` is the preimage of `x` under `p`.
-/
@[simp]
def fibre_at (x : X) := { y : Y // p y = x}

#check @fibre_at

local notation ` p⁻¹ ` : 15 := λ x, @fibre_at X Y p x
#check p⁻¹

/-!  ## Question 5 (20 pts):
Let `p : Y → X` be a function. Prove that if all the fibres of `p` are inhabited then `p` is surjective.
-/

def surj_of_pointed_fibres {ptd_fibres : ∀ x : X, is_inhabited (p⁻¹ x) } : is_surjective p :=
begin
   sorry,
end


import order.boolean_algebra
import tactic
open boolean_algebra

variables {α : Type*} [boolean_algebra α]

@[simp] def symm_diff (X Y : α) : α := (X \ Y) ⊔ (Y \ X)
@[simp] lemma sdiff_eq {X Y : α} : X \ Y = X ⊓ Yᶜ := sdiff_eq

-- commutativity/associativity with explicit params for easier rewriting
lemma inf_comm' (X Y : α) : X ⊓ Y = Y ⊓ X := by apply inf_comm
lemma inf_assoc' (X Y Z : α) : X ⊓ Y ⊓ Z = X ⊓ (Y ⊓ Z) := by apply inf_assoc

lemma inf_right_comm (X Y Z : α) : X ⊓ Y ⊓ Z = X ⊓ Z ⊓ Y := by rw [inf_assoc, inf_comm' Y, ←inf_assoc]

local attribute [simp] symm_diff sdiff_eq

lemma symm_diff_comm (X Y : α) : symm_diff X Y = symm_diff Y X :=
  by simp [sup_comm]

-- 'Normal form' for associativity
lemma symm_diff_three (X Y Z : α) :
  symm_diff (symm_diff X Y) Z = X ⊓ Yᶜ ⊓ Zᶜ ⊔ Y ⊓ Xᶜ ⊓ Zᶜ ⊔ (Z ⊓ (Xᶜ ⊓ Yᶜ) ⊔ Z ⊓ (Y ⊓ X)) :=
begin
  simp only [symm_diff, sdiff_eq, inf_sup_right, compl_sup,compl_inf,compl_compl'],
  repeat {rw inf_sup_left},
  repeat {rw inf_sup_right},
  rw [inf_compl_eq_bot, inf_comm' Xᶜ X, inf_compl_eq_bot],
  simp,
end

lemma symm_diff_assoc (X Y Z : α) : symm_diff (symm_diff X Y) Z = symm_diff X (symm_diff Y Z) :=
begin
  rw [symm_diff_three, symm_diff_comm, symm_diff_three],
  rw [inf_comm' Y Xᶜ, inf_comm' Z, inf_comm' Z, inf_comm' Y X, inf_right_comm Y,
      inf_assoc' Z, inf_comm' Y, inf_comm' Z, inf_comm' Yᶜ, inf_comm' Z Y],
    nth_rewrite 1 ←sup_assoc,
    nth_rewrite 4 sup_comm,
    repeat {rw ←sup_assoc},
    repeat {rw ←inf_assoc},
end

lemma inf_distrib_diff (X Y Z : α) : X ⊓ (Y \ Z) = (X ⊓ Y) \ (X ⊓ Z) :=
  by {simp only [sdiff_eq, compl_inf, inf_sup_left], rw [inf_right_comm _ Y, ←inf_assoc], simp,  }

lemma symm_diff_distrib_inf_left (X Y Z : α) : X ⊓ (symm_diff Y Z)  = symm_diff (X ⊓ Y) (X ⊓ Z) :=
  by simp only [symm_diff, inf_sup_left, inf_sup_right, inf_distrib_diff]

lemma symm_diff_distrib_inf_right (X Y Z : α) : (symm_diff X Y) ⊓ Z  = symm_diff (X ⊓ Z) (Y ⊓ Z) :=
  by {rw [inf_comm', inf_comm' X, inf_comm' Y], apply symm_diff_distrib_inf_left}

lemma symm_diff_inter (X Y : α) :
  symm_diff X (X ⊓ Y) = X \ Y :=
  by simp [inf_right_comm X Y, ←inf_assoc' _ Xᶜ, inf_sup_left]

lemma sup_sdiff (X Y : α) :
  X ⊔ (X \ Y) = X :=
  by simp

lemma top_symm_diff (X : α) :
  symm_diff ⊤ X = Xᶜ :=
  by simp

lemma symm_diff_self (X : α) :
  symm_diff X X = ⊥ :=
  by simp

@[simp] lemma bot_diff (X : α) :
  ⊥ \ X = ⊥ :=
  by simp

@[simp] lemma diff_bot (X : α) :
  X \ ⊥ = X :=
  by simp

@[simp] lemma le_iff_inf (X Y : α) :
  X ≤ Y ↔ X ⊓ Y = X :=
  inf_eq_left.symm

-----------------------------------------------

@[simp] instance to_comm_ring : comm_ring α :=
{
  add := λ X Y, symm_diff X Y,
  add_assoc := λ X Y Z, symm_diff_assoc X Y Z,
  zero := ⊥,
  zero_add := λ X, by simp [has_add.add],
  add_zero := λ X, by simp [has_add.add],
  neg := λ X, X,
  add_left_neg := λ X, symm_diff_self X,
  add_comm := λ X Y, symm_diff_comm X Y,
  mul := λ X Y, X ⊓ Y,
  mul_assoc := λ X Y Z, inf_assoc,
  one := ⊤,
  one_mul := λ X, top_inf_eq,
  mul_one := λ X, inf_top_eq,
  left_distrib := λ X Y Z, symm_diff_distrib_inf_left X Y Z,
  right_distrib := λ X Y Z, symm_diff_distrib_inf_right X Y Z,
  mul_comm := λ X Y, inf_comm,
}

lemma one_add (X : α) : 1 + X = Xᶜ :=
  top_symm_diff X

lemma add_one (X : α) : X + 1 = Xᶜ :=
  by {rw add_comm, from top_symm_diff X}

lemma top_to_ring: (⊤ : α) = (1 : α) := rfl

lemma bot_to_ring : (⊥ : α) = (0 : α) := rfl

lemma symm_diff_to_ring {X Y : α} : (X \ Y) ⊔ (Y \ X) = X + Y := rfl

lemma inf_to_ring {X Y : α} : X ⊓ Y = X * Y := rfl

lemma sup_to_ring {X Y : α} : X ⊔ Y = (X + Y) + X*Y :=
begin
  rw [add_assoc],
  nth_rewrite 1 ←one_mul Y,
  rw [←right_distrib, one_add, ←symm_diff_to_ring, ←inf_to_ring],
  rw [sdiff_eq, sdiff_eq, inf_right_comm, compl_inf, inf_sup_left],
  simp only [compl_compl', inf_idem],
  rw [←sdiff_eq, inf_comm' Xᶜ, ←sdiff_eq, sup_sdiff, sup_sdiff_same],
end

lemma compl_to_ring {X : α} :
  Xᶜ = X + 1 :=
  (add_one X).symm

lemma le_to_ring {X Y : α} :
  X ≤ Y ↔ X*Y = X :=
  by {rw ←inf_to_ring, from inf_eq_left.symm}

lemma diff_to_ring {X Y : α} :
  X \ Y = X*(Y + 1) :=
  by rw [add_one, ←inf_to_ring, sdiff_eq]
---------------------

@[simp] lemma mul_idem (X : α) :
  X*X = X :=
  inf_idem

@[simp] lemma two_eq_zero :
  (2 : α) = (0 : α) :=
  let h : (2:α) = (1:α) + (1:α) := rfl in
  by rw [h, one_add, ←top_to_ring, ←bot_to_ring, compl_top]

@[simp] lemma add_self (X : α) :
  X + X = 0 :=
  by {ring SOP, rw two_eq_zero, from mul_zero X}

lemma add_self_left (X Y : α) :
   X + (X + Y) = Y :=
   by rw [←add_assoc, add_self, zero_add]

@[simp] lemma prod_comp_cancel (X : α) : X*(X+1) = 0 :=
  by {ring SOP, simp}

lemma expand_product {X₁ X₂ Y₁ Y₂ S : α} :
  (X₁ * S + X₂ * (S+1)) * (Y₁ * S + Y₂ * (S+1)) = X₁ * Y₁ * S + X₂ * Y₂ * (S+1) :=
  begin
    simp only [←mul_assoc, mul_comm _ S, prod_comp_cancel, mul_idem, left_distrib, right_distrib, mul_one],
    ring SOP,
    simp [mul_comm, two_eq_zero, (by ring : (3:α) = (2:α) + (1:α)), mul_left_comm],
  end


import algebra.group_power data.real.basic

section M1F_Sheet02

def countable_union_from_zero {α : Type} (X : nat → set α ) := { t : α | exists i, t ∈ X i}
def countable_union_from_one {α : Type} (X : nat → set α ) := { t : α | exists i, i > 0 ∧ t ∈ X i}

def Q0201a_sets : ℕ → set ℝ := λ n x, ↑n ≤ x ∧ x < (n+1)

theorem Q0201a : countable_union_from_zero Q0201a_sets = { x | 0 ≤ x} := sorry

def Q0201b_sets : ℕ → set ℝ := λ n x, 1/(↑n) ≤ x ∧ x ≤ 1

theorem Q0201b : countable_union_from_one Q0201b_sets = { x | 0 < x ∧ x ≤ 1} := sorry

def Q0201c_sets : ℕ → set ℝ := λ n x, -↑n < x ∧ x < n

theorem Q0201c : countable_union_from_one Q0201c_sets = { x | true } := sorry

def countable_intersection_from_one {α : Type} (X : nat → set α ) := { t : α | ∀ i, i>0 → t ∈ X i}

theorem Q0201d : countable_intersection_from_one Q0201c_sets = {x | -1<x ∧ x<1} := sorry

end M1F_Sheet02


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.smul_with_zero
import algebra.regular.basic

/-!
# Action of regular elements on a module

We introduce `M`-regular elements, in the context of an `R`-module `M`.  The corresponding
predicate is called `is_smul_regular`.

There are very limited typeclass assumptions on `R` and `M`, but the "mathematical" case of interest
is a commutative ring `R` acting an a module `M`. Since the properties are "multiplicative", there
is no actual requirement of having an addition, but there is a zero in both `R` and `M`.
Smultiplications involving `0` are, of course, all trivial.

The defining property is that an element `a ∈ R` is `M`-regular if the smultiplication map
`M → M`, defined by `m ↦ a • m`, is injective.

This property is the direct generalization to modules of the property `is_left_regular` defined in
`algebra/regular`.  Lemma `is_smul_regular.is_left_regular_iff` shows that indeed the two notions
coincide.
-/

variables {R S : Type*} (M : Type*) {a b : R} {s : S}

/-- An `M`-regular element is an element `c` such that multiplication on the left by `c` is an
injective map `M → M`. -/
def is_smul_regular [has_scalar R M] (c : R) := function.injective ((•) c : M → M)

lemma is_left_regular.is_smul_regular [has_mul R] {c : R} (h : is_left_regular c) :
  is_smul_regular R c := h

/-- Left-regular multiplication on `R` is equivalent to `R`-regularity of `R` itself. -/
lemma is_left_regular_iff [has_mul R] {a : R} :
  is_left_regular a ↔ is_smul_regular R a := iff.rfl

lemma is_right_regular.is_smul_regular [has_mul R] {c : R} (h : is_right_regular c) :
  is_smul_regular R (mul_opposite.op c) := h

/-- Right-regular multiplication on `R` is equivalent to `Rᵐᵒᵖ`-regularity of `R` itself. -/
lemma is_right_regular_iff [has_mul R] {a : R} :
  is_right_regular a ↔ is_smul_regular R (mul_opposite.op a) := iff.rfl

namespace is_smul_regular

variables {M}

section has_scalar

variables [has_scalar R M] [has_scalar R S] [has_scalar S M] [is_scalar_tower R S M]

/-- The product of `M`-regular elements is `M`-regular. -/
lemma smul (ra : is_smul_regular M a) (rs : is_smul_regular M s) :
  is_smul_regular M (a • s) :=
λ a b ab, rs (ra ((smul_assoc _ _ _).symm.trans (ab.trans (smul_assoc _ _ _))))

/-- If an element `b` becomes `M`-regular after multiplying it on the left by an `M`-regular
element, then `b` is `M`-regular. -/
lemma of_smul (a : R) (ab : is_smul_regular M (a • s)) :
  is_smul_regular M s :=
@function.injective.of_comp _ _ _ (λ m : M, a • m) _ (λ c d cd, ab
  (by rwa [smul_assoc, smul_assoc]))

/-- An element is `M`-regular if and only if multiplying it on the left by an `M`-regular element
is `M`-regular. -/
@[simp] lemma smul_iff (b : S) (ha : is_smul_regular M a) :
  is_smul_regular M (a • b) ↔ is_smul_regular M b :=
⟨of_smul _, ha.smul⟩

lemma is_left_regular [has_mul R] {a : R} (h : is_smul_regular R a) :
  is_left_regular a := h

lemma is_right_regular [has_mul R] {a : R} (h : is_smul_regular R (mul_opposite.op a)) :
  is_right_regular a := h

lemma mul [has_mul R] [is_scalar_tower R R M]
  (ra : is_smul_regular M a) (rb : is_smul_regular M b) : is_smul_regular M (a * b) :=
ra.smul rb

lemma of_mul [has_mul R] [is_scalar_tower R R M] (ab : is_smul_regular M (a * b)) :
  is_smul_regular M b :=
by { rw ← smul_eq_mul at ab, exact ab.of_smul _ }

@[simp] lemma mul_iff_right [has_mul R] [is_scalar_tower R R M] (ha : is_smul_regular M a) :
  is_smul_regular M (a * b) ↔ is_smul_regular M b :=
⟨of_mul, ha.mul⟩

/-- Two elements `a` and `b` are `M`-regular if and only if both products `a * b` and `b * a`
are `M`-regular. -/
lemma mul_and_mul_iff [has_mul R] [is_scalar_tower R R M] :
  is_smul_regular M (a * b) ∧ is_smul_regular M (b * a) ↔
  is_smul_regular M a ∧ is_smul_regular M b :=
begin
  refine ⟨_, _⟩,
  { rintros ⟨ab, ba⟩,
    refine ⟨ba.of_mul, ab.of_mul⟩ },
  { rintros ⟨ha, hb⟩,
    exact ⟨ha.mul hb, hb.mul ha⟩ }
end

end has_scalar

section monoid

variables [monoid R] [mul_action R M]

variable (M)

/-- One is `M`-regular always. -/
@[simp] lemma one : is_smul_regular M (1 : R) :=
λ a b ab, by rwa [one_smul, one_smul] at ab

variable {M}

/-- An element of `R` admitting a left inverse is `M`-regular. -/
lemma of_mul_eq_one (h : a * b = 1) : is_smul_regular M b :=
of_mul (by { rw h, exact one M })

/-- Any power of an `M`-regular element is `M`-regular. -/
lemma pow (n : ℕ) (ra : is_smul_regular M a) : is_smul_regular M (a ^ n) :=
begin
  induction n with n hn,
  { simp only [one, pow_zero] },
  { rw pow_succ, exact (ra.smul_iff (a ^ n)).mpr hn }
end

/-- An element `a` is `M`-regular if and only if a positive power of `a` is `M`-regular. -/
lemma pow_iff {n : ℕ} (n0 : 0 < n) :
  is_smul_regular M (a ^ n) ↔ is_smul_regular M a :=
begin
  refine ⟨_, pow n⟩,
  rw [← nat.succ_pred_eq_of_pos n0, pow_succ', ← smul_eq_mul],
  exact of_smul _,
end

end monoid

section monoid_smul

variables [monoid S] [has_scalar R M] [has_scalar R S] [mul_action S M] [is_scalar_tower R S M]

/-- An element of `S` admitting a left inverse in `R` is `M`-regular. -/
lemma of_smul_eq_one (h : a • s = 1) : is_smul_regular M s :=
of_smul a (by { rw h, exact one M })

end monoid_smul

section monoid_with_zero

variables [monoid_with_zero R] [monoid_with_zero S] [has_zero M]
          [mul_action_with_zero R M] [mul_action_with_zero R S] [mul_action_with_zero S M]
          [is_scalar_tower R S M]

/-- The element `0` is `M`-regular if and only if `M` is trivial. -/
protected lemma subsingleton (h : is_smul_regular M (0 : R)) : subsingleton M :=
⟨λ a b, h (by repeat { rw mul_action_with_zero.zero_smul })⟩

/-- The element `0` is `M`-regular if and only if `M` is trivial. -/
lemma zero_iff_subsingleton : is_smul_regular M (0 : R) ↔ subsingleton M :=
⟨λ h, h.subsingleton, λ H a b h, @subsingleton.elim _ H a b⟩

/-- The `0` element is not `M`-regular, on a non-trivial module. -/
lemma not_zero_iff : ¬ is_smul_regular M (0 : R) ↔ nontrivial M :=
begin
  rw [nontrivial_iff, not_iff_comm, zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/-- The element `0` is `M`-regular when `M` is trivial. -/
lemma zero [sM : subsingleton M] : is_smul_regular M (0 : R) :=
zero_iff_subsingleton.mpr sM

/-- The `0` element is not `M`-regular, on a non-trivial module. -/

end monoid_with_zero

section comm_semigroup

variables [comm_semigroup R] [has_scalar R M] [is_scalar_tower R R M]

/-- A product is `M`-regular if and only if the factors are. -/
lemma mul_iff : is_smul_regular M (a * b) ↔
  is_smul_regular M a ∧ is_smul_regular M b :=
begin
  rw ← mul_and_mul_iff,
  exact ⟨λ ab, ⟨ab, by rwa mul_comm⟩, λ rab, rab.1⟩
end

end comm_semigroup

end is_smul_regular

section group

variables {G : Type*} [group G]

/-- An element of a group acting on a Type is regular. This relies on the availability
of the inverse given by groups, since there is no `left_cancel_smul` typeclass. -/
lemma is_smul_regular_of_group [mul_action G R] (g : G) : is_smul_regular R g :=
begin
  intros x y h,
  convert congr_arg ((•) g⁻¹) h using 1;
  simp [←smul_assoc]
end

end group

section units

variables [monoid R] [mul_action R M]

/-- Any element in `Rˣ` is `M`-regular. -/
lemma units.is_smul_regular (a : Rˣ) : is_smul_regular M (a : R) :=
is_smul_regular.of_mul_eq_one a.inv_val

/-- A unit is `M`-regular. -/
lemma is_unit.is_smul_regular (ua : is_unit a) : is_smul_regular M a :=
begin
  rcases ua with ⟨a, rfl⟩,
  exact a.is_smul_regular M
end

end units


import .src_09_or_elimination

namespace mth1001

section applications_to_even_and_odd

/-
In this section, we'll show applications of the law of the excluded middle, contradiction,
and contrapositive.
-/

/-
Here's a very short proof that `0 ≠ 1`, where `≠` is typed as `\ne`. The goal is closed using
the `linarith` tactic, which can solve linear equations and inequalities.

Note the use of `by` instead of the `begin` … `end` block. Also note that we type `(0 : ℤ)`; this
specifies that the theorem refers to the `0` in `ℤ` rather than any other `0`.
-/
theorem zero_ne_one : (0 : ℤ) ≠ 1 := by linarith

/-
We use this to prove that `0` is not odd. Again, you don't need to understand the details
of the proof.
-/
theorem not_odd_zero : ¬(odd (0 : ℤ)) :=
begin
  rintro ⟨k, hk⟩,
  apply zero_ne_one,
  rw [←(int.zero_mod 2), hk, add_comm, int.add_mul_mod_self_left],
  refl,
end

example : ¬(odd (0 : ℤ)) :=
begin
  rintro ⟨k, hk⟩,
  apply zero_ne_one,
  rw [←(int.zero_mod 2), hk, add_comm, int.add_mul_mod_self_left],
  refl,
end

-- Exercise 074:
/-
In a previous section, we proved that every integer `n` is even or odd. However, we haven't
yet discounted the possiblity that there is some integer `n` that is *both* even and odd.

Use `linarith` to solve any equations that arise.
-/
theorem not_exists_even_and_odd : ¬ (∃ m, even m ∧ odd m) :=
begin
  intro h,
  cases h with k hk,
  cases hk with evenk oddk,
  cases evenk with a ha,
  cases oddk with b hb,
  sorry
end

/-
For those wishing to spend the least amount of time typing, note that Lean offers tactics
`rcases` and `rintro`. Their use use best illustrated by the following in which I have
replaced the first five lines of the above example with only two.
-/
example : ¬(∃ m, even m ∧ odd m) :=
begin
  rintro ⟨k, hk⟩,
  rcases hk with ⟨⟨a, ha⟩, ⟨b, hb⟩⟩,
  sorry
end

-- Exercise 075:
/-
As a consequence, we'll show an integer is even if and only if it is not odd.
-/
theorem even_iff_not_odd {a : ℤ} : even a ↔ ¬(odd a) :=
begin
  sorry
end

-- Exercise 076:
-- We need an auxiliary result, that the square of an odd number is odd.
theorem odd_square_of_odd {b : ℤ} : odd b → odd (b*b) :=
begin
  sorry
end

/-
Given a statement `p → q`, its *converse* is the statement `q → p`. Given an integer `a`, we've
proved `even a → even (a*a)`. Our aim is to prove the converse of the statement, namely
`even (a*a) → even a`.
-/

-- Exercise 077:
/-
The following theorem can be proved using only `contrapose`, `contrapose!`, `intro`, `apply`, and
`exact`, together with the results `even_iff_not_odd` and `odd_square_of_odd`.

Recall that if `h : p ↔ q`, then `h.mp : p → q` and `h.mpr : q → p`.
-/
example (b : ℤ) : even (b*b) → even b :=
begin
  contrapose,
  intro hneven,
  have h₁ : odd (b*b) → ¬(even (b*b)),
  { sorry, },
  sorry
end

end applications_to_even_and_odd

/-
SUMMARY:

* Applications of previous work.
* Using `rcases` and `rintro` as recursive versions of `cases` and `intro`.
-/

end mth1001


/-
This is a d∃∀duction file providing exercises for basic set theory. French version.
-/

import data.set
import tactic

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object

-- dEAduction definitions
import set_definitions

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement or an equality
-- (since it will be called with 'rw' or 'symp_rw')

-------------------------
-- dEAduction METADATA --
-------------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists']
-- proofs names ['use_proof_methods', 'new_object', 'apply', 'assumption']
-- magic names ['compute']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'sorry']

/- dEAduction
Title
    Théorie des ensembles
Author
    Frédéric Le Roux
Institution
    Université de France
Description
    Ce cours correspond à un cours standard de théorie "élémentaire" des ensembles.
-/

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
parameters {X Y Z: Type}

open set

------------------
-- COURSE TITLE --
------------------
namespace theorie_des_ensembles
/- dEAduction
PrettyName
    Théorie des ensembles
-/

namespace generalites
/- dEAduction
PrettyName
    Généralités
-/

------------------------
-- COURSE DEFINITIONS --
------------------------
lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
/- dEAduction
ImplicitUse
    True
-/
begin
    exact iff.rfl,
end

lemma definition.egalite_deux_ensembles {A A' : set X} :
(A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles
ImplicitUse
    True
-/
begin
     exact set.ext_iff
end

lemma definition.ensemble_vide
(A: set X) :
(A = ∅) ↔ ∀ x : X, x ∉ A
:=
begin
    exact eq_empty_iff_forall_not_mem,
end

-- lemma definition.ensemble_non_vide
-- (A: set X) :
-- (A ≠ ∅) ↔ ∃ x : X, x ∈ A
-- :=
-- begin
--     todo
-- end

lemma definition.ensemble_extension {X: Type}  {P : X → Prop} {x:X} :
 x ∈ {x | P x} ↔ P x
:=
/- dEAduction
PrettyName
    Ensemble en extension
-/
begin
    refl
end

lemma definition.double_inclusion (A A' : set X) :
A = A' ↔ (A ⊆ A' ∧ A' ⊆ A) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles : double inclusion
ImplicitUse
    True
-/
begin
    exact set.subset.antisymm_iff
end

lemma exercise.inclusion_transitive
(A B C : set X) :
(A ⊆ B ∧ B ⊆ C) → A ⊆ C
:=
/- dEAduction
PrettyName
    Transitivité de l'inclusion
-/
begin
    todo
end

end generalites

---------------
-- SECTION 1 --
---------------
namespace unions_et_intersections
-- variables unions_et_intersections --
variables {A B C : set X}

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.intersection_deux_ensembles {A B : set X} {x : X} :
x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
/- dEAduction
PrettyName
    Intersection de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl
end

lemma definition.intersection_quelconque_ensembles {I : Type} {E : I → set X}  {x : X} :
(x ∈ set.Inter E) ↔ (∀ i:I, x ∈ E i) :=
/- dEAduction
PrettyName
    Intersection d'une famille quelconque d'ensembles
-/
begin
    exact set.mem_Inter
end

lemma definition.union_deux_ensembles  {A : set X} {B : set X} {x : X} :
x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
/- dEAduction
PrettyName
    Union de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl
end

lemma definition.union_quelconque_ensembles {I : Type} {E : I → set X}  {x : X} :
(x ∈ set.Union (λ i, E i)) ↔ (∃ i:I, x ∈ E i) :=
/- dEAduction
PrettyName
    Union d'une famille quelconque d'ensembles
-/
begin
    exact set.mem_Union
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices

lemma exercise.intersection_inclus_ensemble :
A ∩ B ⊆ A
:=
/- dEAduction
PrettyName
    Un ensemble contient son intersection avec un autre
-/
begin
    todo
end

lemma exercise.union_distributive_inter : A ∩ (B ∪ C)  = (A ∩ B) ∪ (A ∩ C) :=
/- dEAduction
PrettyName
    Intersection avec une union
Description
    L'intersection est distributive par rapport à l'union
AvailableLogic
    $ALL
AvailableProofs
    $ALL
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
AvailableTheorems
    double_inclusion
ExpectedVarsNumber
    X=3, A=1, B=1
-/
begin
    rw generalites.definition.egalite_deux_ensembles,
    intro x, split,
    intro H,
    cases H with H1 H2,
    cases H2 with H2a H2b,
    left,
    split,
    assumption, assumption,
    right, split, assumption, assumption, todo
end

-- NB: 'ExpectedVarsNumber' is not implemented yet
-- planned to be used for naming variables

lemma exercise.inter_distributive_union : A ∪ (B ∩ C)  = (A ∪ B) ∩ (A ∪ C) :=
/- dEAduction
PrettyName
    Union avec une intersection
Description
    L'union est distributive par rapport à l'intersection
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    todo
end

end exercices

end unions_et_intersections

---------------
-- SECTION 2 --
---------------
namespace complementaire
/- dEAduction
PrettyName
    Complémentaire
-/

-- variables complementaire --
variables  {A B : set X}
variables {I : index_set} {E F : I → set X}
-- notation `∁`A := set.compl A

-----------------
-- DEFINITIONS --
-----------------
lemma definition.complement {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
/- dEAduction
PrettyName
    Complémentaire
-/
begin
    finish
end

---------------
-- EXERCICES --
---------------
lemma exercise.complement_complement : (set.compl (set.compl A)) = A :=
/- dEAduction
PrettyName
    Complémentaire du complémentaire
Description
    Tout ensemble est égal au complémentaire de son complémentaire
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    todo
end

lemma exercise.complement_union_deux :
set.compl (A ∪ B) = (set.compl A) ∩ (set.compl B) :=
/- dEAduction
PrettyName
    Complémentaire d'union I
Description
    Le complémentaire de l'union de deux ensembles égale l'intersection des complémentaires
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    todo
end

lemma exercise.complement_union_quelconque :
set.compl (set.Union (λ i, E i)) = set.Inter (λ i, set.compl (E i)) :=
/- dEAduction
PrettyName
    Complémentaire d'union II
Description
    Le complémentaire d'une réunion quelconque égale l'intersection des complémentaires
-/
begin
    -- hypo_analysis,
end

lemma exercise.inclusion_complement_I :
A ⊆ B → set.compl B ⊆ set.compl A
:=
/- dEAduction
PrettyName
    Le passage au complémentaire renverse les inclusions, implication
Description
    Si A est inclus dans B, alors le complémentaire de A contient le complémentaire de B
-/
begin
    todo
end

lemma exercise.inclusion_complement_II :
A ⊆ B ↔ set.compl B ⊆ set.compl A
:=
/- dEAduction
PrettyName
    Le passage au complémentaire renverse les inclusions, équivalence
Description
    Si A est inclus dans B, alors le complémentaire de A contient le complémentaire de B
-/
begin
    todo
end

/- Autres : différence-/

end complementaire

-- Ajouter :  4. relations ?

namespace produits_cartesiens
/- dEAduction
PrettyName
    Produits cartésiens
-/

-- Peut-on en faire une définition ?
lemma theorem.type_produit :
∀ z:X × Y, ∃ x:X, ∃ y:Y, z = (x,y)
:=
/- dEAduction
PrettyName
    Element d'un produit cartésien de deux ensembles
-/
begin
    todo
end

lemma definition.produit_de_parties {A : set X} {B : set Y}
{x:X} {y:Y} :
(x,y) ∈ set.prod A B ↔ x ∈ A ∧ y ∈ B
:=
/- dEAduction
PrettyName
    Produit cartésien de deux parties
-/
begin
    todo
end

lemma exercise.produit_avec_intersection
(A : set X) (B C : set Y) :
set.prod A (B ∩ C) = (set.prod A B) ∩ (set.prod A C)
:=
begin
    todo
end

end produits_cartesiens
---------------
-- SECTION 3 --
---------------
namespace applications_I
/- dEAduction
PrettyName
    Applications et opérations ensemblistes
-/

-- variables applications --

variables  {A A': set X}
variables {f: X → Y} {B B': set Y}
-- variables {I : Type} {E : I → set X} {F : I → set Y}
variables {I : index_set} {E : set_family I X} {F : set_family I Y}
variables (g : Y → Z) (h : X → Z)

-- a-t-on besoin de ceci ?
-- lemma theorem.egalite_fonctions : f = f' ↔ ∀ x : X, f(x) = f'(x) :=
--  function.funext_iff

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.image_directe (y : Y) : y ∈ f '' A ↔ ∃ x : X, x ∈ A ∧  f x = y :=
begin
    todo
end

lemma definition.image_reciproque (x:X) : x ∈ f  ⁻¹' B ↔ f(x) ∈ B :=
begin
    todo
end

lemma definition.composition {x:X}:
composition g f x = g (f x)
:=
begin
    todo,
end

lemma definition.egalite_fonctions (f' : X → Y) :
f = f' ↔ ∀ x, f x = f' x :=
/- dEAduction
PrettyName
    Egalité de deux fonctions
-/
begin
    exact function.funext_iff,
end

lemma definition.Identite (f₀: X → X) :
f₀ = Identite ↔ ∀ x, f₀ x = x :=
/- dEAduction
PrettyName
    Application identité
-/
begin
    apply definition.egalite_fonctions,
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/
open applications_I.definitions

lemma exercise.image_de_reciproque : f '' (f ⁻¹' B)  ⊆ B :=
/- dEAduction
PrettyName
    Image de l'image réciproque
-/
begin
    todo
end

lemma exercise.reciproque_de_image : A ⊆ f ⁻¹' (f '' A) :=
/- dEAduction
PrettyName
    Image réciproque de l'image
-/
begin
    todo
end

lemma exercise.image_reciproque_inter :  f ⁻¹'  (B∩B') = f ⁻¹'  (B) ∩ f ⁻¹'  (B') :=
/- dEAduction
PrettyName
    Image réciproque d'une intersection de deux ensembles
-/
begin
    todo
end

lemma  exercise.image_reciproque_union  : f ⁻¹' (B ∪ B') = f ⁻¹' B ∪ f ⁻¹' B'
:=
/- dEAduction
PrettyName
    Image réciproque d'une union de deux ensembles
-/
begin
    todo
end

-- set_option pp.width 100
lemma exercise.image_reciproque_inter_quelconque :
(f ⁻¹'  (set.Inter (F))) = set.Inter (λ i, f ⁻¹' (F i): set_family I X)
-- (f ⁻¹'  (set.Inter (λ i, F i))) = set.Inter (λ i, f ⁻¹' (F i))
:=
/- dEAduction
PrettyName
    Image réciproque d'une intersection quelconque
-/
begin
    todo
end

lemma exercise.image_reciproque_union_quelconque :
(f ⁻¹'  (set.Union (λ i, F i))) = set.Union (λ i, f ⁻¹' (F i))
:=
/- dEAduction
PrettyName
    Image réciproque d'une union quelconque
-/
begin
    todo
end

lemma exercise.image_inter_inclus_inter_images :
f '' (A∩A') ⊆ f '' (A) ∩ f '' (A')
:=
/- dEAduction
PrettyName
    Image d'une intersection
-/
begin
    todo
end

lemma exercise.reciproque_complementaire_I :
f ⁻¹' (set.compl B) ⊆ set.compl (f ⁻¹' B)
:=
/- dEAduction
PrettyName
    Image réciproque du complémentaire, inclusion
-/
begin
    todo
end

lemma exercise.reciproque_complementaire_II :
f ⁻¹' (set.compl B) = set.compl (f ⁻¹' B)
:=
/- dEAduction
PrettyName
    Image réciproque du complémentaire, égalité
-/
begin
    todo
end

lemma exercices.image_reciproque.composition
(C: set Z)
:
((composition g f) )⁻¹' C = f ⁻¹' (g ⁻¹' C)
:=
begin
    todo
end

end exercices
end applications_I

----------------
-- SUBSECTION --
----------------
namespace applications_II
/- dEAduction
PrettyName
    Injections et surjections
-/

-- variables injections_surjections --
variables (f: X → Y) (g : Y → Z) (h : X → Z)

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.injectivite :
injective f ↔ ∀ x y : X, (f x = f y → x = y)
:=
/- dEAduction
PrettyName
    Application injective
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.surjectivite :
surjective f ↔ ∀ y : Y, ∃ x : X, y = f x
:=
/- dEAduction
PrettyName
    Application surjective
ImplicitUse
    True
-/
begin
    refl,
end

-- A bouger, mais à enlever de tous les exos où ça ne sert pas !
lemma definition.existe_un_unique
(P : X → Prop) :
(∃! (λx,  P x)) ↔  (∃ x : X, (P x ∧ (∀ x' : X, P x' → x' = x)))
:=
/- dEAduction
PrettyName
    ∃! : existence et unicité
-/
begin
    todo
end

lemma definition.bijectivite_1 :
bijective f ↔ (injective f ∧ surjective f)
:=
/- dEAduction
PrettyName
    Application bijective (première définition)
-/
begin
    todo
end

lemma definition.bijectivite_2 :
bijective f ↔ ∀ y : Y, exists_unique (λ x, y = f x)
:=
/- dEAduction
PrettyName
    Application bijective (seconde définition)
-/
begin
    refl,
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

open applications_II.definitions

lemma exercise.composition_injections
(H1 : injective f) (H2 : injective g)
:
injective (composition g f)
:=
/- dEAduction
PrettyName
    Composition d'injections
-/
begin
    todo
end

lemma exercise.composition_surjections
(H1 : surjective f) (H2 : surjective g) :
surjective (composition g f)
:=
/- dEAduction
PrettyName
    Composition de surjections
-/
begin
    todo
end

lemma exercise.injective_si_compo_injective
(H1 : injective (composition g f)) :
injective f
:=
/- dEAduction
PrettyName
    Injective si composition injective
-/
begin
    todo
end

lemma exercise.surjective_si_compo_surjective
(H1 : surjective (composition g f)) :
surjective g
:=
/- dEAduction
PrettyName
    Surjective si composition surjective
-/
begin
    todo
end

lemma exercise.injective_ssi_inverse_gauche : (injective f) ↔
∃ F: Y → X, (composition F f) = Identite :=
/- dEAduction
PrettyName
    (x) Injectivité et inverse à gauche
-/
begin
    todo
end

lemma exercise.surjective_ssi_inverse_droite : (surjective f) ↔
∃ F: Y → X, (composition f F) = Identite :=
/- dEAduction
PrettyName
    (*) Surjectivité et inverse à droite
-/
begin
    todo
end

lemma exercise.bijective_ssi_inverse :
(bijective f) ↔ ∃ g : Y → X,
composition g f = Identite ∧ composition f g  = Identite
:=
/- dEAduction
PrettyName
    (**) Bijectivité et existence d'une application réciproque
-/
begin
    todo
end

lemma exercise.unicite_inverse :
(bijective f) → exists_unique (λ g : Y → X,
composition g f = Identite)
:=
/- dEAduction
PrettyName
    (+) Unicité de la réciproque d'une application bijective
-/
begin
    todo
end

lemma exercise.Cantor (f : X → set X):
 ¬ surjective f
:=
/- dEAduction
PrettyName
    (+) Théorème de Cantor : il n'y a pas de surjection d'un ensemble vers l'ensemble de ses parties
-/
begin
    by_contradiction H14,
    let A := {x | x ∉ f x}, have H15 : A = {x | x ∉ f x}, refl,
    rw theorie_des_ensembles.applications_II.definitions.definition.surjectivite at H14,
    have H16 := H14 A,
    cases H16 with x H17,
    cases (classical.em (x dans A)) with H22 H23,
    {
        have H22b: x ∉ A,
        rw H15 at H22,
        rw generalites.definition.ensemble_extension at H22,
        rw H17, assumption,
        contradiction,
    },
    {
        have H22b: x ∈ A,
        rw H15 at H23,
        -- simp only[ensemble_extension] at H23,
        rw generalites.definition.ensemble_extension at H23,
        push_neg at H23,
        rw H17, assumption,
        contradiction
    }
end

end exercices

end applications_II

-----------------------------------
-----------------------------------
namespace exercices_supplementaires

-- relations : rel d'eq implique classes égales ou disjointes
-- les images réciproques des singletons forment une partition
-- bijective ssi inversible à g et d et inverses coincident

lemma exercise.exercice_ensembles_1
(A B : set X) :
A ⊆ B ↔ A ∩ B = A
:=
/- dEAduction
PrettyName
    Caractérisation de l'inclusion par l'intersection
-/
begin
    todo
end

lemma exercise.complement_intersection_2
(A B : set X):
set.compl (A ∩  B) = (set.compl A) ∪ (set.compl B)
:=
/- dEAduction
PrettyName
    Complémentaire d'une intersection
-/
begin
    todo
end

lemma exercise.exercice_ensembles_3
(A B : set X) :
A ∩ B = A ∪ B → A = B
:=
/- dEAduction
PrettyName
    Quand l'intersection égale l'union
-/
begin
    todo
end

lemma exercise.exercice_ensembles_4a
(A B C : set X) :
A ∩ B = A ∩ C ∧ (set.compl A) ∩ B = (set.compl A) ∩ C → B ⊆ C
:=
/- dEAduction
PrettyName
    Caractérisation par intersection avec A et son complémentaire, I
-/
begin
    todo
end

lemma exercise.exercice_ensembles_4b
(A B C : set X) :
A ∩ B = A ∩ C ∧ (set.compl A) ∩ B = (set.compl A) ∩ C → B = C
:=
/- dEAduction
PrettyName
    Caractérisaton par intersection avec A et son complémentaire, II
-/
begin
    todo
end

lemma exercise.exercice_ensembles_5
(A B C : set X) :
A ∩ B = A ∩ C ∧ A ∪ B = A ∪ C → B = C
:=
/- dEAduction
PrettyName
    Même union et même intersection
-/
begin
    todo
end

--def diff {X : Type} (A B : set X) := {x ∈ A | ¬ x ∈ B}
--notation A `\\` B := diff A B

-- def symmetric_difference {X : Type} (A B : set X) := (A ∪ B) \ (A ∩ B)
-- notation A `Δ` B := symmetric_difference A B

namespace difference_et_difference_symetrique
/- dEAduction
PrettyName
    Différence et différence symétrique
-/

namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.difference
(A B : set X) (x : X) :
x ∈ (A \ B) ↔ x ∈ A ∧ x ∉ B
:=
/- dEAduction
PrettyName
    Différence de deux ensembles
-/
begin
    refl,
end

lemma definition.difference_symetrique
(A B : set X) :
(A Δ B) =  (A ∪ B) \ (A ∩ B)
:=
/- dEAduction
PrettyName
    Différence symétrique de deux ensembles
-/
begin
    refl,
end

end definitions

namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

lemma exercise.difference_symetrique_1
(A B : set X) :
(A Δ B) = (A \ B) ∪ (B \ A)
:=
/- dEAduction
PrettyName
    Différence symétrique I
-/
begin
    todo
end

lemma exercise.difference_symetrique_2
(A B : set X) :
(A Δ B) = (B Δ A)
:=
/- dEAduction
PrettyName
    (*) Différence symétrique II
-/
begin
    todo
end

lemma exercise.difference_symetrique_3
(A B C : set X) :
((A Δ B) Δ C) = (A Δ (B Δ C))
:=
/- dEAduction
PrettyName
    (**) Différence symétrique III
-/
begin
    todo
end

lemma exercise.difference_symetrique_4 :
∃! (λE : set X, ∀ A : set X, (A Δ E) = A) :=
/- dEAduction
PrettyName
    (+) Différence symétrique VI
-/
begin
    todo
end

lemma exercise.difference_symetrique_5 (A : set X) :
exists_unique (λA' : set X, (A Δ A') = set.univ)
:=
/- dEAduction
PrettyName
    (+) Différence symétrique V
-/
begin
    todo
end

lemma exercise.difference_symetrique_6
(A B : set X) :
(A Δ B) = ∅ ↔ A = B
:=
/- dEAduction
PrettyName
    (+) Différence symétrique VI
-/
begin
    todo
end

end exercices

end difference_et_difference_symetrique

-- applications
variable (f: X → Y)

namespace applications

lemma exercise.exercice_applications_1
(A B : set X) :
A ⊆ B → f '' A ⊆ f '' B
:=
/- dEAduction
PrettyName
    Image directe et inclusion
-/
begin
    todo
end

lemma exercise.exercice_applications_2
(A B : set X) :
f '' (A ∪ B)  = f '' A ∪ f '' B
:=
/- dEAduction
PrettyName
    Image d'une union
-/
begin
    todo
end

open applications_II.definitions
lemma exercise.exercice_factorisation_I
(g : Y → Z) (h: X → Z) :
(∃ f: X → Y, h = (composition g f)) ↔ h '' set.univ ⊆ g '' set.univ
:=
/- dEAduction
PrettyName
    (+) Factorisation I
-/
begin
    todo
end

lemma exercise.exercice_factorisation_II
(f : X → Y) (h: X → Z) :
(∃ g: Y → Z, h = (composition g f)) ↔ (∀ x y, (f x = f y → h x = h y))
:=
/- dEAduction
PrettyName
    (+) Factorisation II
-/
begin
    todo
end

-- TODO: ajouter exoset ficall.pdf exos (140 bijections) 141 142 146

lemma exercise.injectivite_surjecivite_1 (f: X → Y) (g: Y → Z)
(H1 : injective (composition g f)) (H2 : surjective f)
:
injective g
:=
/- dEAduction
PrettyName
    Injectivité et surjectivité I
-/
begin
    todo
end

lemma exercise.injectivite_surjecivite_2 (f: X → Y) (g: Y → Z)
(H1 : surjective (composition g f)) (H2 : injective g)
:
surjective f
:=
/- dEAduction
PrettyName
    Injectivité et surjectivité II
-/
begin
    todo
end

lemma exercise.injectivite_categorielle
(f: Y → Z):
(injective f) → (∀X: Type, ∀ g h : X → Y, (composition f g) = (composition f h) → g = h)
:=
/- dEAduction
PrettyName
    Injectivité catégorielle
-/
begin
    todo
end

lemma exercise.surjectivite_categorielle
(f: X → Y):
(surjective f) →  (∀Z: Type, ∀ g h : Y → Z, (composition g f ) = (composition h f ) → g = h)
:=
/- dEAduction
PrettyName
    Surjectivité catégorielle
-/
begin
    todo
end

end applications

end exercices_supplementaires

end theorie_des_ensembles

end course


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

Defining a group given by generators and relations
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.free_group
import Mathlib.group_theory.quotient_group
import Mathlib.PostPort

namespace Mathlib

/-- Given a set of relations, rels, over a type α, presented_group constructs the group with
generators α and relations rels as a quotient of free_group α.-/
def presented_group {α : Type} (rels : set (free_group α)) :=
  quotient_group.quotient (subgroup.normal_closure rels)

namespace presented_group

protected instance group {α : Type} (rels : set (free_group α)) : group (presented_group rels) :=
  quotient_group.quotient.group (subgroup.normal_closure rels)

/-- `of x` is the canonical map from α to a presented group with generators α. The term x is
mapped to the equivalence class of the image of x in free_group α. -/
def of {α : Type} {rels : set (free_group α)} (x : α) : presented_group rels :=
  quotient_group.mk (free_group.of x)

/-
Presented groups satisfy a universal property. If β is a group and f : α → β is a map such that the
images of f satisfy all the given relations, then f extends uniquely to a group homomorphism from
presented_group rels to β
-/

theorem closure_rels_subset_ker {α : Type} {β : Type} [group β] {f : α → β} {rels : set (free_group α)} (h : ∀ (r : free_group α), r ∈ rels → coe_fn (free_group.to_group f) r = 1) : subgroup.normal_closure rels ≤ monoid_hom.ker (free_group.to_group f) :=
  subgroup.normal_closure_le_normal
    fun (x : free_group α) (w : x ∈ rels) => iff.mpr (monoid_hom.mem_ker (free_group.to_group f)) (h x w)

theorem to_group_eq_one_of_mem_closure {α : Type} {β : Type} [group β] {f : α → β} {rels : set (free_group α)} (h : ∀ (r : free_group α), r ∈ rels → coe_fn (free_group.to_group f) r = 1) (x : free_group α) (H : x ∈ subgroup.normal_closure rels) : coe_fn (free_group.to_group f) x = 1 :=
  iff.mp (monoid_hom.mem_ker (free_group.to_group f)) (closure_rels_subset_ker h w)

/-- The extension of a map f : α → β that satisfies the given relations to a group homomorphism
from presented_group rels → β. -/
def to_group {α : Type} {β : Type} [group β] {f : α → β} {rels : set (free_group α)} (h : ∀ (r : free_group α), r ∈ rels → coe_fn (free_group.to_group f) r = 1) : presented_group rels →* β :=
  quotient_group.lift (subgroup.normal_closure rels) (monoid_hom.of ⇑(free_group.to_group f))
    (to_group_eq_one_of_mem_closure h)

@[simp] theorem to_group.of {α : Type} {β : Type} [group β] {f : α → β} {rels : set (free_group α)} (h : ∀ (r : free_group α), r ∈ rels → coe_fn (free_group.to_group f) r = 1) {x : α} : coe_fn (to_group h) (of x) = f x :=
  free_group.to_group.of

theorem to_group.unique {α : Type} {β : Type} [group β] {f : α → β} {rels : set (free_group α)} (h : ∀ (r : free_group α), r ∈ rels → coe_fn (free_group.to_group f) r = 1) (g : presented_group rels →* β) (hg : ∀ (x : α), coe_fn g (of x) = f x) {x : presented_group rels} : coe_fn g x = coe_fn (to_group h) x :=
  quotient_group.induction_on x
    fun (_x : free_group α) =>
      free_group.to_group.unique (monoid_hom.comp g (quotient_group.mk' (subgroup.normal_closure rels))) hg

protected instance inhabited {α : Type} (rels : set (free_group α)) : Inhabited (presented_group rels) :=
  { default := 1 }